# compute HL polynomial in n variables: genhyp(n);comphl1([partition]);

#read `N:/My Documents/soft/alcoves/hall-litt-c.txt`:
#read `C:/Documents and Settings/lenart/My Documents/soft/alcoves/hall-litt-c.txt`:

print(`for Maple 9,10; run genhyp first`);

Perm2LengthB:=proc(p) local i,j,l;
l:=0;
for i from 1 to nops(p)-1 do
 for j from i+1 to nops(p) do
  if cmp(p[j],p[i]) then l:=l+1 fi
 od
od;
l
end;

ListCode:=proc(n)
  if (n=1) then
    RETURN([[0], [1]])
  fi;
  RETURN(map(proc(code, n) local i;
               op(code); seq([%, i], i=0..2*n-1)
             end, ListCode(n-1), n))
end;

Code2Bar:=proc(code)
  local
    bar, # the result...
    rd,  # a reduced decomposition...
    i,   # variable for loop...
    j;   # variable for sequence...
  rd:=Code2Rd(code);
  bar:=[seq(j, j=1..nops(code))];
  for i in rd do
    if (i=0) then
      bar:=subsop(1=-bar[1], bar)
    else
      bar:=subsop(i=bar[i+1], i+1=bar[i], bar)
    fi
  od;
  RETURN(bar)
end;

Bar2Length:=proc(p) local s,i;s:=Perm2LengthB(p);for i from 1 to nops(p) do if p[i]<0 then s:=s+nops(p)+p[i]+1 fi od;s; end;

Code2Rd:=proc(code)
  local
    i, j; # variables for sequence...
  [seq( [seq(-j, j=-i+1..-1), seq(j, j=0..i-1)]   , i=1..nops(code))];
  RETURN([seq(op(1..code[i], %[i]), i=1..nops(code))])
end;

genhyp:=proc(n) local i,b0;global bc,sbc;
b0:=ListCode(n);bc:=[seq(Code2Bar(b0[i]),i=1..nops(b0))]; 
sbc:=[seq(Bar2Length(bc[i]),i=1..nops(bc))];
print(`number of elements`,nops(bc));
end;

lchf:=proc(n,nn) local l,i,j,m1,m2,m3,m4;
l:=[];
for i from n to 1 by -1 do
 for j from n+1 to nn do l:=[[i,j],op(l)] od od;
m1:=nops(l);
for i from n to 1 by -1 do
 for j from i to 1 by -1 do l:=[[i,j],op(l)] od od;
m2:=nops(l);
for i from n to 1 by -1 do
 for j from nn to n+1 by -1 do l:=[[j,i],op(l)] od od;
m3:=nops(l);
for i from n to 1 by -1 do
 for j from i-1 to 1 by -1 do l:=[[i,j],op(l)] od od;
m4:=nops(l);
l,m4-m3,m4;
#l,m4-m3,m4-m2,m4-m1,m4;
#l,m4;
end;

#lt listed as [3,2,1]
lch:=proc(lt,n) local i,lc,ll,r;
lc:=[];ll:=[[0,0]];
for i from nops(lt) to 1 by -1 do
 r:=lchf(lt[i],n);
 lc:=[op(lc),op(r[1])];
 ll:=[op(ll),[ll[-1][1]+r[2],lt[i]],[ll[-1][1]+r[3],lt[i]]];
# ll:=[op(ll),[ll[-1][1]+r[2],lt[i]],[ll[-1][1]+r[3],lt[i]],[ll[-1][1]+r[4],lt[i]],[ll[-1][1]+r[5],lt[i]]];
#  ll:=[op(ll),[ll[-1][1]+r[2],lt[i]]];
od;
lc,ll;
end;

cmp:=proc(i,j) if i*j>0 then if i<j then true else false fi else if i>0 then true else false fi fi end;

decllong:=proc(w,p) local l1,l2;l1:=Bar2Length(w);l2:=Bar2Length(tr(w,p)); if l1>l2 then true else false fi end;

#### - take care that for ei+ej, entries [i,j] appear as [j,i]
decl:=proc(w,p) if p[1]<p[2] then cmp(w[p[2]],w[p[1]]) 
else if p[1]=p[2] then if w[p[1]]<0 then true else false fi 
else cmp(-w[p[1]],w[p[2]]) fi fi
end;

tr:=proc(w,p) local w1;if p[1]<p[2] then tr1(w,p) else if p[1]=p[2] then w1:=w;w1[p[1]]:=-w1[p[1]];w1 
else w1:=tr1(w,p);w1[p[1]]:=-w1[p[1]];w1[p[2]]:=-w1[p[2]];w1 fi fi end; 

