#
# COPYLEFT NOTICE:
# Copyleft (c) 1991 by John R. Stembridge.
#  
# Permission is granted to anyone to to use, modify, or redistribute this
# software freely, subject to the following restrictions:
# 
# 1. The author accepts no responsibility for any consequences of this
# software and makes no guarantee that the software is free of defects.
# 2. The origin of this software must not be misrepresented, either by
# explicit claim or by omission.
# 3. This notice and the copyleft must be included in all copies or
# modified versions of this software.
# 4. This software may not be included or redistributed as part of any
# package to be sold for profit unless the author has given explicit written
# permission to do so.
# 
# John Stembridge
# Department of Mathematics
# University of Michigan
# Ann Arbor, MI 48109-1003
# Internet:  jrs@math.lsa.umich.edu
#
###############################################################################
#
#  J(P,X) returns the poset of order ideals of the poset P with vertex set X.
#    If X=an integer n, then vertex set={1,...,n}. The poset returned will be
#    naturally labeled. If the second argument can be omitted if there are
#    no isolated points.
#
`posets/J`:=proc() local P,n,i,j,X,anti,DD,d,res,k;
  if nargs=1 then
    X:=map(op,args[1])
  elif type(args[2],'integer') then
    X:={$1..args[2]} else X:=args[2]
  fi;
  P:=posets['closure'](args[1]);
  anti:=table(posets['antichains'](P,X,0));
  n:=nops([indices(anti)]); res:=NULL;
  for i to n do;
    anti[i]:= anti[i] union
      map(proc(x,y) if member(x[2],y) then x[1] fi end,P,anti[i]);
    for j to i-1 do;
      d:=nops(anti[i])-nops(anti[j]);
      if d=1 then
        DD:=anti[i] minus anti[j];
        if nops(DD)=1 then res:=res,[j,i] fi;
      elif d=-1 then
        DD:=anti[j] minus anti[i];
        if nops(DD)=1 then res:=res,[i,j] fi;
      fi;
    od;
  od;
  X:=map(op,posets['filter']({res}));
  subs({seq(X[k]=k,k=1..n)},{res});
end:

#
# Lattices(n) returns a list of all nonisomorphic lattices on n vertices.
#  NOTE: The lattices in this list are represented by their COVERING relations;
#  i.e., a set of ordered pairs [i,j] with no instance of [i,k] and [k,j] for
#  any k. The posets are naturally labeled; i.e., every relation [i,j]
#  satisfies i<j. To obtain the actual transitive relation, use closure().
#
`posets/Lattices`:=proc(n) option remember; 
  if not type(n,posint) then ERROR(`positive integer expected`,n)
  elif n>4 then `posets/gen_Lattices`(n)
  elif n=4 then [posets['chain'](4),{[1,2]} &* {[1,2]}]
  else [posets['chain'](n)]
  fi;
end:
#
# gen_Lattices(n)=create a list of naturally labeled, nonisomorphic lattices
#   on the vertex set {1..n}.
#
# Remark: It is actually faster (for n up to 9) to create this list by
#  taking the list of Posets(n-2), adding a minimal and maximal element to
#  each member of the list, and then using the lattice() procedure in the
#  examples directory to remove the posets that are not lattices.
#
`posets/gen_Lattices`:=proc(n)
local res,P,down,e,A,new,legal,j,i,lbs,m;
  res:=[];
  for P in posets[Lattices](n-1) do;
    down:=table([seq({i},i=1..n-2)]);
    for e in posets[closure](P,n-1) do down[e[2]]:={op(down[e[2]]),e[1]} od;
    for A in posets[antichains](P,n-1) minus {{},{n-1}} do;
      new:=subs(n-1=n,P) union map(<[x,y]|x,y>,A,n-1) union {[n-1,n]};
      down[n-1]:=`union`(seq(down[A[i]],i=1..nops(A)),{n-1});
      legal:=true;
      for j to n-2 while legal do;
        lbs:=down[n-1] intersect down[j]; m:=max(op(lbs));
        if lbs minus down[m] <> {} then legal:=false fi;
      od;
      if legal then res:=[op(res),posets[covers](new)] fi;
    od;
  od;
  posets[rm_isom](res);
end:

#
# Posets(n) returns a list of all nonisomorphic posets on n vertices.
#  NOTE: The posets in this list are represented by their COVERING relations;
#  i.e., a set of ordered pairs [i,j] with no instance of [i,k] and [k,j] for
#  any k. The posets are naturally labeled; i.e., every relation [i,j]
#  satisfies i<j. To obtain the actual transitive relation, use closure(.).
#
`posets/Posets`:=proc(n) local res,P,A,t; option remember;
  if not type(n,posint) then ERROR(`positive integer expected`,n) fi;
  if n = 1 then []
  elif n = 2 then [{},{[1,2]}]
  else
    res:=NULL;
    for P in posets[Posets](n-1) do;
      for A in posets[antichains](P,n-1) do;
        res:=res, P union {seq([t,n],t=A)}
      od;
    od;
    posets[rm_isom]([res]);
  fi
end:

#
#  W(P,X,z) returns the W polynomial of the poset P with vertex set X
#    in the variable z. If X=an integer n, then vertex set={1,...,n}.
#    The labeling of P is ignored. 
#    If P has no isolated points, W(P,z) will also work.
#  W(P,X,z,bad), where  bad  is a subset of cover relations of P,  will return
#    the W polynomial for a labeling in which descents occur at these places.
#  W(P,n,z,bad), W(P,z,bad) will work similarly.
#
`posets/W`:=proc()
  local P,X,anti,n,poly,old,new,i,j,k,l,d,bad,one,Zero,down,f;
  if type(args[nargs],'set') then
    bad:=args[nargs]; f:=nargs-1
  else
    bad:={}; f:=nargs
  fi;
  if f=2 then X:=map(op,args[1])
    elif type(args[2],'integer') then X:={$1..args[2]}
    else X:=args[2]
  fi;
  P:=posets['closure'](args[1]);
  anti:=table(posets['antichains'](P,X,0));
  n:=nops([indices(anti)]); down:=table([{}$n]);
  for i to n do;
    anti[i]:= anti[i] union
      map(proc(x,y) if member(x[2],y) then x[1] fi end,P,anti[i]);
    if "={} then Zero:=i elif nops(")=nops(X) then one:=i fi;
    for j to i-1 do;
      d:=nops(anti[i])-nops(anti[j]);
      if d>0 then
        if `posets/W/safe`(anti[i] minus anti[j],d,bad) then
          down[i]:={op(down[i]),j} fi;
      elif d<0 then
        if `posets/W/safe`(anti[j] minus anti[i],-d,bad) then
          down[j]:={op(down[j]),i} fi;
      fi;
    od;
  od;
  old:=subsop(Zero=1,[0$n]); poly:=0;
  for i to nops(X) do;
    new:=[seq(sum('old[down[l][k]]',k=1..nops(down[l])),l=1..n)];
    poly:=poly+new[one]*args[f]^i*(1-args[f])^(nops(X)-i); old:=new;
  od;
  expand(poly);
end:
#
`posets/W/safe`:=proc(DD,d,bad) local e;
  if nops(DD)<>d then RETURN(false) fi;
  if d=1 then RETURN(true) fi;
  for e in bad do;
    if member(e[1],DD) and member(e[2],DD) then RETURN(false) fi;
  od;
  true
end:

#
# antichains(P,X) returns a list of all antichains in the poset P with
#   vertex set X. (if X = an integer n, then vertex set={1...n}).
#   If the second argument is omitted, then no isolated points are assumed.
# antichains(P,X,b), where b is any third argument (e.g., 'true'), will do
#   the same, but will assume that P has already been transitively closed.
# antichains(P,n,b) works similarly.
#
`posets/antichains`:=proc() local P,X;
  if nargs=1 then
    X:=map(op,args[1])
  elif type(args[2],'integer') then
    X:={$1..args[2]} else X:=args[2]
  fi;
  if nargs<3 then P:=posets['closure'](args[1]) else P:=args[1] fi;
  `posets/antichains/sub`(P,X);
end:
#
`posets/antichains/sub`:=proc(P,X) local P1,P2,X1,e,x1;
  if nops(X)<2 then RETURN({{},X}) fi;
  X1:=X minus {X[1]}; P2:=P; P1:=NULL;
  for e in P do;
    if e[1]=X[1] then
      P2:=P2 minus {e}; X1:=X1 minus {e[2]};
    elif e[2]=X[1] then
      P2:=P2 minus {e}; X1:=X1 minus {e[1]};
    fi;
  od;
  for e in P2 do
    if member(e[1],X1) and member(e[2],X1) then P1:=P1,e fi;
  od;
  #map(<x union {y}|x,y>,`posets/antichains/sub`({P1},X1),X[1])
  x1 := {X[1]};
  {seq(e union x1, e=`posets/antichains/sub`({P1},X1))}
    union `posets/antichains/sub`(P2,X minus {X[1]});
