#
# Test file for coxeter/weyl 2.4
#
# This is a test suite that does some basic checks
# to see that the package is working properly.
#
# If you are using the unix version, run the shell command
#   maple -q < cw_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)
  assign(evaln(i),i+1); # subversively global
  if nargs=3 then
    if f(op(args[2]))=args[3] then lprint(i,OKAY) else args fi
  elif nargs=4 then
    if pr(f(op(args[3])))=args[4] then lprint(i,OKAY) else args fi
  elif nargs=5 then
    if pr(op(args[3]))=args[4] then lprint(i,OKAY) else args fi
  fi
end:
i:=0:
if assigned(withcoxeter) then # we are using the vanilla edition
  withweyl() else with(weyl) fi:

# weights
test(weights,[[2*e1,2*(e2-e1)]],[e1+e2,2*e2]);
test(weights,[G2],[-e1+e3,-e2-e1+2*e3]);

#rho, co_rho
test(rho,[C3],e1+2*e2+3*e3);
test(co_rho,[C3],(e1+3*e2+5*e3)/2);

# weight_coords
test(weight_coords,[rho(F4),F4],[1,1,1,1]);
test(weight_coords,[a*e1+b*e2+c*e3,B3],[2*a,-a+b,-b+c]);

if assigned(withcoxeter) then # we are using the vanilla edition
  withcoxeter() else with(coxeter) fi:

# base, co_base
test(base,[B2*A2],[e2-e1,e3-e2,e4,e5-e4]);
test(base,[[e2-e1,e3-e2,e4,e5-e4]],[e2-e1,e3-e2,e4,e5-e4]);
test(co_base,[[e2-e1,e3-e2,e4,e5-e4]],[e2-e1,e3-e2,2*e4,e5-e4]);
test(base,x->evalf(x,6),[I2[5]],[e1,-.809017*e1+.587785*e2]);
m:=array([[1,3,2],[3,1,4],[2,4,1]]):
test(base,[m],[e3-e2,e2-e1,e1]);

# cartan_matrix
test(cartan_matrix,x->op(3,convert(x,listlist)),[F4],[0,-2,2,-1]);
m:=[[2,-1],[-2,2]]:
test(cartan_matrix,x->convert(x,listlist),[[e1-e2,2*e2]],m);
test(cartan_matrix,x->convert(x,listlist),[array(m)],m);
m:=array([[1,2,3],[2,1,3],[3,3,1]]):
test(cartan_matrix,x->convert(x,listlist),
  [m],[[2,0,-1],[0,2,-1],[-1,-1,2]]);

# index
test(index,[D4],4);
test(index,[[e1-e2,2*e2]],2);

# char_poly
test(char_poly,[[1,3,2,3],B3],1-q+q^2-q^3);
test(char_poly,[[1,2,3,4],D4,2],27);
test(char_poly,x->evalf(x,3),[[1,2,3,2],base(H3),z],
  1.-1.62*z+1.62*z^2-1.00*z^3);

# class_rep
test(class_rep,[[1,2,3,4,3,4,1],A2^2],[1,3,4]);
test(class_rep,x->op(18,x),[E6],[1,2,3,5]);
test(class_rep,[I2[5]],[[],[1],[1,2],[1,2,1,2]]);

# class_size
test(class_size,[[4,3,2,1,2,1],H4],720);
test(class_size,[longest_elt(A2*G2),A2*G2],3);
test(class_size,[C3],[1,6,8,3,6,3,6,1,6,8]);

# cox_matrix
test(cox_matrix,x->x[1,2],[H4],5);
m:=[[1,6],[6,1]]:
test(cox_matrix,x->convert(x,listlist),[[e1-e3,-e1-e2+2*e3]],m);
test(cox_matrix,x->convert(x,listlist),[array(m)],m);
m:=array([[2,-2,0],[-1,2,-1],[0,-2,2]]):
test(cox_matrix,x->convert(x,listlist),[m],[[1,4,2],[4,1,4],[2,4,1]]);

#cprod
chi:=[8,4,2,0$7]:
test(cprod,[chi,chi,B3],4);
test(cprod,[[3,1,0,1,-1,-1,1,-3,-1,0],chi,B3],1);

# degrees,exponents,cox_number,num_refl,size
test(degrees,[D6],[2,4,6,6,8,10]);
test(exponents,[H4],[1,11,19,29]);
test(cox_number,[E6],12);
test(cox_number,[A3^2*A1],4);
test(num_refl,[B3*A3],15);
test(size,[E8],696729600);

# highest_root
test(highest_root,[C4],2*e4);
test(highest_root,x->evalf(x,3),[I2[5]],.309*e1+.951*e2);

# induce
S:=base(H3): J:=[S[2],S[3]]: f:=[1,-1,1]:
test(induce,[f,J,H3],[20,0,-4,0,2,0,0,0,0,0]);
J:=[e2-e1,e3-e2,e5-e4]: f:=[seq(coeff(char_poly(w,J,-q),q),w=class_rep(J))]:
test(induce,[f,J,A4],[30,4,-2,0,-2,0,0]);