rev:=proc(s) local i; [seq(s[nops(s)+1-i],i=1..nops(s))] end;

tr1:=proc(p,t) local aux,p1;
p1:=p;aux:=p1[t[1]];p1[t[1]]:=p1[t[2]];p1[t[2]]:=aux;p1
end;


#ll[1] limit in chain of perms;ll[2] height of column; typical [[0,0],[4,2],[7,1]] for [[1,4],[1,3][2,4],[2,3],[1,4],[1,3],[1,2]]
#returns list of tableaux for each folding plus related parameters
fold:=proc(lc,w,ll) local i,j,ww,lfld,lw,llw,fld,ready,lt,t,w1,k,kk;
#print(lc,w,ll);
lfld:=[[]];ww:=w;llw:=[[w]];
i:=1;lw:=[w];fld:=[];ready:=false;
while not ready do
 if i<=nops(lc) then
  if decl(ww,lc[i]) then
   ww:=tr(ww,lc[i]);
   lw:=[op(lw),ww];
   fld:=[op(fld),i];lfld:=[op(lfld),fld];llw:=[op(llw),lw];
#if nops(lfld)>20000 then ERROR() fi;
  fi;
  i:=i+1;
 fi;
 if i>nops(lc) then
  if fld=[] then ready:=true
  else
   i:=fld[-1]+1;fld:=subsop(-1=NULL,fld);lw:=subsop(-1=NULL,lw);
   ww:=lw[-1];
  fi
 fi;
od;
#print(lfld);
lt:=[];
for i from 1 to nops(lfld) do
 t:=[];fld:=lfld[i];kk:=0;w1:=w;lw:=llw[i];
 for j from 1 to nops(ll)-1 do
  t:=[op(t),[seq(w1[k],k=1..ll[j+1][2])]];
  while (kk+1<=nops(fld)) and (fld[kk+1]<=ll[j+1][1]) do kk:=kk+1 od;
  if kk<=nops(fld) then w1:=lw[kk+1] fi;
 od;
################################################
lt:=[op(lt),[t,Bar2Length(lw[-1]),nops(fld),fld]];
#*****lt:=[op(lt),[t,Bar2Length(lw[-1]),nops(fld),fld,lw[1],lw[-1]]];
od;
#print(`----`,lt);
lt;
end;

#returns only fld
fold1:=proc(lc,w) local i,j,ww,lfld,lw,llw,fld,ready,lt,t,w1,k,kk;
#print(lc,w,ll);
lfld:=[[]];ww:=w;llw:=[[w]];
i:=1;lw:=[w];fld:=[];ready:=false;
while not ready do
 if i<=nops(lc) then
  if decl(ww,lc[i]) then
   ww:=tr(ww,lc[i]);
   lw:=[op(lw),ww];
   fld:=[op(fld),i];lfld:=[op(lfld),fld];llw:=[op(llw),lw];
if nops(lfld)>22000 then ERROR() fi;
  fi;
  i:=i+1;
 fi;
 if i>nops(lc) then
  if fld=[] then ready:=true
  else
   i:=fld[-1]+1;fld:=subsop(-1=NULL,fld);lw:=subsop(-1=NULL,lw);
   ww:=lw[-1];
  fi
 fi;
od;
[seq([lfld[i],Bar2Length(llw[i][-1])],i=1..nops(lfld))];
end;

#returns only fld; uses increasing condition on chains
fold2:=proc(lc,w) local i,j,ww,lfld,lw,llw,fld,ready,lt,t,w1,k,kk;
#print(lc,w,ll);
lfld:=[[]];ww:=w;llw:=[[w]];
i:=1;lw:=[w];fld:=[];ready:=false;
while not ready do
 if i<=nops(lc) then
  if not decl(ww,lc[i]) then
   ww:=tr(ww,lc[i]);
   lw:=[op(lw),ww];
   fld:=[op(fld),i];lfld:=[op(lfld),fld];llw:=[op(llw),lw];
  fi;
  i:=i+1;
 fi;
 if i>nops(lc) then
  if fld=[] then ready:=true
  else
   i:=fld[-1]+1;fld:=subsop(-1=NULL,fld);lw:=subsop(-1=NULL,lw);
   ww:=lw[-1];
  fi
 fi;
od;
[seq([lfld[i],Bar2Length(llw[i][-1])],i=1..nops(lfld))];
end;

