Quelle carrierrtsys.gi
Sprache: unbekannt
|
|
###########################################################################
# functions for constructing certain carrier algebras and root systems
#
#
# the functions contained in this file are
#
# RootSystem
# RootsystemOfCartanSubalgebra
# LieAlgebraIsomorphismByCanonicalGenerators
# ChevalleyBasis
# RootSystemOfZGradedLieAlgebra
# RegularCarrierAlgebraOfSL2Triple:
#
# corelg.WDD
# corelg.CartanMatrixOfCanonicalGeneratingSet
# corelg.myChevalleyBasis
# corelg.carrZm
# corelg.rtsys_withgrad
# corelg.gradedSubalgebraByCharacteristic
# corelg.carrierAlgebraBySL2Triple
# corelg.nil_orbs_outer
#
###########################################################################
#Input: lie algebra L over Gaussian rationals, a characteristic h,
# a signature table T
#Output: the wdd's of h
#
corelg.WDD:= function( L, h, T )
local sl2, K, H, ch, t, cc, tableM, adh, possibles, adh2, fac2, myfactors,
k, dim, rank, poss0, l, c1, c2, fac, f, inds1, inds2, ev, pos,
myMatrixOfAction;
myMatrixOfAction := function(L,bas,h)
local cf, tmp, pos, bas2;
cf := Coefficients(Basis(L),h);
pos := Filtered([1..Length(cf)],x->not cf[x]=0*cf[x]);
bas2 := Basis(L){pos};
cf := cf{pos};
tmp := List(bas2,x->TransposedMatDestructive(
List(bas,b-> Coefficients( bas, x^b ) )));
return tmp*cf;
end;
if T.tipo = "notD" then
T := T.tab;
adh := TransposedMat( AdjointMatrix( Basis(L), h ) );
adh := List(adh,x->List(x,SqrtFieldEltByCyclotomic));
possibles:= [ ];
dim := Dimension(L);
rank := RankMat(adh);
for k in [1..Length(T)] do
if T[k][1][1] = dim-rank then
Add( possibles, T[k] );
fi;
od;
k:= 1;
while Length(possibles) > 1 do
rank := RankMat( adh-k*adh^0 );
poss0 := [ ];
for l in [1..Length(possibles)] do
if possibles[l][1][k+1] = dim-rank then
Add( poss0, possibles[l] );
fi;
od;
possibles:= poss0;
k:= k+1;
od;
return possibles[1][2];
else
myfactors := function(mm)
local d, n, x, fx, r, i,m, tmp;
m := List(mm,x->List(x,SqrtFieldEltByCyclotomic));
d := Length(m);
n := 0;
x := Indeterminate(SqrtField,"x");
fx := [];
while Length(fx)<d do
tmp := List(m,x->List(x,ShallowCopy));
for i in [1..Length(tmp)] do tmp[i][i] := tmp[i][i]-n; od;
r := d-RankMat(tmp);
if r>0 then
for i in [1..r] do
Add(fx,x-(n*One(SqrtField)));
if n > 0 then Add(fx,x+(n*One(SqrtField))); fi;
od;
fi;
n := n+1;
if n>1000 then return Error("mhm...n greater 1000"); fi;
od;
return List(fx,SqrtFieldPolynomialToRationalPolynomial);
end;
adh := myMatrixOfAction(L, Basis( T.V1 ), h );
c1 := [ ];
#adh := List(adh,x->List(x,SqrtFieldEltByCyclotomic));
#fac := Factors( SqrtFieldPolynomialToRationalPolynomial(
# CharacteristicPolynomial( adh ) ) );
fac := myfactors(adh);
for f in fac do
ev:= ExtRepPolynomialRatFun( f );
if ev[1] = [] then
ev:= -ev[2];
else
ev:= 0;
fi;
pos:= PositionProperty( c1, x -> x[1]=ev );
if pos = fail then
Add( c1, [ev,1] );
else
c1[pos][2]:= c1[pos][2]+1;
fi;
od;
Sort( c1, function(a,b) return a[1]<b[1]; end );
adh := myMatrixOfAction(L, Basis( T.V2 ), h );
c2 := [];
#adh2 := List(adh,x->List(x,SqrtFieldEltByCyclotomic));
#fac2 := Factors( SqrtFieldPolynomialToRationalPolynomial(
# CharacteristicPolynomial( adh2 ) ) );
fac := myfactors(adh);
#if not AsSet(fac)=AsSet(fac2) then Error("mhm..."); fi;
for f in fac do
ev := ExtRepPolynomialRatFun( f );
if ev[1] = [] then
ev := -ev[2];
else
ev := 0;
fi;
pos:= PositionProperty( c2, x -> x[1]=ev );
if pos = fail then
Add( c2, [ev,1] );
else
c2[pos][2]:= c2[pos][2]+1;
fi;
od;
Sort( c2, function(a,b) return a[1]<b[1]; end );
inds1:= Filtered( [1..Length(T.tab1)], x -> T.tab1[x][1]=c1 );
inds2:= Filtered( [1..Length(T.tab2)], x -> T.tab2[x][1]=c2 );
return T.tab1[ Intersection( inds1, inds2 )[1] ][2];
fi;
end;
##############################################################################
##
#F RootsystemOfCartanSubalgebra( <L> )
#F RootsystemOfCartanSubalgebra( <L>, <H> )
##
## <L> is a semisimple lie algebra over Gaussian rationals or SqrtField;
## this function returns a rootsystem of <L> with respect to <H>, and
## with repect to CartanSubalgebra(<L>) if <H> is not provided
##
InstallGlobalFunction( RootsystemOfCartanSubalgebra, function( arg )
local F, # coefficients domain of `L'
BL, # basis of `L'
H, # A Cartan subalgebra of `L'
basH, # A basis of `H'
sp, # A vector space
B, # A list of bases of subspaces of `L' whose direct sum
# is equal to `L'
newB, # A new version of `B' being constructed
i,j,l, # Loop variables
facs, # List of the factors of `p'
V, # A basis of a subspace of `L'
M, # A matrix
cf, # A scalar
a, # A root vector
ind, # An index
basR, # A basis of the root system
h, # An element of `H'
posR, # A list of the positive roots
fundR, # A list of the fundamental roots
issum, # A boolean
CartInt, # The function that calculates the Cartan integer of
# two roots
C, # The Cartan matrix
S, # A list of the root vectors
zero, # zero of `F'
hts, # A list of the heights of the root vectors
sorh, # The set `Set( hts )'
sorR, # The soreted set of roots
R, # The root system.
Rvecs, # The root vectors.
x,y, # Canonical generators.
noPosR, # Number of positive roots.
facs0, num, fam, f, b, c, r, F0, Mold, one, t1, t2, t3, L;
# Let a and b be two roots of the rootsystem R.
# Let s and t be the largest integers such that a-s*b and a+t*b
# are roots.
# Then the Cartan integer of a and b is s-t.
L := arg[1];
if Length(arg)=2 then H := arg[2]; else H := CartanSubalgebra(L); fi;
if HasRootSystem(H) then
return RootSystem(H);
fi;
CartInt := function( R, a, b )
local s,t,rt;
s:=0; t:=0;
rt:=a-b;
while (rt in R) or (rt=0*R[1]) do
rt:=rt-b;
s:=s+1;
od;
rt:=a+b;
while (rt in R) or (rt=0*R[1]) do
rt:=rt+b;
t:=t+1;
od;
return s-t;
end;
F := LeftActingDomain( L );
one := One(F);
# removed, to speed things up a bit:
#if Determinant( KillingMatrix( Basis( L ) ) ) = Zero( F ) then
# Error("the Killing form of <L> is degenerate" );
# return fail;
#fi;
# First we compute the common eigenvectors of the adjoint action of a
# Cartan subalgebra H. Here B will be a list of bases of subspaces
# of L such that H maps each element of B into itself.
# Furthermore, B has maximal length w.r.t. this property.
BL := Basis( L );
B := [ ShallowCopy( BasisVectors( BL ) ) ];
basH := BasisVectors( Basis( H ) );
for i in basH do
#Print("now ",Position(basH,i)," of basH\n");
newB := [ ];
for j in B do
#Print(" now ",Position(B,j)," of B\n");
if Length(j) = 1 then
Add( newB, j );
else
V := Basis( VectorSpace( F, j, "basis" ), j );
Mold := List( j, x -> Coefficients( V, i*x ) );
if fail in Flat(Mold) then
Info(InfoCorelg,1,"Extension of base field would be necessary; have to return fail");
return fail;
fi;
if IsSqrtField(F) then
M := SqrtFieldMakeRational(Mold);
if M = false then
#Error("matrix we want to compute char pol of cannot be made rationals");
#Print(" matrix cannot be made rations; use CharPol for SqrtField\n");
M := Mold;
f := CharacteristicPolynomial( M );
facs := Set(Factors( f ));
else
f := CharacteristicPolynomial( M );
facs := Set(Factors( f ));
f := SqrtFieldRationalPolynomialToSqrtFieldPolynomial(f);
facs := Set(List(facs,SqrtFieldRationalPolynomialToSqrtFieldPolynomial));
fi;
else
M := Mold;
f := CharacteristicPolynomial( M );
facs := Set(Factors( f ));
fi;
num := IndeterminateNumberOfUnivariateLaurentPolynomial(f);
fam := FamilyObj( f );
facs0:= [ ];
for l in facs do
if Degree(l) = 1 then
Add( facs0, l );
elif Degree(l) = 2 then # we just take square roots...
cf := CoefficientsOfUnivariatePolynomial(l);
b := cf[2];
c := cf[1];
r := (-b+Sqrt(b^2-4*c))/2; #have Sqrt method for rat in SqrtField!
if not r in F then Error("cannot do this over ",F); fi;
Add( facs0, PolynomialByExtRep( fam, [ [], -r, [num,1], one] ) );
r := (-b-Sqrt(b^2-4*c))/2;
if not r in F then Error("cannot do this over ",F); fi;
Add( facs0, PolynomialByExtRep( fam, [ [], -r, [num,1], one] ) );
else
Error("not split");
return fail;
fi;
od;
for l in facs0 do
#t1 := Runtime();
V := NullspaceMat( Value( l, Mold ) );
#t2 := Runtime();
Add( newB, List( V, x -> LinearCombination( j, x ) ) );
#t3 := Runtime();
#Print("ns, lc",t2-t1," ", t3-t2,"\n");
od;
fi;
od;
B:= newB;
od;
# Now we throw away the subspace H.
B:= Filtered( B, x -> ( not x[1] in H ) );
# If an element of B is not one dimensional then H does not split
# completely, and hence we cannot compute the root system.
for i in [ 1 .. Length(B) ] do
if Length( B[i] ) <> 1 then
Error("the Cartan subalgebra of <L> in not split" );
return fail;
fi;
od;
# Now we compute the set of roots S.
# A root is just the list of eigenvalues of the basis elements of H
# on an element of B.
S := [];
zero := Zero( F );
for i in [ 1 .. Length(B) ] do
a := [ ];
ind := 0;
cf := zero;
while cf = zero do
ind := ind+1;
cf := Coefficients( BL, B[i][1] )[ ind ];
od;
for j in [1..Length(basH)] do
Add( a, Coefficients( BL, basH[j]*B[i][1] )[ind] / cf );
od;
Add( S, a );
od;
Rvecs := List( B, x -> x[1] );
# A set of roots basR is calculated such that the set
# { [ x_r, x_{-r} ] | r\in R } is a basis of H.
basH := [ ];
basR := [ ];
sp := MutableBasis( F, [], Zero(L) );
i :=1;
while Length( basH ) < Dimension( H ) do
a:= S[i];
j:= Position( S, -a );
h:= B[i][1]*B[j][1];
if not IsContainedInSpan( sp, h ) then
#if not corelg.eltInSubspace(L,BasisVectors(sp), h) then
CloseMutableBasis( sp, h );
Add( basR, a );
Add( basH, h );
fi;
i:=i+1;
od;
# A root a is said to be positive if the first nonzero element of
# [ CartInt( S, a, basR[j] ) ] is positive.
# We calculate the set of positive roots.
posR:= [ ];
i:=1;
while Length( posR ) < Length( S )/2 do
a:= S[i];
if (not a in posR) and (not -a in posR) then
cf := 0;
j := 0;
while cf = 0 do
j := j+1;
cf := CartInt( S, a, basR[j] );
od;
if 0 < cf then
Add( posR, a );
else
Add( posR, -a );
fi;
fi;
i:=i+1;
od;
# A positive root is called simple if it is not the sum of two other
# positive roots.
# We calculate the set of simple roots fundR.
fundR:= [ ];
for a in posR do
issum:= false;
for i in [1..Length(posR)] do
for j in [i+1..Length(posR)] do
if a = posR[i]+posR[j] then
issum:=true;
fi;
od;
od;
if not issum then
Add( fundR, a );
fi;
od;
# Now we calculate the Cartan matrix C of the root system.
C:= List( fundR, i -> List( fundR, j -> CartInt( S, i, j ) ) );
# Every root can be written as a sum of the simple roots.
# The height of a root is the sum of the coefficients appearing
# in that expression.
# We order the roots according to increasing height.
V := BasisNC( VectorSpace( F, fundR ), fundR );
hts := List( posR, r -> Sum( Coefficients( V, r ) ) );
sorh := Set( hts );
sorR:= [ ];
for i in [1..Length(sorh)] do
Append( sorR, Filtered( posR, r -> hts[Position(posR,r)] = sorh[i] ) );
od;
Append( sorR, -1*sorR );
Rvecs:= List( sorR, r -> Rvecs[ Position(S,r) ] );
# We calculate a set of canonical generators of L. Those are elements
# x_i, y_i, h_i such that h_i=x_i*y_i, h_i*x_j = c_{ij} x_j,
# h_i*y_j = -c_{ij} y_j for i \in {1..rank}
x:= Rvecs{[1..Length(C)]};
noPosR:= Length( Rvecs )/2;
y:= Rvecs{[1+noPosR..Length(C)+noPosR]};
for i in [1..Length(x)] do
V:= VectorSpace( LeftActingDomain(L), [ x[i] ] );
B:= Basis( V, [x[i]] );
y[i]:= y[i]*2/Coefficients( B, (x[i]*y[i])*x[i] )[1];
od;
h:= List([1..Length(C)], j -> x[j]*y[j] );
# Now we construct the root system, and install as many attributes
# as possible. The roots are represented als lists [ \alpha(h_1),....
# ,\alpha(h_l)], where the h_i form the Cartan part of the canonical
# generators.
R:= Objectify( NewType( NewFamily( "RootSystemFam", IsObject ),
IsAttributeStoringRep and IsRootSystemFromLieAlgebra ),
rec() );
SetCanonicalGenerators( R, [ x, y, h ] );
SetUnderlyingLieAlgebra( R, L );
SetPositiveRootVectors( R, Rvecs{[1..noPosR]});
SetNegativeRootVectors( R, Rvecs{[noPosR+1..2*noPosR]} );
SetCartanMatrix( R, C );
posR:= [ ];
for i in [1..noPosR] do
B:= Basis( VectorSpace( F, [ Rvecs[i] ] ), [ Rvecs[i] ] );
posR[i]:= List( h, hj -> Coefficients( B, hj*Rvecs[i] )[1] );
od;
#roots are rationals
if IsSqrtField(F) then
posR := List(posR, x-> List(x, SqrtFieldEltToCyclotomic));
fi;
SetPositiveRoots( R, posR );
SetNegativeRoots( R, -posR );
SetSimpleSystem( R, posR{[1..Length(C)]} );
SetRootSystem(H,R);
return R;
end);
#####################################################################
corelg.CartanMatrixOfCanonicalGeneratingSet := function(L,R)
local mat, i, j, u, k;
mat:= List( R[3], x -> [] );
for i in [1..Length(R[3])] do
for j in [1..Length(R[3])] do
if i = j then
mat[i][j]:= 2;
else
u:= R[3][j]*R[1][i];
k:= -3;
while not u = k*R[1][i] do k:= k+1; od;
mat[i][j]:= k;
fi;
od;
od;
return mat;
#return List(R[1],e-> List(R[3],h->
# Coefficients(Basis(Subspace(L,[e]),[e]),h*e)[1]));
end;
######################################################################
InstallMethod( RootSystem,
"for Lie algebras",
true,
[ IsLieAlgebra ], 0, function(L)
return RootsystemOfCartanSubalgebra( L, CartanSubalgebra(L) );
end );
##############################################################################
##
#F LieAlgebraIsomorphismByCanonicalGenerators( <L1>, <R1>, <L2>, <R2> )
##
## <L1> and <L2> both are semisimple lie algebras over Gaussian rationals or SqrtField
## and either <R1> and <R2> both are canonical generators of <L1> and <L2> defining
## the same Cartan Matrix, or <R1> and <R2> are rootsystems or Cartan subalgebras of
## <L1> and <L2>, respectively; this functions constructs an isomorphism from
## <L1> to <L2> by mapping canonical generators onto canonical generators.
## Attention: This function does not check whether the map actually is a
## Lie isomorphisms!
##
InstallGlobalFunction(LieAlgebraIsomorphismByCanonicalGenerators, function( L1, R1, L2, R2 )
local b1, b2, c1, c2, t, tp, en, i, cm1, cm2, tmp;
#R1 and R2 are canonical generators wrt same ordering
if IsList(R1) and IsList(R2) then
#check if can gens really define the same Cartan Matrix
cm1 := corelg.CartanMatrixOfCanonicalGeneratingSet(L1,R1);
cm2 := corelg.CartanMatrixOfCanonicalGeneratingSet(L2,R2);
if not cm1=cm2 then
Error("Cartan Matrices of canonical gen sets are different");
fi;
b1:= SLAfcts.canbas( L1, R1 );
b2:= SLAfcts.canbas( L2, R2 );
tmp := AlgebraHomomorphismByImagesNC( L1, L2, corelg.myflat(b1), corelg.myflat(b2) );
SetIsIsomorphismOfLieAlgebras(tmp,true);
return tmp;
fi;
#otherwise, R1 and R2 are CSA or Rootsystems
#construct canonical generators and then isomorphism
if not IsRootSystem(R1) then R1 := RootsystemOfCartanSubalgebra(L1,R1); fi;
if not IsRootSystem(R2) then R2 := RootsystemOfCartanSubalgebra(L2,R2); fi;
t := CartanType( CartanMatrix(R1) );
tp := ShallowCopy( t.types );
en := ShallowCopy( t.enumeration );
SortParallel( tp, en );
c1 := [ [], [], [] ];
for i in [1..Length(en)] do
Append( c1[1], CanonicalGenerators(R1)[1]{en[i]} );
Append( c1[2], CanonicalGenerators(R1)[2]{en[i]} );
Append( c1[3], CanonicalGenerators(R1)[3]{en[i]} );
od;
t := CartanType( CartanMatrix(R2) );
tp := ShallowCopy( t.types );
en := ShallowCopy( t.enumeration );
SortParallel( tp, en );
c2 := [ [], [], [] ];
for i in [1..Length(en)] do
Append( c2[1], CanonicalGenerators(R2)[1]{en[i]} );
Append( c2[2], CanonicalGenerators(R2)[2]{en[i]} );
Append( c2[3], CanonicalGenerators(R2)[3]{en[i]} );
od;
return LieAlgebraIsomorphismByCanonicalGenerators(L1,c1,L2,c2);
end);
###############################################
#this is print:
InstallMethod( ViewObj,
"for IsIsomorphismOfLieAlgebras",
true,
[ IsIsomorphismOfLieAlgebras ], 100,
function( o )
local r,t,m,i,minus,signs, tmp;
Print(Concatenation(["<Lie algebra isomorphism between Lie algebras of dimension ",
String(Dimension(Source(o)))," over ",String(LeftActingDomain(Source(o))),">"]));
end );
##############################################################################
corelg.myChevalleyBasis := function(LL,R)
local tp, K, f, cc, h, pr, xx, yy, i, sp, rt, pos;
if HasChevalleyBasis(R) then return ChevalleyBasis(R); fi;
tp := CartanType( CartanMatrix(R) );
K := DirectSumOfAlgebras( List( tp.types, x ->
SimpleLieAlgebra( x[1], x[2], LeftActingDomain(LL) ) ) );
f := LieAlgebraIsomorphismByCanonicalGenerators( K, RootSystem(K), LL, R );
cc := List( ChevalleyBasis(K), x -> List( x, y -> Image( f, y ) ) );
h := CanonicalGenerators(R)[3];
pr := PositiveRoots(R);
xx := [ ]; yy:= [ ];
for i in [1..Length(cc[1])] do
sp := BasisNC( SubspaceNC( LL, [cc[1][i]],"basis" ), [ cc[1][i] ] );
rt := List( h, u -> Coefficients( sp, u*cc[1][i] )[1] );
pos := Position( pr, rt );
#if pos <> i then Print(i," ",pos,"\n"); fi;
xx[pos]:= cc[1][i]; yy[pos]:= cc[2][i];
od;
cc := [ xx, yy, h ];
SetChevalleyBasis( R, cc );
return cc;
end;
##############################################################################
##
#F ChevalleyBasis( <R> );
##
## <L> is a semisimple lie algebra over Gaussian rationals or SqrtField
## and <R> is a rootsystem of <L> (with respect to some Cartan subalgebra);
## this function returns a Chevalley basis
## of this rootsystem / the rootsystem of the Cartan subalgebra
##
#InstallGlobalFunction( ChevalleyBasisOfRootsystem, function( L, R)
InstallMethod( ChevalleyBasis,
"for a root system",
true,
[ IsRootSystem ], 0,
function( R )
local L, R1, cb1, iso, perm, pr, pr1, cb, tmp, pos, i, cg1;
L := UnderlyingLieAlgebra(R);
return corelg.myChevalleyBasis( L, R );
end);
##############################################################################
##
#F RootSystemOfZGradedLieAlgebra( <L>, <gr> );
#F RootSystemOfZGradedLieAlgebra( <L>, <gr>, <H> );
##
## <L> is a semisimple lie algebra over Gaussian rationals or SqrtField
## with Z-grading <gr>, which is a record with entries g0, gp, gn;
## this function returns a rootsystem of <L> with respect to <H>, and
## with repect to CartanSubalgebra(<L>) if <H> is not provided, such that
## the simple roots lie in <gr>.gp[1] and <gr>.g0
##
InstallGlobalFunction( RootSystemOfZGradedLieAlgebra, function( arg )
# g a grading in carrier form, ie a record with components g0, gp, gn.
local F, # coefficients domain of L
BL, # basis of L
H, # A Cartan subalgebra of L
basH, # A basis of H
sp, # A vector space
B, # A list of bases of subspaces of L whose direct sum
# is equal to L
newB, # A new version of B being constructed
i,j,l, # Loop variables
facs, # List of the factors of p
V, # A basis of a subspace of L
M, # A matrix
cf, # A scalar
a, # A root vector
ind, # An index
basR, # A basis of the root system
h, # An element of H
posR, # A list of the positive roots
fundR, # A list of the fundamental roots
issum, # A boolean
CartInt, # The function that calculates the Cartan integer of
# two roots
C, # The Cartan matrix
S, # A list of the root vectors
zero, # zero of F
hts, # A list of the heights of the root vectors
sorh, # The set Set( hts )
sorR, # The soreted set of roots
R, # The root system.
Rvecs, # The root vectors.
x,y, # Canonical generators.
noPosR, # Number of positive roots.
facs0, num, fam, f, b, c, r, possp, g0, F0, Mold, one, L, g;
# Let a and b be two roots of the rootsystem R.
# Let s and t be the largest integers such that a-s*b and a+t*b
# are roots.
# Then the Cartan integer of a and b is s-t.
CartInt := function( R, a, b )
local s,t,rt;
s:=0; t:=0;
rt:=a-b;
while (rt in R) or (rt=0*R[1]) do
rt:=rt-b;
s:=s+1;
od;
rt:=a+b;
while (rt in R) or (rt=0*R[1]) do
rt:=rt+b;
t:=t+1;
od;
return s-t;
end;
L:= arg[1]; g:= arg[2];
if Length(arg) = 3 then
H:= arg[3];
else
H:= CartanSubalgebra(L);
fi;
F := LeftActingDomain( L );
one := One(F);
if DeterminantMat( KillingMatrix( Basis( L ) ) ) = Zero( F ) then
Error("the Killing form of <L> is degenerate" );
return fail;
fi;
# First we compute the common eigenvectors of the adjoint action of a
# Cartan subalgebra H. Here B will be a list of bases of subspaces
# of L such that H maps each element of B into itself.
# Furthermore, B has maximal length w.r.t. this property.
BL:= Basis( L );
B:= [ ShallowCopy( BasisVectors( BL ) ) ];
basH:= BasisVectors( Basis( H ) );
for i in basH do
newB:= [ ];
for j in B do
if Length(j) = 1 then
Add( newB, j );
else
V := Basis( VectorSpace( F, j, "basis" ), j );
Mold := List( j, x -> Coefficients( V, i*x ) );
if IsSqrtField(F) then
M := List(Mold,x->List(x,SqrtFieldEltToCyclotomic));
f := CharacteristicPolynomial( M );
facs := Set(Factors( f ));
f := SqrtFieldRationalPolynomialToSqrtFieldPolynomial(f);
facs := Set(List(facs,SqrtFieldRationalPolynomialToSqrtFieldPolynomial));
else
M := Mold;
f := CharacteristicPolynomial( M );
facs := Set(Factors( f ));
fi;
num := IndeterminateNumberOfUnivariateLaurentPolynomial(f);
fam := FamilyObj( f );
facs0:= [ ];
for l in facs do
if Degree(l) = 1 then
Add( facs0, l );
elif Degree(l) = 2 then # we just take square roots...
cf := CoefficientsOfUnivariatePolynomial(l);
b := cf[2];
c := cf[1];
r := (-b+Sqrt(b^2-4*c))/2;
if not r in F then Error("cannot do this over ",F); fi;
Add( facs0, PolynomialByExtRep( fam, [ [], -r, [num,1], one] ) );
r := (-b-Sqrt(b^2-4*c))/2;
if not r in F then Error("cannot do this over ",F); fi;
Add( facs0, PolynomialByExtRep( fam, [ [], -r, [num,1], one] ) );
else
Error("not split!");
return fail;
fi;
od;
for l in facs0 do
V := NullspaceMat( Value( l, Mold ) );
Add( newB, List( V, x -> LinearCombination( j, x ) ) );
od;
fi;
od;
B:= newB;
od;
# Now we throw away the subspace H.
B := Filtered( B, x -> ( not x[1] in H ) );
#B:= Filtered( B, x -> ( not corelg.eltInSubspace(L,BasisVectors(Basis(H)),x[1])));
# If an element of B is not one dimensional then H does not split
# completely, and hence we cannot compute the root system.
for i in [ 1 .. Length(B) ] do
if Length( B[i] ) <> 1 then
Error("the Cartan subalgebra of <L> in not split" );
return fail;
fi;
od;
# Now we compute the set of roots S.
# A root is just the list of eigenvalues of the basis elements of H
# on an element of B.
S:= [];
zero:= Zero( F );
for i in [ 1 .. Length(B) ] do
a:= [ ];
ind:= 0;
cf:= zero;
while cf = zero do
ind:= ind+1;
cf:= Coefficients( BL, B[i][1] )[ ind ];
od;
for j in [1..Length(basH)] do
Add( a, Coefficients( BL, basH[j]*B[i][1] )[ind] / cf );
od;
Add( S, a );
od;
Rvecs:= List( B, x -> x[1] );
# A set of roots basR is calculated such that the set
# { [ x_r, x_{-r} ] | r\in R } is a basis of H.
basH:= [ ];
basR:= [ ];
sp:= MutableBasis( F, [], Zero(L) );
i:=1;
while Length( basH ) < Dimension( H ) do
a:= S[i];
j:= Position( S, -a );
h:= B[i][1]*B[j][1];
#if not corelg.eltInSubspace(L,BasisVectors(sp),h ) then
if not IsContainedInSpan( sp, h ) then
CloseMutableBasis( sp, h );
Add( basR, a );
Add( basH, h );
fi;
i:=i+1;
od;
# A root a is said to be positive if the corr root space lies in g_k with k>0,
# or in g_k with k=0 and the first nonzero element of
# [ CartInt( S, a, basR[j] ) ] is positive.
# We calculate the set of positive roots.
posR:= [ ];
i:=1;
possp:= SubspaceNC( L, Concatenation( g.gp ),"basis" );
g0:= SubspaceNC( L, g.g0,"basis" );
while Length( posR ) < Length( S )/2 do
a:= S[i];
if (not a in posR) and (not -a in posR) then
if B[i][1] in possp then
#if corelg.eltInSubspace(L,Basis(possp),B[i][1] ) then
Add( posR, a );
elif B[i][1] in g0 then
cf:= 0;
j:= 0;
while cf = 0 do
j:= j+1;
cf:= CartInt( S, a, basR[j] );
od;
if 0 < cf then
Add( posR, a );
else
Add( posR, -a );
fi;
else
Add( posR, -a );
fi;
fi;
i:=i+1;
od;
# A positive root is called simple if it is not the sum of two other
# positive roots.
# We calculate the set of simple roots fundR.
fundR:= [ ];
for a in posR do
issum:= false;
for i in [1..Length(posR)] do
for j in [i+1..Length(posR)] do
if a = posR[i]+posR[j] then
issum:=true;
fi;
od;
od;
if not issum then
Add( fundR, a );
fi;
od;
# Now we calculate the Cartan matrix C of the root system.
C:= List( fundR, i -> List( fundR, j -> CartInt( S, i, j ) ) );
# Every root can be written as a sum of the simple roots.
# The height of a root is the sum of the coefficients appearing
# in that expression.
# We order the roots according to increasing height.
V:= BasisNC( VectorSpace( F, fundR ), fundR );
hts:= List( posR, r -> Sum( Coefficients( V, r ) ) );
sorh:= Set( hts );
sorR:= [ ];
for i in [1..Length(sorh)] do
Append( sorR, Filtered( posR, r -> hts[Position(posR,r)] = sorh[i] ) );
od;
Append( sorR, -1*sorR );
Rvecs:= List( sorR, r -> Rvecs[ Position(S,r) ] );
# We calculate a set of canonical generators of L. Those are elements
# x_i, y_i, h_i such that h_i=x_i*y_i, h_i*x_j = c_{ij} x_j,
# h_i*y_j = -c_{ij} y_j for i \in {1..rank}
x:= Rvecs{[1..Length(C)]};
noPosR:= Length( Rvecs )/2;
y:= Rvecs{[1+noPosR..Length(C)+noPosR]};
for i in [1..Length(x)] do
V:= VectorSpace( LeftActingDomain(L), [ x[i] ] );
B:= Basis( V, [x[i]] );
y[i]:= y[i]*2/Coefficients( B, (x[i]*y[i])*x[i] )[1];
od;
h:= List([1..Length(C)], j -> x[j]*y[j] );
# Now we construct the root system, and install as many attributes
# as possible. The roots are represented als lists [ \alpha(h_1),....
# ,\alpha(h_l)], where the h_i form the Cartan part of the canonical
# generators.
R:= Objectify( NewType( NewFamily( "RootSystemFam", IsObject ),
IsAttributeStoringRep and IsRootSystemFromLieAlgebra ),
rec() );
SetCanonicalGenerators( R, [ x, y, h ] );
SetUnderlyingLieAlgebra( R, L );
SetPositiveRootVectors( R, Rvecs{[1..noPosR]});
SetNegativeRootVectors( R, Rvecs{[noPosR+1..2*noPosR]} );
SetCartanMatrix( R, C );
posR:= [ ];
for i in [1..noPosR] do
B:= Basis( VectorSpace( F, [ Rvecs[i] ] ), [ Rvecs[i] ] );
posR[i]:= List( h, hj -> Coefficients( B, hj*Rvecs[i] )[1] );
od;
#roots are rationals
if IsSqrtField(F) then
posR := List(posR, x-> List(x, SqrtFieldEltToCyclotomic));
fi;
SetPositiveRoots( R, posR );
SetNegativeRoots( R, -posR );
SetSimpleSystem( R, posR{[1..Length(C)]} );
return R;
end);
########################################################################################
########################################################################################
#
# the following functions define RegularCarrierAlgebraOfSL2Triple:
# - corelg.carrZm
# - corelg.rtsys_withgrad
# - corelg.gradedSubalgebraByCharacteristic
# - corelg.carrierAlgebraBySL2Triple
########################################################################################
########################################################################################
########################################################################################
corelg.carrZm:= function( L, gr, e )
local h, lams, sp, i, gp, gn, eigensp, g0, g1, gm, m, K, k, dim,t0;
sp:= SubalgebraNC( L, gr[1] );
h:= BasisVectors(CanonicalBasis( CartanSubalgebra( Intersection( sp, LieNormalizer(L,
SubalgebraNC(L,[e]))))));
lams:= [ ];
sp:= BasisNC( SubspaceNC( L, [e],"basis" ), [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( SubspaceNC( 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( SubalgebraNC( L, Concatenation( gm, g0, g1 ) ) );
g0:= BasisVectors( Basis( Intersection( SubspaceNC( L, g0,"basis" ), K ) ) );
dim:= Length(g0);
k:= 1;
while dim < Dimension(K) do
g1:= BasisVectors( Basis( Intersection( SubspaceNC( L,
eigensp( gr[ (k mod m) +1 ], k ) ), K ) ) );
Add( gp, g1 );
dim:= dim+Length(g1);
gm:= BasisVectors( Basis( Intersection( SubspaceNC( 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;
###############################################################################
corelg.rtsys_withgrad := function( L, rvecs, H, g )
# g a grading in carrier form, ie a record with components g0, gp, gn.
# rvecs is a list of the root vectors
local F, # coefficients domain of L
BL, # basis of L
basH, # A basis of H
sp, # A vector space
B, # A list of bases of subspaces of L whose direct sum
# is equal to L
newB, # A new version of B being constructed
i,j,l, # Loop variables
facs, # List of the factors of p
V, # A basis of a subspace of L
M, # A matrix
cf, # A scalar
a, # A root vector
ind, # An index
basR, # A basis of the root system
h, # An element of H
posR, # A list of the positive roots
fundR, # A list of the fundamental roots
issum, # A boolean
CartInt, # The function that calculates the Cartan integer of
# two roots
C, # The Cartan matrix
S, # A list of the root vectors
zero, # zero of F
hts, # A list of the heights of the root vectors
sorh, # The set Set( hts )
sorR, # The soreted set of roots
R, # The root system.
Rvecs, # The root vectors.
x,y, # Canonical generators.
noPosR, # Number of positive roots.
facs0, num, fam, f, b, c, r, possp, g0, v, fct;
# Let a and b be two roots of the rootsystem R.
# Let s and t be the largest integers such that a-s*b and a+t*b
# are roots.
# Then the Cartan integer of a and b is s-t.
CartInt := function( R, a, b )
local s,t,rt;
s:=0; t:=0;
rt:=a-b;
while (rt in R) or (rt=0*R[1]) do
rt:=rt-b;
s:=s+1;
od;
rt:=a+b;
while (rt in R) or (rt=0*R[1]) do
rt:=rt+b;
t:=t+1;
od;
return s-t;
end;
F:= LeftActingDomain(L);
BL:= Basis(L);
basH:= Basis(H);
B:= List( rvecs, x -> [x] );
# Now we compute the set of roots S.
# A root is just the list of eigenvalues of the basis elements of H
# on an element of B.
S:= [];
zero:= Zero( F );
for i in [ 1 .. Length(B) ] do
a:= [ ];
ind:= 0;
cf:= zero;
while cf = zero do
ind:= ind+1;
cf:= Coefficients( BL, B[i][1] )[ ind ];
od;
for j in [1..Length(basH)] do
Add( a, Coefficients( BL, basH[j]*B[i][1] )[ind] / cf );
od;
Add( S, a );
od;
Rvecs:= List( B, x -> x[1] );
# A set of roots basR is calculated such that the set
# { [ x_r, x_{-r} ] | r\in R } is a basis of H.
basH:= [ ];
basR:= [ ];
sp:= MutableBasis( F, [], Zero(L) );
i:=1;
while Length( basH ) < Dimension( H ) do
a:= S[i];
j:= Position( S, -a );
h:= B[i][1]*B[j][1];
#if not corelg.eltInSubspace(L,BasisVectors(sp), h) then
if not IsContainedInSpan( sp, h ) then
CloseMutableBasis( sp, h );
Add( basR, a );
Add( basH, h );
fi;
i:=i+1;
od;
# A root a is said to be positive if the corr root space lies in g_k with k>0,
# or in g_k with k=0 and the first nonzero element of
# [ CartInt( S, a, basR[j] ) ] is positive.
# We calculate the set of positive roots.
posR:= [ ];
i:=1;
possp:= SubspaceNC( L, Concatenation( g.gp ),"basis" );
g0:= SubspaceNC( L, g.g0,"basis" );
while Length( posR ) < Length( S )/2 do
a:= S[i];
if (not a in posR) and (not -a in posR) then
if B[i][1] in possp then
Add( posR, a );
elif B[i][1] in g0 then
cf:= zero;
j:= 0;
while cf = zero do
j:= j+1;
cf:= CartInt( S, a, basR[j] );
od;
if 0 < cf then
Add( posR, a );
else
Add( posR, -a );
fi;
else
Add( posR, -a );
fi;
fi;
i:=i+1;
od;
# A positive root is called simple if it is not the sum of two other
# positive roots.
# We calculate the set of simple roots fundR.
fundR:= [ ];
for a in posR do
issum:= false;
for i in [1..Length(posR)] do
for j in [i+1..Length(posR)] do
if a = posR[i]+posR[j] then
issum:=true;
fi;
od;
od;
if not issum then
Add( fundR, a );
fi;
od;
# Now we calculate the Cartan matrix C of the root system.
C:= List( fundR, i -> List( fundR, j -> CartInt( S, i, j ) ) );
# Every root can be written as a sum of the simple roots.
# The height of a root is the sum of the coefficients appearing
# in that expression.
# We order the roots according to increasing height.
V:= BasisNC( VectorSpace( F, fundR ), fundR );
hts:= List( posR, r -> Sum( Coefficients( V, r ) ) );
sorh:= Set( hts );
sorR:= [ ];
for i in [1..Length(sorh)] do
Append( sorR, Filtered( posR, r -> hts[Position(posR,r)] = sorh[i] ) );
od;
Append( sorR, -1*sorR );
Rvecs:= List( sorR, r -> Rvecs[ Position(S,r) ] );
# We calculate a set of canonical generators of L. Those are elements
# x_i, y_i, h_i such that h_i=x_i*y_i, h_i*x_j = c_{ij} x_j,
# h_i*y_j = -c_{ij} y_j for i \in {1..rank}
x:= Rvecs{[1..Length(C)]};
noPosR:= Length( Rvecs )/2;
y:= Rvecs{[1+noPosR..Length(C)+noPosR]};
for i in [1..Length(x)] do
V:= VectorSpace( LeftActingDomain(L), [ x[i] ] );
B:= Basis( V, [x[i]] );
y[i]:= y[i]*2/Coefficients( B, (x[i]*y[i])*x[i] )[1];
od;
h:= List([1..Length(C)], j -> x[j]*y[j] );
# Now we construct the root system, and install as many attributes
# as possible. The roots are represented als lists [ \alpha(h_1),....
# ,\alpha(h_l)], where the h_i form the Cartan part of the canonical
# generators.
R:= Objectify( NewType( NewFamily( "RootSystemFam", IsObject ),
IsAttributeStoringRep and IsRootSystemFromLieAlgebra ),
rec() );
SetCanonicalGenerators( R, [ x, y, h ] );
SetUnderlyingLieAlgebra( R, L );
SetPositiveRootVectors( R, Rvecs{[1..noPosR]});
SetNegativeRootVectors( R, Rvecs{[noPosR+1..2*noPosR]} );
SetCartanMatrix( R, C );
fct:= function(x)
if IsGaussRat(x) then return x; else return x![1][1][1]; fi;
end;
posR:= [ ];
for i in [1..noPosR] do
B:= Basis( VectorSpace( F, [ Rvecs[i] ] ), [ Rvecs[i] ] );
v:= List( h, hj -> Coefficients( B, hj*Rvecs[i] )[1] );
posR[i]:= List( v, x -> fct(x) );
od;
SetPositiveRoots( R, posR );
SetNegativeRoots( R, -posR );
SetSimpleSystem( R, posR{[1..Length(C)]} );
return R;
end;
########################################################################
corelg.gradedSubalgebraByCharacteristic:= function( L, gr, h )
# here L is a Z/2-graded Lie algebra, grading in gr, two element list...
# h nuetral elt of sl2 triple. We get the Z-graded subalgebra such that
# g_k = { x\in L \mid x in gr[k mod 2], [h,x] = 2*k*x}
local adh, id, g0, g1, grad, gp, gn, k, done, cf, sp;
adh:= TransposedMat( AdjointMatrix( Basis(L), h ) );
id:= adh^0;
g0:= SubspaceNC( L, gr[1],"basis" );
g1:= SubspaceNC( L, gr[2],"basis" );
grad:= [g0,g1];
gp:= [ ];
k:= 1;
done:= false;
while not done do
cf:= NullspaceMat( adh-2*k*id );
if cf <> [] then
sp:= Intersection( grad[(k mod 2)+1], SubspaceNC( L, List( cf, c -> c*Basis(L) ) ) );
Add( gp, BasisVectors( Basis(sp) ) );
k:= k+1;
else
done:= true;
fi;
od;
gn:= [ ];
k:= 1;
done:= false;
while not done do
cf:= NullspaceMat( adh+2*k*id );
if cf <> [] then
sp:= Intersection( grad[(k mod 2)+1], SubspaceNC( L, List( cf, c -> c*Basis(L) ) ) );
Add( gn, BasisVectors( Basis(sp) ) );
k:= k+1;
else
done:= true;
fi;
od;
cf:= NullspaceMat( adh );
sp:= Intersection( grad[1], SubspaceNC( L, List( cf, c -> c*Basis(L) ) ) );
return rec( g0:= BasisVectors( Basis(sp) ), gp:= gp, gn:= gn );
end;
##################################################################################
corelg.carrierAlgebraBySL2Triple:= function( L, grad, sl2 )
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, R0, gs, grading,
cardat, U, gsp, grr, r0, gp, gn, K0, rvs, F, fct, rsp;
gs:= corelg.gradedSubalgebraByCharacteristic( L, grad, sl2[2] );
F:= LeftActingDomain(L);
K0:= SubalgebraNC( L, Concatenation( gs.g0, corelg.myflat( gs.gp ), corelg.myflat( gs.gn ) ) );
K0:= LieDerivedSubalgebra( K0 );
gs.g0:= BasisVectors( Basis( Intersection( K0, SubspaceNC( L, gs.g0,"basis" ) ) ) );
rvs:= [ ];
for v in PositiveRootVectors(RootSystem(L)) do
if v in K0 then Add( rvs, v ); fi;
#if corelg.eltInSubspace(L,BasisVectors(Basis(K0)),v) then Add( rvs, v); fi;
od;
for v in NegativeRootVectors(RootSystem(L)) do
if v in K0 then Add( rvs, v ); fi;
#if corelg.eltInSubspace(L,BasisVectors(Basis(K0)),v) then Add( rvs, v); fi;
od;
SetCartanSubalgebra( K0, Intersection( CartanSubalgebra(L), K0 ) ); #!!!
## SetCartanSubalgebra( K0, Intersection( MaximallyCompactCartanSubalgebra(L), K0 ) );
if Length(rvs)+Dimension( CartanSubalgebra(K0) ) <> Dimension(K0) then
R0:= RootsystemOfCartanSubalgebra(K0);
rvs:= Concatenation( PositiveRootVectors(R0), NegativeRootVectors(R0) );
fi;
R0:= corelg.rtsys_withgrad( K0, rvs, Intersection( CartanSubalgebra(L), K0 ), gs ); #!!!
##R0:= corelg.rtsys_withgrad( K0, rvs, Intersection( MaximallyCompactCartanSubalgebra(L), K0 ), gs );
grading:= [ ];
for v in CanonicalGenerators(R0)[1] do
sp:= Basis( SubspaceNC( L, [v],"basis" ), [v] );
Add( grading, Coefficients( sp, sl2[2]*v )[1]/2 );
od;
posR:= PositiveRootsNF(R0);
posRv:= PositiveRootVectors(R0);
negRv:= NegativeRootVectors(R0);
N:= Length( posR );
rts:= ShallowCopy(posR);
Append( rts, -posR );
B:= BilinearFormMatNF(R0);
rr:= [ rec( pr0:= [ ], pv0:= [ ], nv0:= [] ), rec( r1:= [ ], rv1:= [ ] ), rec( rvm:= [ ] ) ];
for i in [1..Length(posR)] do
v:= posR[i]*grading;
if IsZero(v) then
Add( rr[1].pr0, posR[i] );
Add( rr[1].pv0, posRv[i] );
Add( rr[1].nv0, negRv[i] );
elif IsOne(v) 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( R0 )[pos] );
od;
Bw:= SLAfcts.bilin_weights( R0 );
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)];
rsp := BasisVectors(Basis(r.sp));
if rsp = [] then
rsp := r.sp;
else
rsp := VectorSpace(Rationals,IdentityMat(Length(rsp[1])));
fi;
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
#not corelg.eltInSubspace(rsp,BasisVectors(Basis(r.sp)),r1[i]) 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(R0)[pos] );
else
Add( wrts, -PositiveRootsAsWeights(R0)[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, R0, 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;
C:= CartanMatrix(R0);
CT:= TransposedMat( C );
sp:= Basis( SubspaceNC( L, CanonicalGenerators(R0)[3],"basis" ), CanonicalGenerators(R0)[3] );
h:= BasisVectors( sp );
good:= [ ];
cardat:= [ ];
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, posRv[pos]*negRv[pos] );
else
Add( t, negRv[pos-N]*posRv[pos-N] );
fi;
od;
t:= BasisVectors( Basis( Subspace( L, t ) ) );
ct:= List( t, x -> Coefficients( sp, 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, Zero(F) );
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, One(F) );
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*One(F))*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 );
Add( cardat, [ hZ, h0 ] );
fi;
fi;
fi;
od;
# NEXT can be obtained from Kac diagram!!
x:= CanonicalGenerators(R0)[1];
y:= CanonicalGenerators(R0)[2];
es:= [ ];
fs:= [ ];
g0:= SubspaceNC( L, Concatenation( Basis(CartanSubalgebra(L)), rr[1].pv0, rr[1].nv0 ) );
##g0:= Subspace( L, Concatenation( Basis(MaximallyCompactCartanSubalgebra(L)), rr[1].pv0, rr[1].nv0 ) );
for i in [1..Length(CartanMatrix(R0))] do
if x[i] in g0 then
#if corelg.eltInSubspace(L,BasisVectors(Basis(g0)),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( SubspaceNC(L,[es[j]]), [es[j]] ),
hs[i]*es[j] )[1] );
od;
Add( valmat, val );
od;
chars:= [ ];
fct:= function(x) if IsGaussRat(x) then return x; else return x![1][1][1]; fi; end;
for i in [1..Length(good)] do
u0:= good[i];
v:= List( es, z -> Coefficients( Basis(SubspaceNC(L,[z]),[z]), u0*z )[1] );
v:= List( v, fct );
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];
v:= List( v, fct );
done:= ForAll( v, z -> z >= 0 );
od;
if not u0 in chars then
Add( chars, u0 );
if u0 = sl2[2] then
U:= LieCentralizer( L, SubalgebraNC( L, cardat[i][1] ) );
gsp:= List( grad, u -> SubspaceNC( L, u, "basis" ) );
grr:= SL2Grading( L, cardat[i][2] );
g0:= Intersection( U, gsp[1], SubspaceNC( L, grr[3] ) );
g0:= SubalgebraNC( L, BasisVectors(Basis(g0)), "basis" );
r0:= rec( g0:= BasisVectors( Basis( g0 ) ) );
gp:= [ ];
for j in [1..Length(grr[1])] do
g1:= Intersection( U, gsp[ (j mod Length(grad)) +1 ],SubspaceNC( L, grr[1][j]));
Add( gp, BasisVectors( Basis( g1 ) ) );
od;
gn:= [ ];
for j in [1..Length(grr[2])] do
g1:= Intersection( U, gsp[(-j mod Length(grad)) +1 ],SubspaceNC( L, grr[2][j]));
Add( gn, BasisVectors( Basis( g1 ) ) );
od;
# remove trailing []-s...
k:= Length(gp);
while Length(gp[k]) = 0 do k:= k-1; od;
gp:= gp{[1..k]};
k:= Length(gn);
while Length(gn[k]) = 0 do k:= k-1; od;
gn:= gn{[1..k]};
r0.gp:= gp; r0.gn:= gn;
U:= SubalgebraNC( L, Concatenation( r0.g0, corelg.myflat(r0.gp), corelg.myflat(r0.gn) ), "basis" );
U:= LieDerivedSubalgebra(U);
r0.g0:= BasisVectors( Basis( Intersection( U, SubspaceNC( L, r0.g0, "basis" ) ) ) );
return r0;
fi;
fi;
od;
return "not found!!";
end;
##############################################################################
##
#F RegularCarrierAlgebraOfSL2Triple( <L>, <sl2> )
##
## <L> is a semisimple lie algebra over Gaussian rationals or SqrtField
## and <sl2> is an SL2-triple in <L> of the form [f,h,e] with ef=h, he=2e, hf=-2f;
## this function returns the Z-graded carrier algebra of <sl2> normalised by
## CartanSubalgebra(<L>).
##
InstallGlobalFunction( RegularCarrierAlgebraOfSL2Triple, function( L, sl2 )
local cr, K0, H0, grading;
if not HasCartanDecomposition(L) then
Error("no Cartan decomposition attached");
fi;
grading := [Basis(CartanDecomposition(L).K),Basis(CartanDecomposition(L).P)];
cr := corelg.carrZm( L, grading, sl2[3] );
K0 := SubalgebraNC( L, cr.g0 );
H0 := Intersection( CartanSubalgebra(L), K0 );
if LieNormalizer(K0,H0) = H0 then
return cr;
else
return corelg.carrierAlgebraBySL2Triple( L, grading, sl2 );
fi;
end);
##################################################################################
##################################################################################
##################################################################################
#
# Added nil orbs for outer aut... modification of SLA function
corelg.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:= SubalgebraNC( 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:= ChevalleyBasis(L)[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);
Rs:= RootsystemOfCartanSubalgebra(s);
Cs:= CartanMatrix( Rs );
ranks:= Length( Cs );
bas:= ShallowCopy( CanonicalGenerators(Rs)[3] );
Append( bas, BasisVectors( Basis(r) ) );
b0:= Basis( VectorSpace( F, bas ), bas );
in_weylch:= function( h )
local cf, u;
u:= h*hL;
if not u in g0 then return false; fi;
#if not corelg.eltInSubspace(L,BasisVectors(Basis(g0)),u) then return false; fi;
cf:= Coefficients( b0, u ){[1..ranks]};
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( SubspaceNC( L, gr1 ), gr1 );
g2:= Basis( SubspaceNC( 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:= SubspaceNC( L, bb );
h0:= h*hL;
if h0 in ef then #otherwise we can just discard h...
#if corelg.eltInSubspace(L,BasisVectors(Basis(ef)),h0) then
found:= false;
good:= false;
while not found do
co:= List( e, x -> Random(Omega) );
x:= co*e;
sp:= SubspaceNC( L, List( f, y -> x*y) );
if Dimension(sp) = Length(e) and h0 in sp then
#if Dimension(sp) = Length(e) and
# corelg.eltInSubspace(L,BasisVectors(Basis(sp)),h0) 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:= SubspaceNC( L, List( f, y -> x*y) );
if Dimension(sp) = Length(e) and h0 in sp then
#if Dimension(sp) = Length(e) and
# corelg.eltInSubspace(L,BasisVectors(Basis(sp)),h0) 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, SubalgebraNC( g0, [h0] ) );
sp0:= SubspaceNC( L, List( Basis(C_h0), y -> y*x ) );
if Dimension(sp0) = Length(e) then
found:= true;
good:= false;
fi;
fi;
od;
fi;
od;
return rec( hs:= good_h, sl2:= sl2s, chars:= List( good_h, charact ) );
end;
################################################################################
[ Dauer der Verarbeitung: 0.15 Sekunden
(vorverarbeitet)
]
|
2026-04-02
|
