Quelle autom.gi
Sprache: unbekannt
|
|
rahmenlose Ansicht.gi DruckansichtUnknown {[0] [0] [0]}Entwicklung
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] );
--> --------------------
--> maximum size reached
--> --------------------
[ Verzeichnis aufwärts0.215unsichere Verbindung
]
|
2026-03-28
|