cnjpart:=proc(p0) local p,p1,i;
p:=p0;while p[-1]=0 do p:=subsop(-1=NULL,p) od;
p1:=[];
while p<>[] do
 p1:=[op(p1),nops(p)];
 while p<>[] and p[-1]=1 do p:=subsop(-1=NULL,p) od;
 for i from 1 to nops(p) do p[i]:=p[i]-1 od;
od;
p1;
end;

red:=proc(e) local e1;
e1:=expand(e);
while rem(e1,t,t)=0 do e1:=simplify(e1/t) od;
while rem(e1,1-t,t)=0 do e1:=simplify(e1/(1-t)) od;
e1;
end;

redt:=proc(e) local e1;
e1:=expand(e);
while rem(e1,t,t)=0 do e1:=simplify(e1/t) od;
e1;
end;

powt:=proc(e) local e1,e2;
e1:=expand(e);e2:=1;
while rem(e1,t,t)=0 do e1:=simplify(e1/t);e2:=e2*t od;
e2;
end;

die1:=rand(1..2);with(combinat);

compress:=proc(p0) local p,i,j,aux,p1,pa;
p:=[seq(abs(p0[i]),i=1..nops(p0))];pa:=p;
for i from 1 to nops(p)-1 do
 for j from i+1 to nops(p) do
  if p[i]>p[j] then aux:=p[i];p[i]:=p[j];p[j]:=aux fi;
 od
od;
p1:=[0$nops(p)];
for i from 1 to nops(p) do
 j:=1;while pa[i]<>p[j] do j:=j+1 od;
 p1[i]:=j*sign(p0[i]);
od;
p1
end;


#tests sums for last column only, length k; w is a permutation, of length n, corresponding to the last column; it's randomly generated; 
tstlast:=proc(k,n) local w,lw,lc,ll,s,i,j,r,lt,ii,p1,p2;
r:=lch([k],n);lc:=r[1];ll:=r[2];
for i from 1 to ll[2][1] do lc:=subsop(1=NULL,lc) od;#ll[3][1]:=ll[3][1]-ll[2][1];ll:=subsop(2=NULL,ll);
print(lc,ll);
s:=0;
w:=randperm(n);
for i from 1 to n do j:=die1();if j=2 then w[i]:=-w[i] fi od;
print(w,nops(lc));
p1:=[seq(w[i],i=1..k)];p2:=compress([seq(w[i],i=k+1..n)]);
lw:=Bar2Length(w);
lt:=fold1(lc,w);
#print(lt);
for j from 1 to nops(lt) do
 s:=s+expand(t^((lw+lt[j][2]-nops(lt[j][1]))/2)*(1-t)^nops(lt[j][1]))
od;
if s<>t^(Perm2LengthB(p1)+Bar2Length(p2)) then ERROR(`-----`,factor(s),nops(lt)) fi;
print(`***`,factor(s),nops(lt));
end;

weight:=proc(lc,lev,fld,p,lam) local i,nf,a,w,al,j,n,ps,w1;
nf:=nops(fld);w:=lam;n:=nops(lam);
for i from nf to 1 by -1 do
 a:=lc[fld[i]];
 if a[1]<a[2] then al:=[seq(0,j=1..a[1]-1),1,seq(0,j=a[1]+1..a[2]-1),-1,seq(0,j=a[2]+1..n)];ps:=w[a[1]]-w[a[2]]
 else if a[1]>a[2] then al:=[seq(0,j=1..a[2]-1),1,seq(0,j=a[2]+1..a[1]-1),1,seq(0,j=a[1]+1..n)];ps:=w[a[2]]+w[a[1]]
 else al:=[seq(0,j=1..a[1]-1),2,seq(0,j=a[1]+1..n)];ps:=w[a[1]] fi fi;
 w:=w+(lev[fld[i]]-ps)*al;
od;
w1:=[0$n];for i from 1 to n do w1[abs(p[i])]:=sign(p[i])*w[i] od;
w1;
end;

refl:=proc(a,b,a1);
if b<0 then if a1=a then -b else if a1=-b then a else a1 fi fi
else if a1=a then -b else if a1=b then -a else a1 fi fi
fi;
end;

posdir:=proc(lc,fld,w) 
local n,i,j,flc,ii,nn,a,b,a1,b1,np,x;
nn:=nops(lc);flc:=[[0,0]$nn];
for i from 1 to nn do
 if lc[i][1]<lc[i][2] then flc[i]:=[lc[i][1],-lc[i][2]] else flc[i]:=[lc[i][2],lc[i][1]] fi
