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* 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;
}
local poly* decompose_character(poly* ch)
{ wt_init(ch->ncols); /* for building result */
while (ch->coef[0]->size!=0) /* i.e., |while (ch!=0)| */
{ bigint* c=ch->coef[0];
if (c->size<0)
{ cmpfn=sav_cmpfn;
defaultgrp=sav_dfgrp;
error ("Non-virtual decomposition failed.\n");
}
{ wt_ins(ch->elm[0],c,false); /* contribute weight to result */
c=copybigint(c,NULL);
c->size= -c->size;
ch=Addmul_pol_pol_bin(ch,Domchar_irr(ch->elm[0],NULL),c);
}
}
{ poly* result=wt_collect();
{
cmpfn=sav_cmpfn;
defaultgrp=sav_dfgrp;
clrsorted(result);
}
return result;
}
}
bigint* Classord(entry* kappa, lie_Index l)
{ lie_Index prev=0,i=0,j,n=0,k,f=1; bigint* x=copybigint(one,NULL);
while (i<l && (k=kappa[i++])>0)
{ for (j=0; j<k; ++j) x=mul1(x,++n);
/* extend $\Card\kappa!$ in numerator */
div1(x,k); /* contribution to $k^{c_k(\kappa)}$ in denominator */
if (k!=prev) { f=1; prev=k;} /* this case applies the first time */
else div1(x,++f); /* contribution to $c_k(\kappa)!$ in denominator */
}
return x;
}
local bigint* simp_stabsize(entry* v, simpgrp* g)
{ object sav_grp=grp; vector* I; bigint* result;
lie_Index i,nz=0,r=g->lierank;
for (i=0; i<r; ++i) if (v[i]==0) nz++; /* count non-zero coordinates */
if (nz==0) return one;
if (nz==r) return simp_worder(copybigint(one,NULL),g);
I=mkvector(nz);
for (i=0,nz=0; i<r; ++i) if (v[i]==0) I->compon[nz++]=i+1;
grp=(object)g; result=sub_Worder(I); grp=sav_grp;
freemem(I); return result;
}
object Factor(bigint* num)
{ num=copybigint(num,NULL);
if (num->size<0) { Printf("- "); num->size=-num->size; }
{ bigint* temp=mkbigint(num->size); _digit p; int i=0;
if (num->size==0) { Printf("0"); goto quit; }
for (p=2; p<=trial_limit; p+= inc[i++])
{ if (i==array_size(inc)) i=3; /* after |37-31| wrap to difference |11-7| */
if (copybigint(num,temp),div1(temp,p)==0)
{ _index n; _digit pn=p; int e=1; copybigint(temp,num);
for (n=1; pn<=MaxDigit/p; ++n) pn*=p; /* highest $p^n$ fitting in |_digit| */
for (; div1(temp,pn)==0; e+=n) copybigint(temp,num);
/* find factors $p^n$ */
if (n>1) /* then there might be some factors |p| left */
for (copybigint(num,temp); div1(temp,p)==0; ++e) copybigint(temp,num);
/* factors |p| */
Printf("%ld",(long)p); if (e>1) Printf("^%ld",(long)e);
if (cmp1(num,1)==0) goto quit; /* last factor was found */
Printf(" * ");
}
}
printbigint(num,0);
if (num->size>2) Printf(" (Last factor need not be a prime)");
quit: Printf("\n");
freemem(num); freemem(temp);
}
return (object) NULL;
}
bigint* n_tableaux(entry* lambda, lie_Index l)
{ lie_Index i,j,k=0; entry* h; bigint* res=copybigint(one,NULL);
do if (--l<=0) return one;
while (lambda[l]==0); /* find last non-zero part */
h=mkintarray(lambda[0]);
for(j=0; j<lambda[0]; ++j) h[j]=0; /* accumulated column heigths */
for(i=l; i>=0; --i)
{ entry li=lambda[i]-1;
for(j=0; j<=li; ++j) res=mul1(res,++k); /* part of factorial */
for(j=0; j<=li; ++j) div1(res,(++h[j])+li-j); /* divide by hook lengths */
}
freearr(h); return res;
}
poly* Reduce_pol(poly* p)
{ entry** expon=p->elm; bigint** coef=p->coef; lie_Index t=0,f=0,len=p->ncols;
heap_sort_p(p,cmpfn);
/* don't exclude cases~$<2$: we must catch $0$-polynomials */
while (++f<p->nrows)
if (coef[f]->size==0) clrshared(coef[f]); /* drop term with zero coef */
else if (eqrow(expon[f],expon[t],len)) /* equal exponents: add coef's */
{ clrshared(coef[t]); clrshared(coef[f]);
coef[t]=add(coef[t],coef[f]); setshared(coef[t]);
}
else /* now term at f replaces one at t as discriminating term */
{ if (coef[t]->size) t++; else clrshared(coef[t]); /* keep if nonzero */
swap_terms(expon,coef,t,f); /* move term, preserve row separateness */
}
if (p->nrows!=0)
/* |p| mights have no terms at all (e.g. from |alt_dom|). */
if (coef[t]->size) t++; else clrshared(coef[t]); /* handle final term */
else *coef=copybigint(null,NULL); /* safer not to introduce aliasing */
if ((p->nrows=t)==0) /* then must keep last term; coef is cleared */
{ lie_Index i; p->nrows=1; setshared(*coef); /* |*coef| was |0| but not shared */
for (i=0; i<len; i++) expon[0][i]=0; /* clear first exponent as well */
}
setsorted(p); return p;
}
bigint* fac(lie_Index n)
{ bigint* f=copybigint(one,NULL); while (n>1) f=mul1(f,n--); return f; }
bigint* simp_worbitsize(entry* w, simpgrp* g)
/* |w| is assumed to be dominant */
{ return quotient(simp_worder(copybigint(one,NULL),g),simp_stabsize(w,g)); }
bigint* Worder(object grp)
{ lie_Index i; bigint* result=copybigint(one,NULL);
if (type_of(grp)==SIMPGRP) return simp_worder(result,&grp->s);
for (i=0; i<grp->g.ncomp; ++i) result = simp_worder(result,Liecomp(grp,i));
return result;
}