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(); }