od;
#fold chain
for i from nops(fld) to 1 by -1 do
 ii:=fld[i];a:=flc[ii][1];b:=flc[ii][2];
 flc[ii]:=[0,0];
#better algorithm by computing r_j_1...r_j_i; later do (r_j_1...r_j_s(\rho),\alpha_p^\vee)
 for j from ii+1 to nn do
  if flc[j][1]<>0 then
   a1:=sign(flc[j][1])*refl(a,b,abs(flc[j][1]));b1:=sign(flc[j][2])*refl(a,b,abs(flc[j][2]));
   if abs(a1)<abs(b1) then flc[j]:=[a1,b1] else flc[j]:=[b1,a1] fi;
  fi;
 od;
od;
np:=0;
for i from 1 to nn do 
 a:=flc[i][1];
 if a<>0 then 
  b:=flc[i][2]; 
  x:=[sign(a)*w[abs(a)],sign(b)*w[abs(b)]]; if abs(x[1])>abs(x[2]) then x:=[x[2],x[1]] fi; 
  if x[1]>0 then np:=np+1 fi 
 fi;
od;
np;
end;

levels:=proc(lc) local i,j,lev;
lev:=[1$nops(lc)];
for i from 2 to nops(lc) do
 j:=i-1;
 while (j>=1) and (lc[j]<>lc[i]) do j:=j-1 od;
 if j>=1 then lev[i]:=lev[j]+1 fi;
od;
lev;
end;

isdom:=proc(w) local i;
i:=1;
while (i<=nops(w)-1) and (w[i]>=w[i+1]) do i:=i+1 od;
if i=nops(w) and w[-1]>=0 then true else false fi;
end;

#checks if schwer's formula agrees with ram's formula
compschwer:=proc(lam) local lev,lam1,lc,n,i,hl,j,lt,k,nhl,r,lpt,w,nz,hl1,lpt1,nhl1,lc1,lev1,ps,kk,nfl;global bc,sbc;
n:=nops(lam);lam1:=cnjpart(lam);nz:=0;i:=n;while lam[i]=0 do i:=i-1;nz:=nz+1 od;nfl:=0;
r:=lch(lam1,n);lc:=r[1];lev:=levels(lc);
lc1:=[[2,1],[3,1],[4,1],[1,1],[1,4],[1,3],[2,1],[3,2],[3,1],[4,2],[4,1],[2,2],[2,1],[1,1],[2,4],[1,4],[3,2],[3,1],[2,1]];lev1:=levels(lc1);
hl:=array(1..1100000);nhl:=0;lpt:=table();hl1:=array(1..1100000);nhl1:=0;lpt1:=table();
for i from 1 to nops(bc) do
 j:=1;while (j<=n-1) and ((lam[j]<>lam[j+1]) or (cmp(bc[i][j],bc[i][j+1]))) do j:=j+1 od;
 if j=n then
  while lam[j]=0 and bc[i][j]>0 do j:=j-1 od;
  if lam[j]<>0 then
   lt:=fold1(lc,bc[i]);
   for j from 1 to nops(lt) do
    nfl:=nfl+1;
    if nfl mod 10000=0 then print(nfl/1000,i) fi;
#if sbc[i]+lt[j][2]-lt[j][3]<0 then ERROR(lc,bc[i],ll,nops(lt),j) fi;
    w:=weight(lc,lev,lt[j][1],bc[i],lam);
    if isdom(w) then
     k:=lpt[op(w)];
#print(w1,pt);
     if op(0,k)<>`Integer` then 
      nhl:=nhl+1;
      lpt[op(w)]:=nhl;
      hl[nhl]:=[t^((sbc[i]+lt[j][2]-nops(lt[j][1]))/2)*(1-t)^nops(lt[j][1]),w]
     else hl[k][1]:=expand(hl[k][1]+t^((sbc[i]+lt[j][2]-nops(lt[j][1]))/2)*(1-t)^nops(lt[j][1]));
     fi;
    fi;
   od;
   lt:=fold1(lc1,bc[i]);
   for j from 1 to nops(lt) do
    w:=weight(lc1,lev1,lt[j][1],bc[i],lam);
    if isdom(w) then
     ps:=sum((lam[kk]+w[kk])*(n-kk+1/2),kk=1..n);k:=lpt1[op(w)];