end:

#
# chain(n) returns (the cover-relation for) an n-element chain.
#
`posets/chain`:=proc(n) local i; {seq([i,i+1],i=1..n-1)} end:

#
#  char_poly(P,z) returns the characteristic polynomial of the poset P.
#    P must have a unique minimal element. 
#    In particular, it cannot have any isolated points.
#  char_poly(P,X,z) and char_poly(P,n,z) can also be used for consistency.
#
`posets/char_poly`:=proc() local P,X,n,z,i,ord,filterP,ht,v,x0;
  if nargs<2 then ERROR(`Wrong number of arguments`) fi;
  if nargs=2 then X:=map(op,args[1])
    elif type(args[2],'integer') then X:={$1..args[2]}
    else X:=args[2]
  fi;
  n:=nops(X); ord:=table([seq(X[i]=i,i=1..n)]);
  filterP:=posets['filter'](args[1],X);
  if nops(filterP[1])>1 then
     ERROR(`Poset must have a unique minimal element`) fi;
  ht:=nops(filterP);
  P:=posets['closure'](args[1]) union map(<[x,x]|x>,X); 
  z:=array('sparse',1..n,1..n,map(proc(x,y) (y[x[1]],y[x[2]])=1 end,P,ord));
  v:=array(1..n);
  for i to ht do;
    for x0 in filterP[i] do;
      v[ord[x0]]:=args[nargs]^(ht-i)
    od;
  od;
  linalg['linsolve'](z,v)[ord[filterP[1][1]]];
end:
#

#
# closure(R) returns the transitive closure of any acyclic relation R.
# R need not be naturally labeled, just a set of ordered pairs [a,b].
#
`posets/closure`:=proc() local R,X,i,j,k,n;
  R:=args[1];
  X:=map(op,posets['filter'](R));
  n:=nops(X);
  for i to n-2 do;
    for j from i+1 to n-1 do;
      if not member([X[i],X[j]],R) then next fi;
      for k from j+1 to n do;
        if member([X[j],X[k]],R) then R:=R union {[X[i],X[k]]} fi;
      od;
    od;
  od;
  R;
end:

#
# covers(R) returns the list of cover relations for any acyclic relation R.
# R need not be naturally labeled, just a set of ordered pairs [a,b].
#
`posets/covers`:=proc() local R,n,i,j,k,X;
  R:=args[1];
  X:=map(op,posets['filter'](R));
  n:=nops(X);
  for i from n-1 by -1 to 2 do;
    for j to n-i do;
      if not member([X[j],X[j+i]],R) then next fi;
      for k from j+1 to j+i-1 do;
        if member([X[j],X[k]],R) and member([X[k],X[j+i]],R) then
          R:=R minus {[X[j],X[j+i]]} fi; 
      od;
    od;
  od;
  R;
end:

#
# dual(R) returns the dual of the relation R. That is, each ordered pair
# [a,b] in R (a list or set) is replaced by [b,a].
#
`posets/dual`:=proc(R) map(<[x[2],x[1]]|x>,R) end:

#
# extensions(P,X) returns a list of all linear extensions of the poset P
# with vertex set X. If the second argument is an integer n, then X={1..n}.
# The second argument may be omitted if there are no isolated points.
#
`posets/extensions`:=proc(P) local X,bot,Q,x,res,new;
  if nargs=1 then X:=map(op,P)
    elif type(args[2],'integer') then X:={$1..args[2]}
    else X:=args[2]
  fi;
  if nops(X)=1 then RETURN([op(X)]) fi;
  bot:=X minus map(<e[2]|e>,P);
  res:=[];
  for x in bot do;
    Q:=map(proc(e,y) if e[1]<>y then e fi end,P,x); 
    new:=`posets/extensions`(Q,X minus {x});
    res:=[op(res),op(map(<[y,op(z)]|z,y>,new,x))];
  od;
  res;
end:

#
# filter(D) returns the filtration of acyclic graph D.
#   filtration = [F1,F2,...,F_r], where F1={minimal elements},
#   F2={minimal elements of D-F1}, etc...
# filter(D,X) = same as above but uses vertex set X (necessary if D has
#   isolated points). filter(D,n)= same but with vertex set = {1,...,n}.
# filter(D,X,'flag') or filter(D,n,'flag') does the same, but also assigns
#   flag:=true or false, according to whether D is ranked; i.e., all edges of
#   D are of the form [i,j], where i in F_k and j in F_{k+1} for some k.
#
`posets/filter`:=proc(P) local X,Q,Y,k,res,e;
  if nargs=1 then X:=map(op,P)
    elif type(args[2],'integer') then X:={$1..args[2]}
    else X:=args[2]
  fi;
  if nargs=3 then assign(args[3],true) fi;
  if P={} then RETURN([X]) fi;
  #Y:=map(<op(2,x)|x>,P);
  Y:={seq(e[2],e=P)};
  #Q:=map(proc(x,Z) if member(x[1],Z) and member(x[2],Z) then x fi end,P,Y);
  Q:={seq(`if`(member(e[1],Y) and member(e[2],Y),e,NULL),e=P)};
  res:=[X minus Y, op(`posets/filter`(Q,Y))];
  if nargs<3 then RETURN(res) fi;
  for e in P do;
    for k while not member(e[1],res[k]) do od;
    if k>=nops(res) or not member(e[2],res[k+1]) then
      assign(args[3],false); break
    fi;
  od;
  res;
end:

#
# height(D) = cardinality of longest path in the acyclic digraph D.
#
`posets/height`:=proc(P) local X,ht,i;
  if P={} then RETURN(1) fi;
  X:=map(op,P); ht:=`posets/height/ht`(P,X);
  max(seq(ht[X[i]],i=1..nops(X)));
end:
#
`posets/height/ht`:=proc(P,X) local ht,x,bot,top,T,Q,v,e;
  if P={} then
    for x in X do ht[x]:=1 od; 
  else
    bot:=map(<y[1]|y>,P); top:=X minus bot;
    T:={}; Q:={};    
    for e in P do;  
      if member(e[2],top) then T:={op(T),e} else Q:={op(Q),e} fi;  
    od;    
    ht:=`posets/height/ht`(Q,bot);
    for v in top do ht[v]:=1 od;  
    for e in T do ht[e[2]]:=max(ht[e[2]],1+ht[e[1]]) od;  
  fi;
  op(ht);
end:

#
# invariants(P) will partition the vertices of the poset P (or any acyclic
#   digraph) into types according to the number and level of vertices that
#   cover or are covered by each vertex. The number of vertices of each
#   type is invariant under isomorphism, and thus can be used in isomorphism
#   testing. The output will be a list of lists [L_1,...,L_m]. Assuming
#   [F_1,...,F_k] is the filtration of P, a typical L_j will be of the form
#   [V,i,n_1,...,n_k], where V is a set of vertices in F_i, and for every x
#   in V, n_j is the number of vertices of F_j that cover or are covered by x.
#   The L_j's are sorted lexicographically by the sublists [i,n_1,...,n_k].
# invariants(P,n) and invariants(P,X) can be used to specify the vertex set.
#   If the filtration F of P has already been computed, then this information
#   can be passed on by invoking invariants(P,F).
#
`posets/invariants`:=proc(P) local F,X,i,j,x,lev,res,grp,e,types,typ;
  if nargs=2 and type(args[2],'list') then F:=args[2]
    else F:=posets['filter'](args) fi;
  X:=map(op,F); 
  for j to nops(F) do;
    for x in F[j] do lev[x]:=j od;
  od;
  res:=table('sparse');
  for e in P do;
    res[e[1],lev[e[2]]]:=res[e[1],lev[e[2]]]+1;
    res[e[2],lev[e[1]]]:=res[e[2],lev[e[1]]]+1;
  od;
  types:=[]; grp:=table();
  for x in X do
    typ:=[lev[x],seq(res[x,i],i=1..nops(F))];
    if member(typ,types,'j') then
      grp[j]:=grp[j],x
    else
      types:=[op(types),typ];
      grp[nops(types)]:=x 
    fi;
  od;
  res:=[seq([{grp[i]},op(types[i])],i=1..nops(types))];
  sort(res,`posets/invariants/lex`);
end:
#
`posets/invariants/lex`:=proc(x,y) local i;
  for i from 2 to nops(x) do
    if x[i]<>y[i] then RETURN(evalb(x[i]<y[i])) fi;
  od;
  true
