void w_refl(entry* lambda, lie_Index wi)
{ if (type_of(grp)==SIMPGRP) simp_w_refl(lambda,wi,&grp->s);
else if (simpgroup(grp)) simp_w_refl(lambda,wi,Liecomp(grp,0));
else
{ lie_Index i,d,offset=0;
for (i=0; wi>=(d=Liecomp(grp,i)->lierank); ++i) { offset+=d; wi-=d; }
simp_w_refl(lambda+offset,wi,Liecomp(grp,i));
}
}
boolean isroot(entry* alpha)
{ _index n_parts=0, i,j;
if (type_of(grp)==SIMPGRP) return simp_isroot(alpha,&grp->s);
if (grp->g.ncomp==1) return simp_isroot(alpha,Liecomp(grp,0));
for (i=0; i<grp->g.ncomp; ++i)
{ simpgrp* g=Liecomp(grp,i); _index r=g->lierank;
for (j=0; j<r; ++j) if (alpha[j]!=0)
if (n_parts>0 || !simp_isroot(alpha,g)) return false;
else { ++n_parts; break; }
alpha+=r;
}
return n_parts==1; /* |alpha| is root if supported on 1 simple component */
}
vector* Simproot_norms(object grp)
{ if (type_of(grp)==SIMPGRP)
{ simp_proots(&grp->s); return grp->s.root_norm; }
{ _index i; for (i=0; i<grp->g.ncomp; ++i) simp_proots(Liecomp(grp,i)); }
if (grp->g.ncomp==1) return Liecomp(grp,0)->root_norm;
{ _index i,t=0; vector* result=mkvector(Ssrank(grp));
for (i=0; i<grp->g.ncomp; ++i)
{ simpgrp* g=Liecomp(grp,i); _index r=g->lierank;
copyrow(g->root_norm->compon,&result->compon[t],r); t+=r;
}
return result;
}
}
matrix* Cartan(void)
{ if (type_of(grp)==SIMPGRP) return simp_Cartan(&grp->s);
if (simpgroup(grp)) return simp_Cartan(Liecomp(grp,0));
{ _index i,j, t=0;
matrix* cartan=mat_null(Ssrank(grp),Lierank(grp));
for (i=0; i<grp->g.ncomp; ++i)
{ _index r=Liecomp(grp,i)->lierank;
entry** c=simp_Cartan(Liecomp(grp,i))->elm;
for (j=0; j<r; ++j) copyrow(c[j],&cartan->elm[t+j][t],r);
t+=r;
}
return cartan;
}
}
void Wrtaction(entry* alpha, vector* word)
{ lie_Index i; entry* w=word->compon;
for (i=0; i<word->ncomp; ++i) if(w[i]!=0)
{ lie_Index wi=w[i]-1;
if (type_of(grp)==SIMPGRP) simp_rt_refl(alpha,wi,&grp->s);
else if (simpgroup(grp)) simp_rt_refl(alpha,wi,Liecomp(grp,0));
else
{ lie_Index j,d,offset=0;
for (j=0; wi>=(d=Liecomp(grp,j)->lierank); ++j)
{ offset+=d; wi-=d; }
simp_rt_refl(alpha+offset,wi,Liecomp(grp,j));
}
}
}
matrix* Posroots(object grp)
{ if (type_of(grp)==SIMPGRP) return simp_proots(&grp->s);
if (simpgroup(grp)) return simp_proots(Liecomp(grp,0));
{ _index i,j,t1=0,t2=0;
matrix* result=mat_null(Numproots(grp),Ssrank(grp));
entry** m=result->elm;
for (i=0; i<grp->g.ncomp; ++i)
{ matrix* posr=simp_proots(Liecomp(grp,i));
_index r=Liecomp(grp,i)->lierank;
for (j=0; j<posr->nrows; ++j) copyrow(posr->elm[j],&m[t1+j][t2],r);
t1+=posr->nrows; t2+=r;
}
return result;
}
}
vector* Exponents(object grp)
{ if (type_of(grp)==SIMPGRP)
{ simp_exponents(&grp->s); return grp->s.exponents; }
if (simpgroup(grp))
{ simp_exponents(Liecomp(grp,0)); return Liecomp(grp,0)->exponents; }
{ _index i,t=0; vector* v=mkvector(Lierank(grp)); entry* e=v->compon;
{ for (i=0; i<grp->g.ncomp; ++i)
{ simpgrp* g=Liecomp(grp,i); _index r=g->lierank;
copyrow(simp_exponents(g),&e[t],r); t+=r;
}
for (i=0; i<grp->g.toraldim; ++i) e[t+i]=0;
}
return v;
}
}
entry Detcartan(void)
{ if (type_of(grp)==SIMPGRP) return simp_detcart(&grp->s);
{ _index i; entry result=1;
for (i=0; i<grp->g.ncomp; ++i) result *= simp_detcart(Liecomp(grp,i));
return result;
}
}
_index Numproots(object grp) /* should really return bigint */
{ if (type_of(grp)==SIMPGRP) return simp_numproots(&grp->s);
{ _index i,d=0;
for (i=0; i<grp->g.ncomp; ++i) d += simp_numproots(Liecomp(grp,i));
return d;
}
}
_index Lierank(object grp)
{ _index i,r; if (type_of(grp)==SIMPGRP) return grp->s.lierank;
r=grp->g.toraldim;
for (i=0; i<grp->g.ncomp; ++i) r += (Liecomp(grp, i))->lierank;
return r;
}
matrix* Icartan(void)
{ if (simpgroup(grp)) return simp_icart(Liecomp(grp,0));
{ matrix* result=mat_null(Lierank(grp),Ssrank(grp)); entry** m=result->elm;
_index k,t=0;
entry det=Detcartan(); /* product of determinants of simple factors */
for (k=0; k<grp->g.ncomp; ++k)
{ simpgrp* g=Liecomp(grp,k);
_index i,j,r=g->lierank;
entry** a=simp_icart(g)->elm;
entry f=det/simp_detcart(g); /* multiplication factor */
for (i=0; i<r; ++i) for (j=0; j<r; ++j) m[t+i][t+j]=f*a[i][j];
t+=r;
}
return result;
}
}
matrix* Center(object grp)
{ _index i,j,R=Lierank(grp),n_gen;
for (n_gen=grp->g.toraldim,i=0; i<grp->g.ncomp; ++i)
{ simpgrp* g=Liecomp(grp,i);
if (simp_detcart(g)>1) n_gen+=1+(g->lietype=='D' && g->lierank%2==0);
}
{ matrix* res=mat_null(n_gen,R+1); entry** m=res->elm; _index k=0,s=0;
for (j=0; j<grp->g.ncomp; ++j)
{ simpgrp* g=Liecomp(grp,j); _index n=g->lierank; entry d=simp_detcart(g);
if (d>1)
{
switch (g->lietype)
{ case 'A': for (i=0; i<n; ++i) m[k][s+i]=i+1;
/* $[1,2,3,\ldots,n]$; $d=n+1$ */
break; case 'B': m[k][s+n-1]=1; /* $[0,0,\ldots,0,1]$; $d=2$ */
break; case 'C': for (i=0; i<n; i+=2) m[k][s+i]=1;
/* $[1,0,1,0,\ldots]$; $d=2$ */
break; case 'D':
{ m[k][s+n-2]=m[k][s+n-1]=1;
if (n%2==1) for (i=0; i<n; i+=2) m[k][s+i]+=2;
/* $[2,0,2,\ldots,2,1,3]$; $d=4$ */
else
{ d=2; m[k++][R]=d; /* $[0,0,\ldots,0,1,1]$; $d=2$ */
for (i=0; i<n; i+=2) m[k][s+i]=1; /* $[1,0,1,\ldots,1,0]$; $d=2$ */
}
}
break; case 'E':
if (n==7)
{ m[k][s+1]=m[k][s+4]=m[k][s+6]=1; } /* $[0,1,0,0,1,0,1]$; $d=2$ */
else { m[k][s]=m[k][s+4]=1; m[k][s+2]=m[k][s+5]=2; }
/* $[1,0,2,0,1,2]$; $d=3$ */
}
m[k++][R]=d; /* insert denominator for last generator, and advance */
}
s+=n; /* advance offset into semisimple elements */
}
for (i=0; i<grp->g.toraldim; ++i) m[k++][s+i]=1;
assert(k==n_gen); return res;
}
}
bigint* Orbitsize(entry* w)
{ lie_Index i,d,s=Ssrank(grp); entry* x=mkintarray(s),* y=x; bigint* result=one;
copyrow(w,x,s); make_dominant(x);
if (type_of(grp)==SIMPGRP) return simp_worbitsize(x,&grp->s);
for (i=0; i<grp->g.ncomp; ++i,y+=d)
{ simpgrp* g=Liecomp(grp,i); d=g->lierank;
result=mult(result,simp_worbitsize(y,g));
}
freearr(x); return result;
}
local poly* vdecomp_irr(entry* lambda)
{ if (type_of(grp)==SIMPGRP) return simp_vdecomp_irr(lambda,&grp->s);
if (simpgroup(grp)) return simp_vdecomp_irr(lambda,Liecomp(grp,0));
{ poly* result;
lie_Index i;
{ lie_Index td=grp->g.toraldim;
lambda+=Ssrank(grp);
result=mkpoly(1,td);
copyrow(lambda,*result->elm,td);
*result->coef=one;
}
for (i=grp->g.ncomp-1; i>=0; --i)
/* traverse simple components in reverse order */
{ simpgrp* g=Liecomp(grp,i);
lambda-=g->lierank;
result= Disjunct_mul_pol_pol(simp_vdecomp_irr(lambda,g),result);
}
return result;
}
}
matrix* Closure(matrix* m, boolean close, group* lie_type)
{ matrix* result; lie_Index i,j;
group* tp=(s=Ssrank(grp), lie_type==NULL ? mkgroup(s) : lie_type);
tp->toraldim=Lierank(grp); tp->ncomp=0; /* start with maximal torus */
m=copymatrix(m);
if (close)
if (type_of(grp)==SIMPGRP) close = two_lengths(grp->s.lietype);
else
{ for (i=0; i<grp->g.ncomp; i++)
if (two_lengths(Liecomp(grp,i)->lietype)) break;
close= i<grp->g.ncomp;
}
{ entry* t;
for (i=0; i<m->nrows; i++)
if (!isroot(t=m->elm[i]))
error("Set of root vectors contains a non-root\n");
else if (!isposroot(t=m->elm[i]))
for (j=0; j<m->ncols; j++) t[j]= -t[j]; /* make positive root */
Unique(m,cmpfn);
}
{ lie_Index next;
for (i=0; i<m->nrows; i=next)
{ lie_Index d,n=0; simpgrp* c;
next=isolcomp(m,i);
fundam(m,i,&next);
if (close) long_close(m,i,next),fundam(m,i,&next);
c=simp_type(&m->elm[i],d=next-i);
{ j=tp->ncomp++;
while(--j>=0 && grp_less(tp->liecomp[j],c))
n += (tp->liecomp[j+1]=tp->liecomp[j])->lierank;
tp->liecomp[++j]=c; tp->toraldim -= d;
/* insert component and remove rank from torus */
cycle_block(m,i-n,next,n);
/* move the |d| rows down across |n| previous rows */
}
}
}
if (lie_type==NULL)
return result=copymatrix(m),freemem(m),freemem(tp),result;
else return freemem(m),(matrix*)NULL; /* |Cartan_type| doesn't need |m| */
}
poly* Adjoint(object grp)
{ _index i,j,r=Lierank(grp)
,n=type_of(grp)==SIMPGRP ? 1: grp->g.ncomp+(grp->g.toraldim!=0);
poly* adj= mkpoly(n,r);
for (i=0; i<n; ++i)
{ adj->coef[i]=one; for (j=0; j<r; ++j) adj->elm[i][j]=0; }
if (type_of(grp)==SIMPGRP) set_simp_adjoint(adj->elm[0],&grp->s);
else
{ _index offs=0; simpgrp* g;
for (i=0; i<grp->g.ncomp; offs+=g->lierank,++i)
set_simp_adjoint(&adj->elm[i][offs],g=Liecomp(grp,i));
if (grp->g.toraldim!=0)
{ adj->coef[i]=entry2bigint(grp->g.toraldim);
setshared(adj->coef[i]);
}
}
return adj;
}
_index Ssrank(object g) /* Semisimple rank */
{ _index i,r=0; if (type_of(g)==SIMPGRP) return g->s.lierank;
for (i=0; i<g->g.ncomp; ++i) r += (Liecomp(g,i))->lierank;
return r;
}
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;
}
