#
# plot_poset(P,<options>) plot the poset P using maple 2D graphics.
#  The embedding algorithm uses filter() to arrange the vertices into levels,
#  and then applies sort() to each level of vertices. Then the embedding of
#  vertices is adjusted so that no vertex intersects the interior of an edge.
# Requires MapleV.2 or later.
#
# The <options> may include any of the following in any order...
#  proportional   use horizontal spacing between vertices that is inversely
#                 proportional to the number of vertices in each level
#  ranked         attempt to use the vertex levels returned by
#                 the ranked() function, if possible.
#  stretch=<num>  stretch the vertical axis by given factor.
#  ecolor=<color> use the specified color for edges (default=red)
#  ecolor=<table> use the <table> to choose the color of each edge. Edges of P
#                 not in the table are given the default color. 
#  vcolor=<color> use the specified color for vertices or their labels
#                 (default=white)
#  labels         label the vertices, rather than plotting them as points
#  labels=<table> use the entries of <table> to produce a label (must be
#                 of type 'string') for each vertex.
#  title=<string> add the indicated title to the plot
#
`posets/plot_poset`:=proc(P) local X,f,i,j,F,pt,vclr,eclr,str,lbl,t,p,C,Q;
  if ceil(0)<>0 then ERROR(`requires MapleV R2 or later`) fi;
  if nargs=1 then X:=map(op,P); j:=2
    elif type(args[2],'integer') then X:={$1..args[2]}; j:=3
    elif type(args[2],'set') then X:=args[2]; j:=3
    else X:=map(op,P); j:=2
  fi;
  if not member('ranked',[args]) or not posets['ranked'](P,X,F)
    then F:=posets['filter'](P,X) fi;
  F:=[seq(sort([op(i)]),i=F)]; f:=nops(F);
  str:=2.0; lbl:=NULL; t:=``;
  eclr:=eval(`posets/default`['ecolor'],1); C:=table(); Q:=P;
  vclr:=eval(`posets/default`['vcolor'],1);
  for i in [args[j..nargs]] do;
    if op(1,i)='vcolor' then vclr:=op(2,i)
      elif op(1,i)='ecolor' then
        if type(op(2,i),'table') then C:=op(2,i);
          Q:=P minus map(<op(op(x))>,{entries(C)});
          elif type(op(2,i),'name') then eclr:=op(2,i)
        fi;
      elif op(1,i)='stretch' then str:=str*op(2,i)
      elif op(1,i)='labels' then
        if nops(i)>1 then lbl:=op(2,i) else
          lbl:=table([seq(p=convert(p,'string'),p=X)]) fi;
      elif op(1,i)='title' then t:=op(2,i);
    fi;
  od;
  if member('proportional',[args]) then str:=str/f;
    true,[seq([seq((2*j-1)/nops(F[i]),j=1..nops(F[i]))],i=1..f)];
  else
    false,[seq([seq(2*j-nops(F[i]),j=1..nops(F[i]))],i=1..f)];
  fi;
  pt:=`posets/plot_poset/adjust`(P,F,f,");
  pt:=table([seq(seq(F[i][j]=(1.0*pt[i][j],str*i),j=1..nops(F[i])),i=1..f)]);
  if lbl=NULL then 
    p:=plot([entries(pt)],'color'=vclr,'style'='point')
  else
    p:=plots['textplot']([seq([pt[i],lbl[i]],i=map(op,F))],'color'=vclr)
  fi;
  p:=p,seq(plot({seq([pt[i[1]],pt[i[2]]],i=C[op(j)])},
    'color'=op(j)),j=[indices(C)]);
  if nops(Q)>0 then p:=p,plot({seq([pt[i[1]],pt[i[2]]],i=Q)},'color'=eclr) fi;
  plots['display']({p},'title'=t,'scaling'='constrained','axes'='none');
end:
#
`posets/plot_poset/adjust`:=proc(P,F,f,flag)
    local coords,i,j,vr,hr,bad,e,conflict,v,h,r,d,n;
  vr:=table([seq(seq(i=j,i=F[j]),j=1..f)]);
  bad:=table([seq(i=NULL,i=map(op,F))]);
  map(proc(x,y) if y[x[2]]-y[x[1]]>1 then x fi end,P,vr);
  if nops(")=0 then RETURN(args[5]) else coords:=args[5] fi;
  for e in "" do bad[e[2]]:=bad[e[2]],e[1] od;
  hr:=table([seq(seq(F[j][i]=i,i=1..nops(F[j])),j=1..f)]);
  for i from 3 to f do;
    n:=nops(F[i]); d:=-1; j:=iquo(n,2)+1;
    while j>0 and j<=n do;
      conflict:=true;
      while conflict do;
        conflict:=false;
        for e in {bad[F[i][j]]} do;
          v:=i-vr[e];
          h:=coords[i][j]-coords[vr[e]][hr[e]];
          for r to v-1 do;
            if member(coords[i][j]-r*h/v,coords[i-r]) then
              if flag then 1/n else 1 fi;
              if d<0 then [0$(j-1),(")$(n-j+1)] else [-(")$j,0$(n-j)] fi;
              coords:=subsop(i=zip(<x+y>,coords[i],"),coords);
              conflict:=true; break;
            fi;
          od;
          if conflict then break fi;
        od;
      od;
      j:=j+d; d:=-d-signum(d);
    od;
  od;
  coords;
end:
#
save `posets/plot_poset`, `posets/plot_poset/adjust`,
  ``.HomeLib.`/posets/plot_poset.m`;
quit;