end:

#
# isom(P,Q) decides if the acyclic relations P and Q are isomorphic.
#   First the number of edges of P and Q are compared, then the number of
#   vertices in their filtrations, then the number of vertices of each type.
# isom(P) will return the number of potential relabelings of the vertices
#   that could be required to decide whether P is isomorphic to some Q.
#
`posets/isom`:=proc()
    local P,Q,filterP,filterQ,shapeP,shapeQ,typeP,typeQ,i,X,Y,w,perms;
  if nargs=1 then
    RETURN(convert(map(<nops(x[1])!|x>,posets['invariants'](args[1])),`*`)) fi;
  P:=args[1]; Q:=args[2];
  if nops(P)<>nops(Q) then RETURN(false) fi;
  filterP:=posets['filter'](P);
  filterQ:=posets['filter'](Q);
  shapeP:=map(nops,filterP); shapeQ:=map(nops,filterQ);
  if shapeP<>shapeQ then RETURN(false) fi;
  typeP:=posets['invariants'](P,filterP);
  typeQ:=posets['invariants'](Q,filterQ);
  shapeP:=map(<subsop(1=nops(x[1]),x)|x>,typeP);
  shapeQ:=map(<subsop(1=nops(x[1]),x)|x>,typeQ);
  if shapeP<>shapeQ then RETURN(false) fi;
  X:=map(op,map(<x[1]|x>,typeP));
  Y:=map(op,map(<x[1]|x>,typeQ));
  Q:=subs({seq(Y[i]=X[i],i=1..nops(X))},Q);
  if P=Q then RETURN(true) fi;
  perms:=[seq(typeP[i][1]$nops(typeP[i][1]),i=1..nops(typeP))];
  for w in posets['permfit'](table(perms),nops(perms)) do;
    if Q=subs({seq(X[i]=w[i],i=1..nops(X))},P) then RETURN(true) fi; 
  od;
  false;
end:

#
#  mobius(P,X) returns a table of values for the mobius function of the
#    poset P with vertex set X.
#  mobius(P,n) does the same but assumes X={1,...,n}
#  mobius(P), does the same, but assumes there are no isolated points. 
#  mobius(P,[a,b]) returns the value of the mobius function at [a,b].
#
`posets/mobius`:=proc() local P,X,n,z,i,ord,v,a,b,single;
  single:=false; X:=map(op,args[1]);
  if nargs>1 then
    if type(args[2],'integer') then X:={$1..args[2]}
      elif type(args[2],'list') then single:=true;
        a:=args[2][1]; b:=args[2][2]; X:=X union {a,b}
      else X:=args[2]
    fi;
  fi;
  n:=nops(X); ord:=table([seq(X[i]=i,i=1..n)]);
  P:=posets['closure'](args[1]) union map(<[x,x]|x>,X); 
  z:=array('sparse',1..n,1..n,map(proc(x,y) (y[x[1]],y[x[2]])=1 end,P,ord));
  if single then
    v:=array('sparse',1..n,[(ord[b])=1]);
    linalg['linsolve'](z,v)[ord[a]];
  else
    table(map(proc(x,m,y) (op(x))=m[y[x[1]],y[x[2]]] end,P,
      linalg['inverse'](z),ord));
  fi;
end:

