\\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ We need global variables: iipm=invariant_inner_product_matrix \\ cartanm=cartan_matrix \\ pos_roots=positive_roots \\ LieRank=dimension of representation \\ M=weights global(pos_roots,twice_rho,MW,ml,cartanm,iipm,LieRank,list,child_nb,u_nb); \\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ initializes list,child_nb for representation with multiplicities and \\ weights MW. Output: \\ [child_nb,mother_nb,new_weights,mother,child,new_pos_roots] init_M(M)= { list=vector(1); child_nb=1;u_nb=2; list[child_nb]=[child_nb, 0, M, [], vector(LieRank), pos_roots]; write("data",concat(["DimensionRepresentation = ", sum(i=1,matsize(M)[1],M[i,1]),";"])); } \\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ 0-SECTION \\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ ist_gleich(u,v) has Boolean output 0,1; 1 iff vectors v,w are equal ist_gleich(v,w)=if( (v-w)*(v-w)~==0 , 1, 0); \\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ the integral vector v with 1<=v[1]m,p++);m=m-binomial(p-1,s-i+1);p) } \\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ 1-SECTION \\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ N is a matrix. Its row are considered as vertices of a simplex. \\ The function nullproj(N) computes the shortes vector in the affine subspace \\ spanned by that simplex nullproj(N)= { local(s,d,resN,resL,cramer); s=matsize(N)[1];cramer=matrix(s,s,i,j,if(i=2 it checks that the number of \\ roots r with (L,r)<0 equals the number of weights m counted with \\ multiplicities and with (L,m)<(L,L). If g==1 it checks that the number of \\ roots r with (L,r)<0 is less or equal to the number of weights \\ m counted with multiplicities and with (L,m)<(L,L). The value of \\ g is the number of the mother. dim_cond(M,R,L,g)= { local(countM,countR); countR=0; countM=0; for(i=1,matsize(M)[1], if(vector(LieRank,j,M[i,j+1]-L[j])*iipm*L~<0, countM=countM+M[i,1])); for(i=1,matsize(R)[1], if(vector(LieRank,j,R[i,j])*iipm*L~==0,countR++);); if(g>1,if(matsize(R)[1]-countR == countM,1,0), if(matsize(R)[1]-countR <= countM,1,0)) } \\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ 2-SECTION \\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ computes children of children .... and stores in list. \\ non_neg_weight() reduces the list of weights, only non-negative \\ weights can occur as vertices of a simplex with the foot in the Weyl \\ chamber. Moreover we make a list of edges that can belong to simplices \\ with their foot in the Weyl chamber.We store for each weight a the \\ possible weigths b such that the number of b exceeds the number of a \\ that b-a is non-negative and non-positive, as \\ done in non_neg_and_non_pos(). all_perp makes the list of foots \\ of simplices that satisfie 4 tests: to be non_zero, to lie in simplex, \\ to lie in Weyl chamber and satisfy according to g=mother_nb the \\ test of dim_cond(). saturL() enhances this list with data according \\ to the child data structure. We do finally the saturation of the list by \\ searching with satur() for children of children .... saturlist()= { non_neg_weights(); all_perp(); saturL(); while(u_nb<=child_nb,satur(list[u_nb]);u_nb++); } \\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ computes the children of ML, if we have mother_nb=ML[2]>0 . We reproduce \\ new_weights, new_pos_roots in the hyperplane that is perpendicular to \\ the child. Now we search for children that satisfy the 4 tests. satur(ML)= { local(ml1,nb_w,nb_r,new_weights,new_pos_roots,dimS,test,sub, item,sM,v,r,a,candidate,c,f); f=0; nb_r=0; r=matsize(ML[6])[1]; v=vector(r); \\compute new_pos_roots for(i=1,r, if(ML[6][i,]*iipm*ML[5]~==0, nb_r++; v[nb_r]=i;); ); if(nb_r==0, return() ); \\if nb_r==0, do nothing new_pos_roots=matrix(nb_r,LieRank, i,j, ML[6][v[i],j] ); a=matsize(ML[3])[1]; ml1=matrix(a,LieRank,i,j,ML[3][i,j+1]); v=vector(a); nb_w=0; \\compute new_weigths for(i=1,a, if( (ml1[i,]-ML[5])*iipm*ML[5]~==0 , nb_w++;v[nb_w]=i;);); new_weights=matrix( nb_w, LieRank+1, i,j, if(j==1, ML[3][v[i],j], ML[3][v[i],j]-ML[5][j-1]) ); dimS=matrank( matrix(nb_w,LieRank,i,j,new_weights[i,j+1]) ); for(s=1,dimS, for(ss=1,binomial(nb_w,s), \\consider (s-1)-simplex sM sub=subset(s,ss); sM=matrix(s,LieRank,i,j,new_weights[sub[i],j+1]); if(matrank(sM)==s, candidate=nullproj(sM); \\simplex(sM) non degenerate? if(vecmin(candidate[1])>=0, test=1; \\foot in simplex? if(in_chamber(candidate[2],new_pos_roots)==1,\\in chamber? if( f>0, c=f; while( c<=child_nb&&test>0, if( ist_gleich(list[c][5],candidate[2])==1, test=0); c++ )); if( test && dim_cond(new_weights,new_pos_roots,candidate[2],ML[1])==1, child_nb++; if(f==0,f=child_nb); \\we have a new child new_child = [child_nb, ML[1], new_weights, ML[5], candidate[2], new_pos_roots]; list = concat(list,[new_child]); )))); );); \\4 testing if's, 2 for's } \\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ saturL() enhances the data structures of the children that we have up \\ to this time. saturL()= { for( i=1,length(perpLch), if( dim_cond(list[1][3],list[1][6],perpLch[i],1)==1 , child_nb++; list=concat( list , [[child_nb,1,list[1][3],vector(LieRank),perpLch[i],list[1][6]]]) ); ); } \\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ non_neg_weights() reduces the number of weights and the number \\ of possible edges of simplices. non_neg_weights()= { local(a,v); \\ we need more global variables: nb_w \\ perLch= list of admissible perpendiculars L \\ pW \\ list_edge_cand= global(nb_w,perpLch,pW,list_edges_cand); a=matsize(ml)[1]; v=vector(a); nb_w=0; for( i=1,a, if( vecmax(vector(LieRank,j,twice_rho[j]*ml[i,j]))>0 , nb_w++; v[nb_w]=i); ); pW=matrix(nb_w,LieRank,i,j,ml[v[i],j]); perpLch=vector(0); list_edges_cand=vector(nb_w); for( i=1,nb_w, list_edges_cand[i]=Set([]); for( j=i+1,nb_w, if( 1<2, \\\ is_non_neg_and_non_pos(pW[i,]-pW[j,]), list_edges_cand[i]=setunion(list_edges_cand[i],Set([j]) ))) ); } \\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ is_non_neg_and_non_pos(v) is used to reduce the number of edges. is_non_neg_and_non_pos(v)=if(vecmin(v) <= 0 && vecmax(v) >= 0, 1, 0) \\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ edges_cand(v) lists given the weight v which weights u can occur in \\ an edge (u,v), i.e., u-v has to be non_neg_and_non_pos. edges_cand(v)= { local(res); res=list_edges_cand[v[1]]; for(j=2,length(v),res=setintersect(res,list_edges_cand[v[j]])); res } \\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ stamp(L) helps us to recognize L and to avoid considering L several times. stamp(L)= { local(res); res=""; for(j=1,length(L), res=if(j 2 , Z=C; z=vector(Z,i,simplex[i]) , Z=nb_w); if(s=0 && in_chamber(L[2],pos_roots)==1, if(setsearch(listperp,signL,1), listperp=setunion(listperp,Set([signL])); countPerp++;print([cand,L[2],countPerp,s]); perpLch=concat(perpLch,[L[2]]); ))); a++;); b++;); ); } \\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ hnc computes strata given the group g in LiE format, i.e. A3A2 \\ and a weight vector "X1,0,0,1,0" or a sum of weight vectors \\ "X1,0,1,0,0+X1,0,0,1,0+X1,0,0,0,1" ( " " and the X's are important, \\ since we use \\ a shell escape to the LiE script ./PROG/slie. Some help and \\ examples are given, if one executes ./PROG/slie without input. See \\ the text of ./PROG/slie.) hnc(g,w)= { local(res); extern(concat(["./PROG/slie ",g," ",w])); read("data");init_M(MW);res=strata(); \\ uncomment following 2 lines and the \\ output will appended to "datax" and will be formatted. write("data"," ");write("data","[ , ]"); for(i=1,length(res)/2,write("data",[res[2*i-1],res[2*i]])); res } \\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ dynkin_char(L)=2/(L*iipm*L~)*(L*cartanm); dc(s)=vector(length(s),i,if(i%2,dynkin_char(s[i]),s[i])); \\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ translation omega to alpha base. omega2alpha(X)= { local(Y); Y=X/cartanm; matrix(matsize(Y)[1],matsize(Y)[2]+1,i,j,if(j==matsize(Y)[2]+1,1,Y[i,j])); } \\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ computes admissible strata from list strata()= { local(n,t,tB,res0,res1); saturlist(); t=vector(length(list),i,list[i][2]); \\ uncomment following 3 lines and the tree t will formatted \\ and appended to "data" or datax. write("data"," "); write("data", " Tree of candidats for strata given in CAYLEY code :"); write("data1",vector(length(t),i,if(divrem(i,10)[2]==0,t[i]*BR,t[i]))); system("sed -f ./PROG/sed_data data1 | cat - >> data;rm data1"); n=2; while(n<=length(t)&&t[n]==1,n++); res0=vector(n-2,i,[list[i+1][5],adm(leaf(t,i+1))]); res1=[];for(i=1,n-2,if(res0[i][2]==1, res1=concat(res1,[dimStrata( list[1][3],res0[i][1]), res0[i][1] ]))); return(res1) } \\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ adm(t)= { local(n); if(length(t)==0,return(1));if(length(t)==1,return(0));n=1; while(n<=length(t)&&t[n]==0,if(adm(leaf(t,n))==1,return(0));n++); return(1); } \\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ leaf(t,ii)= { local(c,s,T,pol,jj); pol=x-ii;c=0;T=vector(length(t)); s=1; while(s<=length(t), if(subst(pol,x,t[s])==0,pol=pol*(x-s);c++;T[c]=[t[s],s]);s++;); vector(c,i,if(t[T[i][1]]==0,0, for(j=1,i-1,if(T[i][1]==T[j][2],jj=j));jj)) } \\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ computes the dimension of strata. dimStrata(M,L)= { local(ml1,dimO); dimO=0; ml1=matrix(matsize(M)[1],length(L),i,j,M[i,j+1]); for(i=1,matsize(M)[1], if( (ml1[i,]-L)*iipm*L~ >= 0 , dimO=dimO+M[i,1]);); for(i=1,matsize(pos_roots)[1], if( pos_roots[i,]*iipm*L~ != 0 , dimO++);); dimO } \\ #-#-#-#-#-#-#-#-#-#-#-#-#-#-#-#-# \\ \\behind(u,v,M)= \\ u behind v \\{ \\for(i=1,matsize(M)[1], \\ if((M[i,]-u)*iipm*u~>=0&&(M[i,]-v)*iipm*v~<=0,return(0)) ); \\return(1) \\} \\wbehind(u,v,M)= \\{ \\local(alpha); \\if(behind(u,v,M),return(1)); \\for(i=1,LieRank,for(j=1,LieRank, \\ beta=vector(LieRank,k,if(k==i,1,0)); \\ alpha=vector(LieRank,k,if(k==j,1,0)); \\ if(behind(u-(alpha*iipm*u~)*alpha,v-(beta*iipm*v~)*beta,M),return(1)))); \\ return(0) \\} \\hasse(g,M)= \\{ \\local(str,sstr,N); \\init_gr(g);init_M(M); \\N=matrix(matsize(M)[1],matsize(M)[2]-1,i,j,M[i,j]); \\str=alles(g,M); \\sstr=vecsort(vector(length(str)/2,i,[str[2*i-1],str[2*i]]),2); \\matrix(length(sstr),length(sstr),i,j, \\ if(i==j,0,wbehind(sstr[i][1],sstr[j][1],N))) \\} \\ \\