#
# Test file for posets 2.4
#
# This is a test suite that runs some basic checks
# to see that the package is working properly.
#
# If you are using the unix version, run the shell command
#   maple -q < posets_test | more
# and check that the output is a stream of OKAY's.
#
# If you are using the vanilla version, start maple, load the package,
# then load this file, and check that the output is a stream of OKAY's.
#
test:=proc(f,pr) local b,N;
  assign(evaln(i),i+1); # subversively global
  if nargs=3 then
    b:=evalb(f(op(args[2]))=args[3])
  elif nargs=4 then
    b:=evalb(pr(f(op(args[3])))=args[4])
  elif nargs>4 then
    b:=evalb(pr(op(args[3]))=args[4]) fi;
  if substring(f,1..7)<>`posets/` then N:=f
    else N:=substring(f,8..length(f)) fi;
  printf(`%3d:  %-12.12s  `,i,N);
  if b then printf(`OKAY\n`) else
    printf(`FAILED\n`); printf(`\n`); args[2..nargs] fi
end:
i:=0:
if assigned(withposets) then # we are using the vanilla edition
  withposets() else with(posets) fi:
encode:=proc(P) local e;
  convert([seq(2^(e[1]+e[2]*(e[2]-3)/2),e=P)],`+`) end:
decode:=proc() local n,i,k,P,del; 
  n:=args[1]; i:=1; P:=NULL; 
  for k from 0 while n>0 do
    if irem(n,2,'n')=1 then del:=i*(i-1)/2-k;
      while del<=0 do del:=del+i; i:=i+1 od;
      P:=P,[i-del,i]
    fi
  od; {P} 
end:

#chain
test(chain,[4],{[1,2],[2,3],[3,4]});

#encode/decode
test(encode,[{[2,4],[3,4],[1,5],[2,5],[3,5]}],496);
test(decode,[496],{[2,4],[3,4],[1,5],[2,5],[3,5]});

#filter
J3:=decode(218777715):
test(filter,[J3,9],[{1,9},{2,3,5},{4,6,7},{8}]);
test(filter,[{[1,2],[1,3],[3,4],[2,5],[4,5]}],[{1},{2,3},{4},{5}]);
test(filter,[{[a,b],[b,e],[c,e]},{a,b,c,d,e}],[{a,d,c},{b},{e}]);

#ranked
test(ranked,[{[1,2],[1,3],[3,4],[2,5],[4,5]},6],false);
P:={[1,2],[2,3],[4,3],[4,5],[5,6],[6,7]}:
test(ranked,[P,7],true);
P:={[1,2],[4,5],[7,6],[10,9],[2,3],[4,3],[8,7],[8,9]}:
test(ranked,x->[x,F],[P,'F'],[true,[{1,8,10},{2,4,7,9},{3,5,6}]]);

#Lattices
test(Lattices,[4],[{[1,2],[1,3],[2,4],[3,4]},chain(4)]);
test(Lattices,x->encode(op(26,x)),[7],1581837);
test(Lattices,nops,[6,ranked],9);

#product
test(`&*`,x->isom(J3,x),[chain(2)$3],true);
P:={[1,2],[1,4],[2,5],[3,6],[4,5]}:
test(`&*`,x->isom(P,x),[chain(2),{[a,b]},{a,b,c}],true);
P:={[1,2],[1,4],[2,5],[3,6],[4,5],[7,8]}:
test(`&*`,(x,y)->isom(P,9,x,y),[{[1,2]},3,{[1,2]},3],true);

#connected
test(connected,x->[x,C],[{[1,2],[4,5],[3,4]},'C'],
  [false,{{1,2},{3,4,5}}]);
test(connected,[chain(2) &* chain(3)],true);
test(connected,[chain(2) &* chain(3),7],false);

#Posets
test(Posets,[3],[{},{[1,3],[2,3]},{[1,2]},{[1,3],[1,2]},{[2,3],[1,2]}]);
test(Posets,x->op(15,x),[5],{[1,3],[2,3],[3,5],[1,4]});
test(Posets,nops,[4,connected],14);
test(Posets,nops,[4,connected,4],10);

#ord_sum
P:={[2,3],[1,3],[1,4],[2,4]}:
test(`&+`,x->isom(P,x),[{},2,{},2],true);
Q:={[1,2],[1,3],[2,5],[5,6],[3,4],[2,4],[3,5],[4,6]}:
test(`&+`,x->isom(Q,x),[{},1,P,{},1],true);

#atomic
test(atomic,[({},1) &+ ({},3) &+ ({},1)],true);
test(atomic,[decode(24979)],false);

#distributive
test(distributive,x->[x,C],[decode(21133),'C'],[true,{2,3,4}]);
test(distributive,[({},1) &+ ({},3) &+ ({},1)],false);

#dual
test(dual,[{[1,2],[1,3],[3,4]}],{[2,1],[3,1],[4,3]});
test(dual,[{[1,2],[1,3],[3,4]},5],{[2,1],[3,1],[4,3]});

#lattice
M:=chain(2) &* chain(3):
test(lattice,[M,6],true);
test(lattice,[M,7],false);
M:=({},3) &+ M:
test(lattice,[M,'semi'],false);
test(lattice,[dual(M),'semi'],true);

#modular
test(modular,[({},1) &+ ({},3) &+ ({},1)],true);
test(modular,[({},1) &+ (chain(2),3) &+ ({},1)],false);
L:=({},1) &+ {[1,2],[1,3],[4,3],[4,5]} &+ ({},1):
test(modular,[L,'upper'],true);
test(modular,[L,'lower'],false);

#closure
test(closure,encode,[{[2,4],[3,5],[1,2],[1,3],[4,6],[5,6]}],32091);
test(closure,[{[a,b],[a,c]},{a,b,c,d}],{[a,b],[a,c]});

#covers
test(covers,[{[a,b],[b,d],[d,e],[c,d],[a,e]}],{[a,b],[c,d],[b,d],[d,e]});
test(covers,[closure(chain(4)),5],chain(4));

#subinterval
P:=decode(24883):
test(subinterval,[P,[1,4]],{[1,2],[1,3],[2,4],[3,4]});
test(subinterval,[P,[-infinity,5]],{[1,3],[3,5]});
test(subinterval,proc() [args] end,[P,[2,5]],[]);
test(subinterval,proc() [args] end,[P,7,[7,infinity]],[{},{7}]);

#subposet
test(subposet,[{[2,5],[2,3],[1,2],[1,4],[5,6],[4,5],[3,6]},{2,3,4}],{[2,3]});
test(subposet,[P,{1,2,4,5}],{[1,2],[2,4],[1,5]});
test(subposet,[P,8,{1,4,5,7}],{[1,4],[1,5]});

#J
test(J,[{},3],J3);
test(J,[chain(2) &* chain(2)],{[1,2],[2,3],[2,4],[3,5],[4,5],[5,6]});
test(J,[{[a,b],[b,c]},{a,b,c}],chain(4));
test(J,[{[a,b]},[a,b,c]],{[1,2],[1,4],[2,3],[2,5],[3,6],[4,5],[5,6]});
test(J,[{[a,b]},[c,a,b]],{[1,2],[1,3],[2,4],[3,4],[3,5],[4,6],[5,6]});

#ideals
P:=decode(907):
test(ideals,[P,[$1..5]],
  [{},{1},{1,2},{1,3},{1,2,3},{1,4},{1,2,4},{1,3,4},{$1..4},{$1..5}]);
test(ideals,[{},[a,b,c]],[{},{a},{b},{a,b},{c},{a,c},{b,c},{a,b,c}]);
test(ideals,[{[1,3],[2,3]},4,3..4],[{1,2,4},{1,2,3},{1,2,3,4}]);
test(ideals,[{[1,3],[2,3]},[$1..4],3..4],[{1,2,3},{1,2,4},{1,2,3,4}]);
test(ideals,[chain(2) &* chain(3),q],1+q+2*q^2+2*q^3+2*q^4+q^5+q^6);

#strongcomps
P:={[a,b],[b,c],[c,a],[0,a],[c,1]}:
test(strongcomps,x->[x,Q],[P,'Q'],[[{0},{a,b,c},{1}],{[1,2],[2,3]}]);
P:={op(J3),[8,3],[2,1]}: f:=[{1,2},{5},{6},{3,4,7,8}]:
test(strongcomps,[P],f);
test(strongcomps,x->[x,encode(Q)],[P,9,'Q'],[[{9},op(f)],948]);

#orbit
test(`posets/orbit`,[[{d=e,e=d},{a=d,b=e,c=f,d=a,e=b,f=c}],b],{a,b,d,e});
test(`posets/orbit`,[[{a=b,b=a},{a=b,b=c,c=d,d=a}],c],{a,b,c,d});

#fastdisc
test(`posets/fastdisc`,[{op(chain(5)),[4,6]},[{$1..6}]],
  [{5,6},{1},{2},{3},{4}]);
test(`posets/fastdisc`,[{op(chain(6)),[1,1],[4,4],[6,1]},[{$1..6}]],
  [{2,5},{3,6},{1,4}]);

#isom
P:={[2,4],[3,4],[3,5],[1,2],[1,3],[4,6],[5,6]}:
Q:={[2,5],[2,3],[1,2],[1,4],[5,6],[4,5],[3,6]}:
test(isom,[P,Q,8],false);
test(isom,[P,Q],true);
test(isom,x->[x,f],[P,7,Q,7,'f'],[true,{1=1,2=4,3=2,5=3,4=5,6=6,7=7}]);
test(isom,[J({[a,b],[a,c]}),J({[a,b],[c,b]})],false);

#canon
P:=chain(2) &* chain(3):
test(canon,[P,6],{[6,2],[4,1],[2,1],[5,3],[6,4],[3,4],[5,6]});
test(canon,[dual(P)],{[6,2],[4,1],[2,1],[5,3],[6,4],[3,4],[5,6]});
test(canon,[{[a,b],[c,b],[c,d]},'natural'],{[2,4],[1,4],[2,3]});

#rm_isom
P:=Posets(4):
test(rm_isom,nops,[[op(P),op(subs({1=a,2=b,3=c,4=d},P))]],16);

#autgroup
P:=({},3) &+ ({},2):
ag:=`posets/orbit`([{1=2,2=1},{2=3,3=2},{4=5,5=4}],[$1..6]):
test(autgroup,x->`posets/orbit`(x,[$1..6]),[P,6],ag);
f:=proc(G) local i,c,pi,pg; # validating a permgroup is tedious
  pg:=map(y->map(x->[op(x),x[1]],y),op(2,G));
  pg:=[seq({seq(seq(c[i-1]=c[i],i=2..nops(c)),c=pi)},pi=pg)];
  `posets/orbit`(pg,[$1..op(1,G)])
end:
ag:=`posets/orbit`([{2=3,3=2,6=7,7=6},{3=5,5=3,4=6,6=4}],[$1..8]):
test(autgroup,f,[J3,'permgroup'],ag);

#antichains
test(antichains,[{[a,b],[b,c]},{a,b,c}],[{},{a},{b},{c}]);
test(antichains,[{[a,b]},[a,b,c]],[{},{a},{b},{c},{a,c},{b,c}]);
test(antichains,[{[a,b]},[c,a,b]],[{},{c},{a},{a,c},{b},{b,c}]);
P:=decode(24883):
test(antichains,[P,7,q],1+7*q+9*q^2+3*q^3);
test(antichains,[P,'max'],[{1},{2,3},{2,5},{4,5},{6}]);
P:=decode(46139382623574971021):
test(antichains,[P,3..3],
  [{3,5,7},{3,5,10},{3,8,10},{6,8,10}]);

#chains
test(chains,[{[a,b],[b,c]},{a,b,c}],
  [[],[a],[b],[a,b],[c],[a,c],[b,c],[a,b,c]]);
test(chains,[{[1,2],[3,4]},[1,3,2,4]],[[],[1],[3],[2],[1,2],[4],[3,4]]);
test(chains,[{[1,2],[3,4]},[1,2,3,4]],[[],[1],[2],[1,2],[3],[4],[3,4]]);
P:=({},1) &+ ({[1,2]},3) &+ ({},1):
test(chains,[P,'max'],[[1,4,5],[1,2,3,5]]);
test(chains,[P,6,q],1+6*q+8*q^2+5*q^3+q^4);
test(chains,[P,[$1..5],3..3],[[1,2,3],[1,2,5],[1,3,5],[2,3,5],[1,4,5]]);

#zeta
test(zeta,[{[a,b],[b,c]},{a,b,c,d},q],1+1/2*q+1/2*q^2);
test(zeta,[J3,t],t^3);
P:=({},1) &+ ({},3) &+ ({},1):
test(zeta,[P,-1],2);

#f_poly/h_poly
P:=decode(1196557):
test(f_poly,[P,t],t+5*t^2+4*t^3+t^4);
test(h_poly,[P,7,t],t+2*t^2-3*t^3+t^4);
test(h_poly,[J3,z],z+4*z^2+z^3);

#char_poly
test(char_poly,[J3,z],z^3-3*z^2+3*z-1);
test(char_poly,[({},1) &+ ({},3) &+ ({},1),5,q],q^2-3*q+2);

#flag_f/flag_h
P:=decode(17291):
test(flag_f,[P,z],z[3]+3*z[1]*z[3]+z[2]*z[3]+3*z[1]*z[2]*z[3]);
test(flag_h,[P,z],z[3]+2*z[1]*z[3]);
test(flag_h,[chain(4),4,q],q[3]);