#print(w1,pt);
     if op(0,k)<>`Integer` then 
      nhl1:=nhl1+1;
      lpt1[op(w)]:=nhl1;
      hl1[nhl1]:=[t^(ps+nz^2-n^2+sbc[i]-nops(lt[j][1])-posdir(lc1,lt[j][1],bc[i]))*(1-t)^nops(lt[j][1]),w]
     else hl1[k][1]:=expand(hl1[k][1]+t^(ps+nz^2-n^2+sbc[i]-nops(lt[j][1])-posdir(lc1,lt[j][1],bc[i]))*(1-t)^nops(lt[j][1]));
     fi;
    fi;
   od;
  fi;
 fi;
od;
if nhl<>nhl1 then ERROR(`different number of weights`,nhl,nhl1) fi;
for i from 1 to nhl do 
 k:=lpt1[op(hl[i][2])];if op(0,k)<>`Integer` then ERROR(`missing weight in Schwer`,hl[i]) fi;
 if hl[i][1]<>hl1[k][1] then ERROR(`different coefficients`,hl[i],hl1[k]) fi;
od;
print(`*** Checked ***`);
end;

#compression in Schwer's formula
compschwer1:=proc(lam) local hl1,lc,ll,n,i,hl,j,lt,k,nhl,r,lpt,nfl,hl2,hl3,lev,nz,w,ps;global bc,sbc;
n:=nops(lam);nz:=0;i:=n;while lam[i]=0 do i:=i-1;nz:=nz+1 od;
lc:=[[2,1],[3,1],[4,1],[1,1],[1,4],[1,3],[2,1],[3,2],[3,1],[4,2],[4,1],[2,2],[2,1],[1,1],[2,4],[1,4],[3,2],[3,1],[2,1]];
ll:=[[0,0],[0,1],[6,1],[7,2],[16,2],[19,3],[19,3]];
lev:=levels(lc);
hl:=array(1..80000000);nhl:=0;lpt:=table();nfl:=0;
for i from 1 to nops(bc) do
 j:=1;while (j<=n-1) and ((lam[j]<>lam[j+1]) or (cmp(bc[i][j],bc[i][j+1]))) do j:=j+1 od;
 if j=n then
  while lam[j]=0 and bc[i][j]>0 do j:=j-1 od;
  if lam[j]<>0 then
   lt:=fold(lc,bc[i],ll);
   nfl:=nfl+nops(lt);
   for j from 1 to nops(lt) do
    w:=weight(lc,lev,lt[j][-1],bc[i],lam);
    if isdom(w) then
     ps:=sum((lam[kk]+w[kk])*(n-kk+1/2),kk=1..n);
     k:=lpt[op(lt[j][1])];
     if op(0,k)<>`Integer` then 
      nhl:=nhl+1;
      if nhl mod 2000=0 then print(nhl,i) fi;
      lpt[op(lt[j][1])]:=nhl;
      hl[nhl]:=[t^(ps+nz^2-n^2+sbc[i]-nops(lt[j][-1])-posdir(lc,lt[j][-1],bc[i]))*(1-t)^nops(lt[j][-1]),lt[j][1],1]
     else hl[k][1]:=expand(hl[k][1]+t^(ps+nz^2-n^2+sbc[i]-nops(lt[j][-1])-posdir(lc,lt[j][-1],bc[i]))*(1-t)^nops(lt[j][-1]));
      hl[k][3]:=hl[k][3]+1;
     fi;
    fi;
   od;
  fi;
 fi;
od;
hl3:=[];
hl1:=[];hl2:=[];k:=0;
for i from 1 to nhl do 
# hl3:=[op(hl3),[factor(hl[i][1]),hl[i][3],hl[i][2]]];
 r:=red(hl[i][1]); if r<>1 then k:=k+1;
 hl2:=[op(hl2),[factor(hl[i][1]),hl[i][3],hl[i][2]]]
#****hl[i][1]:=factor(hl[i][1]);
#hl1:=[op(hl1),[factor(hl[i][1]),hl[i][3],hl[i][2]]] 
#hl1:=[op(hl1),[r+t-1,hl[i][3],hl[i][2]]] 
fi od;
print(`compression factor`,nfl/nhl*1.0,`terms`,nhl,`of which`,k,`that is`,k/nhl*100.0,`per cent in nonstandard form`);
hl2;
end;

#USE tab();
#lam as [3,2,1,0,0,0], lam1 is the transpose - only nonzero column lengths
comphl1:=proc(lam) local hl1,lam1,lc,ll,n,i,hl,j,lt,k,nhl,r,lpt,nfl,hl2,hl3;global bc,sbc;
n:=nops(lam);lam1:=cnjpart(lam);
r:=lch(lam1,n);lc:=r[1];ll:=r[2];
hl:=array(1..800000000);nhl:=0;lpt:=table();nfl:=0;
for i from 1 to nops(bc) do
 j:=1;while (j<=n-1) and ((lam[j]<>lam[j+1]) or (cmp(bc[i][j],bc[i][j+1]))) do j:=j+1 od;
 if j=n then
  while lam[j]=0 and bc[i][j]>0 do j:=j-1 od;
  if lam[j]<>0 then
   lt:=fold(lc,bc[i],ll);
   nfl:=nfl+nops(lt);
   for j from 1 to nops(lt) do
#if sbc[i]+lt[j][2]-lt[j][3]<0 then ERROR(lc,bc[i],ll,nops(lt),j) fi;
    k:=lpt[op(lt[j][1])];
#print(w1,pt);
    if op(0,k)<>`Integer` then 
     nhl:=nhl+1;
     if nhl mod 2000=0 then print(nhl,i) fi;
     lpt[op(lt[j][1])]:=nhl;
     hl[nhl]:=[t^((sbc[i]+lt[j][2]-lt[j][3])/2)*(1-t)^lt[j][3],lt[j][1],1]
#*****hl[nhl]:=[t^((sbc[i]+lt[j][2]-lt[j][3])/2)*(1-t)^lt[j][3],lt[j][1],1,[t^((sbc[i]+lt[j][2]-lt[j][3])/2)*(1-t)^lt[j][3],lt[j][-3],lt[j][-2],lt[j][-1]]]
    else hl[k][1]:=expand(hl[k][1]+t^((sbc[i]+lt[j][2]-lt[j][3])/2)*(1-t)^lt[j][3]);hl[k][3]:=hl[k][3]+1;
#*****if hl[k][3]<=13 then hl[k]:=[op(hl[k]),[t^((sbc[i]+lt[j][2]-lt[j][3])/2)*(1-t)^lt[j][3],lt[j][-3],lt[j][-2],lt[j][-1]]] fi
    fi;
   od;
  fi;
 fi;
od;
hl3:=[];
hl1:=[];hl2:=[];k:=0;
for i from 1 to nhl do 
## hl3:=[op(hl3),[factor(hl[i][1]),hl[i][3],hl[i][2]]];
 r:=red(hl[i][1]); if r<>1 then k:=k+1;
 hl2:=[op(hl2),[factor(hl[i][1]),hl[i][3],hl[i][2]]]
# if redt(r+t-1)<>1 then hl2:=[op(hl2),[factor(hl[i][1]),hl[i][3],hl[i][2]]]
##****hl[i][1]:=factor(hl[i][1]);
##hl1:=[op(hl1),[factor(hl[i][1]),hl[i][3],hl[i][2]]] 
##hl1:=[op(hl1),[r+t-1,hl[i][3],hl[i][2]]] 
#fi
fi od;
print(`compression factor`,nfl/nhl*1.0,`terms`,nhl,`of which`,k,`that is`,k/nhl*100.0,`per cent in nonstandard form`);
nhl,nfl/nhl*1.0,hl2,seq(hl[i],i=1..nhl);
end;

rev:=proc(s) local i; [seq(s[nops(s)+1-i],i=1..nops(s))] end;

stat:=proc(tt) local s,n,i,j,k;
#n:=0;
#for i from 1 to nops(tt)-1 do
# for j from 1 to nops(tt[i+1]) do
#  if tt[i][j]<>tt[i+1][j] then n:=n+1 fi
# od
#od;
#s:=(1-t)^n;
n:=0;s:=1;
for i from 1 to nops(tt) do
 for j from 1 to nops(tt[i])-1 do
  for k from j+1 to nops(tt[i]) do
   if cmp(tt[i][k],tt[i][j]) and ((i=nops(tt)) or (k>nops(tt[i+1])) or cmp(tt[i][j],tt[i+1][k])) then n:=n+1 fi;
  od
 od
od;
s*t^n
end;

tst:=proc(r) local tab,s,s1,i;
for i from 1 to nops(r) do
 tab:=r[i][3];
 if tab[1]=tab[2] and tab[3]=tab[4] and tab[5]=tab[6] then
  s:=stat(rev(tab));s1:=powt(r[i][1]);
  if expand(s-s1)<>0 then print(s,factor(r[i][1]),r[i][2],tab) fi
 fi;
od;
end;