matrix* Weyl_orbit(entry* v, matrix** orbit_graph) { lie_Index i,j,k,r=Lierank(grp),s=Ssrank(grp); matrix* result; entry** m; lie_Index level_start=0, level_end=1, cur=1; { entry* lambda=mkintarray(r); copyrow(v,lambda,r); make_dominant(lambda); result=mkmatrix(bigint2entry(Orbitsize(lambda)),r); copyrow(lambda,result->elm[0],r); freearr(lambda); if (orbit_graph!=NULL) *orbit_graph=mkmatrix(result->nrows,s); } m=result->elm; while (level_start<level_end) { for (k=level_start; k<level_end; ++k) for (i=0; i<s; ++i) if (m[k][i]>0) /* only strictly cross walls, and from dominant side */ { w_refl(m[k],i); for (j=level_end; j<cur; ++j) if (eqrow(m[k],m[j],s)) break; if (orbit_graph!=NULL) { (*orbit_graph)->elm[k][i]=j; (*orbit_graph)->elm[j][i]=k; } if (j==cur) { assert(cur<result->nrows); copyrow(m[k],m[cur++],r); } w_refl(m[k],i); } else if (m[k][i]==0 && orbit_graph!=NULL) (*orbit_graph)->elm[k][i]=k; level_start=level_end; level_end=cur; } return result; }
matrix* Weyl_rt_mat(vector* word) { lie_Index i,j,r=Ssrank(grp); matrix* res=mkmatrix(r,r); entry** m=res->elm; for (i=0; i<r; ++i) { for (j=0; j<r; ++j) m[i][j]= i==j; Wrtaction(m[i],word); } 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; }
bigint* sub_Worder(vector* v) { lie_Index i,j,s=Ssrank(grp), n=v->ncomp; matrix* roots=mkmatrix(n,s); entry** m=roots->elm; group* h; bigint* result; if (n==0) { freemem(roots); return one; } for (i=0; i<n; ++i) /* select rows od an identity matrix */ { entry* mij= *m++,vi=v->compon[i]-1; for (j=0; j<s; ++j) *(mij++)= (j==vi); } h=Carttype(roots); freemem(roots); result= Worder((object)h); freemem(h); return(result); }
matrix* Resmat(matrix* roots) { lie_Index i,j,k,r=Lierank(grp),s=Ssrank(grp), n=roots->nrows; vector* root_norms=Simproot_norms(grp); entry* norms=root_norms->compon; /* needed to compute $\<\lambda,\alpha[i]>$ */ matrix* root_images=Matmult(roots,Cartan()),* result=mkmatrix(r,r); entry** alpha=roots->elm,** img=root_images->elm,** res=result->elm; for (i=0; i<r; i++) for (j=0; j<r; j++) res[i][j]= i==j; /* initialise |res| to identity */ for (j=0; j<n; j++) /* traverse the given roots */ { entry* v=img[j], norm=(checkroot(alpha[j]),Norm(alpha[j])); for (k=s-1; v[k]==0; k--) {} if (k<j) error("Given set of roots is not independent; apply closure first.\n"); if (v[k]<0) { for (i=j; i<n; i++) img[i][k]= -img[i][k]; for (i=k-j; i<s; i++) res[i][k]= -res[i][k]; } while(--k>=j) /* clear |v[k+1]| by unimodular column operations with column~|j| */ { entry u[3][2]; lie_Index l=0; u[0][1]=u[1][0]=1; u[0][0]=u[1][1]=0; u[2][1]=v[k]; u[2][0]=v[k+1]; if (v[k]<0) u[2][1]= -v[k], u[0][1]= -1; /* make |u[2][1]| non-negative */ do /* subtract column |l| some times into column |1-l| */ { entry q=u[2][1-l]/u[2][l]; for (i=0; i<3; i++) u[i][1-l]-=q*u[i][l]; } while (u[2][l=1-l]!=0); if (l==0) for (i=0; i<2; i++) swap(&u[i][0],&u[i][1]); { for (i=j; i<n; i++) /* combine columns |k| and |k+1| */ { entry img_i_k=img[i][k]; img[i][k] =img_i_k*u[0][0]+img[i][k+1]*u[1][0]; img[i][k+1]=img_i_k*u[0][1]+img[i][k+1]*u[1][1]; } for (i=k-j; i<s; i++) { entry res_i_k=res[i][k]; res[i][k]=res_i_k*u[0][0]+res[i][k+1]*u[1][0]; res[i][k+1]=res_i_k*u[0][1]+res[i][k+1]*u[1][1]; } } } for (i=0; i<s; i++) { lie_Index inpr= norms[i]*alpha[j][i]; /* this is $(\omega_i,\alpha[j])$ */ if (inpr%norm!=0) error("Supposed root has non-integer Cartan product.\n"); res[i][j]=inpr/norm; /* this is $\<\omega_i,\alpha[j]>$ */ } } freemem(root_norms); freemem(root_images); return result; }
matrix* Weyl_root_orbit(entry* v) { lie_Index i,j,r=Lierank(grp),s=Ssrank(grp); entry* x=mkintarray(r); matrix* orbit, *result; entry** m; lie_Index dc=Detcartan(); mulvecmatelm(v,Cartan()->elm,x,s,r); orbit=Weyl_orbit(x,NULL); result=mkmatrix(orbit->nrows,s); m=result->elm; mulmatmatelm(orbit->elm,Icartan()->elm,m,orbit->nrows,s,s); freemem(orbit); for (i=0; i<result->nrows; ++i) for (j=0; j<s; ++j) m[i][j]/=dc; return result; }
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; } }
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; } }
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* 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| */ }
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; } }
boolean isposroot(entry* alpha) { _index i,s=Ssrank(grp); for (i=0; i<s; ++i) if (alpha[i]!=0) return alpha[i]>0; assert(false); return false; /* to avoid compiler warnings */ }
void checkroot(entry* alpha) { if (!isroot(alpha)) { printarr(alpha,Ssrank(grp)); error (" is not a root.\n"); } }
void testdom(entry* v, object grp) { _index j, s=Ssrank(grp); for(j=0; j<s; j++) if (*v++<0) error ("Weight is not dominant\n"); }
group* Carttype(matrix* m) { group* type=mkgroup(s=Ssrank(grp)); /* rank bounds number of components */ Closure(m,false,type); return type; }