#
#  omega(P,X,z) returns the order polynomial of the poset P with vertex set X
#    in the variable z. If X=an integer n, then vertex set={1,..,n}. The 
#    labeling of P is ignored. If P has no isolated points, then omega(P,z)
#    will also work.
#  omega(P,X,z,bad), where  bad  is a subset of cover relations of P,  will
#    return the order poly of the labeled poset having descent set = bad.
#
`posets/omega`:=proc() local n,z,poly,i,j,new_args;
  if type(args[nargs],'set') then j:=nargs-1 else j:=nargs fi;
  if j=2 then
    n:=nops(map(op,args[1]))
  elif type(args[2],'integer') then
    n:=args[2]
  else
    n:=nops(args[2])
  fi;
  new_args:=op(subsop(j=z,[args]));
  poly:=(1+z)^n*subs(z=z/(1+z),posets['W'](new_args));
  poly:=expand(expand(poly,1+z));
  [seq(coeff(poly,z,i)*`posets/omega/bin`(args[j],i),i=1..n)];
  convert(",`+`);
end:
#
`posets/omega/bin`:=proc(x,j)
  if j=0 then 1 else x/j*`posets/omega/bin`(x-1,j-1) fi;
end:

#
# P &+ Q returns the ordinal sum of the posets P and Q. (Similarly, one can
# use P &+ Q &+ R, and so on). If one or more of the arguments has isolated
# points, say P, then one must use the syntax [P,X] &+ Q, where X= the vertex
# set of P. If X={1,2,...,n}, then [P,n] &+ Q can also be used. The output
# will always be a poset  on the vertex set {1,2,...,m}, where m=the number
# of vertices in P and Q. Note that P &+ Q will never have isolated vertices.
#
unprotect(`&+`);
`&+`:=proc() local P,X,i,j,x,n,top,bot;
  if nargs>2 then RETURN(args[1] &+ (&+(args[2..nargs]))) fi;
  for x to nargs do;
    if type(args[x],'list') then
      P[x]:=args[x][1]; X[x]:=args[x][2];
    else
      P[x]:=args[x]; X[x]:=map(op,P[x])
    fi;
    if type(X[x],'integer') then n[x]:=X[x]
      else n[x]:=nops(X[x]);
      P[x]:=subs({seq(X[x][i]=i,i=1..n[x])},P[x]);
    fi;
  od;
  top:={$1..n[1]} minus map(<e[1]|e>,P[1]);
  bot:={$1..n[2]} minus map(<e[2]|e>,P[2]);
  {op(P[1]),op(subs({seq(i=i+n[1],i=1..n[2])},P[2])),
  seq(seq([top[i],bot[j]+n[1]],j=1..nops(bot)),i=1..nops(top))};
end:

#
# Let B = a table with index set {1,...,n}, where B[i] = a subset of some
# n-element list X.  permfit(B) returns a list of permutations w of X, where
# w[i] belongs to B[i] for all i.
#
`posets/permfit`:=proc(B) local res,n,i,j,x,Bhat;
  if nargs=2 then n:=args[2] else n:=nops([indices(B)]) fi;
  if n=1 then
    if B[1]={} then RETURN([]) else RETURN([[op(B[1])]]) fi;
  fi;
  res:=NULL;
  for i in B[n] do;
    for j to n-1 do Bhat[j]:=B[j] minus {i} od;
    # res:=res,op(map(<[op(x),y]|x,y>,`posets/permfit`(Bhat),i));
    res:=res,seq([op(x),i],x=`posets/permfit`(Bhat,n-1))
  od;
  [res];
end:

#
# P &* Q returns the direct product of the posets P and Q. (Similarly, one can
# use P &* Q &* R, and so on). If one or more of the arguments has isolated
# points, say P, then one must use the syntax [P,X] &* Q, where X= the vertex
# set of P. If X={1,2,...,n}, then [P,n] &* Q can also be used. If all of
# the arguments are of the form [P,X] or [P,n], then the output will be of the
# form [PQ,m], where PQ= the (cover relation of the) product, and m=the number
# of vertices of PQ. The vertex set of the output will always be {1,2,...,m}.
#
unprotect(`&*`);
`&*`:=proc() local X,P,PQ,XY,flag,i,j,x,e;
  if nargs>2 then RETURN(args[1] &* (&*(args[2..nargs]))) fi;
  PQ:=NULL;
  for x to nargs do;
    if type(args[x],'list') then 
      P[x]:=args[x][1]; X[x]:=args[x][2]; flag[x]:=true;
    else
      P[x]:=args[x]; X[x]:=map(op,P[x]); flag[x]:=false;
    fi;
    if type(X[x],'integer') then X[x]:={$1..X[x]} fi;
  od;
  for e in P[1] do;
    for x in X[2] do PQ:=PQ,[[e[1],x],[e[2],x]] od;
  od;
  for e in P[2] do;
    for x in X[1] do PQ:=PQ,[[x,e[1]],[x,e[2]]] od;
  od;
  XY:=[seq(seq([X[1][i],X[2][j]],j=1..nops(X[2])),i=1..nops(X[1]))];
  PQ:=subs({seq(XY[i]=i,i=1..nops(XY))},{PQ});
  if flag[1] and flag[2] then [PQ,nops(XY)] else PQ fi;
end:

#
#  rm_isom(<list>) removes all isomorphic copies from <list>, a list or set
#    of acyclic digraphs. Each graph is assumed to have the same number of
#    vertices. The posets of the final result will be relabeled to use
#    vertices 1,2,3...., and will be naturally labeled.
#
`posets/rm_isom`:=proc()
  local Q,R,inven,subinv,shapes,i,j,k,l,F,X,grp,i0,w,blk,s,
    alive,inv,typ,types,perms;
  R:=table(args[1]); shapes:=[];
#
# This section partitions the posets into groups according to their filtration
#
  for i to nops([indices(R)]) do;
    F:=posets['filter'](R[i]);
    X:=map(op,F); s:=map(nops,F);
    R[i]:=subs({seq(X[k]=k,k=1..nops(X))},R[i]);
    if member(s,shapes,'j') then
      inven[j]:=inven[j],i;
    else
      shapes:=[op(shapes),s]; inven[nops(shapes)]:=i
    fi;
  od;
  alive:=[];
#
# This section refines the partition into groups according to the number of
# vertices of each type, as defined by invariants().
#
  for i to nops(shapes) do;
    if nops([inven[i]])=1 then alive:=[op(alive),inven[i]]; next fi;
    F:=`posets/rm_isom/part`(shapes[i]);
    types:=[]; subinv:=table();
    for j in [inven[i]] do;
      inv:=posets['invariants'](R[j],F);
      X:=map(op,map(<op(1,x)|x>,inv));
      typ:=map(<subsop(1=nops(x[1]),x)|x>,inv);
      R[j]:=subs({seq(X[l]=l,l=1..nops(X))},R[j]);
      if member(typ,types,'k') then
        if R[j]<>R[op(1,[subinv[k]])] then subinv[k]:=subinv[k],j fi;
      else
        types:=[op(types),typ]; subinv[nops(types)]:=j
      fi;
    od;
    for j to nops(types) do;
      grp:=[subinv[j]]; 
      if nops(grp)=1 then alive:=[op(alive),grp[1]]; next fi;
#
# Now, assuming that there are at least two distinct posets whose vertices
# all have the same type, generate all possible type-preserving re-labellings
# and remove the isomorphic copies.
# 
      blk:=`posets/rm_isom/part`(map(<op(1,x)|x>,types[j]));
      perms:=[seq(blk[l]$nops(blk[l]),l=1..nops(blk))]; 
      perms:=posets['permfit'](table(perms),nops(perms));
      while nops(grp)>0 do;
        i0:=grp[1]; alive:=[op(alive),i0];
        grp:=subsop(1=NULL,grp);
        for w in perms while nops(grp)>0 do;
          Q:=subs({seq(l=w[l],l=1..nops(X))},R[i0]);
          for k from nops(grp) by -1 to 1 do;
            if Q=R[grp[k]] then grp:=subsop(k=NULL,grp) fi;
          od;
        od;
      od;
    od;
  od;
  [seq(R[alive[l]],l=1..nops(alive))];
end:
#
`posets/rm_isom/part`:=proc(shape) local ps,i,j;
  ps:=[0];
  for i to nops(shape) do ps:=[op(ps),ps[i]+shape[i]] od;
  [seq({$ps[j]+1..ps[j+1]},j=1..nops(ps)-1)];
end:

#
#  zeta(P,X,z) returns the zeta polynomial of the poset P with vertex set X
#    in the variable z. If X=an integer n, then vertex set={1,...,n}.
#    If P has no isolated points, then zeta(P,z) also works.
#  Patched on 4/1/92 to remove bug related to copying tables.
#
`posets/zeta`:=proc() local num,poly,e,x,i,j,X,old,new,up;
  if nargs=2 then X:=map(op,args[1])
    elif type(args[2],'integer') then X:={$1..args[2]}
    else X:=args[2]
  fi;
  poly:=0; num:=nops(X); 
  for x in X do old[x]:=1; up[x]:={} od;
  for e in posets['closure'](args[1]) do up[e[1]]:={op(up[e[1]]),e[2]} od;
  for i while num>0 do;
    poly:=poly+num*`posets/zeta/bin`(args[nargs]-2,i-1);
    for x in X do new[x]:=convert([seq(old[up[x][j]],j=1..nops(up[x]))],`+`) od;
    num:=convert(convert(new,'list'),`+`); 
    old:=table([seq(X[j]=new[X[j]],j=1..nops(X))]);
  od;
  poly;
end:
#
`posets/zeta/bin`:=proc(x,j)
  if j=0 then 1 else x/j*`posets/zeta/bin`(x-1,j-1) fi;
end:

posets[antichains]:=eval(`posets/antichains`):
posets[chain]:=eval(`posets/chain`):
posets[char_poly]:=eval(`posets/char_poly`):
posets[closure]:=eval(`posets/closure`):
posets[covers]:=eval(`posets/covers`):
posets[dual]:=eval(`posets/dual`):
posets[extensions]:=eval(`posets/extensions`):
posets[filter]:=eval(`posets/filter`):
posets[height]:=eval(`posets/height`):
posets[invariants]:=eval(`posets/invariants`):
posets[isom]:=eval(`posets/isom`):
posets['J']:=eval(`posets/J`):
posets[Lattices]:=eval(`posets/Lattices`):
posets[mobius]:=eval(`posets/mobius`):
posets[omega]:=eval(`posets/omega`):
posets[permfit]:=eval(`posets/permfit`):
posets[Posets]:=eval(`posets/Posets`):
posets[rm_isom]:=eval(`posets/rm_isom`):
posets['W']:=eval(`posets/W`):
posets[zeta]:=eval(`posets/zeta`):
`combinat/posets` := eval(posets):

`help/text/posets` := TEXT(
`HELP FOR: The posets package`,
`      `,
`CALLING SEQUENCES:`,
`   <function>(args)`,
`   posets[<function>](args)`,
`      `,
`SYNOPSIS:   `,
`   `,
`- To use <function>, either use the long notation posets[<function>](...);`,
`  or first define the posets functions by doing  with(posets);  then use`,
`  the short notation  <function>(...);`,
`      `,
`- The functions in the posets package are:`,
`      `,
`  J		Lattices	Posets 		W`,
`  antichains	chain		char_poly	closure		covers`,
`  dual		extensions	filter		height		invariants`,
`  isom		mobius		omega		permfit 	rm_isom`,
`  zeta		&+		&*`,
`   `,
`- Help for any of these functions can be obtained with ?<function>`
):

`help/text/&*` := TEXT(
`FUNCTION :  &* - direct product of posets`,
`    `,
`CALLING SEQUENCE :  S1 &* S2 &* S3;     &*(S1,S2,S3,...);`,
`    `,
`PARAMETERS :  S1,S2,S3,...  =  a sequence of two or more poset "structures"`,
`   `,
` A poset "structure" S has one of the following forms:`,
`  - a poset--i.e., a set of covering relations`,
`  - [P,X], where P is a poset with vertex set X`,
`  - [P,n], where P is a poset with vertex set {1,2,...,n} `,
`   `,
`SYNOPSIS :   `,
`  If P and Q are posets with vertex sets X and Y, the direct product is`,
`  defined to be the poset with vertex set X x Y (cartesian product) in which`,
`  [x1,y1] <= [x2,y2] if and only if x1 <= x2 in P and y1 <= y2 in Q.`,
`  Whenever the posets package is loaded via the with() command, a neutral`,
`  operator ``&*`` for constructing direct products is defined. Assuming that P`,
`  and Q are posets without isolated vertices, the expression  P &* Q (and`,
`  more generally, P &* Q &* R, etc) will compute the direct product of P and`,
`  Q (and R ...). The output of this computation will be an (abstract) poset`,
`  that is ISOMORPHIC to the product of P and Q, not EQUAL to the product of P`,
`  and Q. In particular, the vertex set will be {1,2,...,p*q} (where p,q =`,
`  # of vertices in P, Q), rather than X x Y, and the output will be a set of`,
`  pairs [i,j], corresponding to the covering relations of the product. `,
`  If one or more of the posets P,Q,... has isolated vertices, then its`,
`  vertex set must be specified. For example if Q has isolated vertices, and`,
`  its vertex set is Y, then the syntax P &* [Q,Y] should be used. If Y is of`,
`  the form {1,2,...,n} for some n, then the syntax P &* [Q,n] can also be`,
`  used. The output will be in one of two forms: if every poset in the list`,
`  of arguments has its vertex set specified (in the form [P,X] or [P,n]),`,
`  then the output will be [R,N], where R is (the covering relation of) the`,
`  product, and N is the number of vertices. Otherwise, if at least one of`,
`  the arguments does not specify the vertex set, then the resulting product`,
`  cannot have isolated vertices, and so only R itself is returned. In all`,
`  cases, the vertex set will be {1,2,...,N}.`,
`   `,
`EXAMPLES :   `,
`  Q:=chain(2);`,
`  P:=Q &* Q &* Q;                     yields`,
`    {[1,2],[1,3],[5,6],[1,5],[2,6],[3,7],[4,8],[3,4],[2,4],[5,7],[7,8],[6,8]}`,
`  isom(P,J({},3));                    yields                  true`,
`  Q &* [{[a,b]},{a,b,c}];             yields  {[1,2],[1,4],[2,5],[3,6],[4,5]}`,
`  [{[1,2]},3] &* [{[1,2]},3];         yields`,
`                                    [{[1,2],[1,4],[2,5],[3,6],[4,5],[7,8]},9]`,
`    `,
`SEE  ALSO :  &+, isom`
):
`help/text/&+` := TEXT(
`FUNCTION :  &+    - ordinal sum of posets`,
`    `,
`CALLING SEQUENCE :  S1 &+ S2 &+ S3;     &+(S1,S2,S3,...);`,
`    `,
`PARAMETERS :  S1,S2,S3,...  =  a sequence of two or more poset "structures"`,
`   `,
` A poset "structure" S has one of the following forms:`,
`  - a poset--i.e., a set of covering relations`,
`  - [P,X], where P is a poset with vertex set X`,
`  - [P,n], where P is a poset with vertex set {1,2,...,n} `,
`   `,
`SYNOPSIS :   `,
`  If P and Q are posets with vertex sets X and Y, the ordinal sum is`,
`  defined to be the poset with vertex set X u Y (disjoint union) in which`,
`  x <=y if and only if x<=y in P, or x<=y in Q, or x in X, y in Y.`,
`  Whenever the posets package is loaded via the with() command, a neutral`,
`  operator ``&+`` for constructing ordinal sums is defined. Assuming that P`,
`  and Q are posets without isolated vertices, the expression  P &+ Q (and`,
`  more generally, P &+ Q &+ R, etc) will compute the ordinal sum of P and`,
`  Q (and R ...). The output of this computation will be an (abstract) poset`,
`  that is ISOMORPHIC to the sum of P and Q, not EQUAL to the sum of P and Q.`,
`  In particular, the vertex set will be {1,2,...,p+q} (where p,q = # of`,
`  vertices in P, Q), rather than X u Y. `,
`  If one or more of the posets P,Q,... has isolated vertices, then its`,
`  vertex set must be specified. For example if Q has isolated vertices, and`,
`  its vertex set is Y, then the syntax P &+ [Q,Y] should be used. If Y is of`,
`  the form {1,2,...,n} for some n, then the syntax P &+ [Q,n] can also be`,
`  used. Note that the ordinal sum of two or more posets will never have`,
`  isolated vertices.`,
`   `,
`EXAMPLES :   `,
`  one:=[{},1]; two:=[{},2];`,
`  P:=two &+ two;               yields             {[2,3],[1,3],[1,4],[2,4]}`,
`  (Now add a "0" and a "1" to P: )`,
`  one &+ P &+ one;             yields`,
`                          {[1,2],[1,3],[2,5],[5,6],[3,4],[2,4],[3,5],[4,6]}`,
`  &+(chain(2)$3);              yields       {[1,2],[2,3],[4,5],[5,6],[3,4]}`,
`    `,
`SEE  ALSO :  &*, isom`
):
`help/text/J` := TEXT(
`FUNCTION :  J - order ideals of a poset`,
`    `,
`CALLING SEQUENCE :  J(P);    J(P,n);    J(P,X);`,
`    `,
`PARAMETERS :  P = a poset`,
`              n = a positive integer`,
`              X = a set (the vertex set)`,
`   `,
`SYNOPSIS :   `,
`  An order ideal of a poset P is a subset I of the vertices of P with the`,
`  property that if a is in I and b<a in P, then b is in I.`,
`  The set of order ideals of P is partially ordered by inclusion; i.e.,`,
`  I < J whenever I is a subset of J.`,
`  J(P,X) computes the abstract poset of order ideals of the poset P with`,
`  vertex set X. The vertex set of J(P,X) is taken to be {1,2,...,n},`,
`  where n = the number of order ideals of P. (No information is provided`,
`  about which ideal a given integer corresponds to.)`,
`  If the vertex set of P is {1,2,..,m}, then the poset of order ideals can`,
`  also be obtained by calling J(P,m).`,
`  If there are no isolated vertices in P, (i.e., every vertex of P is`,
`  related in P to at least one other element), then the poset of order ideals`,
`  can also be obtained by calling J(P).`,
`  Note that J({},n) is the Boolean algebra of all subsets of an n-set.`,
`   `,
`EXAMPLES :   `,
`  J({},3);                        yields`,
`    {[1,4],[4,5],[6,8],[7,8],[5,8],[1,2],[2,5],[2,6],[1,3],[3,6],[3,7],[4,7]}`,
`  filter(");                      yields     [{1}, {2,3,4}, {5,6,7}, {8}]`,
`  J({[1,2],[2,3]});               yields         {[1,2],[3,4],[2,3]}`,
`  J({[a,b]},{a,b,c});             yields`,
`                               {[1,2],[2,5],[1,3],[2,4],[4,6],[5,6],[3,5]}`,
`    `,
`SEE  ALSO :  antichains`
):
`help/text/Lattices` := TEXT(
`FUNCTION :  Lattices - list of nonisomorphic lattices`,
`     `,
`CALLING SEQUENCE :  Lattices(n);`,
`    `,
`PARAMETERS :  n = a positive integer`,
`   `,
`SYNOPSIS :   `,
`  Lattices(n) returns a complete list of nonisomorphic lattices on n points.`,
`  Each poset in the list uses the vertex set {1,2,...,n}, and is naturally`,
`  labeled; i.e., if [i,j] is a relation of the poset, then i<j.`,
`  Remember that the posets in this package are represented by their`,
`  COVERING relation. To recover the transitive relation, use closure().`,
`  Note, it takes quite a while to compute n = 9.`,
`   `,
`   n     nops(Lattices(n))       length(Lattices(n))`,
`      (=number of lattices)        (=space used)`,
`   1		1			7`,
`   2		1			15		`,
`   3		1			23`,
`   4		2			67`,
`   5		5			223`,
`   6		15			839`,
`   7		53			3599`,
`   8		222			17803`,
`   9		1078			99995`,
`   `,
`EXAMPLES :   `,
`  Lattices(2);            yields                    [{[1,2]}]`,
`  Lattices(6)[7];         yields       {[1,2],[3,4],[1,3],[4,5],[2,6],[5,6]}`,
`(i.e., the 7th in the list of 6-vertex lattices. Your answer may vary.)`,
`   `,
`SEE  ALSO :  Posets, covers, closure`
):
`help/text/Posets` := TEXT(
`FUNCTION :  Posets - list of nonisomorphic posets`,
`    `,
`CALLING SEQUENCE :  Posets(n);`,
`    `,
`PARAMETERS :  n = a positive integer`,
`   `,
`SYNOPSIS :   `,
`  Posets(n) returns a complete list of nonisomorphic posets on n points.`,
`  Each poset in the list uses the vertex set {1,2,...,n}, and is naturally`,
`  labeled; i.e., if [i,j] is a relation of the poset, then i<j.`,
`  Remember that the posets in this package are represented by their`,
`  COVERING relation. To recover the transitive relation, use closure().`,
`  Note, it takes quite a while to compute n = 7.`,
`   `,
`   n   nops(Posets(n))          length(Posets(n))`,
`        (=number of posets)      (=space used)`,
`   1           1                       7`,
`   2           2                      19`,
`   3           5                      79`,
`   4          16                     395`,
`   5          63                    2239`,
`   6         318                   15131`,
`   7        2045                  124367`,
`   `,
`EXAMPLES :   `,
`  Posets(2);                     yields         [{}, {[1,2]}]`,
`  Posets(5)[37];                 yields        {[1,3],[2,3],[3,4],[3,5]}`,
`(i.e., the 37th poset in the list of 5-vertex posets. Your answer may vary.)`,
`   `,
`SEE  ALSO :  Lattices, covers, closure`
):
`help/text/W` := TEXT(
`FUNCTION :  W - W-polynomial of a poset`,
`    `,
`CALLING SEQUENCE :  W(P,z);         W(P,z,strict);`,
`                    W(P,n,z);       W(P,n,z,strict);`,
`                    W(P,X,z);       W(P,X,z,strict);`,
`    `,
`PARAMETERS :    P   = a poset`,
`                z   = any expression (or name)`,
`                n   = a positive integer`,
`                X   = a set (the vertex set)`,
`             strict = (optional) a subset of P`,
`   `,
`SYNOPSIS :   `,
`  The W-polynomial of a poset P with n vertices is related to the`,
`  omega-polynomial f(z) of P as follows: `,
`           W(z)=(1-z)^(n+1)*sum(f(k)*z^k,k=0..infinity).`,
`  It can also be defined via`,
`           W(z)=sum(a[k]*(1-z)^(n-k)*z^k,k=1..n),             (*)`,
`  where a[k]= number of order-preserving maps from P ONTO a k-element chain.`,
`  It can be shown that W(1) equals the number of linear extensions of P.`,
`  W(P,X,z) computes the W-polynomial of the poset P with vertex set X,`,
`  evaluated at z. If the vertex set is {1,2,...,n}, then this can also be`,
`  computed by calling W(P,n,z). If there are no isolated vertices in P,`,
`  (i.e., every vertex of P is related in P to at least one other`,
`  element), then one may use W(P,z).`,
`  In the second form, one may include as an optional third or fourth argument`,
`  a subset of (the covering relations of) P. In this form, W() computes`,
`  a modification of (*) in which a[k] equals the number of order-preserving`,
`  maps phi from P onto a k-element chain in which phi(a) < phi(b) for each`,
`  pair [a,b] in the chosen subset of P. These "modified" polynomials arise as`,
`  W-polynomials of unnaturally labeled posets.`,
`   `,
`EXAMPLES :   `,
`  W({},4,q);                     yields             q+11*q^2+11*q^3+q^4`,
`  P:=chain(2) &* chain(3);`,
`  W(P,z,{[1,2],[5,6]});          yields                   4*z^3+z^4`,
`  W({[a,b],[a,c]},{a,b,c,d},z);  yields                 z+5*z^2+2*z^3`,
`    `,
`SEE  ALSO :  omega, extensions`
):
`help/text/antichains` := TEXT(
`FUNCTION :  antichains - antichains of a partially ordered set`,
`    `,
`CALLING SEQUENCE :  antichains(P);`,
`                    antichains(P,n);`,
`                    antichains(P,X);`,
`    `,
`PARAMETERS :  P = a poset`,
`              n = a positive integer`,
`              X = a set (the vertex set)`,
`   `,
`SYNOPSIS :   `,
`  An antichain of a poset P is a subset A of the vertices of P with the`,
`  property that no pair [a,b] with a,b in A belongs to P.`,
`  antichains(P,X) determines the set of all antichains of the poset P `,
`  with vertex set X. `,
`  If the vertex set is {1,2,..,n}, then the set of antichains can also`,
`  be obtained by calling   antichains(P,n).`,
`  If there are no isolated vertices in P, (i.e., every vertex of P is`,
`  related in P to at least one other element), then the set of `,
`  antichains can also be obtained by calling antichains(P).`,
`  The number of antichains of P equals the number of order ideals of P.`,
`   `,
`EXAMPLES :   `,
`  antichains({[1,2]},3);          yields      {{},{1},{2,3},{3},{2},{1,3}}`,
`  antichains({[1,2]});            yields      {{},{1},{2}}`,
`  antichains({[a,b],[a,c]},{a,b,c});   `,
`                                  yields      {{},{b,c},{a},{b},{c}}`,
`    `,
`SEE  ALSO :  J`
):
`help/text/chain` := TEXT(
`FUNCTION :  chain - total order of specified length`,
`    `,
`CALLING SEQUENCE :  chain(n);`,
`    `,
`PARAMETERS :  n = a positive integer`,
`   `,
`SYNOPSIS :   `,
`  chain(n) returns (the cover-relation of) an n-element chain, using the`,
`  vertex set {1,...,n}.`,
`   `,
`EXAMPLES :   `,
`  chain(3);                     yields     {[1,2], [2,3]}`
):
`help/text/char_poly` := TEXT(
`FUNCTION :  char_poly - characteristic polynomial of a graded poset`,
`    `,
`CALLING SEQUENCE :  char_poly(P,z);`,
`                    char_poly(P,n,z);`,
`                    char_poly(P,X,z);`,
`    `,
`PARAMETERS :    P   = a poset`,
`                z   = any expression (or name)`,
`                n   = a positive integer`,
`                X   = a set (the vertex set)`,
`   `,
`SYNOPSIS :   `,
`  If P is the graded poset with a unique minimal element m, then the`,
`  characteristic polynomial of P is defined to be the sum of`,
`               mobius(m,x)*q^(h-rank(x))`,
`  over all vertices x of P, where mobius() denotes the mobius function of P`,
`  and h denotes the height of P. The procedure does verify that the poset`,
`  has a unique minimal element, but does not attempt to verify that P is`,
`  graded.   `,
`  Although posets with unique minimal elements cannot have isolated`,
`  vertices (unless there is only one vertex), one may specify the number`,
`  of vertices n or the vertex set X, for consistency.`,
`  The coefficients of char_poly(P,z) are known as the Whitney numbers of P`,
`  of the first kind.`,
`   `,
`EXAMPLES :   `,
`  char_poly(chain(4),z);                yields         -z^2+z^3`,
`  char_poly(J({},3),z); `,
`  factor(");                            yields         (-1+z)^3`,
`    `,
`SEE  ALSO :  mobius, height`
):
`help/text/closure` := TEXT(
`FUNCTION :  closure - transitive closure of an acyclic relation`,
`    `,
`CALLING SEQUENCE :  closure(P);`,
`    `,
`PARAMETERS :  P = a set of pairs of the form [a,b]`,
`   `,
`SYNOPSIS :   `,
`  closure(P) computes the transitive closure of the acyclic relation P.`,
`  Thus, if P is a set of ordered pairs of the form [a,b] for various a and b,`,
`  then closure(P) will be the smallest set containing P such that whenever`,
`  [a,b] and [b,c] belong to closure(P), then so does [a,c].`,
`  If P contains any cycles (e.g., {[a,b],[b,c],[c,d],[d,a]}), then`,
`  closure(P) will enter an infinite loop.`,
`   `,
`EXAMPLES :   `,
`  closure({[1,2],[2,3]});            yields   {[1,2],[2,3],[1,3]}`,
`  closure({[a,b],[a,c]});            yields   {[a,b],[a,c]}`,
`    `,
`SEE  ALSO :  covers`
):
`help/text/covers` := TEXT(
`FUNCTION :  covers - covering relations of an acyclic relation `,
`    `,
`CALLING SEQUENCE :  covers(P);`,
`    `,
`PARAMETERS :  P = a set of pairs of the form [a,b]`,
`   `,
`SYNOPSIS :   `,
`  covers(P) computes the covering relations of P, assuming P is acyclic. `,
`  Thus, if P is a set of ordered pairs of the form [a,b] for various a and b,`,
`  then covers(P) will be the set consisting of those pairs [a,b] of P such`,
`  that there is no element c with [a,c] and [c,b] in P.`,
`  If P contains any cycles (e.g., {[a,b],[b,c],[c,d],[d,a]}), then`,
`  covers(P) will enter an infinite loop.`,
`   `,
`EXAMPLES :   `,
`  P:={[a,b],[b,d],[c,d]};`,
`  closure(P);`,
`  covers(");                      yields   {[c,d],[a,b],[b,d]}`,
`    `,
`SEE ALSO :  closure`
):
`help/text/dual` := TEXT(
`FUNCTION :  dual - dual of a partially ordered set`,
`    `,
`CALLING SEQUENCE :  dual(P);`,
`    `,
`PARAMETERS :  P = a poset (or any acyclic relation)`,
`   `,
`SYNOPSIS :   `,
`  dual(P) returns the dual of P. That is, each ordered pair [a,b] of P`,
`  is replaced by [b,a]. `,
`   `,
`EXAMPLES :   `,
`  P:={[1,2],[1,3],[3,4]};`,
`  dual(P);                     yields     {[2,1], [3,1], [4,3]}`,
`  isom(P,");                   yields            false`
):
`help/text/extensions` := TEXT(
`FUNCTION :  extensions - linear extensions of a partially ordered set`,
`    `,
`CALLING SEQUENCE :  extensions(P);`,
`                    extensions(P,n);`,
`                    extensions(P,X);`,
`    `,
`PARAMETERS :  P = a poset`,
`              n = a positive integer`,
`              X = a set (the vertex set)`,
`   `,
`SYNOPSIS :   `,
`  A linear extension of a poset P is a linear ordering of the vertices so`,
`  that for each relation [a,b] of P,  a  precedes  b  in the ordering.`,
`  extensions(P,X) returns a list of all extensions of the poset P  with`,
`  vertex set X.  If the vertex set is {1,2,..,n}, then the list of extensions`,
`  can also be obtained by calling   extensions(P,n).`,
`  If there are no isolated vertices in P, (i.e., every vertex of P is`,
`  related in P to at least one other element), then the set of `,
`  extensions can be obtained by calling extensions(P).`,
`   `,
`EXAMPLES :   `,
`  extensions({[1,2]},3);              yields     [[1,2,3], [1,3,2], [3,1,2]]`,
`  extensions({[1,2]});                yields              [[1, 2]]`,
`  extensions({[a,b],[a,c]},{a,b,c});  yields         [[a,b,c], [a,c,b]]`,
`    `,
`SEE ALSO :  W`
):
`help/text/filter` := TEXT(
`FUNCTION :  filter - filtration of an acyclic directed graph`,
`    `,
`CALLING SEQUENCE :  filter(D);  `,
`                    filter(D,n);    filter(D,n,'ranked');`,
`                    filter(D,X);    filter(D,X,'ranked');`,
`    `,
`PARAMETERS :  D     = an acyclic digraph (e.g., a poset)`,
`              n     = a positive integer`,
`              X     = a set (the vertex set)`,
`           'ranked' = a name `,
`   `,
`SYNOPSIS :   `,
`  If D is any acyclic directed graph, we define the filtration of D to be`,
`  the list of sets [F_1,F_2,...,F_r], where F_1 is the set of sources of D`,
`  (i.e., vertices with in-degree 0), F_2 is the set of sources of D - F_1,`,
`  F_3 is the set of sources of (D - F_1) - F_2, and so on.`,
`  If D is a poset, then F_1 = the minimal elements of D, and so on.`,
`  filter(D)  computes the filtration of D. `,
`  If D has one or more isolated points, then it is necessary to specify the`,
`  vertex set of D. Use filter(D,X) to specify that D has vertex set X.`,
`  If X = {1,2,...,n}, then one may also use filter(D,n).`,
`  WARNING: if D has any cycles (e.g., {[a,b],[b,c],[c,a]}), then filter(D)`,
`  will enter an infinite loop.`,
`  If the (optional) third argument is a name, then this name will be assigned`,
`  'true' or 'false', according to whether D is "ranked". To be ranked`,
`  means that for every vertex a in F_i, if [a,b] is an edge of D, then b`,
`  must belong to F_(i+1). There exist other definitions of "ranked", some of`,
`  which disagree with this one.`,
`   `,
`EXAMPLES :   `,
`  filter(J({},3));                yields     [{1}, {2,3,4}, {5,6,7}, {8}]`,
`  P:={[1,2],[1,3],[3,4],[2,5],[4,5]};`,
`  filter(P,5,'ranked');           yields         [{1}, {2,3}, {4}, {5}]`,
`  ranked;                         yields                 false`,
`  filter({[a,b],[b,e],[c,e]},{a,b,c,d,e});`,
`                                  yields           [{a,d,c}, {b}, {e}]`,
`    `,
`SEE  ALSO : invariants`
):
`help/text/height` := TEXT(
`FUNCTION :  height - size of longest chain (or path) in a poset or digraph`,
`    `,
`CALLING SEQUENCE :  height(P)`,
`    `,
`PARAMETERS :  P = a poset  or acyclic digraph `,
`   `,
`SYNOPSIS :   `,
`  If P is a poset, height(P) computes the cardinality of the longest`,
`  chain of P. (Do not confuse height with length; the length is defined to`,
`  be height - 1.)`,
`  The procedure will work equally well if P is any acyclic directed graph.`,
`  Beware that if P has cycles, then height(P) will enter an infinite loop.`,
`   `,
`EXAMPLES :   `,
`  height(chain(4));               yields                4`,
`    `,
`SEE  ALSO :  filter`
):
`help/text/invariants` := TEXT(
`FUNCTION :  invariants - vertex partition of an acyclic directed graph`,
`                           according to invariant types`,
`    `,
`CALLING SEQUENCE :  invariants(D);      invariants(D,X);`,
`                    invariants(D,n);    invariants(D,F);`,
`    `,
`PARAMETERS :  D = an acyclic digraph (e.g., a poset)`,
`              n = a positive integer (the number of vertices)`,
`              X = a set (the vertex set)`,
`              F = the filtration of D`,
`   `,
`SYNOPSIS :   `,
`  Let [F_1,F_2,...,F_r] be the filtration of an acyclic directed graph D.`,
`  (See the help file for 'filter'.) Define the "type" of a vertex x of D`,
`  to be the list [i,n_1,n_2,...,n_r], where x belongs to F_i, and n_j is`,
`  the number of vertices y in F_j such that [x,y] or [y,x] is in D. The`,
`  number of vertices of each type is invariant under isomorphism, and thus`,
`  can be used in isomorphism testing.`,
`  The procedure invariants(D) classifies each vertex of D by type. If there`,
`  are m types of vertices, the output will be of the form [L_1,...,L_m].`,
`  Each L_k will be a list [S,i,n_1,n_2,...,n_r], where S is the set of`,
`  vertices of type [i,n_1,n_2,...,n_r]. The ordering of the L_k's is`,
`  lexicographic by type, so a given set of types will always appear in the`,
`  same order.`,
`  If D has one or more isolated vertices, then the vertex set will need to`,
`  be explicitly specified. Use invariants(D,X) to specify that D has vertex`,
`  set X, and use invariants(D,n) to specify the vertex set {1,...,n}.  If`,
`  the filtration F of D has already been determined, then this information`,
`  can be passed on by invoking invariants(D,F). This too can serve to `,
`  specify the vertex set.`,
`   `,
`EXAMPLES :   `,
`  invariants({[a,c],[b,c]});         yields      [[{a,b},1,0,1],[{c},2,2,0]]`,
`  P:=chain(2) &* chain(2); F:=filter(P,5);`,
`  invariants(P,F);                   yields `,
`                 [[{5},1,0,0,0],[{1},1,0,2,0],[{2,3},2,1,0,1],[{4},3,0,2,0]]`,
`    `,
`SEE  ALSO : filter, isom, rm_isom `
):
`help/text/isom` := TEXT(
`FUNCTION :  isom - test posets for isomorphism`,
`    `,
`CALLING SEQUENCE :  isom(P,Q);  `,
`                    isom(P);`,
`    `,
`PARAMETERS :  P,Q  = posets (or any acyclic digraphs)`,
`   `,
`SYNOPSIS :   `,
`  Two posets are isomorphic if there is a one-to-one correspondence between`,
`  the vertices (say, x <---> x') so that [a,b] is a relation of P if and`,
`  only if [a',b'] is a relation of Q.`,
`  isom(P,Q) determines whether the two posets P and Q are isomorphic.`,
`  The procedure ignores any isolated vertices that P and Q may have.`,
`  The algorithm works by first comparing the number of (covering) relations `,
`  of P and Q. Next, it filters both P and Q (see the help file for 'filter'),`,
`  and compares the number of vertices in each level of the filtration.`,
`  If these numbers are the same, it then computes the number of vertices of`,
`  each "type" (as defined in the help file for 'invariants'). If these`,
`  numbers are identical, then a list of all type-preserving bijections`,
`  between the vertices of P and Q is generated and tested. If this list`,
`  turns out to be large (say, >> 5000 terms), then the procedure could run`,
`  out of space or take too much time.`,
`  In the second form, isom(P) will compute the number of type-preserving`,
`  bijections that might be required in attempting to decide whether P`,
`  is isomorphic to some other Q.`,
`  isom() can also be used to test whether two acyclic digraphs are`,
`  isomorphic. Beware, however, that if P or Q has any cycles, such as`,
`  {[a,b],[b,c],[c,a]}, then the procedure will enter an infinite loop.`,
`   `,
`EXAMPLES :   `,
`  P:=chain(2) &* chain(3); Q:=chain(3) &* chain(2);`,
`  isom(P,Q);                      yields              true`,
`  isom(P);                        yields               1 `,
`  P:=J({[a,b],[a,c]});`,
`  isom(P,dual(P));                yields              false`,
`  P:=J({},4); isom(P);            yields             414720`,
`    `,
`SEE  ALSO :  rm_isom, filter, invariants, Posets, Lattices`
):
`help/text/mobius` := TEXT(
`FUNCTION :  mobius - mobius function of a partially ordered set`,
`    `,
`CALLING SEQUENCE :  mobius(P);      mobius(P,n);`,
`                    mobius(P,X);    mobius(P,[a,b]);`,
`    `,
`PARAMETERS :  P  =  a poset`,
`              n  =  a positive integer`,
`              X  =  a set (the vertex set)`,
`             a,b =  vertices of P`,
`   `,
`SYNOPSIS :   `,
`  The mobius function of a partially ordered set is an integer-valued`,
`  function defined on the set of related pairs [a,b] in P. (Or equivalently,`,
`  on the intervals of P.)  For a definition, see Stanley's "Enumerative`,
`  Combinatorics", Vol. I, p. 116.`,
`  mobius(P,X) computes the mobius function of the poset P with vertex set X.`,
`  It returns a table of values of the mobius function; the indices of the`,
`  table are the pairs (a,b) in the transitive closure of P, including all`,
`  pairs (a,a) with a in X.  If the vertex set is {1,2,..,n}, then the mobius`,
`  function can be obtained via mobius(P,n).  If there are no isolated`,
`  vertices in P, (i.e., every vertex of P is related in P to at least one`,
`  other element), then one may use mobius(P). `,
`  If one needs the mobius function at only one particular pair [a,b], this`,
`  can be obtained by calling  mobius(P,[a,b]). This yields results faster`,
`  than computing the entire mobius table.`,
`  Note that if P has a unique maximal element M and unique minimal element m,`,
`  then mobius(P,[m,M])=zeta(P,-1).`,
`   `,
`EXAMPLES :   `,
`  mobius({[a,b],[a,c]},{a,b,c});         yields`,
`                          table([(a,a)=1,(a,b)=-1,(a,c)=-1,(b,b)=1,(c,c)=1])`,
`  mo:=mobius(J({},3));`,
`  mo[1,8];                               yields          -1`,
`  mobius(J({},3),[1,8]);                 yields          -1`,
`    `,
`SEE  ALSO :  zeta`
):
`help/text/omega` := TEXT(
`FUNCTION :  omega - order polynomial of a poset`,
`    `,
`CALLING SEQUENCE :  omega(P,z);         omega(P,z,strict);`,
`                    omega(P,n,z);       omega(P,n,z,strict);`,
`                    omega(P,X,z);       omega(P,X,z,strict);`,
`    `,
`PARAMETERS :    P   = a poset`,
`                z   = any expression (or name)`,
`                n   = a positive integer`,
`                X   = a set (the vertex set)`,
`             strict = (optional) a subset of P`,
`   `,
`SYNOPSIS :   `,
`  The order polynomial of a poset P is the unique polynomial omega(z) with`,
`  the property that for each positive integer k, omega(k) equals the number`,
`  of order-preserving maps from P to a k-element chain. (Equivalently,`,
`  omega(z) can be defined to be the zeta polynomial of J(P).)`,
`  omega(P,X,z) computes the order polynomial of the poset P with vertex`,
`  set X, evaluated at z. If the vertex set is {1,2,...,n}, then this can`,
`  also be computed by calling omega(P,n,z). If there are no isolated vertices`,
`  in P, (i.e., every vertex of P is related in P to at least one other`,
`  element), then one may use omega(P,z).`,
`  In the second form, one may include as an optional third or fourth argument`,
`  a subset of (the covering relations of) P. In this form, omega() computes`,
`  a "modified" order polynomial f(z) with the property that for each`,
`  positive integer k, f(k) equals the number of order-preserving maps phi`,
`  from P to a k-element chain in which phi(a) < phi(b) for each pair [a,b]`,
`  in the chosen subset of P. (Rather than merely phi(a) <= phi(b).)`,
`  These "modified" polynomials arise as order polynomials of unnaturally`,
`  labeled posets.`,
`   `,
`EXAMPLES :   `,
`  omega(chain(4),5,z);`,
`  factor(");                          yields   1/24*z^2*(z+3)*(z+2)*(z+1)`,
`  omega(chain(4),z,{[3,4]}); `,
`  factor(");                          yields    1/24*z*(z-1)*(z+2)*(z+1)`,
`  omega({[a,b],[a,c]},{a,b,c,d},3);   yields                42`,
`    `,
`SEE  ALSO :  W, zeta, J`
):
`help/text/permfit` := TEXT(
`FUNCTION :  permfit - permutations with restricted position`,
`    `,
`CALLING SEQUENCE :  permfit(T);`,
`    `,
`PARAMETERS :  T = a table`,
`   `,
`SYNOPSIS :   `,
`  Let T be a table with index set {1,2,...,n}. Assume that each entry`,
`  of the table is a subset of some n-element set X. `,
`  permfit(T) returns the list of all permutations w of X with the property`,
`  that w[i] belongs to T[i] for i=1,2,...,n. The permutations are listed`,
`  in one-line form; i.e., [w[1],w[2],...,w[n]].`,
`  This procedure is used by isom() and rm_isom() to generate bijections`,
`  between (potentially) isomorphic posets.`,
`   `,
`EXAMPLES :   `,
`  T:=table([{a,b},{b,c},{c,d},{a,d}]);`,
`  permfit(T);                               yields     [[b,c,d,a], [a,b,c,d]]`,
`  permfit(table([{1,2,3},{1,2,3},{1,2}]));  yields`,
`                                         [[3,2,1], [2,3,1], [3,1,2], [1,3,2]] `
):
`help/text/rm_isom` := TEXT(
`FUNCTION :  rm_isom - remove isomorphic copies from a list of posets.`,
`    `,
`CALLING SEQUENCE :  rm_isom(L);  `,
`    `,
`PARAMETERS :  L  = a list or set of posets (or acyclic digraphs) `,
`   `,
`SYNOPSIS :   `,
`  Two posets are isomorphic if there is a one-to-one correspondence between`,
`  the vertices (say, x <---> x') so that [a,b] is a relation of P if and`,
`  only if [a',b'] is a relation of Q.`,
`  If L is a list or set of posets, rm_isom(L) finds all instances of pairs`,
`  of isomorphic posets, and deletes "extra" copies, so that every poset`,
`  in the original list L is isomorphic to exactly one poset in the output.`,
`  IMPORTANT: The algorithm ignores the possibility of isolated vertices.`,
`  The vertices in the posets that are returned will be relabeled in a`,
`  "natural" order using positive integers.  In particular, the resulting`,
`  posets, although isomorphic to the original ones, need not be IDENTICAL`,
`  to any of the posets in the original list.`,
`  The algorithm works by breaking the list into groups according to the`,
`  number of vertices in each level of the filtrations of the posets (see the`,
`  help file for 'filter'). Then the groups are broken down into smaller`,
`  subgroups according to the number of vertices of each 'type', as defined`,
`  in the help file for 'invariants'. Finally, the procedure removes all`,
`  isomorphic copies in each subgroup by considering all possible type-`,
`  preserving relabelings of the posets.`,
`  rm_isom() can also be applied to lists or sets of acyclic digraphs.`,
`  Beware, however, that if any graph has cycles, e.g., {[a,b],[b,c],[c,a]},`,
`  then the procedure will enter an infinite loop.`,
`   `,
`EXAMPLES :   `,
`  L:=[op(Posets(4)),op(subs({1=a,2=b,3=c,4=d},Posets(4)))];`,
`  rm_isom(L);`,
`  nops(");                          yields              16`,
`    `,
`SEE  ALSO :  filter, invariants, isom, Posets, Lattices`
):
`help/text/zeta` := TEXT(
`FUNCTION :  zeta - zeta polynomial of a poset`,
`    `,
`CALLING SEQUENCE :  zeta(P,z);`,
`                    zeta(P,n,z);`,
`                    zeta(P,X,z);`,
`    `,
`PARAMETERS :    P   = a poset`,
`                z   = any expression (or name)`,
`                n   = a positive integer`,
`                X   = a set (the vertex set)`,
`   `,
`SYNOPSIS :   `,
`  The zeta polynomial of a poset P is the unique polynomial f(z) with`,
`  the property that for each integer k > 0, f(k+1) equals the number`,
`  weakly increasing (relative to P) sequences x1 <= x2 <= ... <= x[k] of`,
`  vertices of P. In particular, f(2) equals the number of vertices of P.`,
`  zeta(P,X,z) computes the zeta polynomial of the poset P with vertex set X,`,
`  evaluated at z. If the vertex set is {1,2,...,n}, then this can also be`,
`  computed by calling zeta(P,n,z). If there are no isolated vertices in P,`,
`  (i.e., every vertex of P is related in P to at least one other element),`,
`  then one may use zeta(P,z).`,
`  If P has a unique maximal element M and unique minimal element m, then`,
`  zeta(P,-1)=mobius(P,[m,M]).`,
`   `,
`EXAMPLES :   `,
`  zeta(chain(4),5,q);`,
`  factor(");                            yields     1/6*(q+3)*(q**2+2)`,
`  zeta(J({},3),z); `,
`  expand(");                            yields             z^3`,
`  zeta({[a,b],[a,c],[b,d],[c,d]},-1);   yields              1`,
`    `,
`SEE  ALSO :  mobius, omega`
):

#save `posets.m`;
#quit