# perm_char
test(perm_char,[[1,2],C3],[6,2,0,4,0,2,2,0,0,0]);
S:=base(C3): r:=highest_root(C3):
test(perm_char,[[S[1],S[2],-r],C3],[3,1,0,3,1,3,1,3,1,0]);

# interior_pt
test(interior_pt,[F4],e1+2*e2+3*e3+8*e4);
test(interior_pt,[[e1,e2,e1-e3]],e1+e2);

# irr_chars
test(irr_chars,[A2],[[1,1,1],[2,0,-1],[1,-1,1]]);
test(irr_chars,y->map(x->op(1,x),y),[H3],[1,1,3,3,3,3,4,4,5,5]);

# length_gf
test(length_gf,[A2,z],z^3+2*z^2+2*z+1);
test(length_gf,x->normal(x/length_gf(A2)),[B3],q^6+q^5+q^4+2*q^3+q^2+q+1);

# multperm
test(multperm,[[1,2],{s1=[[6,7]],s2=[[7,8]]}],[[6,8,7]]);
test(multperm,[[2,1],{s1=[[6,7]],s2=[[7,8]]},8],[[6,7,8]]);
P:={s1=[[3,4],[5,6]], s2=[[3,5],[4,6]], s3=[[2,3],[6,7]], s4=[[1,2],[7,8]]}:
test(multperm,[longest_elt(D4),permgroup(8,P)],[[1,8],[2,7],[3,6],[4,5]]);

# name_of
test(name_of,[[e1+e2,e1-e2]],A1^2);
S:=base(F4): r:=highest_root(F4): pi:='pi':
test(name_of,x->[x,pi],[[-r,S[2],S[3],S[4]],pi],[B4,[2,3,4,1]]);
test(name_of,[array([[1,5],[5,1]])],I2[5]);
test(name_of,[E5],E5);
test(name_of,[cartan_matrix(E5)],D5);

# orbit
test(orbit,[e4,C4],[e4,e3,e2,e1,-e1,-e2,-e3,-e4]);
test(orbit,[e1+e2+e3,D3],[e1+e2+e3, e3-e1-e2, e2-e1-e3, e1-e2-e3]);

# orbit_size
test(orbit_size,[(e1+e2+e3+e4+e5)/2,D5],16);
test(orbit_size,[(e1+e2+e3+e4+e5)/2,D5,-1],32);
test(orbit_size,[e1,H4],120);

# perm2word
pg:=permgroup(8,{s1=[[6,7]],s2=[[7,8]]}): sc:=stab_chain(pg):
test(perm2word,[[[6,8,7]],pg,sc],[1,2]);
test(perm2word,[[[6,7,8]],pg,sc],[2,1]);
pg:=permgroup(12, {s1=[[3,4],[5,6],[7,8],[9,10]],
 s2=[[2,3],[4,5],[8,9],[10,11]], s3=[[1,2],[5,7],[6,8],[11,12]]}):
test(perm2word,[[[1,7],[4,8],[5,9],[6,12]],pg],[3,2,1,2,3]);

# perm_rep
test(perm_rep,[B3],permgroup(6,
  {s1=[[3,4]],s2=[[2,3],[4,5]],s3=[[1,2],[5,6]]}));
test(perm_rep,[{1,3},A3],permgroup(6,
  {s1=[[2,3],[4,5]],s2=[[1,2],[5,6]],s3=[[2,4],[3,5]]}));
test(perm_rep,x->op(2,x),[A3*I2[6]],{s1=[],s2=[],s3=[],s4=[[2,3],[4,5]],
  s5=[[1,2],[3,4],[5,6]]});

# pos_roots
test(pos_roots,[B2],[e1,e2-e1,e2,e2+e1]);
test(pos_roots,[[e1,-e2-e1]],[e1,-e2-e1,-e2,e1-e2]);

# presentation
test(presentation,[A2],grelgroup({s1,s2},
  {[s1,s1],[s2,s2],[s1,s2,s1,s2,s1,s2]}));
test(presentation,x->map(nops,op(2,x)),[H3],{2,4,6,10});

# rank
test(rank,[I2[7]],2);
test(rank,[A3^2*B3*D10],19);
test(rank,[cartan_matrix(C4)],4);

# reduce
test(reduce,[[1,2,3,1,2,3],A3],[2,1,3,2]);
test(reduce,[[1,2,3,1,2,3],A3,0],[2,3,1,2]);
 
# iprod
test(iprod,[e1+e2,e1-2*e2+e3],-1);
test(iprod,[e1+e2,a*e1+b*e2+c*e3],a+b);
test(iprod,map,[iprod,base(D4),e3+e4],[0,0,1,0],0);

# reflect
test(reflect,[e1+e2, e1+2*e2],-2*e1-e2);
test(reflect,x->collect(x,{e1,e2}),[e1+e2, a*e1+b*e2],-b*e1-a*e2);
S:=base(B4): v:=interior_pt(B4): a:='a': b:='b':
test(reflect,[seq(S[w],w=longest_elt(B4)),v],-v);