#W 
f:=expand(q^4*t*(q^2*t+1)*(q^4*t^2+3*q^3*t+4*q^2*t+3*q*t+1)):
test(W,[{},4,q,t],f);
test(W,[{},4,1,t,'ideals'],subs(q=1,f));
P:=decode(24883):
test(W,[P,q,t,{[1,2],[5,6]}],q^9*t^2+q^11*t^3+2*q^12*t^3+q^13*t^3);
f:=expand(q^4*t*(1+2*q^3*t+2*q^2*t+q^5*t^2+q*t+q^4*t^2)):
test(W,[{[a,b],[a,c]},{a,b,c,d},q,t],f);
test(W,[chain(9),q,t,'linear',{[1,2],[3,4],[5,6]}],q^18*t^4);
test(W,[chain(4) &* chain(4),1,1],24024);

#omega
test(omega,[chain(4),5,z],1/24*z^5+1/4*z^4+11/24*z^3+1/4*z^2);
test(omega,[chain(4),z,{[3,4]}],1/24*z^4+1/12*z^3-1/24*z^2-1/12*z);
test(omega,[chain(4),6,z,'ideals'],1/4*z^3+11/24*z^4+1/4*z^5+1/24*z^6);
test(omega,[{[a,b],[a,c]},{a,b,c,d},3],42);
test(omega,[chain(9),q,'linear',chain(5)],
  (-30*q^7+273*q^5-820*q^3+576*q+q^9)/9!);

#eulerian
P:=decode(25011):
test(eulerian,[P],true);
test(eulerian,[P,7],false);
test(eulerian,x->[x,F],[J({[1,2]},3),'F'],[false,[{1},{2,3},{4,5},{6}]]);

#meet
f:=proc(M,n) local i,j,L; L:=[seq(seq(M[i,j],i=1..j),j=1..n)];
  map(proc(x) if type(x,'integer') then x else [] fi end,L) end:
test(meet,x->f(x,8),[J3],
  [1,1,2,1,1,3,1,2,3,4,1$4,5,1,2,1,2,5,6,1,1,3,3,5,5,7,$1..8]);
test(meet,proc() [args] end,[{[a,b],[c,b],[d,c]},[a,c,d]],[]);
test(meet,x->f(x,5),[{[1,4],[1,3],[2,3],[2,4]},5],
  [1,[],2,1,2,3,1,2,2,4,[],[],[],[],5]);

#mobius
test(mobius,x->{op(op(2,x))},[{[a,b],[a,c]},{a,b,c}],
  {(c,c)=1,(a,c)=-1,(a,a)=1,(a,b)=-1,(b,b)=1});
test(mobius,[&+({},1,{},4,{},1),[1,6]],3);
test(mobius,x->f(x,8),[J3],[1,-1,1,-1,0,1,1,-1,-1,1,-1,0,0,0,1,1,
  -1,0,0,-1,1,1,0,-1,0,-1,0,1,-1,1,1,-1,1,-1,-1,1]);

#extensions
test(extensions,x->{op(x)},[{[1,2]},3],{[1,2,3], [1,3,2], [3,1,2]});
test(extensions,[{[1,2]}],[[1,2]]);
test(extensions,x->{op(x)},[{[a,b],[a,c]},{a,b,c}],{[a,b,c], [a,c,b]});

#disj_union
P:={[1,2],[4,5],[3,4]}:
test(`&u`,x->isom(P,x),[chain(2),chain(3)],true);
P:={[1,2],[2,4],[5,6]},6:
test(`&u`,(x,y)->isom(P,x,y),[{[a,b],[b,c]},{a,b,c,d},chain(2)],true);
P:={[1,2],[4,5],[7,8],[10,11]},12:
test(`&u`,(x,y)->isom(P,x,y),
  [chain(2),3,chain(2),3,chain(2),3,chain(2),3],true);

#rand_poset
coin:=proc() assign(evaln(f),irem(427419669081*f,999999999989));
  irem(f,2) end: f:=42:
test(rand_poset,encode,[10,coin],17643793572133);

#plot_poset,layout
if ceil(0)=0 then #we are using Maple V R2 or later
  F:=[[1,2],[3,4,5],[6,7],[8,9]]: pt:=[[0,2],[-1,1,3],[0,2]$2]:
  test(`posets/layout`,[{[1,7],[1,8]},F,false,pt],[[1,0,1],[2,2,1],
    [3,-1,2],[4,1,2],[5,3,2],[6,0,3],[7,3,3],[8,-1,4],[9,2,4]]);
  test(plot_poset,x->op(0,x),[chain(4)],PLOT) fi:

if assigned(withposets) then printf(`if OKAY, restart Maple\n`) else quit fi: