poly* SAtensor(boolean alt,_index m,poly* p)
{ _index n,r=Lierank(grp); poly** adams,** q,* result;
if (m==0) return poly_one(r); else if (m==1) return p;
adams=alloc_array(poly*,m+1);
for (n=1; n<=m; ++n) adams[n]=Adams(n,p);
q=alloc_array(poly*,m+1);
q[0]=poly_one(r);
for (n=1; n<=m; ++n)
{
{ _index i; q[n]=Tensor(p,q[n-1]); /* the initial term of the summation */
for (i=2; i<=n; ++i) q[n] =
Add_pol_pol(q[n],Tensor(adams[i],q[n-i]),alt&&i%2==0);
}
{ _index i; bigint* big_n=entry2bigint(n); setshared(big_n);
for (i=0; i<q[n]->nrows; ++i)
{ bigint** cc= &q[n]->coef[i]
,* c= (clrshared(*cc),isshared(*cc)) ? copybigint(*cc,NULL) : *cc;
*cc=divq(c,big_n); setshared(*cc);
{ if (c->size != 0)
error("Internal error (SAtensor): remainder from %ld.\n" ,(long)n);
freemem(c);
}
}
clrshared(big_n); freemem(big_n);
}
}
result=q[m];
{ for (n=1; n<=m; ++n) freepol(adams[n]); } freearr(adams);
{ for (n=0; n<m; ++n) freepol(q[n]); } freearr(q);
return result;
}
poly* Plethysm(entry* lambda,_index l,_index n,poly* p)
{ if (n==0) return poly_one(Lierank(grp)); else if (n==1) return p;
{ _index i,j;
poly* sum= poly_null(Lierank(grp)),**adams=alloc_array(poly*,n+1);
poly* chi_lambda=MN_char(lambda,l);
for (i=1; i<=n; ++i) { adams[i]=Adams(i,p); setshared(adams[i]); }
for (i=0;i<chi_lambda->nrows;i++)
{ entry* mu=chi_lambda->elm[i]; poly* prod=adams[mu[0]],*t;
for (j=1; j<n && mu[j]>0; ++j)
{ t=prod; prod=Tensor(t,adams[mu[j]]); freepol(t); }
sum= Addmul_pol_pol_bin(sum,prod,mult(chi_lambda->coef[i],Classord(mu,n)));
}
freemem(chi_lambda);
setshared(p); /* protect |p|; it coincides with |adams[1]| */
for (i=1; i<=n; ++i)
{ clrshared(adams[i]); freepol(adams[i]); } freearr(adams);
clrshared(p);
{ bigint* fac_n=fac(n); setshared(fac_n); /* used repeatedly */
for (i=0; i<sum->nrows; ++i)
{ bigint** cc= &sum->coef[i]
,* c= (clrshared(*cc),isshared(*cc)) ? copybigint(*cc,NULL) : *cc;
*cc=divq(c,fac_n); setshared(*cc);
if (c->size!=0) error("Internal error (plethysm).\n"); else freemem(c);
}
clrshared(fac_n); freemem(fac_n);
}
return sum;
}
}
poly* LR_tensor_irr(entry* lambda,entry * mu, _index n)
{ _index i,j;
entry* nu; entry** T;
if (n==0) return poly_one(0);
{ nu=&mkintarray(n+1)[1]; copyrow(lambda,nu,n); nu[-1]=lambda[0]+mu[0];
T=alloc_array(entry*,n+1);
for (i=0;i<=n;++i) /* allocate row |T[i]| and place sentinel before it */
{ T[i]= &mkintarray(mu[i==0?0:i-1]+1)[1]; T[i][-1]=n-1-i; }
for (i=0,j=mu[0]-1; j>=0; --j)
{ while (i<n && mu[i]>j) ++i; /* find first |i| with |mu[i]<=j| */
T[i][j]=-1; /* place sentinel at bottom of column |j| */
}
}
wt_init(n); /* prepare to collect terms with exponents of size~|n| */
{ j=-1; for (i=n-1; i>0 && mu[i]==0; --i) {} /* move to initial position */
recurse: /* recursive starting point; */
if (++j>=mu[i] &&(j=0,--i<0)) /* move to next empty position, if any */
wt_ins(nu,one,false); /* if not, |T| is full; contribute |nu| once */
else
{ _index k= T[i+1][j]; entry prev= nu[k];
do
{ while (nu[++k]==prev) {} /* find next |k| with |nu[k]<nu[@t$k'$@>]| */
++nu[T[i][j]=k]; goto recurse;
/* insert |k| into |T| and extend partition |nu|; recurse */
resume: prev= --nu[k=T[i][j]];
/* restore |k| and |nu|; set |prev=nu[k]| */
} while (prev>nu[T[i][j-1]]);
/* if so, there are still corners of |nu| to try */
}
if (j==0) j= ++i<n?mu[i]:0; /* return to end of row below if necessary */
if (--j>=0) goto resume; /* do return jump unless empty row is reached */
}
{ --nu; freearr(nu);
for (i=0;i<=n;i++) { entry* t=&T[i][-1]; freearr(t); }
freearr(T);
}
return wt_collect(); /* return sum of all contributed terms */
}
poly* MN_char(entry* lambda, lie_Index l)
{ lie_Index n=check_part(lambda,l);
if (n==0) return poly_one(0); /* the character of $\Sym0$ */
while (lambda[l-1]==0) --l; /* minimise |l| */
wt_init(n); /* get ready for accumulating contributions to the character */
{
entry* mu=mkintarray(3*n),* save=mu+n,* lambda_prime=save+n;
int i, j, r, d=lambda[0]+l, k=0; /* sum of leg lengths */
boolean* edge=alloc_array(boolean,2*d-2),* candidate=edge+d-2;
/* lie_Index |2<=r<d| */
enum {hor, vert}; /* values used for |edge| */
for (i=0; i<n; ++i) mu[i]=0;
{ int r=l-1,c=0; /* current column number */
for (j=0; r>=0; --r)
{ while (c<lambda[r]) { edge[j++]=hor; ++c; } /* columns of length |r| */
edge[j++]=vert; /* row |r|, of length |c==lambda[r]| */
}
}
for (r=2; r<d; ++r)
{ for (j=0; j+r<d; ++j)
if (edge[j]==hor && edge[j+r]==vert) break;
candidate[r]= j+r<d;
}
{ i=0; /* index of last entry that was set in~|mu| */
for (r=d-1; r>1; --r) /* try hooks of size |r| */
if (candidate[r])
{ recurse: /* recursive starting point */
{ for (j=1; j<r; ++j) k+=edge[j]; /* leg length of hook first tried */
for (j=0; j<d-r; ++j)
{ if (edge[j]==hor && edge[j+r]==vert)
{ edge[j]=vert; edge[j+r]=hor; mu[i]=r; save[i++]=j; goto recurse;
resume: j=save[--i]; r=mu[i]; mu[i]=0; edge[j]=hor; edge[j+r]=vert;
}
k+= edge[j+r]-edge[j+1]; /* adjust |k| for hook tried next */
}
while (++j<d) k-= edge[j]; /* restore |k| */
}
}
}
{ int r=l,c=0,s=0; /* size of |lambda_prime| */
for (j=0; r>0; )
if (edge[j++]==vert) s+=lambda_prime[--r]=c; else ++c;
/* build |lambda_prime| from edges */
for (j=0; j<s; ++j) mu[i++]=1; /* extend |mu| with |s| ones */
wt_ins(mu,n_tableaux(lambda_prime,l),k%2);
for (j=0; j<s; ++j) mu[--i]=0; /* remove the ones again */
}
if (i>0) goto resume;
{ freearr(edge); freearr(mu); }
}
return wt_collect();
}