# restrict
test(restrict,[[$1..10],[1,2],C3],[1,4,2,6,7]);
test(restrict,[[$1..10],[2*e1,e2-e1,-2*e3],C3],[1,4,4,6,2,5,6,8,7,9]);

# root_coords
test(root_coords,[highest_root(G2),G2],[3,2]);
test(root_coords,[a*e1+b*e2+c*e3,B3],[a+b+c,b+c,c]);
test(root_coords,x->evalf(x,3),[2*e2,H3],[2.62,3.24,1.62]);

# stab_chain
pg:=permgroup(6,{s3=[[1,2],[5,6]],s1=[[3,4]],s2=[[2,3],[4,5]]}):
test(stab_chain,[pg],[[1,[1,2,3,4,5,6],[[],[3],[3,2],[3,2,1],[3,2,1,2],
  [3,2,1,2,3]]],[2,[2,3,4,5],[[],[2],[2,1],[2,1,2]]],[3,[3,4],[[],[1]]]]);

# vec2fc
test(vec2fc,[-e1+2*e2,D4],2*e4+e3);
S:=base(F4): w:='w':
test(vec2fc,x->[x,w],[-S[2],S,w],[e4,[2,1,3,2,4,3,2,1]]);

# longest_elt
test(longest_elt,[H3],[1,2,1,2,1,3,2,1,2,1,3,2,1,2,3]);
test(longest_elt,[[e2-e1,e4-e3,e3-e2]],[1,2,3,1,2,3]);

#minuscule
test(minuscule,[C4],[e4]);
test(minuscule,[C4,'quasi'],[e4,e3+e4]);
test(minuscule,[F4*G2],[]);
test(minuscule,[F4*G2,'quasi'],[e4,e7-e5]);

# weyl_dim
test(weyl_dim,[weights(F4)[2],F4],273);
w:=weights(C2): v:=expand(a*w[1]+b*w[2]):
test(weyl_dim,normal,[v,C2],(1+a)*(1+b)*(2+a+b)*(3+2*a+b)/6);
test(weyl_dim,[2*e2+e1,B2,q],q^(-5)*(1-q^7)*(1-q^5)/(1-q)^2);

# weight_mults
w:=weights(C3):
test(weight_mults,[w[1]+w[3],C3],M[1,0,1]+M[0,0,2]+3*M[0,1,0]+4*M[0,0,0]);
test(weight_mults,[w[1]+w[3],e1+e3,C3],3);

# weight_sys
test(weight_sys,[w[1]+w[3],C3],[e1+e2+2*e3,2*e3,e2+e3,0]);
w:=weights(G2): wc:='wc':
test(weight_sys,x->wc,[3*w[1],G2,wc],
  [[3,0],[1,1],[2,0],[0,1],[1,0],[0,0]]);

#tensor
w:=weights(G2):
test(tensor,[w[2],w[2],G2],X[0,2]+X[3,0]+X[0,1]+X[2,0]+X[0,0]);
w:=weights(A3): f:=X[3,0,1]+X[1,1,1]+X[2,0,0]+X[0,1,0]:
test(tensor,[2*w[1],w[1]+w[3],A3,'qtensor'],f);
test(tensor,[2*w[1],w[1]+w[3],A3,'mchain'],f);
test(tensor,[2*w[1],w[1]+w[3],A3,'klimyk'],f);
test(tensor,[e4,e3+e4,F4,'qtensor'],X[1,0,0,1]+X[0,1,0,0]+X[1,0,0,0]);

#branch
w:=weights(A3): f:=X[2,0,1]+X[-2,2,1]+X[-1,1,0]+X[-3,2,0]+X[0,1,1]+X[1,0,0]:
test(branch,[2*w[1]+w[3],[2,3],A3],f);
test(branch,[2*w[1]+w[3],[2,3],A3,'mchain'],f);
w:=weights(F4): f:=X[1,0,0,0]+X[0,1,0,-1]+X[1,0,0,-1]:
test(branch,[w[1],{1,2,3},F4,'klimyk'],f);
test(branch,[w[1],{1,2,3},F4,'mchain'],f);

#toM
test(toM,[M[0,1,0]*X[1,0,0],C3],M[1,1,0]+3*M[0,1,1]+3*M[1,0,0]+8*M[0,0,1]);
test(toM,[M[1,0]*M[0,1],G2],M[1,1]+2*M[2,0]+2*M[1,0]);

#toX
test(toX,[X[2,0,0]*(a*X[0,1,0]+b*X[0,0,2]),A3],
  a*X[2,1,0]+b*X[2,0,2]+(a+b)*X[1,0,1]+b*X[0,0,0]);
test(toX,[M[0,1,0,0],F4],X[0,1,0,0]-2*X[0,0,0,1]-3*X[1,0,0,0]+5*X[0,0,0,0]);

if assigned(withcoxeter) then lprint(`if OKAY, restart Maple`) else quit fi: