| Quellcodebibliothek Statistik Leitseite products/Sources/formale Sprachen/GAP/pkg/sla/gap/ (GAP Algebra Version 4.15.1©) Datei vom 12.6.2024 mit Größe 106 kB |
|
Quelle autom.gi Sprache: Shell |
|||||||||||||||
|
InstallMethod( FiniteOrderInnerAutomorphisms, "for string, integer and integer", true, [ IsString, IsInt, IsInt ], 0, function( type, rank, m ) # finite order auts of the simple Lie algebra, # of order m, that correspond to untwisted diagrams, # in other words, they correpond to the identity # diagram automorphism. local L, w, cc, ch, g, a, ss, good, s, i, auts, g0, t, G, f, stack, stack0, j, u, p1, p2, list, n; n:= rank; if type = "A" then list:= [2..n+1]; Add( list, 1 ); p1:= PermList( list ); p2:= (); i:= 1; while 1+i < n+2-i do p2:= p2*(1+i,n+2-i); i:= i+1; od; G:= Group( [ p1, p2 ] ); elif type = "B" then if rank = 2 then G:= Group([(1,3)]); else G:= Group([(1,2)]); fi; elif type = "C" then p2:= (); i:= 1; while i < n+2-i do p2:= p2*(i,n+2-i); i:= i+1; od; G:= Group( [p2] ); elif type = "D" and rank > 4 then p2:= (); i:= 1; while i < n+2-i do p2:= p2*(i,n+2-i); i:= i+1; od; G:= Group( [(1,2),(n,n+1),p2] ); elif type = "D" and rank = 4 then G:= Group( [ (1,2,4,5), (1,2) ] ); elif type = "E" and rank = 6 then G:= Group( [ (1,2,7)*(3,4,6), (1,2)*(3,4)] ); elif type = "E" and rank = 7 then G:= Group( [ (1,8)*(2,7)*(4,6) ] ); else G:= Group( [ () ] ); fi; G:= Elements( G ); G:= Filtered( G, x -> x <> x^0 ); L:= SimpleLieAlgebra( type, rank, CF(m) ); w:= E(m); cc:= ExtendedCartanMatrix( RootSystem(L) ); ch:= ChevalleyBasis(L); g:= [ ch[2][ Length(ch[2]) ] ]; Append( g, ch[1]{[1..rank]} ); a:= cc.labels; ss:= [ ]; stack:= [ List( g, x -> 0 ) ]; for i in [1..Length(g)] do stack0:= [ ]; for s in stack do u:= a*s; if u = m and Gcd(s) = 1 then good:= true; for p1 in G do t:= Permuted( s, p1 ); if t in ss then good:= false; break; fi; od; if good then Add( ss, s ); fi; elif u < m then for j in [0..m-u] do t:= ShallowCopy(s); t[i]:= j; Add( stack0, t ); od; fi; od; stack:= stack0; od; for s in stack do u:= a*s; if u = m and Gcd(s) = 1 then good:= true; for p1 in G do t:= Permuted( s, p1 ); if t in ss then good:= false; break; fi; od; if good then Add( ss, s ); fi; fi; od; auts:= [ ]; for s in ss do g0:= List( [1..Length(g)], i -> w^s[i]*g[i] ); f:= AlgebraHomomorphismByImagesNC( L, L, g, g0 ); SetOrder(f,m); SetKacDiagram( f, rec( CM:= cc.ECM, labels:= cc.labels, weights:= s ) ); Add( auts, f ); od; return auts; end ); InstallMethod( FiniteOrderOuterAutomorphisms, "for string, and three integers", true, [ IsString, IsInt, IsInt, IsInt ], 0, function( type, rank, m, d ) # corresponding to the diagram automorphism of # order d. local phi, L, w, R, cg, cg0, sim, i, pos, f, mat, mat0, sol, cK, H, K, V, y, rt, sp, h, g, rts, B, C, j, v, a, ss, done, s, auts, g0, G, t, n, p2, good, u, p1, stack, stack0, en; phi:= function( rt ) local r0; if type = "A" then return Reversed(rt); elif type = "D" and d=2 then r0:= ShallowCopy( rt ); r0[ rank ]:= rt[rank-1]; r0[rank-1]:= rt[rank]; elif type = "D" and d = 3 then if rank <> 4 then Error( "only D_4 has a diagram automorphism of order 3"); fi; r0:= ShallowCopy( rt ); r0[1]:= rt[4]; r0[3]:= rt[1]; r0[4]:= rt[3]; else r0:= ShallowCopy(rt); r0[1]:= rt[6]; r0[6]:= rt[1]; r0[3]:=rt[5]; r0[5]:= rt[3]; fi; return r0; end; if type = "A" and rank = 1 then return [ ]; fi; if type ="D" and d = 2 then n:= rank-1; p2:= (); i:= 1; while i < n+2-i do p2:= p2*(i,n+2-i); i:= i+1; od; G:= Group( [ p2 ] ); G:= Elements( G ); G:= Filtered( G, x -> x <> x^0 ); elif type = "A" and IsOddInt(rank) then G:= [ (1,2) ]; else G:= [ ]; fi; if d=2 then L:= SimpleLieAlgebra( type, rank, CF(m) ); else L:= SimpleLieAlgebra( type, rank, CF(3*m) ); fi; w:= E(m); R:= RootSystem(L); cg:= CanonicalGenerators( R ); cg0:= [ [], [], [] ]; sim:= SimpleSystemNF( R ); for i in [1..Length(sim)] do pos:= Position( sim, phi(sim[i]) ); Add( cg0[1], cg[1][pos] ); Add( cg0[2], cg[2][pos] ); Add( cg0[3], cg[3][pos] ); od; f:= AlgebraHomomorphismByImagesNC( L, L, Flat(cg), Flat(cg0) ); mat:= [ ]; for i in [1..Dimension(L)] do Add( mat, Coefficients( Basis(L), Image( f, Basis(L)[i] ) ) ); od; mat0:= mat- IdentityMat( Dimension(L) ); sol:= NullspaceMat( mat0 ); K:= Subalgebra( L, List( sol, x -> LinearCombination(Basis(L),x) ) ); cK:= CanonicalGenerators( RootSystem(K) ); if d=2 then mat0:= mat+IdentityMat( Dimension(L) ); else mat0:= mat-E(3)*IdentityMat( Dimension(L) ); fi; sol:= NullspaceMat( mat0 ); V:= LeftAlgebraModuleByGenerators( K, function(x,v) return x*v; end, List( sol, x -> LinearCombination( Basis(L), x ) ) ); y:= List( cK[2], x -> MatrixOfAction( Basis(V), x ) ); # get simultaneous kernel... mat:= y[1]; for i in [2..Length(y)] do Append( mat, y[i] ); od; sol:= NullspaceMat( TransposedMatDestructive(mat) ); g:= [ LinearCombination( Basis(V), sol[1] )![1] ]; sp:= Basis( VectorSpace( LeftActingDomain(L), g ), g ); rt:= [ ]; for h in cK[3] do Add( rt, Coefficients( sp, h*g[1] )[1] ); od; sim:= SimpleRootsAsWeights( RootSystem(K) ); sp:= Basis( VectorSpace( Rationals, sim ), sim ); rts:= [ Coefficients( sp, rt ) ]; Append( rts, SimpleSystemNF(RootSystem(K) ) ); B:= BilinearFormMatNF( RootSystem(K) ); C:= NullMat( Length(rts), Length(rts) ); for i in [1..Length(rts)] do for j in [1..Length(rts)] do C[i][j]:= 2*( rts[i]*(B*rts[j]) )/( rts[j]*(B*rts[j]) ); od; od; Append( g, cK[1] ); if type ="D" and d=2 then # find the standard enumeration... pos:= PositionProperty( C, x -> Length(Filtered(x,y-> y<>0 ) ) = 2); en:= [ pos ]; while Length(en) < Length(C) do pos:= Filtered( [1..Length(C[pos])], j -> C[pos][j] < 0 and not j in en )[1]; Add( en, pos ); od; C:= C{en}{en}; g:= g{en}; fi; v:= NullspaceMat(C)[1]; a:= Lcm( List( v, DenominatorRat ) ); v:= a*v; ss:= [ ]; stack:= [ List( g, x -> 0 ) ]; for i in [1..Length(g)] do stack0:= [ ]; for s in stack do u:= d*(v*s); if u = m and Gcd(s) = 1 then good:= true; for p1 in G do t:= Permuted( s, p1 ); if t in ss then good:= false; break; fi; od; if good then Add( ss, s ); fi; elif u < m then for j in [0..m-u] do t:= ShallowCopy(s); t[i]:= j; Add( stack0, t ); od; fi; od; stack:= stack0; od; for s in stack do u:= d*(v*s); if u = m and Gcd(s) = 1 then good:= true; for p1 in G do t:= Permuted( s, p1 ); if t in ss then good:= false; break; fi; od; if good then Add( ss, s ); fi; fi; od; auts:= [ ]; for s in ss do g0:= List( [1..Length(g)], i -> w^s[i]*g[i] ); f:= AlgebraHomomorphismByImagesNC( L, L, g, g0 ); SetOrder(f,m); SetKacDiagram(f,rec( CM:= C, labels:= v, weights:= s )); Add( auts, f ); od; return auts; end ); InstallOtherMethod( Grading, "for a finite order automorphism", true, [ IsGeneralMapping ], 0, function( f ) local L, m, w, mat, id, spaces, i, sp; L:= Source(f); m:= Order(f); w:= E(m); mat:= List( Basis(L), x -> Coefficients( Basis(L), Image(f,x) ) ); id:= mat^0; spaces:= [ ]; for i in [0..m-1] do sp:= NullspaceMat( mat - w^i*id ); Add( spaces, List( sp, x -> LinearCombination(Basis(L),x) ) ); od; return spaces; end ); SLAfcts.nil_orbs_inner:= function( L, gr0, gr1, gr2 ) # Here L is a simple graded Lie algebra; gr0 a basis of the # elts of degree 0, gr1 of degree 1, and gr2 of degree -1. # We find the nilpotent G_0-orbits in g_1. # We assume that the given CSA of L is also a CSA of g_0. local F, g0, s, r, HL, Hs, R, Ci, hL, hl, C, rank, posRv_L, posR_L, posR, i, j, sums, fundR, inds, tr, h_candidates, BH, W, h, c_h, ph, stb, v, w, is_rep, h0, wr, Omega, good_h, g1, g2, h_mats1, h_mats2, mat, sl2s, id1, id2, V, e, f, bb, ef, found, good, co, x, C_h0, sp, sp0, y, b, bas, c, Cs, B, k, sol, info; F:= LeftActingDomain(L); g0:= Subalgebra( L, gr0, "basis" ); s:= LieDerivedSubalgebra( g0 ); r:= LieCentre(g0); HL:= CartanSubalgebra(L); Hs:= Intersection( s, HL ); SetCartanSubalgebra( s, Hs ); R:= RootSystem(L); Ci:= CartanMatrix( R )^-1; hL:= CanonicalGenerators(R)[3]; hl:= List( NilpotentOrbits(L), x -> (Ci*WeightedDynkinDiagram(x))*hL ); for i in [1..Length(hl)] do if hl[i] = 0*hl[i] then Unbind( hl[i] ); fi; od; hl:= Filtered( hl, x -> IsBound(x) ); C:= CartanMatrix( R ); rank:= Length(C); # we have to compute a root system of s such that its # positive roots are also positive in L... # Note that since the CSA of s is a subset of the CSA of L, # the roots of s are a subset of the roots of L; also: # the part of the CSA of L that is not in s, commutes with s, # the coordinates of the roots of s with respect to those h-s # is zero (if you understand what I mean...). posRv_L:= PositiveRootVectors(R); posR_L:= PositiveRootsNF(R); posR:= [ ]; for i in [1..Length(posRv_L)] do if posRv_L[i] in s then Add( posR, posR_L[i] ); fi; od; sums:= [ ]; for i in [1..Length(posR)] do for j in [i+1..Length(posR)] do Add( sums, posR[i]+posR[j] ); od; od; fundR:= Filtered( posR, x -> not x in sums ); inds:= List( fundR, x -> Position( posR_L, x ) ); tr:= WeylTransversal( R, inds ); info:= "Constructed a Weyl transversal of "; Append( info, String(Length(tr)) ); Append( info, " elements."); Info(InfoSLA,2,info); h_candidates:= [ ]; BH:= Basis( VectorSpace( F, hL ), hL ); W:= WeylGroup(R); for h in hl do # first we get the indices of the simple reflections that # stabilise h... c_h:= Coefficients( BH, h ); ph:= C*c_h; stb:= Filtered( [1..rank], k -> ph[k] = 0 ); for w in tr do is_rep:= true; for i in stb do # see whether there is an expression for w ending with i v:= ShallowCopy(w); Add( v, i ); if LengthOfWeylWord( W, v ) < Length(w) then is_rep:= false; break; fi; od; if is_rep then h0:= ShallowCopy(c_h); wr:= Reversed(w); for i in wr do h0[i]:= h0[i] - (C[i]*h0); od; AddSet( h_candidates, h0 ); fi; od; od; info:= "Constructed "; Append( info, String( Length(h_candidates) ) ); Append( info, " Cartan elements to be checked." ); Info( InfoSLA, 2, info ); # now we need to compute sl_2 triples wrt the h-s found... Omega:= [0..Dimension(L)]; good_h:= [ ]; g1:= Basis( Subspace( L, gr1 ), gr1 ); g2:= Basis( Subspace( L, gr2 ), gr2 ); # the matrices of hL[i] acting on g1 h_mats1:= [ ]; for h0 in hL do mat:= [ ]; for i in [1..Length(g1)] do Add( mat, Coefficients( g1, h0*g1[i] ) ); od; Add( h_mats1, mat ); od; # those of wrt g2... h_mats2:= [ ]; for h0 in hL do mat:= [ ]; for i in [1..Length(g1)] do Add( mat, Coefficients( g2, h0*g2[i] ) ); od; Add( h_mats2, mat ); od; sl2s:= [ ]; id1:= IdentityMat( Length(g1) ); id2:= IdentityMat( Length(g2) ); for h in h_candidates do mat:= h*h_mats1; mat:= mat - 2*id1; V:= NullspaceMat( mat ); e:= List( V, v -> v*gr1 ); mat:= h*h_mats2; mat:= mat + 2*id2; V:= NullspaceMat( mat ); f:= List( V, v -> v*gr2 ); # check whether h0 in [e,f].... bb:= [ ]; for x in e do for y in f do Add( bb, x*y ); od; od; ef:= Subspace( L, bb ); h0:= h*hL; if h0 in ef then #otherwise we can just discard h... found:= false; good:= false; while not found do co:= List( e, x -> Random(Omega) ); x:= co*e; sp:= Subspace( L, List( f, y -> x*y) ); if Dimension(sp) = Length(e) and h0 in sp then # look for a nice one... for i in [1..Length(co)] do k:= 0; found:= false; while not found do co[i]:= k; x:= co*e; sp:= Subspace( L, List( f, y -> x*y) ); if Dimension(sp) = Length(e) and h0 in sp then found:= true; else k:= k+1; fi; od; od; mat:= List( f, u -> Coefficients( Basis(sp), x*u ) ); sol:= SolutionMat( mat, Coefficients( Basis(sp), h0 ) ); Add( good_h, h ); Add( sl2s, [sol*f,h0,x] ); found:= true; else C_h0:= LieCentralizer( g0, Subalgebra( g0, [h0] ) ); sp0:= Subspace( L, List( Basis(C_h0), y -> y*x ) ); if Dimension(sp0) = Length(e) then found:= true; good:= false; fi; fi; od; fi; od; # Now we compute a set of canonical generators of s... inds:= List( fundR, x -> Position( posR_L, x ) ); x:= PositiveRootVectors( R ){inds}; y:= NegativeRootVectors( R ){inds}; for i in [1..Length(x)] do V:= VectorSpace( F, [ x[i] ] ); b:= Basis( V, [x[i]] ); c:= Coefficients( b, (x[i]*y[i])*x[i] )[1]; y[i]:= y[i]*2/c; od; bas:= List( [1..Length(x)], i -> x[i]*y[i] ); Append( bas, BasisVectors( Basis(r) ) ); b:= Basis( Subspace( L, bas ), bas ); # Cartan matrix of s... Cs:= NullMat( Length(fundR), Length(fundR) ); B:= BilinearFormMatNF(R); for i in [1..Length(fundR)] do for j in [1..Length(fundR)] do Cs[i][j]:= 2*( fundR[i]*(B*fundR[j]) )/( fundR[j]*(B*fundR[j]) ); od; od; return sl2s; return rec( hs:= good_h, sl2:= sl2s, chars:= List( good_h, x -> Cs*( Coefficients( b, x*hL ){[1..Length(x)]} ) ) ); end; SLAfcts.loop_W:= function( C, h_lst, func ) # C: Cartan matrix # h_lst: list of initial elements of H (given as coefficient vectors, # rel to basis of Chevalley type). # func: function H --> true, false, # if func(orb elt) = true, then orb elt is included... local rank, sim, path, h_orb, h, r, i, j, idone, nu, ispos, wrd, hs0; rank:= Length( C ); sim:= ShallowCopy(C); path:= [ rec( wt:= List( [1..rank], x -> 1 ), word:= [ ], hs:= h_lst, ind:= 0 ) ]; h_orb:= [ ]; for h in h_lst do if func(h) then Add( h_orb, h ); fi; od; while Length(path) > 0 do r:= path[ Length(path) ]; i:= r.ind+1; idone:= false; while i <= rank and not idone do if r.wt[i] <= 0 then i:= i+1; else nu:= r.wt - r.wt[i]*sim[i]; # i.e. s_i(r.wt) ispos:= true; for j in [i+1..rank] do if nu[j] < 0 then ispos:= false; break; fi; od; if ispos then path[Length(path)]:= rec( wt:= r.wt, word:= r.word, hs:= r.hs, ind:= i ); wrd:= [ i ]; Append( wrd, r.word ); hs0:= ShallowCopy(r.hs); for j in [1..Length(hs0)] do h:= ShallowCopy(hs0[j]); h[i]:= h[i] - C[i]*h; # i.e., s_i(h) hs0[j]:= h; od; Add( path, rec( wt:= nu, word:= wrd, hs:= hs0, ind:= 0 ) ); for h in hs0 do if func( h ) then if not h in h_orb then Add( h_orb, h ); fi; fi; od; idone:= true; else i:= i+1; fi; fi; od; if not idone then # get rid of last elt as it is searched through Unbind( path[Length(path)] ); fi; od; return h_orb; end; SLAfcts.nil_orbs_outer:= function( L, gr0, gr1, gr2 ) # Here L is a simple graded Lie algebra; gr0 a basis of the # elts of degree 0, gr1 of degree 1, and gr2 of degree -1. # We find the nilpotent G_0-orbits in g_1. # We *do not* assume that the given CSA of L is also a CSA of g_0. local F, g0, s, r, HL, Hs, R, Ci, hL, hl, C, rank, posRv_L, posR_L, posR, i, j, sums, fundR, inds, tr, h_candidates, BH, W, h, c_h, ph, stb, v, w, is_rep, h0, wr, Omega, good_h, g1, g2, h_mats1, h_mats2, mat, sl2s, id1, id2, V, e, f, bb, ef, found, good, co, x, C_h0, sp, sp0, y, b, bas, c, Cs, B, Rs, nas, b0, ranks, in_weylch, charact, k, sol, info; F:= LeftActingDomain(L); g0:= Subalgebra( L, gr0, "basis" ); s:= LieDerivedSubalgebra( g0 ); r:= LieCentre(g0); HL:= CartanSubalgebra(L); Hs:= Intersection( s, HL ); SetCartanSubalgebra( s, Hs ); R:= RootSystem(L); Ci:= CartanMatrix( R )^-1; hL:= CanonicalGenerators(R)[3]; hl:= List( NilpotentOrbits(L), x -> Ci*WeightedDynkinDiagram(x) ); for i in [1..Length(hl)] do if hl[i] = 0*hl[i] then Unbind( hl[i] ); fi; od; hl:= Filtered( hl, x -> IsBound(x) ); C:= CartanMatrix( R ); rank:= Length(C); if Dimension(s) > 0 then Rs:= RootSystem(s); Cs:= CartanMatrix( Rs ); ranks:= Length( Cs ); bas:= ShallowCopy( CanonicalGenerators(Rs)[3] ); Append( bas, BasisVectors( Basis(r) ) ); b0:= Basis( VectorSpace( F, bas ), bas ); else ranks:= 0; bas:= BasisVectors( Basis(r) ); b0:= Basis( VectorSpace( F, bas ), bas ); fi; in_weylch:= function( h ) local cf, u; u:= h*hL; if not u in g0 then return false; fi; cf:= Coefficients( b0, u ){[1..ranks]}; if Length(cf)=0 then return true; fi; if ForAll( Cs*cf, x -> x >= 0 ) then return true; else return false; fi; end; charact:= function( h ) local cf; cf:= Coefficients( b0, h ){[1..ranks]}; return Cs*cf; end; h_candidates:= SLAfcts.loop_W( C, hl, in_weylch ); info:= "Constructed "; Append( info, String(Length(h_candidates)) ); Append( info, " Cartan elements to be checked."); Info(InfoSLA,2,info); # now we need to compute sl_2 triples wrt the h-s found... Omega:= [0..Dimension(L)]; good_h:= [ ]; g1:= Basis( Subspace( L, gr1 ), gr1 ); g2:= Basis( Subspace( L, gr2 ), gr2 ); # the matrices of hL[i] acting on g1 h_mats1:= [ ]; for h0 in bas do mat:= [ ]; for i in [1..Length(g1)] do Add( mat, Coefficients( g1, h0*g1[i] ) ); od; Add( h_mats1, mat ); od; # those of wrt g2... h_mats2:= [ ]; for h0 in bas do mat:= [ ]; for i in [1..Length(g1)] do Add( mat, Coefficients( g2, h0*g2[i] ) ); od; Add( h_mats2, mat ); od; sl2s:= [ ]; id1:= IdentityMat( Length(g1) ); id2:= IdentityMat( Length(g2) ); for h in h_candidates do c_h:= Coefficients( b0, h*hL ); mat:= c_h*h_mats1; mat:= mat - 2*id1; V:= NullspaceMat( mat ); e:= List( V, v -> v*gr1 ); mat:= c_h*h_mats2; mat:= mat + 2*id2; V:= NullspaceMat( mat ); f:= List( V, v -> v*gr2 ); # check whether h0 in [e,f].... bb:= [ ]; for x in e do for y in f do Add( bb, x*y ); od; od; ef:= Subspace( L, bb ); h0:= h*hL; if h0 in ef then #otherwise we can just discard h... found:= false; good:= false; while not found do co:= List( e, x -> Random(Omega) ); x:= co*e; sp:= Subspace( L, List( f, y -> x*y) ); if Dimension(sp) = Length(e) and h0 in sp then # look for a nice one... for i in [1..Length(co)] do k:= 0; found:= false; while not found do co[i]:= k; x:= co*e; sp:= Subspace( L, List( f, y -> x*y) ); if Dimension(sp) = Length(e) and h0 in sp then found:= true; else k:= k+1; fi; od; od; mat:= List( f, u -> Coefficients( Basis(sp), x*u ) ); sol:= SolutionMat( mat, Coefficients( Basis(sp), h0 ) ); Add( good_h, h0 ); Add( sl2s, [sol*f,h0,x] ); found:= true; else C_h0:= LieCentralizer( g0, Subalgebra( g0, [h0] ) ); sp0:= Subspace( L, List( Basis(C_h0), y -> y*x ) ); if Dimension(sp0) = Length(e) then found:= true; good:= false; fi; fi; od; fi; od; return sl2s; return rec( hs:= good_h, sl2:= sl2s, chars:= List( good_h, charact ) ); end; SLAfcts.roots_and_vecs:= function( f ) # we return the roots and corresponding vectors of g_0, and g_1; # the output is a list with two records the first describing # g0, the second describing g1. In the case of g0 the roots are # split in positive/negative. local L, R, posR, posRv, negRv, m, vv, g0, g1, pr0, pv0, nr0, nv0, r1, rv1, i, w, m0, gm, rm, rvm, ord2; if Order(f) = 2 then ord2:= true; else ord2:= false; fi; L:= Source(f); w:= E( Order(f) ); R:= RootSystem(L); posR:= PositiveRootsNF(R); posRv:= PositiveRootVectors( R ); negRv:= NegativeRootVectors( R ); m:= List( Basis(L), x -> ShallowCopy( Coefficients( Basis(L), Image(f,x)))); m0:= m - IdentityMat( Dimension(L) ); vv:= NullspaceMat( m0 ); vv:= List( vv, x -> LinearCombination( Basis(L), x ) ); g0:= Subspace( L, vv, "basis" ); m0:= m - w*IdentityMat( Dimension(L) ); vv:= NullspaceMat( m0 ); vv:= List( vv, x -> LinearCombination( Basis(L), x ) ); g1:= Subspace( L, vv, "basis" ); m0:= m - w^(Order(f)-1)*IdentityMat( Dimension(L) ); vv:= NullspaceMat( m0 ); vv:= List( vv, x -> LinearCombination( Basis(L), x ) ); gm:= Subspace( L, vv, "basis" ); pr0:= [ ]; pv0:= [ ]; nr0:= [ ]; nv0:= [ ]; r1:= [ ]; rv1:= [ ]; rm:= [ ]; rvm:= [ ]; for i in [1..Length(posR)] do if posRv[i] in g0 then Add( pr0, posR[i] ); Add( pv0, posRv[i] ); Add( nr0, -posR[i] ); Add( nv0, negRv[i] ); if not negRv[i] in g0 then Print("OOOOOOOPS!!!!\n"); fi; elif posRv[i] in g1 then Add( r1, posR[i] ); Add( rv1, posRv[i] ); elif posRv[i] in gm then Add( rm, posR[i] ); Add( rvm, posRv[i] ); fi; if negRv[i] in g1 then Add( r1, -posR[i] ); Add( rv1, negRv[i] ); elif negRv[i] in gm then Add( rm, -posR[i] ); Add( rvm, negRv[i] ); fi; od; if ord2 then # g_{-1} = g_{1}.... return [ rec( pr0:= pr0, pv0:= pv0, nr0:= nr0, nv0:= nv0 ), rec( r1:= r1, rv1:= rv1 ), rec( rm:= r1, rvm:= rv1 ) ]; else return [ rec( pr0:= pr0, pv0:= pv0, nr0:= nr0, nv0:= nv0 ), rec( r1:= r1, rv1:= rv1 ), rec( rm:= rm, rvm:= rvm ) ]; fi; end; SLAfcts.root_basis:= function( B, posr ) local inds, i, j, pos, bas, C, tp, subs, sub, s, rrr, R, pi, posRw, rts, concs, news, r; inds:=[ ]; for i in [1..Length(posr)] do for j in [i+1..Length(posr)] do pos:= Position( posr, posr[i]+posr[j] ); if pos <> fail then AddSet( inds, pos ); fi; od; od; bas:=[ ]; for i in [1..Length(posr)] do if not i in inds then Add( bas, posr[i] ); fi; od; C:=List( bas, x -> [ ] ); for i in [1..Length(bas)] do for j in [1..Length(bas)] do C[i][j]:= 2*bas[i]*( B*bas[j] )/( bas[j]*(B*bas[j]) ); od; od; tp:= CartanType( C ); subs:=[ ]; for i in [1..Length(tp.types)] do rrr:= bas{tp.enumeration[i]}; R:= RootSystem( tp.types[i] ); pi:= SLAfcts.pi_systems( R ); sub:= [ ]; posRw:= PositiveRootsAsWeights( R ); for j in [1..Length( pi.types )] do rts:= pi.roots[j]; s:= [ ]; for r in rts do pos:= Position( posRw, r ); if pos <> fail then Add( s, PositiveRootsNF(R)[pos]*rrr ); else pos:= Position( posRw, -r ); Add( s, -PositiveRootsNF(R)[pos]*rrr ); fi; od; Add( sub, s ); od; Add( subs, sub ); od; concs:= [ [ ] ]; for i in [1..Length(subs)] do news:= [ ]; for s in concs do for j in [1..Length(subs[i])] do sub:= ShallowCopy( s ); Append( sub, subs[i][j] ); Add( news, sub ); od; od; concs:= news; od; return concs; end; SLAfcts.zero_systems:= function( B, posr ) local inds, i, j, pos, bas, C, tp, subs, sub, s, rrr, R, pi, posRw, rts, concs, news, r; if Length(posr) = 0 then return rec( bas:= [ ], subs:= [ [] ] ); fi; inds:=[ ]; for i in [1..Length(posr)] do for j in [i+1..Length(posr)] do pos:= Position( posr, posr[i]+posr[j] ); if pos <> fail then AddSet( inds, pos ); fi; od; od; bas:=[ ]; for i in [1..Length(posr)] do if not i in inds then Add( bas, posr[i] ); fi; od; C:=List( bas, x -> [ ] ); for i in [1..Length(bas)] do for j in [1..Length(bas)] do C[i][j]:= 2*bas[i]*( B*bas[j] )/( bas[j]*(B*bas[j]) ); od; od; tp:= CartanType( C ); subs:=[ ]; for i in [1..Length(tp.types)] do rrr:= bas{tp.enumeration[i]}; R:= RootSystem( tp.types[i] ); pi:= SLAfcts.sub_systems( R ); sub:= [ [ ] ]; posRw:= PositiveRootsAsWeights( R ); for j in [1..Length( pi.types )] do rts:= pi.roots[j]; s:= [ ]; for r in rts do pos:= Position( posRw, r ); if pos <> fail then Add( s, PositiveRootsNF(R)[pos]*rrr ); else pos:= Position( posRw, -r ); Add( s, -PositiveRootsNF(R)[pos]*rrr ); fi; od; Add( sub, s ); od; Add( subs, sub ); od; concs:= [ [ ] ]; for i in [1..Length(subs)] do news:= [ ]; for s in concs do for j in [1..Length(subs[i])] do sub:= ShallowCopy( s ); Append( sub, subs[i][j] ); Add( news, sub ); od; od; concs:= news; od; return rec( bas:= bas, subs:= concs ); end; SLAfcts.my_are_conjugate_0:= function( W, R, B, mus, lams ) # R is the big root system, B the bilin form mat wrt weights, # mus and lams are lists of weights, we determine whether # there exists w in W wich w(mus[i]) = lams[i], all i. local sim, i, j, k, a, b, w, mu, rmu; sim:= SimpleRootsAsWeights( R ); for i in [1..Length(mus)] do rmu:= List( W.roots, x -> 2*mus[i]*( B*x )/( x*(B*x) ) ); a:= SLAfcts.conj_dom_wt( mus[i], rmu, W ); rmu:= List( W.roots, x -> 2*lams[i]*( B*x )/( x*(B*x) ) ); b:= SLAfcts.conj_dom_wt( lams[i], rmu, W ); if a[1] <> b[1] then return false; fi; w:= Reversed( b[3] ); Append( w, a[3] ); w:= Reversed(w); for k in [i..Length(mus)] do mu:= ShallowCopy(mus[k]); rmu:= List( W.roots, x -> 2*mu*( B*x )/( x*(B*x) ) ); for j in w do mu:= mu -rmu[j]*W.roots[j]; rmu:= rmu - rmu[j]*W.wgts[j]; od; mus[k]:= mu; od; W:= SLAfcts.stabilizer( lams[i], B, W ); od; return true; end; SLAfcts.my_are_conjugate:= function( W, R, B, mus, lams ) # same as previous function, but now we also permute # the mus, lams. We do assume that they arrive in an # order that defines the same Cartan matrix... local C, perms, i, newperms, p, q, good, j, k, l, nus; # however,... first we try the identity permutation... if SLAfcts.my_are_conjugate_0( W, R, B, mus, lams ) then return true; fi; # The Cartan matrix: C:= List( mus, x -> List( mus, y -> 2*x*(B*y)/( y*(B*y) ) ) ); # Now we determine all permutations of the mus that leave C invariant: perms:= List( [1..Length(mus)], x -> [x] ); # i.e., the first element can be mapped to one of the other elts. # now we see whether this can be extended... for i in [2..Length(mus)] do newperms:= [ ]; for p in perms do for j in [1..Length(mus)] do # see whether p can be extended by adding j... if not j in p then q:= ShallowCopy(p); Add( q, j ); good:= true; for k in [1..i] do if not good then break; fi; for l in [1..i] do if not good then break; fi; if C[k][l] <> C[ q[k] ][ q[l] ] then good:= false; fi; od; od; if good then Add( newperms, q ); fi; fi; od; od; perms:= newperms; od; perms:= Filtered( perms, x -> x <> [1..Length(mus)] ); # already tried it # now we see whether there is a permutation mapping # a permuted mus to lams... for p in perms do nus:= [ ]; for i in [1..Length(p)] do nus[p[i]]:= mus[i]; od; if SLAfcts.my_are_conjugate_0( W, R, B, nus, lams ) then return true; fi; od; return false; end; SLAfcts.inner_orbits_carrier:= function( f ) # we give a list of all flat Z-graded subalgebras of the # graded Lie algebra corresponding to f. local L, R, B, ch, posR, N, rts, rr, pi, r1, zero, stack, res, r, start, rrr, ips, i, vv, u, h, C, CT, pi_0, pi_1, t, s, pos, ct, eqns, rhs, eqn, j, sol, h0, psi0, psi1, good, x, y, es, fs, valmat, val, chars, u0, v, done, gr1, gr2, g1, g2, h_mats1, h_mats2, mat, sl2s, id1, id2, Omega, V, e, ff, found, co, k, sp, extended, zz, bas, sim, Bw, W0, types, weights, wrts, tp, a, c, comb, hZ, hs, info; L:= Source(f); ch:= ChevalleyBasis(L); R:= RootSystem(L); posR:= PositiveRootsNF(R); N:= Length( posR ); rts:= ShallowCopy(posR); Append( rts, -posR ); B:= BilinearFormMatNF(R); rr:= SLAfcts.roots_and_vecs( f ); zz:= SLAfcts.zero_systems( B, rr[1].pr0 ); pi:= zz.subs; # now see how we can extend each element in pi with roots of # weight 1... and compute the maximal ones first! bas:= zz.bas; sim:= [ ]; for a in bas do pos:= Position( posR, a ); Add( sim, PositiveRootsAsWeights( R )[pos] ); od; Bw:= SLAfcts.bilin_weights( R ); W0:= rec( roots:= sim, wgts:= List( sim, x -> List( sim, y -> 2*x*(Bw*y)/( y*(Bw*y) ) ) ) ); r1:= rr[2].r1; zero:= 0*r1[1]; res:= [ ]; for k in [1..Length(pi)] do types:= [ ]; weights:= [ ]; stack:= [ rec( rts0:= pi[k], rts1:= [ ], start:= 0, sp:= VectorSpace( Rationals, pi[k], zero ) ) ]; while Length(stack) > 0 do r:= stack[Length(stack)]; RemoveElmList( stack, Length(stack) ); start:= r.start+1; rrr:= Concatenation( r.rts0, r.rts1 ); extended:= false; for i in [start..Length(r1)] do ips:= List( rrr, x -> x - r1[i] ); if ForAll( ips, x -> not ( x in rts ) ) and not r1[i] in r.sp then vv:= ShallowCopy( BasisVectors( Basis(r.sp) ) ); Add( vv, r1[i] ); u:= ShallowCopy( r.rts1 ); Add( u, r1[i] ); Add( stack, rec( rts0:= r.rts0, rts1:= u, start:= i, sp:= VectorSpace( Rationals, vv ) ) ); extended:= true; fi; od; if not extended then # see whether we can extend by # adding something "smaller" for i in [1..start-1] do if not r1[i] in rrr then ips:= List( rrr, x -> x - r1[i] ); if ForAll( ips, x -> not ( x in rts ) ) and not r1[i] in r.sp then extended:= true; break; fi; fi; od; fi; if not extended then C:= List( rrr, x -> List( rrr, y -> 2*x*(B*y)/(y*(B*y)) ) ); tp:= CartanType( C ); SortParallel( tp.types, tp.enumeration ); wrts:= [ ]; for i in [1..Length(tp.enumeration)] do for j in tp.enumeration[i] do pos:= Position( rts, rrr[j] ); if pos <= N then Add( wrts, PositiveRootsAsWeights(R)[pos] ); else Add( wrts, -PositiveRootsAsWeights(R)[pos-N] ); fi; od; od; found:= false; if tp.types in types then for i in [1..Length(types)] do if tp.types = types[i] then if SLAfcts.my_are_conjugate( W0, R, Bw, wrts, weights[i] ) then found:= true; break; fi; fi; od; fi; if not found then Add( types, tp.types ); Add( weights, wrts ); Add( res, r ); fi; fi; od; od; stack:= [ ]; for r in res do comb:= Combinations( [1..Length(r.rts1)] ); comb:= Filtered( comb, x -> x <> [ ] ); for c in comb do Add( stack, rec( rts0:= r.rts0, rts1:= r.rts1{c} ) ); od; od; res:= stack; info:= "Constructed "; Append( info, String(Length(res)) ); Append( info, " root bases of possible flat subalgebras, now checking them..."); Info( InfoSLA, 2, info ); h:= BasisVectors( Basis( CartanSubalgebra(L) ) ); C:= CartanMatrix(R); CT:= TransposedMat( C ); # HERE we assume inner! good:= [ ]; for r in res do pi_0:= r.rts0; pi_1:= r.rts1; t:= [ ]; pi:= Concatenation( pi_0, pi_1 ); for s in pi do pos:= Position( rts, s ); if pos <= N then Add( t, ch[1][pos]*ch[2][pos] ); else Add( t, ch[2][pos-N]*ch[1][pos-N] ); fi; od; t:= BasisVectors( Basis( Subspace( L, t ) ) ); ct:= List( t, x -> Coefficients( Basis(CartanSubalgebra(L)), x ) ); # i.e. t is a Cartan subalgebra of s # find h0 in t such that a(h0)=1 for all a in pi_1, a(h0)=0 # for all a in pi_0 eqns:=[ ]; rhs:= [ ]; for j in [1..Length(pi_0)] do eqn:= [ ]; for i in [1..Length(t)] do eqn[i]:= pi_0[j]*( C*ct[i] ); od; Add( eqns, eqn ); Add( rhs, 0 ); od; for j in [1..Length(pi_1)] do eqn:= [ ]; for i in [1..Length(t)] do eqn[i]:= pi_1[j]*( C*ct[i] ); od; Add( eqns, eqn ); Add( rhs, 1 ); od; sol:= SolutionMat( TransposedMat(eqns), rhs ); h0:= sol*t; # Find a basis of the subspace of h consisting of u with # a(u) = 0, for a in pi = pi_0 \cup pi_1. eqns:= [ ]; for i in [1..Length(h)] do eqns[i]:= [ ]; for j in [1..Length(pi_0)] do Add( eqns[i], pi_0[j]*CT[i] ); od; for j in [1..Length(pi_1)] do Add( eqns[i], pi_1[j]*CT[i] ); od; od; sol:= NullspaceMat( eqns ); hZ:= List( sol, u -> u*h ); # Now we compute |Psi_0| and |Psi_1|... psi0:= [ ]; for a in rr[1].pv0 do if h0*a = 0*a and ForAll( hZ, u -> u*a = 0*a ) then Add( psi0, a ); fi; od; psi1:= [ ]; for a in rr[2].rv1 do if h0*a = a and ForAll( hZ, u -> u*a = 0*a ) then Add( psi1, a ); fi; od; if Length(pi_0)+Length(pi_1) + 2*Length(psi0) = Length(psi1) then if not 2*h0 in good then Add( good, 2*h0 ); fi; fi; od; info:= "Obtained "; Append( info, String( Length(good) ) ); Append( info, " Cartan elements, weeding out equivalent copies..."); Info(InfoSLA,2,info); # NEXT can be obtained from Kac diagram!! x:= ChevalleyBasis(L)[1]; y:= ChevalleyBasis(L)[2]; es:= [ ]; fs:= [ ]; if Image( f, y[Length(y)] ) = y[Length(y)] then Add( fs, x[Length(x)] ); Add( es, y[Length(y)] ); fi; for i in [1..Length(CartanMatrix(R))] do if Image( f, x[i] ) = x[i] then Add( es, x[i] ); Add( fs, y[i] ); fi; od; hs:= List( [1..Length(es)], i -> es[i]*fs[i] ); valmat:= [ ]; for i in [1..Length(hs)] do val:= [ ]; for j in [1..Length(hs)] do Add( val, Coefficients( Basis( Subspace(L,[es[j]]), [es[j]] ), hs[i]*es[j] )[1] ); od; Add( valmat, val ); od; chars:= [ ]; for i in [1..Length(good)] do u0:= good[i]; v:= List( es, z -> Coefficients( Basis(Subspace(L,[z]),[z]), u0*z )[1] ); done:= ForAll( v, z -> z >= 0 ); while not done do pos:= PositionProperty( v, z -> z < 0 ); u0:= u0 - v[pos]*hs[pos]; v:= v - v[pos]*valmat[pos]; done:= ForAll( v, z -> z >= 0 ); od; if not u0 in chars then Add( chars, u0 ); fi; od; gr1:= rr[2].rv1; gr2:= rr[3].rvm; g1:= Basis( Subspace( L, gr1 ), gr1 ); g2:= Basis( Subspace( L, gr2 ), gr2 ); # the matrices of hL[i] acting on g1 h_mats1:= [ ]; for h0 in h do mat:= [ ]; for i in [1..Length(g1)] do Add( mat, Coefficients( g1, h0*g1[i] ) ); od; Add( h_mats1, mat ); od; # those of wrt g2... h_mats2:= [ ]; for h0 in h do mat:= [ ]; for i in [1..Length(g1)] do Add( mat, Coefficients( g2, h0*g2[i] ) ); od; Add( h_mats2, mat ); od; sl2s:= [ ]; id1:= IdentityMat( Length(g1) ); id2:= IdentityMat( Length(g2) ); Omega:= [1..Dimension(L)]; for h0 in chars do ch:= Coefficients( Basis( CartanSubalgebra(L) ), h0 ); mat:= ch*h_mats1; mat:= mat - 2*id1; V:= NullspaceMat( mat ); e:= List( V, v -> v*gr1 ); mat:= ch*h_mats2; mat:= mat + 2*id2; V:= NullspaceMat( mat ); ff:= List( V, v -> v*gr2 ); found:= false; while not found do co:= List( e, x -> Random(Omega) ); x:= co*e; sp:= Subspace( L, List( ff, y -> x*y) ); if Dimension(sp) = Length(e) and h0 in sp then # look for a nice one... for i in [1..Length(co)] do k:= 0; found:= false; while not found do co[i]:= k; x:= co*e; sp:= Subspace( L, List( ff, y -> x*y) ); if Dimension(sp) = Length(e) and h0 in sp then found:= true; else k:= k+1; fi; od; od; mat:= List( ff, u -> Coefficients( Basis(sp), x*u ) ); sol:= SolutionMat( mat, Coefficients( Basis(sp), h0 ) ); Add( sl2s, [sol*ff,h0,x] ); found:= true; fi; od; od; return sl2s; end; InstallMethod( NilpotentOrbitsOfThetaRepresentation, "for a finite order automorphism", true, [ IsGeneralMapping ], 0, function( f ) local g, L, rank, r, meth, kd, C, inds, i, w, tr; g:= Grading(f); if g[2] = [ ] then return [ ]; fi; meth:= ValueOption( "method" ); L:= Source(f); rank:= Length( CartanMatrix( RootSystem(L) ) ); if Length( KacDiagram( f ).weights ) = rank +1 then if meth = fail then kd:= KacDiagram( f ); C:= kd.CM; inds:= [ ]; for i in [1..Length(kd.weights)] do if kd.weights[i] = 0 then Add( inds, i ); fi; od; if Length(inds) > 0 then w:= SizeOfWeylGroup( CartanType( C{inds}{inds} ).types ); else w:= 1; fi; tr:= SizeOfWeylGroup( RootSystem(L) )/w; if tr > 8000 then meth:= "Carrier"; else meth:= "WeylOrbit"; fi; fi; if meth = "WeylOrbit" then Info(InfoSLA,2,"Selected Weyl orbit method."); r:= SLAfcts.nil_orbs_inner( L, g[1], g[2], g[Length(g)] ); else Info(InfoSLA,2,"Selected carrier algebra method."); r:= SLAfcts.inner_orbits_carrier( f ); fi; else r:= SLAfcts.nil_orbs_outer( L, g[1], g[2], g[Length(g)] ); fi; return r; end ); SLAfcts.CartanMatrixToPositiveRoots:= function( C ) local rank, posr, ready, ind, le, i, a, j, ej, r, b, q, CT; rank:= Length( C ); CT:= TransposedMat(C); # posr will be a list of the positive roots. We start with the # simple roots, which are simply unit vectors. posr:= IdentityMat( rank ); ready:= false; ind:= 1; le:= rank; while ind <= le do # We loop over those elements of posR that have been found in # the previous round, i.e., those at positions ranging from # ind to le. le:= Length( posr ); for i in [ind..le] do a:= posr[i]; # We determine whether a+ej is a root (where ej is the j-th # simple root. for j in [1..rank] do ej:= posr[j]; # We determine the maximum number r such that a-r*ej is # a root. r:= -1; b:= ShallowCopy( a ); while b in posr do b:= b-ej; r:=r+1; od; q:= r-LinearCombination( CT[j], a ); if q>0 and (not a+ej in posr ) then Add( posr, a+ej ); fi; od; od; ind:= le+1; le:= Length( posr ); od; return posr; end; SLAfcts.sub_systems_Delta:= function( R ) # simple root system..., we give reps of all orbits of # sub root systems that have a basis which is a subset of the basis of R, # under the Weyl group local pis, B, roots, types, tps, rts, mus, pos, found, i, j, k, comb, r0, c, C, r1, tp, e, u, t1, rank; tp:= CartanType( CartanMatrix( R ) ); pis:= rec( types:= [tp.types], roots:= [SimpleRootsAsWeights(R){tp.enumeration[1]}] ); B:= SLAfcts.bilin_weights( R ); roots:= [ ]; types:= [ ]; rank:= Length(B); comb:= Combinations( [1..rank] ); comb:= Filtered( comb, x -> (x <> [] and Length(x) <> rank ) ); for i in [1..Length(pis.types)] do tps:= pis.types[i]; rts:= pis.roots[i]; Add( roots, rts ); Add( types, tps ); for c in comb do r0:= rts{c}; # find its type in normal enumeration... C:= List( r0, x -> List( r0, y -> 2*x*(B*y)/(y*(B*y)) ) ); tp:= CartanType( C ); e:= tp.enumeration; r1:= [ ]; for j in [1..Length(e)] do u:= [ ]; for k in e[j] do Add( u, r0[k] ); od; Add( r1, u ); od; t1:= tp.types; SortParallel( t1, r1 ); mus:= Concatenation( r1 ); pos:= Position( types, t1 ); if pos = fail then Add( types, t1 ); Add( roots, mus ); else found:= false; for j in [pos..Length(types)] do if types[j] = t1 then if SLAfcts.are_conjugate( R, B, mus, roots[j] ) then found:= true; break; fi; fi; od; if not found then Add( types, t1 ); Add( roots, mus ); fi; fi; od; od; return rec( types:= types, roots:= roots ); end; SLAfcts.roots_and_vecs_Z:= function( L, g0,g1,gm ) # we return the roots and corresponding vectors of g_0, and g_1; # the output is a list with two records the first describing # g0, the second describing g1. In the case of g0 the roots are # split in positive/negative. local R, posR, posRv, negRv, m, vv, pr0, pv0, nr0, nv0, r1, rv1, i, rm, rvm; R:= RootSystem(L); posR:= PositiveRootsNF(R); posRv:= PositiveRootVectors( R ); negRv:= NegativeRootVectors( R ); pr0:= [ ]; pv0:= [ ]; nr0:= [ ]; nv0:= [ ]; r1:= [ ]; rv1:= [ ]; rm:= [ ]; rvm:= [ ]; for i in [1..Length(posR)] do if posRv[i] in g0 then Add( pr0, posR[i] ); Add( pv0, posRv[i] ); Add( nr0, -posR[i] ); Add( nv0, negRv[i] ); if not negRv[i] in g0 then Print("OOOOOOOPS!!!!\n"); fi; elif posRv[i] in g1 then Add( r1, posR[i] ); Add( rv1, posRv[i] ); elif posRv[i] in gm then Add( rm, posR[i] ); Add( rvm, posRv[i] ); fi; if negRv[i] in g1 then Add( r1, -posR[i] ); Add( rv1, negRv[i] ); elif negRv[i] in gm then Add( rm, -posR[i] ); Add( rvm, negRv[i] ); fi; od; return [ rec( pr0:= pr0, pv0:= pv0, nr0:= nr0, nv0:= nv0 ), rec( r1:= r1, rv1:= rv1 ), rec( rm:= rm, rvm:= rvm ) ]; end; SLAfcts.zero_systems_Z:= function( B, posr ) local inds, i, j, pos, bas, C, tp, subs, sub, s, rrr, R, pi, posRw, rts, concs, news, r; if Length( posr ) = 0 then return rec( bas:= [ ], subs:= [ [] ] ); fi; inds:=[ ]; for i in [1..Length(posr)] do for j in [i+1..Length(posr)] do pos:= Position( posr, posr[i]+posr[j] ); if pos <> fail then AddSet( inds, pos ); fi; od; od; bas:=[ ]; for i in [1..Length(posr)] do if not i in inds then Add( bas, posr[i] ); fi; od; C:=List( bas, x -> [ ] ); for i in [1..Length(bas)] do for j in [1..Length(bas)] do C[i][j]:= 2*bas[i]*( B*bas[j] )/( bas[j]*(B*bas[j]) ); od; od; tp:= CartanType( C ); subs:=[ ]; for i in [1..Length(tp.types)] do rrr:= bas{tp.enumeration[i]}; R:= RootSystem( tp.types[i] ); pi:= SLAfcts.sub_systems_Delta( R ); sub:= [ [ ] ]; posRw:= PositiveRootsAsWeights( R ); for j in [1..Length( pi.types )] do rts:= pi.roots[j]; s:= [ ]; for r in rts do pos:= Position( posRw, r ); if pos <> fail then Add( s, PositiveRootsNF(R)[pos]*rrr ); else pos:= Position( posRw, -r ); Add( s, -PositiveRootsNF(R)[pos]*rrr ); fi; od; Add( sub, s ); od; Add( subs, sub ); od; concs:= [ [ ] ]; for i in [1..Length(subs)] do news:= [ ]; for s in concs do for j in [1..Length(subs[i])] do sub:= ShallowCopy( s ); Append( sub, subs[i][j] ); Add( news, sub ); od; od; concs:= news; od; return rec( bas:= bas, subs:= concs ); end; # NOTE: basis of simple roots in g0 directly from grading-diagram! SLAfcts.zgrad_orbits_carrier:= function( L, grading ) # L: Lie algebra, gr: grading (0,1,-1 components). # local R, B, ch, posR, N, rts, rr, pi, r1, zero, stack, res, r, start, rrr, ips, i, vv, u, h, C, CT, pi_0, pi_1, t, s, pos, ct, eqns, rhs, eqn, j, sol, h0, psi0, psi1, good, x, y, es, fs, valmat, val, chars, u0, v, done, gr1, gr2, g2, h_mats1, h_mats2, mat, sl2s, id1, id2, Omega, V, e, ff, found, co, k, sp, extended, zz, bas, sim, Bw, W0, types, weights, wrts, tp, a, c, comb, hZ, hs, info, posRv, negRv, g0, g1, gm, CM, rr0, l0, l1, gr, deg; ch:= ChevalleyBasis(L); R:= RootSystem(L); posR:= PositiveRootsNF(R); posRv:= PositiveRootVectors(R); negRv:= NegativeRootVectors(R); N:= Length( posR ); rts:= ShallowCopy(posR); Append( rts, -posR ); B:= BilinearFormMatNF(R); rr:= [ rec( pr0:= [ ], pv0:= [ ], nv0:= [] ), rec( r1:= [ ], rv1:= [ ] ), rec( rvm:= [ ] ) ]; for i in [1..Length(posR)] do v:= posR[i]*grading; if v = 0 then Add( rr[1].pr0, posR[i] ); Add( rr[1].pv0, posRv[i] ); Add( rr[1].nv0, negRv[i] ); elif v = 1 then Add( rr[2].r1, posR[i] ); Add( rr[2].rv1, posRv[i] ); Add( rr[3].rvm, negRv[i] ); fi; od; zz:= SLAfcts.zero_systems_Z( B, rr[1].pr0 ); pi:= zz.subs; # now see how we can extend each element in pi with roots of # weight 1... and compute the maximal ones first! bas:= zz.bas; sim:= [ ]; for a in bas do pos:= Position( posR, a ); Add( sim, PositiveRootsAsWeights( R )[pos] ); od; Bw:= SLAfcts.bilin_weights( R ); W0:= rec( roots:= sim, wgts:= List( sim, x -> List( sim, y -> 2*x*(Bw*y)/( y*(Bw*y) ) ) ) ); r1:= rr[2].r1; zero:= 0*r1[1]; res:= [ ]; for k in [1..Length(pi)] do types:= [ ]; weights:= [ ]; stack:= [ rec( rts0:= pi[k], rts1:= [ ], start:= 0, sp:= VectorSpace( Rationals, pi[k], zero ) ) ]; while Length(stack) > 0 do r:= stack[Length(stack)]; RemoveElmList( stack, Length(stack) ); start:= r.start+1; rrr:= Concatenation( r.rts0, r.rts1 ); extended:= false; for i in [start..Length(r1)] do ips:= List( rrr, x -> x - r1[i] ); if ForAll( ips, x -> not ( x in rts ) ) and not r1[i] in r.sp then vv:= ShallowCopy( BasisVectors( Basis(r.sp) ) ); Add( vv, r1[i] ); u:= ShallowCopy( r.rts1 ); Add( u, r1[i] ); Add( stack, rec( rts0:= r.rts0, rts1:= u, start:= i, sp:= VectorSpace( Rationals, vv ) ) ); extended:= true; fi; od; if not extended then # see whether we can extend by # adding something "smaller" for i in [1..start-1] do if not r1[i] in rrr then ips:= List( rrr, x -> x - r1[i] ); if ForAll( ips, x -> not ( x in rts ) ) and not r1[i] in r.sp then extended:= true; break; fi; fi; od; fi; if not extended then C:= List( rrr, x -> List( rrr, y -> 2*x*(B*y)/(y*(B*y)) ) ); tp:= CartanType( C ); SortParallel( tp.types, tp.enumeration ); wrts:= [ ]; for i in [1..Length(tp.enumeration)] do for j in tp.enumeration[i] do pos:= Position( rts, rrr[j] ); if pos <= N then Add( wrts, PositiveRootsAsWeights(R)[pos] ); else Add( wrts, -PositiveRootsAsWeights(R)[pos-N] ); fi; od; od; found:= false; if tp.types in types then for i in [1..Length(types)] do if tp.types = types[i] then if SLAfcts.my_are_conjugate( W0, R, Bw, wrts, weights[i] ) then found:= true; break; fi; fi; od; fi; if not found then Add( types, tp.types ); Add( weights, wrts ); Add( res, r ); fi; fi; od; od; stack:= [ ]; for r in res do comb:= Combinations( [1..Length(r.rts1)] ); comb:= Filtered( comb, x -> x <> [ ] ); for c in comb do Add( stack, rec( rts0:= r.rts0, rts1:= r.rts1{c} ) ); od; od; res:= stack; info:= "Constructed "; Append( info, String(Length(res)) ); Append( info, " root bases of possible flat subalgebras, now checking them..."); Info( InfoSLA, 2, info ); h:= BasisVectors( Basis( CartanSubalgebra(L) ) ); C:= CartanMatrix(R); CT:= TransposedMat( C ); good:= [ ]; for r in res do pi_0:= r.rts0; pi_1:= r.rts1; pi:= Concatenation( pi_0, pi_1 ); CM:= List( pi, x -> List( pi, y -> 2*x*(B*y)/( y*(B*y) ) ) ); rr0:= SLAfcts.CartanMatrixToPositiveRoots( CM ); l0:= 0; l1:= 0; gr:= Concatenation( List( pi_0, x -> 0 ), List( pi_1, x -> 1 ) ); for s in rr0 do deg:= s*gr; if deg=0 then l0:= l0+1; elif deg=1 then l1:= l1+1; fi; od; if 2*l0+Length(pi) = l1 then t:= [ ]; for s in pi do pos:= Position( rts, s ); if pos <= N then Add( t, ch[1][pos]*ch[2][pos] ); else Add( t, ch[2][pos-N]*ch[1][pos-N] ); fi; od; t:= BasisVectors( Basis( Subspace( L, t ) ) ); ct:= List( t, x -> Coefficients( Basis(CartanSubalgebra(L)), x ) ); # i.e. t is a Cartan subalgebra of s # find h0 in t such that a(h0)=1 for all a in pi_1, a(h0)=0 # for all a in pi_0 eqns:=[ ]; rhs:= [ ]; for j in [1..Length(pi_0)] do eqn:= [ ]; for i in [1..Length(t)] do eqn[i]:= pi_0[j]*( C*ct[i] ); od; Add( eqns, eqn ); Add( rhs, 0 ); od; for j in [1..Length(pi_1)] do eqn:= [ ]; for i in [1..Length(t)] do eqn[i]:= pi_1[j]*( C*ct[i] ); od; Add( eqns, eqn ); Add( rhs, 1 ); od; sol:= SolutionMat( TransposedMat(eqns), rhs ); h0:= sol*t; # Find a basis of the subspace of h consisting of u with # a(u) = 0, for a in pi = pi_0 \cup pi_1. eqns:= [ ]; for i in [1..Length(h)] do eqns[i]:= [ ]; for j in [1..Length(pi_0)] do Add( eqns[i], pi_0[j]*CT[i] ); od; for j in [1..Length(pi_1)] do Add( eqns[i], pi_1[j]*CT[i] ); od; od; sol:= NullspaceMat( eqns ); hZ:= List( sol, u -> u*h ); # Now we compute |Psi_0| and |Psi_1|... psi0:= [ ]; for a in rr[1].pv0 do if h0*a = 0*a and ForAll( hZ, u -> u*a = 0*a ) then Add( psi0, a ); fi; od; psi1:= [ ]; for a in rr[2].rv1 do if h0*a = a and ForAll( hZ, u -> u*a = 0*a ) then Add( psi1, a ); fi; od; if Length(pi_0)+Length(pi_1) + 2*Length(psi0) = Length(psi1) then if not 2*h0 in good then Add( good, 2*h0 ); fi; fi; fi; od; info:= "Obtained "; Append( info, String( Length(good) ) ); Append( info, " Cartan elements, weeding out equivalent copies..."); Info(InfoSLA,2,info); # NEXT can be obtained from Kac diagram!! x:= ChevalleyBasis(L)[1]; y:= ChevalleyBasis(L)[2]; es:= [ ]; fs:= [ ]; g0:= Subspace( L, Concatenation( Basis(CartanSubalgebra(L)), rr[1].pv0, rr[1].nv0 ) ); for i in [1..Length(CartanMatrix(R))] do if x[i] in g0 then Add( es, x[i] ); Add( fs, y[i] ); fi; od; hs:= List( [1..Length(es)], i -> es[i]*fs[i] ); valmat:= [ ]; for i in [1..Length(hs)] do val:= [ ]; for j in [1..Length(hs)] do Add( val, Coefficients( Basis( Subspace(L,[es[j]]), [es[j]] ), hs[i]*es[j] )[1] ); od; Add( valmat, val ); od; chars:= [ ]; for i in [1..Length(good)] do u0:= good[i]; v:= List( es, z -> Coefficients( Basis(Subspace(L,[z]),[z]), u0*z )[1] ); done:= ForAll( v, z -> z >= 0 ); while not done do pos:= PositionProperty( v, z -> z < 0 ); u0:= u0 - v[pos]*hs[pos]; v:= v - v[pos]*valmat[pos]; done:= ForAll( v, z -> z >= 0 ); od; if not u0 in chars then Add( chars, u0 ); fi; od; gr1:= rr[2].rv1; gr2:= rr[3].rvm; g1:= Basis( Subspace( L, gr1 ), gr1 ); g2:= Basis( Subspace( L, gr2 ), gr2 ); # the matrices of hL[i] acting on g1 h_mats1:= [ ]; for h0 in h do mat:= [ ]; for i in [1..Length(g1)] do Add( mat, Coefficients( g1, h0*g1[i] ) ); od; Add( h_mats1, mat ); od; # those of wrt g2... h_mats2:= [ ]; for h0 in h do mat:= [ ]; for i in [1..Length(g1)] do Add( mat, Coefficients( g2, h0*g2[i] ) ); od; Add( h_mats2, mat ); od; sl2s:= [ ]; id1:= IdentityMat( Length(g1) ); id2:= IdentityMat( Length(g2) ); #Omega:= [1..Dimension(L)]; Omega:= [-1,0,1,1]; for h0 in chars do ch:= Coefficients( Basis( CartanSubalgebra(L) ), h0 ); mat:= ch*h_mats1; mat:= mat - 2*id1; V:= NullspaceMat( mat ); e:= List( V, v -> v*gr1 ); mat:= ch*h_mats2; mat:= mat + 2*id2; V:= NullspaceMat( mat ); ff:= List( V, v -> v*gr2 ); found:= false; while not found do co:= List( e, x -> Random(Omega) ); x:= co*e; sp:= Subspace( L, List( ff, y -> x*y) ); if Dimension(sp) = Length(e) and h0 in sp then # look for a nice one... for i in [1..Length(co)] do k:= 0; found:= false; while not found do co[i]:= k; x:= co*e; sp:= Subspace( L, List( ff, y -> x*y) ); if Dimension(sp) = Length(e) and h0 in sp then found:= true; else k:= k+1; fi; od; od; mat:= List( ff, u -> Coefficients( Basis(sp), x*u ) ); sol:= SolutionMat( mat, Coefficients( Basis(sp), h0 ) ); Add( sl2s, [sol*ff,h0,x] ); found:= true; fi; od; od; return sl2s; end; ################################################################################ # # method based on Weyl group action... # SLAfcts.nil_orbits_weyl:= function( L, grading ) # grading is a list with the degree of each simple root..., required to be # non-negative. local R, posR, posRv, negRv, g0, g1, gm, R1, D0, rank, inds0, v, i, perm, wrep, rts, w, N, p, D, P0, P1, j, es, fs, hs, valmat, val, chars, done, pos, u0, sg1, sgm, h_mats1, h_mats2, mat, sl2s, id1, id2, Omega, ch, V, e, ff, found, co, x, sp, k, c0, c1, s0, s1, pi_0, pi_1, t, pi, s, ct, eqns, rhs, C, CT, h, good, sol, h0, hZ, psi0, psi1, a, g00, eqn, info, orth, B, U, pU, CM, rr0, l0, l1, gr, deg; R:= RootSystem(L); posR:= PositiveRootsNF(R); posRv:= PositiveRootVectors(R); negRv:= NegativeRootVectors(R); g0:= ShallowCopy( BasisVectors( Basis( CartanSubalgebra(L) ) ) ); g1:= [ ]; gm:= [ ]; g00:= [ ]; R1:= [ ]; D0:= [ ]; rank:= Length( CartanMatrix(R) ); inds0:=[ ]; for i in [1..Length(posR)] do v:= posR[i]*grading; if v = 0 then Add( g0, posRv[i] ); Add( g0, negRv[i] ); Add( g00, posRv[i] ); if i <= rank then Add( D0, posR[i] ); Add( inds0, i ); fi; elif v = 1 then Add( g1, posRv[i] ); Add( gm, negRv[i] ); Add( R1, posR[i] ); fi; od; perm:= SLAfcts.perms(R); wrep:= WeylTransversal( R, inds0 ); info:= "Constructed a Weyl transversal of "; Append( info, String(Length(wrep)) ); Append( info, " elements."); Info(InfoSLA,2,info); N:= Length( posR ); rts:= Concatenation( posR, -posR ); ch:= ChevalleyBasis(L); h:= BasisVectors( Basis( CartanSubalgebra(L) ) ); C:= CartanMatrix(R); CT:= TransposedMat( C ); B:= BilinearFormMatNF( R ); U:=[]; good:= [ ]; for w in wrep do p:= Product( perm{w} ); p:= p^-1; D:= rts{ List( [1..rank], i -> i^p ) }; P0:= Intersection( D, D0 ); P1:= Intersection( D, R1 ); if Length(P1) > 0 then c0:= Combinations( [1..Length(P0)] ); for s0 in c0 do pi_0:= P0{s0}; pi_1:= P1; orth:= true; for s in P0 do if not s in pi_0 then if ForAny( pi_0, x -> not IsZero( x*(B*s) ) ) or ForAny( pi_1, x -> not IsZero( x*(B*s) ) ) then orth:= false; break; fi; fi; od; if orth then Sort( pi_0 ); Sort( pi_1 ); pi:= Concatenation( pi_0, pi_1 ); CM:= List( pi, x -> List( pi, y -> 2*x*(B*y)/( y*(B*y) ) ) ); rr0:= SLAfcts.CartanMatrixToPositiveRoots( CM ); l0:= 0; l1:= 0; gr:= Concatenation( List( pi_0, x -> 0 ), List( pi_1, x -> 1 ) ); for s in rr0 do deg:= s*gr; if deg=0 then l0:= l0+1; elif deg=1 then l1:= l1+1; fi; od; if 2*l0+Length(pi) = l1 then t:= [ ]; for s in pi do pos:= Position( posR, s ); Add( t, ch[1][pos]*ch[2][pos] ); od; t:= BasisVectors( Basis( Subspace( L, t ) ) ); ct:= List( t, x -> Coefficients( Basis(CartanSubalgebra(L)), x ) ); # i.e. t is a Cartan subalgebra of s # find h0 in t such that a(h0)=1 for all a in pi_1, a(h0)=0 # for all a in pi_0 eqns:=[ ]; rhs:= [ ]; for j in [1..Length(pi_0)] do eqn:= [ ]; for i in [1..Length(t)] do eqn[i]:= pi_0[j]*( C*ct[i] ); od; Add( eqns, eqn ); Add( rhs, 0 ); od; for j in [1..Length(pi_1)] do eqn:= [ ]; for i in [1..Length(t)] do eqn[i]:= pi_1[j]*( C*ct[i] ); od; Add( eqns, eqn ); Add( rhs, 1 ); od; sol:= SolutionMat( TransposedMat(eqns), rhs ); h0:= sol*t; if not 2*h0 in good then # Find a basis of the subspace of h consisting of u with # a(u) = 0, for a in pi = pi_0 \cup pi_1. eqns:= [ ]; for i in [1..Length(h)] do eqns[i]:= [ ]; for j in [1..Length(pi_0)] do Add( eqns[i], pi_0[j]*CT[i] ); od; for j in [1..Length(pi_1)] do Add( eqns[i], pi_1[j]*CT[i] ); od; od; sol:= NullspaceMat( eqns ); hZ:= List( sol, u -> u*h ); # Now we compute |Psi_0| and |Psi_1|... psi0:= [ ]; for a in g00 do if h0*a = 0*a and ForAll( hZ, u -> u*a = 0*a ) then Add( psi0, a ); fi; od; psi1:= [ ]; for a in g1 do if h0*a = a and ForAll( hZ, u -> u*a = 0*a ) then Add( psi1, a ); fi; od; if Length(pi_0)+Length(pi_1) + 2*Length(psi0) = Length(psi1) then Add( good, 2*h0 ); fi; fi; fi; fi; #od; od; fi; od; info:= "Obtained "; Append( info, String( Length(good) ) ); Append( info, " Cartan elements, weeding out equivalent copies..."); Info(InfoSLA,2,info); es:= ChevalleyBasis(L)[1]{inds0}; fs:= ChevalleyBasis(L)[2]{inds0}; hs:= List( [1..Length(es)], i -> es[i]*fs[i] ); valmat:= [ ]; for i in [1..Length(hs)] do val:= [ ]; for j in [1..Length(hs)] do Add( val, Coefficients( Basis( Subspace(L,[es[j]]), [es[j]] ), hs[i]*es[j] )[1] ); od; Add( valmat, val ); od; chars:= [ ]; for i in [1..Length(good)] do u0:= good[i]; v:= List( es, z -> Coefficients( Basis(Subspace(L,[z]),[z]), u0*z )[1] ); done:= ForAll( v, z -> z >= 0 ); while not done do pos:= PositionProperty( v, z -> z < 0 ); u0:= u0 - v[pos]*hs[pos]; v:= v - v[pos]*valmat[pos]; done:= ForAll( v, z -> z >= 0 ); od; if not u0 in chars then Add( chars, u0 ); fi; od; sg1:= Basis( Subspace( L, g1 ), g1 ); sgm:= Basis( Subspace( L, gm ), gm ); # the matrices of hL[i] acting on g1 h_mats1:= [ ]; for h0 in h do mat:= [ ]; for i in [1..Length(g1)] do Add( mat, Coefficients( sg1, h0*g1[i] ) ); od; Add( h_mats1, mat ); od; # those of wrt gm... h_mats2:= [ ]; for h0 in h do mat:= [ ]; for i in [1..Length(gm)] do Add( mat, Coefficients( sgm, h0*gm[i] ) ); od; Add( h_mats2, mat ); od; sl2s:= [ ]; id1:= IdentityMat( Length(g1) ); id2:= IdentityMat( Length(gm) ); #Omega:= [1..Dimension(L)]; Omega:= [-1,0,1,1]; for h0 in chars do ch:= Coefficients( Basis( CartanSubalgebra(L) ), h0 ); mat:= ch*h_mats1; mat:= mat - 2*id1; V:= NullspaceMat( mat ); e:= List( V, v -> v*g1 ); mat:= ch*h_mats2; mat:= mat + 2*id2; V:= NullspaceMat( mat ); ff:= List( V, v -> v*gm ); found:= false; while not found do co:= List( e, x -> Random(Omega) ); x:= co*e; sp:= Subspace( L, List( ff, y -> x*y) ); if Dimension(sp) = Length(e) and h0 in sp then # look for a nice one... for i in [1..Length(co)] do k:= 0; found:= false; while not found do co[i]:= k; x:= co*e; sp:= Subspace( L, List( ff, y -> x*y) ); if Dimension(sp) = Length(e) and h0 in sp then found:= true; else k:= k+1; fi; od; od; mat:= List( ff, u -> Coefficients( Basis(sp), x*u ) ); sol:= SolutionMat( mat, Coefficients( Basis(sp), h0 ) ); Add( sl2s, [sol*ff,h0,x] ); found:= true; fi; od; od; return sl2s; end; InstallOtherMethod( NilpotentOrbitsOfThetaRepresentation, "for a Lie algebra and a grading diagram", true, [ IsLieAlgebra, IsList ], 0, function( L, d ) local meth, rank, C, inds, i, w, tr, r; meth:= ValueOption( "method" ); rank:= Length( d ); C:= CartanMatrix( RootSystem(L) ); if meth = fail then inds:= [ ]; for i in [1..Length(d)] do if d[i] = 0 then Add( inds, i ); fi; od; if Length(inds) > 0 then w:= SizeOfWeylGroup( CartanType( C{inds}{inds} ).types ); else w:= 1; fi; tr:= SizeOfWeylGroup( RootSystem(L) )/w; if tr > 8000 then meth:= "Carrier"; else meth:= "WeylOrbit"; fi; fi; if meth = "WeylOrbit" then Info(InfoSLA,2,"Selected Weyl orbit method."); r:= SLAfcts.nil_orbits_weyl( L, d ); else Info(InfoSLA,2,"Selected carrier algebra method."); r:= SLAfcts.zgrad_orbits_carrier( L, d ); fi; return r; end ); #### functions for computing the Hasse diagram of the nil orbs of a theta group ########## # First: functions for dealing with the type of Weyl orbits that we need. # SLAfcts.NextIterator_WeylOrbitH:= function( it ) local output, mu, rank, bound, foundsucc, pos, i, nu, a, B, v, lam, sims, stack, simples, stabs; if it!.isDone then Error("the iterator is exhausted"); fi; output:= it!.currentWeight; B:= it!.B; v:= it!.v; lam:= it!.otherWt; stabs:= it!.stabinds; sims:= it!.simples; #calculate the successor of curweight mu:= ShallowCopy(it!.currentWeight); rank:= Length( mu ); stack:= it!.stack; bound:= 1; foundsucc:= false; while not foundsucc do pos:= fail; for i in [bound..rank] do if mu[i]>0 then nu:= ShallowCopy(mu); nu:= nu -nu[i]*sims[i]; if ForAll( nu{[i+1..rank]}, x -> x >= 0 ) then if Concatenation( nu, it!.c0 )*(B*Concatenation( lam, it!.c1 )) >= v then pos:= i; break; fi; fi; fi; od; if pos <> fail then Add( stack, [ mu, pos ] ); if not pos in stabs and ForAll( stabs, x -> nu[x] >= 0 ) then foundsucc:= true; else mu:= nu; bound:= 1; fi; else if mu = it!.root then # we cannot find a sucessor of the root: we are done it!.isDone:= true; nu:= []; foundsucc:= true; else a:= stack[Length(stack)]; mu:= a[1]; bound:= a[2]+1; RemoveElmList( stack, Length(stack) ); fi; fi; od; it!.stack:= stack; it!.currentWeight:= nu; return output*it!.dualBas; end; SLAfcts.ClosureWeylOrbit:= function( L, K, H, basH, C, dualBas, B, h0, h1, c1, c0 ) # K: semsim Lie algebra, # H: CSA of K, # basH: basis of H, consisting of alpha_i^\vee # C: the Cartan matrix wrt the alpha_i # h0: element of H, of which we compute the orbit; assumed to be dominant. # h1: the other element, used for the Killing value... local mu, nu, rank, Ci, i, j, c, v, bas, pos, sims, nu1; rank:= Length(C); bas:= Basis( H, dualBas ); mu:= Coefficients( bas, h0 ); nu:= Coefficients(bas,h1); nu1:= Concatenation( nu, c1 ); v:= nu1*B*nu1; sims:= List( basH, x -> Coefficients( bas, x ) ); return IteratorByFunctions( rec( IsDoneIterator := IsDoneIterator_WeylOrbit, NextIterator := SLAfcts.NextIterator_WeylOrbitH, ShallowCopy:= function( iter ) return rec( root:= ShallowCopy( iter!.root ), currentWeight:= ShallowCopy( iter!.currentWeight ), stack:= ShallowCopy( iter!.stack ), otherWt:= ShallowCopy( iter!.otherWt ), stabinds:= ShallowCopy( iter!.stabinds ), B:= ShallowCopy( iter!.B ), v:= iter!.v, c0:= iter!.c0, c1:= iter!.c1, dualBas:= iter!.dualBas, simples:= ShallowCopy( iter!.simples ), isDone:= iter!.isDone ); end, root:= mu, currentWeight:= mu, stack:= [ ], otherWt:= nu, stabinds:= Filtered( [1..Length(nu)], i -> nu[i]=0 ), B:= B, v:= v, c0:= c0, c1:= c1, dualBas:= dualBas, simples:= sims, isDone:= false ) ); end; ################################################################################ # Next: the main procedure, starting with some subfunctions... # SLAfcts.cartanorb_prop:= function( L, K0, H0, basH, C, dualBas, B, h, oh, c1, c0, func ) # h in H; its orbit under the Weyl group... local o, hh, count; o:= SLAfcts.ClosureWeylOrbit( L, K0, H0, basH, C, dualBas, B, h, oh, c1, c0 ); while not IsDoneIterator(o) do hh:= NextIterator(o); if func(hh) then return true; fi; od; return false; end; SLAfcts.normaliser:= function( L, K, U ) # L: Lie algebra # K: subalgebra # U: basis of a subspace of L # return: subalgebra of K, of all x such that [x,U] subset U. local n, sp, m, s, eqns, k, d, r, j, i, sol, eqn; n:= Dimension(K); sp:= Subspace(L,U); U:= BasisVectors( Basis(sp) ); m:= Dimension(sp); s:= Dimension(L); eqns:= NullMat( n+m^2, s*m ); for k in [1..m] do d:= Coefficients( Basis(L), U[k] ); for r in [1..s] do if not IsZero(d[r]) then for j in [1..m] do eqns[n+k+(j-1)*m][j+(r-1)*m]:= eqns[n+k+(j-1)*m][j+(r-1)*m]+d[r]; od; fi; od; od; for i in [1..n] do for j in [1..m] do d:= Coefficients( Basis(L), Basis(K)[i]*U[j] ); for r in [1..s] do if not IsZero(d[r]) then eqns[i][j+(r-1)*m]:= eqns[i][j+(r-1)*m]+d[r]; fi; od; od; od; sol:= NullspaceMatDestructive( eqns ); return List( sol, x -> x{[1..n]}*Basis(K) ); end; SLAfcts.inc:= function( sl2, domh, L, K, GM, G1, H0, basH, C, dualBas, B, i0, j0, file, matlist ) # see whether orbit i0 is inclued in j0. local hi, hj, gh, W, ww, V2, U, wd, k, v0, f_chk, R, hh, BH, KH, Ci, Um, q, K0, h0, b0, sp0, h_start, c0, kk, KL, v, t, mats, oh, sp, kval, adh, Uinds, ord, maxU, i, j, mats0, c1, inconvexhull, kappamat, kapinv, invnu, dist0, ip0; inconvexhull:= function( B, S0, p0, dist, ip, eps0 ) # S set of vecs in R^m (rat coords), # p a point in R^m, is p\in S? # dist: distance fct local m, i, one, eps, dists, pos, v, pp, k, j, u, t, S, p; S:= List( S0, x -> Coefficients( B, x ) ); p:= Coefficients( B, p0 ); one:= 1.00000000000000000000000000; S:= List( S, u -> u*one ); p:= p*one; eps:= one*eps0; dists:= List( S, s -> dist(s,p) ); pos:= Position( dists, Minimum( dists ) ); v:= S[pos]; pp:= S[pos]; while true do if dist(p,pp) < eps*dist(p,v) then return [ pp, true ]; else k:= 0; for j in [1..Length(S)] do if dist(pp,S[j]) >= dist(p,S[j]) then k:= j; break; fi; od; if k > 0 then v:= S[k]; else return [ pp, false ]; fi; fi; u:= pp-v; t:= -ip(u,p-pp)/ip(u,u); pp:= pp+t*(-u); od; end; kappamat:= List( Basis(H0), h1 -> List( Basis(H0), h2 -> TraceMat( AdjointMatrix( Basis(L), h1 )*AdjointMatrix(Basis(L),h2)) )); kapinv:= kappamat^-1; invnu:= function(x) # x a root vec in g1, compute invnu of corr root. local sp, b, u; sp:= Basis( Subspace( L, [x] ), [x] ); b:= List( Basis(H0), h1 -> Coefficients( sp, h1*x )[1] ); return (kapinv*b)*Basis(H0); end; dist0:= function(u,v) return (u-v)*kappamat*(u-v); end; ip0:= function(u,v) return u*kappamat*v; end; ord:= function( i1, i2 ) if Length(i1) <> Length(i2) then return Length(i1) < Length(i2); else return i1 < i2; fi; end; hi:= domh[i0]; hj:= domh[j0]; kval:= TraceMat( AdjointMatrix( Basis(L), hi )*AdjointMatrix(Basis(L),hj)); kval:= kval/TraceMat(AdjointMatrix(Basis(L),hi)*AdjointMatrix(Basis(L),hi)); if kval < 1 then return false; fi; ww:= [ ]; for v in Basis(G1) do sp:= Basis( Subspace( L, [v] ), [v] ); k:= Coefficients( sp, hi*v )[1]; if k = 2 then Add( ww, v ); fi; od; V2:= ww; K0:= LieDerivedSubalgebra(K); h0:= BasisVectors(Basis( LieCentre(K) )); b0:= Concatenation( basH, h0 ); sp0:= Basis( Subspace(L,b0), b0 ); R:= RootSystem(K0); hh:= CanonicalGenerators(R)[3]; BH:= Basis( Subspace( L, hh ), hh ); KH:= List( hh, x -> [] ); adh:= List( hh, x -> AdjointMatrix( Basis(L), x ) ); for i in [1..Length(hh)] do for j in [i..Length(hh)] do kval:= TraceMat( adh[i]*adh[j] ); KH[i][j]:= kval; if i <> j then KH[j][i]:= kval; fi; od; od; Um:= Filtered( Basis(GM), x -> hi*x = -2*x ); q:= LieCentralizer( K, Subalgebra(K,[hi]) ); mats:= [ ]; mats0:= [ ]; Uinds:= [ ]; maxU:= [ ]; f_chk:= function( h, c0, t ) local gh, U, k, v0, u1, A, sol, P, M, sp, B, q0, inds, p, i, j, m, n, x, u, c, cf, R, a, s, v, d, r, V, t0, Uind, pos, cf0, found, Om, matrc, colinds, Bt, kval0, kval1, hhh, kv, h00, eps, bl; if Length(c0) > 0 then u1:= h+c0*h0; else u1:= h; fi; U:= [ ]; Uind:= [ ]; for i in [1..Length(V2)] do v:= V2[i]; sp:= Basis( Subspace( L, [v] ), [v] ); k:= Coefficients( sp, u1*v )[1]; if k >= 2 then Add( U, v ); Add( Uind, i ); fi; od; if Length(U) = 0 then return false; fi; pos:= PositionSorted( Uinds, Uind, ord ); if IsBound(Uinds[pos]) and Uinds[pos] = Uind then return false; else Add( Uinds, Uind, pos ); fi; for i in [1..Length(maxU)] do if IsSubset( maxU[i], Uind ) then return false; fi; od; # M:= SLAfcts.normaliser( L, K, U ); Om:= [0..Dimension(L)]; for k in [1..5] do cf0:= List( U, x -> Random( Om ) ); v0:= cf0*U; A:= List( Um, x -> Coefficients( Basis(K), v0*x ) ); if Length(A) = 0 then sol:= fail; else sol:= SolutionMat( A, Coefficients( Basis(K), hi ) ); fi; if sol <> fail then return true; else if Dimension( Subspace( L, v0*M ) ) = Length(U) then Add( maxU, Uind ); return false; fi; fi; od; hhh:= List( U, x -> invnu(x) ); kv:= TraceMat(AdjointMatrix(Basis(L),hi)*AdjointMatrix(Basis(L),hi)); h00:= 2*hi/kv; eps:= 1/10; while eps > 1/10000000 do bl:= inconvexhull( Basis(H0), hhh, h00, dist0, ip0, eps )[2]; if bl then eps:= eps/10; else return false; fi; od; if Length(file) > 0 then V:= Subspace( L, V2 ); m:= Length(U); if m = 0 then return false; fi; n:= Dimension(q); s:= Dimension(V); x:= BasisVectors( Basis(q) ); v:= BasisVectors( Basis(V) ); c:= List( [1..n], r -> [ [ ] ] ); for i in [1..n] do for j in [1..s] do c[i][j]:= Coefficients( Basis( V ), x[i]*v[j] ); od; od; d:= List( U, r -> Coefficients( Basis(V), r ) ); P:= PolynomialRing( Rationals, m ); a:= IndeterminatesOfPolynomialRing( P ); A:= List( [1..s], r -> [ ] ); for r in [1..s] do for i in [1..n] do cf:= Zero(P); for k in [1..m] do for j in [1..s] do cf:= cf + a[k]*d[k][j]*c[i][j][r]; od; od; A[r][i]:= cf; od; od; if Dimension(q)-Length(A) > t then return false; fi; if ForAny(A, IsZero ) then return false; fi; matrc:= rec( inds:= [i0,j0], numindets:= Length(a), fullmat:= A ); q0:= BasisVectors( CanonicalBasis( Intersection( q, KappaPerp( L, Subalgebra(L,[hi]) ) ) ) ); B:= [ ]; # first we find a max set of lin indep rows, for a random v0\in U cf0:= List( U, x -> Random( [1..Dimension(L)^2] ) ); v0:= cf0*U; for i in [1..Length(q0)] do Add( B, Coefficients( Basis(V), q0[i]*v0 ) ); od; inds:= [ 1 ]; sp:= MutableBasis( LeftActingDomain(L), [ ], List( Basis(V), x -> 0 ) ); for i in [1..Length(B)] do if not IsContainedInSpan( sp, B[i] ) then CloseMutableBasis( sp, B[i] ); Add( inds, i+1 ); fi; od; colinds:= [ ]; Bt:= TransposedMat(B{[1..Length(B)]}); sp:= MutableBasis( LeftActingDomain(L), [ ], List( [1..Length(q0)], x -> 0 ) ); for i in [1..Length(Bt)] do if not IsContainedInSpan( sp, Bt[i] ) then CloseMutableBasis( sp, Bt[i] ); Add( colinds, i ); fi; od; # now make the "real" matrix... x:= Concatenation( [hi], q0 ); A:= List( inds, zz -> [ ] ); c:= List( [1..n], r -> [ [ ] ] ); for i in [1..n] do for j in [1..m] do c[i][j]:= Coefficients( Basis( V ), x[i]*U[j] ); od; od; for i in [1..Length(inds)] do for j in [1..s] do p:= Zero(P); for k in [1..m] do p:= p + a[k]*c[inds[i]][k][j]; A[i][j]:= p; od; od; od; matrc.redmat:= A; matrc.colinds:= colinds; Add( matlist, matrc ); else Add( matlist, rec( inds:= [i0,j0] ) ); fi; return false; end; t:= Dimension( Intersection( LieCentralizer( K, Subalgebra(K,[sl2[i0][2]]) ), LieCentralizer(L,Subalgebra(L,[sl2[i0][3]])) ) ); Ci:= CartanMatrix(R)^-1; h_start:= Coefficients( sp0, hj ){[1..Length(basH)]}*basH; c0:= Coefficients( sp0, hj ){[ Length(basH)+1..Length(b0) ]}; c1:= Coefficients( sp0, hi ){[ Length(basH)+1..Length(b0) ]}; oh:= Coefficients( sp0, hi ){[1..Length(basH)]}*basH; v:= SLAfcts.cartanorb_prop( L, K0, H0, basH, C, dualBas, B, h_start, oh, c1, c0, h -> f_chk(h,c0,t) ); return v; end; SLAfcts.is_included_in:= function( diag, j ) local list, done, list0, d, pos; list:= [ j ]; done:= false; while not done do list0:= [ ]; for d in diag do if d[1] in list then AddSet( list0, d[2] ); fi; od; list0:= Set( Concatenation( list, list0 ) ); if Length(list0) = Length(list) then done:= true; fi; list:= list0; od; pos:= Position( list, j ); RemoveElmList( list, pos ); return list; end; SLAfcts.minimize_diag:= function( N, diag ) # if [i,j] and [j,k] and [i,k] then get rid of [i,k]... local edges, s, i, j, k, path2, p1, p2; Sort(diag); edges:= [ ]; for s in diag do i:= s[1]; j:= s[2]; path2:= false; for k in [1..N] do if k <> i and k <> j then p1:= PositionSorted( diag, [i,k] ); p2:= PositionSorted( diag, [k,j] ); if IsBound(diag[p1]) and IsBound(diag[p2]) and diag[p1] = [i,k] and diag[p2] = [k,j] then #if [i,k] in diag and [k,j] in diag then path2:= true; fi; fi; if path2 then break; fi; od; if not path2 then Add( edges, s ); fi; od; return edges; end; SLAfcts.hasse_diag:= function( L, grad, sl2 ) local K, GM, G1, dim, dim1, d1, d2, diag, i, j, k, incs, b, file, K0, R, posRv, posR, negRv, fundR, sums, inds, basH, H0, rank, C, B, posR_L, dualBas, Ci, c, g0, g1, gm, gsp, Cu, domh, sims, pos, bas, mu, h0, b0, c0, sp0, m, m0, r, numvar, matlist, info, set, magmaprog, dualBas0; g0:= grad[1]; gm:= grad[ Length(grad) ]; if Length( grad ) > 1 then g1:= grad[2]; else g1:= grad[1]; fi; file:= ValueOption( "filenm" ); if file = fail then file:= ""; fi; K:= Subalgebra( L, g0 ); GM:= Subspace( L, gm ); G1:= Subspace( L, g1 ); K0:= LieDerivedSubalgebra(K); R:= RootSystem(K0); posR:= PositiveRootsNF(R); fundR:= SimpleSystemNF(R); inds:= List( fundR, x -> Position( posR, x ) ); posRv:= PositiveRootVectors(R); negRv:= NegativeRootVectors(R); basH:= List( inds, i -> posRv[i]*negRv[i] ); H0:= Subalgebra( K0, basH ); rank:= Length( basH ); C:= CartanMatrix(R); dualBas:= [ ]; Ci:= C^-1; for i in [1..rank] do c:= 0*[1..rank]; c[i]:= 1; c:= Ci*c; Add( dualBas, c*basH ); od; dualBas0:= Concatenation( dualBas, BasisVectors(Basis( LieCentre(K) ) ) ); B:= List( [1..Length(dualBas0)], x -> [] ); for i in [1..Length(dualBas0)] do for j in [i..Length(dualBas0)] do B[i][j]:= TraceMat( AdjointMatrix( Basis(L), dualBas0[i] )* AdjointMatrix( Basis(L), dualBas0[j] ) ); B[j][i]:= B[i][j]; od; od; dim:= function( u ) return Dimension( Subspace( L, Basis(K)*u[3] ) ); end; d1:= List( sl2, dim ); SortParallel( d1, sl2 ); d1:= Reversed(d1); sl2:= Reversed(sl2); # now map all h-s to dominant Weyl chamber. h0:= BasisVectors(Basis( LieCentre(K) )); b0:= Concatenation( basH, h0 ); sp0:= Basis( Subspace(L,b0), b0 ); domh:= [ ]; bas:= Basis( H0, dualBas ); sims:= List( basH, x -> Coefficients( bas, x ) ); for i in [1..Length(sl2)] do h0:= Coefficients( sp0, sl2[i][2] ){[1..Length(basH)]}*basH; c0:= Coefficients( sp0, sl2[i][2] ){[ Length(basH)+1..Length(b0) ]}; mu:= Coefficients( bas, h0 ); pos:= PositionProperty( mu, x -> x < 0 ); while pos <> fail do mu:= mu -mu[pos]*sims[pos]; pos:= PositionProperty( mu, x -> x < 0 ); od; if Length(c0) = 0 then Add( domh, mu*bas ); else Add( domh, mu*bas + c0*b0{[Length(basH)+1..Length(b0) ]} ); fi; od; gsp:= List( grad, x -> Subspace( L, x ) ); d2:= [ ]; for i in [1..Length(sl2)] do Cu:= LieCentralizer( L, Subalgebra( L, [sl2[i][3]] ) ); Add( d2, List( gsp, x -> Dimension( Intersection( x, Cu ) ) ) ); od; diag:= [ ]; # [ i, j ] in diag means orbit i is included in the closure of # orbit j. matlist:= [ ]; for i in [2..Length(sl2)] do for j in [i-1,i-2..1] do if (not [i,j] in diag) and d1[i] < d1[j] and ForAll( [1..Length(grad)], k -> d2[i][k] >= d2[j][k] ) then b:= SLAfcts.inc( sl2, domh, L, K, GM, G1, H0, basH, C, dualBas, B, i, j, file, matlist ); if b then Add( diag, [i,j] ); incs:= SLAfcts.is_included_in( diag, j ); for k in incs do Add( diag, [i,k] ); od; fi; fi; od; od; matlist:= Filtered( matlist, x -> not x.inds in diag ); if Length(matlist) = 0 then Info( InfoSLA,2,"All (non-) inclusions proved!"); else info:= "For the following pairs of orbits the first could be included in the\nclosure of the sec (but this is unlikely):\n"; set:= Set( List( matlist, r -> r.inds ) ); for i in [1..Length(set)] do Append( info, String(set[i]) ); if i < Length( set ) then Append( info, ", " ); fi; od; Info( InfoSLA,2, info ); fi; if Length(file) > 0 and Length(matlist) > 0 then magmaprog:= "minors:= function( m )\n\n\ \/\/ m and rxs matrix with s >= r, compute all rxr minors,\n\ \/\/ return false if a nonzero found; otherwise return true.\n\n\ r:= NumberOfRows(m);\n\ s:= NumberOfColumns(m);\n\ if r eq s then return Determinant(m) eq 0; end if;\n\ rows:= [1..r];\n\ done:= false;\n\ len:= s-r;\n\ exc:= [1..len];\n\ while not done do\n\ cols:= [ ];\n\ for i in [1..s] do\n\ if not i in exc then Append( ~cols, i ); end if;\n\ end for;\n\ d:= Minor( m, rows, cols ); \n\ if not IsZero(d) then return false; end if;\n\ pos:= len;\n\ found:= (exc[pos] lt s); \n\ while not found do \n\ pos:= pos-1; \n\ if pos eq 0 then // done... \n\ done:= true;\n\ found:= true;\n\ else\n\ found:= (exc[pos] lt s-(len-pos));\n\ end if;\n\ end while;\n\ if not done then \n\ l:= exc[pos]+1;\n\ for i in [pos..len] do \n\ exc[i]:= l+i-pos; \n\ end for; \n\ end if; \n\ end while; \n\ return true;\n\ end function;\n\n\n\n\ minors0:= function( m, cols )\n\n\ \/\/ m and rxs matrix with s > r \n\ \/\/ and cols are indices of lin indep columns.\n\ \/\/ check whether first row is in span of last r-1 rows...\n\n\ r:= NumberOfRows(m);\n\ s:= NumberOfColumns(m);\n\ rows:= [1..r]; \n\ for i in [1..s] do \n\ if not i in cols then \n\ columns:= cols; \n\ Append( ~columns, i ); \n\ Sort( ~columns ); \n\ d:= Minor( m, rows, columns ); \n\ if not IsZero(d) then return false; end if; \n\ end if; \n\ end for; \n\ return true; \n\ end function; \n\n"; AppendTo( file, magmaprog ); numvar:= 0; for r in matlist do if r.numindets > numvar then numvar:= r.numindets; fi; od; AppendTo( file, "F<" ); for i in [1..numvar] do AppendTo( file, "x_" ); AppendTo( file, i ); if i < numvar then AppendTo(file,","); fi; od; AppendTo( file, ">:= RationalFunctionField( Rationals(), "); AppendTo( file, numvar ); AppendTo( file, ");\n\n"); for r in matlist do AppendTo( file, "print \"inclusion: orbit \", ",r.inds[1], ", \" in orbit \",",r.inds[2],"; m:= r.fullmat; m0:= r.redmat; AppendTo( file, "m:= \n ",m,";\n\n", "m:= Matrix(m);\n\n", "m0:= \n ",m0,";\n\n", "m0:= Matrix(m0);\n\n" ); AppendTo( file, "cols:= ",r.colinds,";\n\n" ); if Length(m[1])-Length(m) < Length(m0[1])-Length(m0) then AppendTo( file, "minors(m);\n\n" ); else AppendTo( file, "if not minors0(m0,cols) then minors(m); else true; end if;\n\n"); fi; od; fi; return rec( diag:= diag, sl2:= sl2 ); end; InstallMethod( ClosureDiagram, "for Lie algebra, list or automorphism, list of sl2 triples", true, [ IsLieAlgebra, IsObject, function( L, obj, sl2 ) local d, g0, g1, gm, R, posR, posRv, negRv, i, v, r, diag, f, g; if IsList( obj ) then d:= obj; g0:= ShallowCopy( ChevalleyBasis(L)[3] ); g1:= [ ]; gm:= [ ]; R:= RootSystem(L); posR:= PositiveRootsNF(R); posRv:= PositiveRootVectors(R); negRv:= NegativeRootVectors(R); for i in [1..Length(posR)] do v:= posR[i]*d; if v = 0 then Add( g0, posRv[i] ); Add( g0, negRv[i] ); elif v = 1 then Add( g1, posRv[i] ); Add( gm, negRv[i] ); fi; od; if Length(g1) > 0 then r:= SLAfcts.hasse_diag( L, [g0,g1,gm], sl2 ); else r:= SLAfcts.hasse_diag( L, [g0], sl2 ); fi; elif IsMapping( obj ) then f:= obj; g:= Grading(f); r:= SLAfcts.hasse_diag( L, g, sl2 ); else Error( "the second argument has to be an automorphism or a list giving a Z-grading"); fi; diag:= SLAfcts.minimize_diag( Length(sl2), r.diag ); return rec( diag:= diag, sl2:= r.sl2 ); end ); SLAfcts.carrZ:= function( L, diag, e ) # L Z-graded by diag, e in L(1); get its carrier algebra. local R, posR, pRv, nRv, g0, i, v, K, h, sp, gp, gn, lams, b, C, c, eigensp, gpos, gneg, gzero, h1, good; R:= RootSystem(L); posR:= PositiveRootsNF(R); pRv:= PositiveRootVectors(R); nRv:= NegativeRootVectors(R); gpos:= [ ]; gneg:= [ ]; gzero:= ShallowCopy( CanonicalGenerators(R)[3] ); for i in [1..Length(posR)] do v:= posR[i]*diag; if v = 0 then Add( gzero, pRv[i] ); Add( gzero, nRv[i] ); elif v > 0 then if not IsBound( gpos[v] ) then gpos[v]:= [ pRv[i] ]; gneg[v]:= [ nRv[i] ]; else Add( gpos[v], pRv[i] ); Add( gneg[v], nRv[i] ); fi; fi; od; K:= Subalgebra( L, gzero ); h1:= BasisVectors( CanonicalBasis( Intersection( LieNormalizer( L, Subalgebra(L,[e]) ), CartanSubalgebra(L) ) ) ); h:= BasisVectors(CanonicalBasis( ( CartanSubalgebra(LieNormalizer(L,Subalgebra(L,[e if Length(h) = Length(h1) then good:= true; else good:= false; fi; lams:= [ ]; sp:= Basis( Subspace( L, [e] ), [e] ); for i in [1..Length(h)] do Add( lams, Coefficients( sp, h[i]*e )[1] ); od; gp:= [ ]; gn:= [ ]; if good then g0:= ShallowCopy( CanonicalGenerators(R)[3] ); b:= List( h, x -> Coefficients( CanonicalBasis(CartanSubalgebra(L)), x ) ); C:= CartanMatrix( R ); for i in [1..Length(posR)] do v:= posR[i]*diag; c:= List( b, x -> posR[i]*C*x ); if v = 0 then if c = 0*c then Add( g0, pRv[i] ); Add( g0, nRv[i] ); fi; else if c = v*lams then if not IsBound( gp[v] ) then gp[v]:= []; gn[v]:= []; fi; Add( gp[v], pRv[i] ); Add( gn[v], nRv[i] ); fi; fi; od; else eigensp:= function( uu, t ) local m, s, sp, eqns, i, j, k, c, sol; m:= Length(h); s:= Length(uu); sp:= Basis( Subspace( L, uu ), uu ); eqns:= NullMat( s, s*m ); for j in [1..m] do for i in [1..s] do c:= Coefficients( sp, h[j]*uu[i] ); for k in [1..s] do eqns[i][(k-1)*m+j]:= c[k]; od; od; od; for k in [1..s] do for j in [1..m] do eqns[k][(k-1)*m+j]:= eqns[k][(k-1)*m+j]-t*lams[j]; od; od; sol:= NullspaceMat( eqns ); return List( sol, x -> x*uu ); end; g0:= eigensp( gzero, 0 ); for i in [1..Length(gpos)] do if IsBound( gpos[i] ) then gp[i]:= eigensp( gpos[i], i ); gn[i]:= eigensp( gneg[i], -i ); fi; od; fi; K:= Subalgebra(L,Concatenation(g0,Flat(gp),Flat(gn))); K:= LieDerivedSubalgebra(K); sp:= Intersection( Subspace(L,g0), K ); g0:= BasisVectors( Basis( sp ) ); for i in [1..Length(gp)] do if IsBound( gp[i] ) then sp:= Intersection( Subspace(L,gp[i]), K ); gp[i]:= BasisVectors( Basis( sp ) ); else gp[i]:= [ ]; fi; od; for i in [1..Length(gn)] do if IsBound( gn[i] ) then sp:= Intersection( Subspace(L,gn[i]), K ); gn[i]:= BasisVectors( Basis( sp ) ); else gn[i]:= [ ]; fi; od; return rec( g0:= g0, posdeg:= gp, negdeg:= gn ); end; SLAfcts.carrZm:= function( L, f, e ) local h, lams, sp, i, gp, gn, eigensp, g0, g1, gm, m, gr, K, k, dim,t0; gr:= Grading(f); sp:= Subspace( L, gr[1] ); h:= BasisVectors(CanonicalBasis( Intersection( sp, CartanSubalgebra(LieNormalizer(L, Subalgebra(L,[e])))))); lams:= [ ]; sp:= Basis( Subspace( L, [e] ), [e] ); for i in [1..Length(h)] do Add( lams, Coefficients( sp, h[i]*e )[1] ); od; gp:= [ ]; gn:= [ ]; eigensp:= function( uu, t ) local m, s, sp, eqns, i, j, k, c, sol; m:= Length(h); s:= Length(uu); sp:= Basis( Subspace( L, uu ), uu ); eqns:= NullMat( s, s*m ); for j in [1..m] do for i in [1..s] do c:= Coefficients( sp, h[j]*uu[i] ); for k in [1..s] do eqns[i][(k-1)*m+j]:= c[k]; od; od; od; for k in [1..s] do for j in [1..m] do eqns[k][(k-1)*m+j]:= eqns[k][(k-1)*m+j]-t*lams[j]; od; od; sol:= NullspaceMat( eqns ); return List( sol, x -> x*uu ); end; m:= Length(gr); g0:= eigensp( gr[1], 0 ); g1:= eigensp( gr[2], 1 ); gm:= eigensp( gr[ m ], -1 ); K:= LieDerivedSubalgebra( Subalgebra( L, Concatenation( gm, g0, g1 ) ) ); g0:= BasisVectors( Basis( Intersection( Subspace( L, g0 ), K ) ) ); dim:= Length(g0); k:= 1; while dim < Dimension(K) do g1:= BasisVectors( Basis( Intersection( Subspace( L, eigensp( gr[ (k mod m) +1 ], k ) ), K ) ) ); Add( gp, g1 ); dim:= dim+Length(g1); gm:= BasisVectors( Basis( Intersection( Subspace( L, eigensp( gr[ (-k mod m) +1 ], -k ) ), K ) ) ); Add( gn, gm ); dim:= dim+Length(gm); k:= k+1; od; return rec( g0:= g0, gp:= gp, gn:= gn ); end; InstallMethod( CarrierAlgebra, "for Lie algebra, list or automorphism, a nilpotent element", true, [ IsLieAlgebra, IsObject, IsObject ], 0, function( L, obj, e ) local d, g0, g1, gm, R, posR, posRv, negRv, i, v, r, diag, f, g; if IsList( obj ) then d:= obj; r:= SLAfcts.carrZ( L, d, e ); elif IsMapping( obj ) then f:= obj; r:= SLAfcts.carrZm( L, f, e ); else Error( "the second argument has to be an automorphism or a list giving a Z-grading"); fi; return r; end ); SLAfcts.jord_dec:= function ( mat ) local F, p, B, f, g, fac, ff, h, w; F := DefaultFieldOfMatrix( mat ); if F = fail then return TRY_NEXT_METHOD; fi; p := Characteristic( F ); f := CharacteristicPolynomial( F, F, mat ); fac := Set( Factors( f ) ); g:= Product( fac ); if f = g then return [ mat, 0 * mat ]; fi; w := GcdRepresentation( g, Derivative( g ) )[2]; w := w * g; B := ShallowCopy( mat ); while Value( g, B ) <> 0 * B do B := B - Value( w, B ); od; return [ B, mat - B ]; end; SLAfcts.semsim_part:= function( L, x, b, B ) # x elm of semsim Lie alg, L, b: basis of Lie alg # B: basis of space spanned by ad L, such that i-th # basis elements is ad b_i. local adx, cf; adx:= AdjointMatrix( Basis(L), x ); cf:= Coefficients( B, SLAfcts.jord_dec( adx )[1] ); return cf*b; end; InstallMethod( CartanSubspace, "for a finite order automorphism", true, [ IsGeneralMapping ], 0, function( f ) local F, sp0, sp1, g, s, r, Omega, s1, b, ad, B, found, x, xs, s0, V, i, cf, cf1, x1, xs1, adx, found0, L, g0, g1; L:= Source(f); g0:= Grading(f)[1]; g1:= Grading(f)[2]; F:= LeftActingDomain(L); sp0:= Subspace( L, g0 ); sp1:= Subspace( L, g1 ); g:= L; s:= L; r:= Subalgebra( L, [] ); Omega:= [ 0, 1, 1, 1 ]; while true do s1:= Intersection( s, sp1 ); if Dimension( s1 ) = 0 then return Intersection( g, sp1 ); fi; b:= BasisVectors( Basis(s) ); ad:= List( b, x -> AdjointMatrix( Basis(s), x ) ); B:= Basis( VectorSpace( F, ad ), ad ); found:= false; while not found do cf:= List( Basis(s1), u -> Random( Omega) ); x:= cf*BasisVectors( Basis(s1) ); adx:= AdjointMatrix( Basis(s), x ); if not IsZero(adx^Dimension(s)) then found0:= false; # we find one with maybe better coefficients while not found0 do cf:= List( Basis(s1), u -> Random( [0,1] ) ); x:= cf*BasisVectors( Basis(s1) ); adx:= AdjointMatrix( Basis(s), x ); found0:= not IsZero( adx^Dimension(s) ); od; for i in [1..Length(cf)] do if not IsZero(cf[i]) then cf1:= ShallowCopy(cf); cf1[i]:= 0; x1:= cf1*BasisVectors( Basis(s1) ); adx:= AdjointMatrix( Basis(s), x1 ); if not IsZero( adx^Dimension(s) ) then x:= x1; cf:= cf1; fi; fi; od; for i in [1..Length(cf)] do if not IsZero(cf[i]) then cf1:= ShallowCopy(cf); cf1[i]:= 0; x1:= cf1*BasisVectors( Basis(s1) ); adx:= AdjointMatrix( Basis(s), x1 ); if not IsZero( adx^Dimension(s) ) then x:= x1; cf:= cf1; fi; fi; od; xs:= SLAfcts.semsim_part( s, x, b, B ); g:= LieCentralizer( g, Subalgebra( g, [xs] ) ); s:= LieDerivedSubalgebra(g); r:= LieCentre(g); found:= true; else s0:= Intersection( s, sp0 ); V:= VectorSpace( F, List( Basis(s0), u -> u*x ) ); if Dimension(V) = Dimension(s1) then return Intersection( r, sp1 ); fi; fi; od; od; end );
¤ Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.0.118Bemerkung: (vorverarbeitet am 2026-10-11) ¤*Bot Zugriff |
|
||||||||||||||
2026-10-11