#Michael Bulois, 2015
#
#Details of Gap instructions linked to section 4.1 of
#M. Bulois and P. Hivert, Sheets of symmetric Lie algebras and slice induction, preprint available at https://hal.archives-ouvertes.fr/hal-01017691v1 
#Less detailed final version available at https://hal.archives-ouvertes.fr/hal-01017691


gap_console();
#GAP, Version 4.6.4 of 04-May-2013 (free software, GPL)
#available at http://www.gap-system.org


LoadPackage("sla"); 
#Package available at http://www.science.unitn.it/~degraaf/sla.html
#Version used: 0.13


Q2:=CyclotomicField(CF(4),[Sqrt(3)]);
s3:=Sqrt(3);

Table:=[ [ [ [  ], [  ] ], [ [  ], [  ] ], [ [ 3 ], [ 2 ] ], [ [ 4 ], [ -2 ] ], 
      [ [ 5 ], [ -3 ] ], [ [ 6 ], [ 3 ] ], [ [ 7 ], [ -1 ] ], 
      [ [ 8 ], [ 1 ] ], [ [ 9 ], [ 1 ] ], [ [ 10 ], [ -1 ] ], 
      [ [ 11 ], [ 3 ] ], [ [ 12 ], [ -3 ] ], [ [  ], [  ] ], [ [  ], [  ] ] ],
  [ [ [  ], [  ] ], [ [  ], [  ] ], [ [ 3 ], [ -1 ] ], [ [ 4 ], [ 1 ] ], 
      [ [ 5 ], [ 2 ] ], [ [ 6 ], [ -2 ] ], [ [ 7 ], [ 1 ] ], 
      [ [ 8 ], [ -1 ] ], [ [  ], [  ] ], [ [  ], [  ] ], [ [ 11 ], [ -1 ] ], 
      [ [ 12 ], [ 1 ] ], [ [ 13 ], [ 1 ] ], [ [ 14 ], [ -1 ] ] ], 
  [ [ [ 3 ], [ -2 ] ], [ [ 3 ], [ 1 ] ], [ [  ], [  ] ], [ [ 1 ], [ 1 ] ], 
      [ [ 7 ], [ 1 ] ], [ [  ], [  ] ], [ [ 9 ], [ 2 ] ], [ [ 6 ], [ -3 ] ], 
      [ [ 11 ], [ -3 ] ], [ [ 8 ], [ -2 ] ], [ [  ], [  ] ], 
      [ [ 10 ], [ 1 ] ], [ [  ], [  ] ], [ [  ], [  ] ] ], 
  [ [ [ 4 ], [ 2 ] ], [ [ 4 ], [ -1 ] ], [ [ 1 ], [ -1 ] ], [ [  ], [  ] ], 
      [ [  ], [  ] ], [ [ 8 ], [ -1 ] ], [ [ 5 ], [ 3 ] ], [ [ 10 ], [ -2 ] ],
      [ [ 7 ], [ 2 ] ], [ [ 12 ], [ 3 ] ], [ [ 9 ], [ -1 ] ], [ [  ], [  ] ], 
      [ [  ], [  ] ], [ [  ], [  ] ] ], 
  [ [ [ 5 ], [ 3 ] ], [ [ 5 ], [ -2 ] ], [ [ 7 ], [ -1 ] ], [ [  ], [  ] ], 
      [ [  ], [  ] ], [ [ 2 ], [ 1 ] ], [ [  ], [  ] ], [ [ 4 ], [ 1 ] ], 
      [ [  ], [  ] ], [ [  ], [  ] ], [ [ 13 ], [ -1 ] ], [ [  ], [  ] ], 
      [ [  ], [  ] ], [ [ 12 ], [ 1 ] ] ], 
  [ [ [ 6 ], [ -3 ] ], [ [ 6 ], [ 2 ] ], [ [  ], [  ] ], [ [ 8 ], [ 1 ] ], 
      [ [ 2 ], [ -1 ] ], [ [  ], [  ] ], [ [ 3 ], [ -1 ] ], [ [  ], [  ] ], 
      [ [  ], [  ] ], [ [  ], [  ] ], [ [  ], [  ] ], [ [ 14 ], [ 1 ] ], 
      [ [ 11 ], [ -1 ] ], [ [  ], [  ] ] ], 
  [ [ [ 7 ], [ 1 ] ], [ [ 7 ], [ -1 ] ], [ [ 9 ], [ -2 ] ], [ [ 5 ], [ -3 ] ],
      [ [  ], [  ] ], [ [ 3 ], [ 1 ] ], [ [  ], [  ] ], 
      [ [ 1, 2 ], [ 1, 3 ] ], [ [ 13 ], [ -3 ] ], [ [ 4 ], [ 2 ] ], 
      [ [  ], [  ] ], [ [  ], [  ] ], [ [  ], [  ] ], [ [ 10 ], [ 1 ] ] ], 
  [ [ [ 8 ], [ -1 ] ], [ [ 8 ], [ 1 ] ], [ [ 6 ], [ 3 ] ], [ [ 10 ], [ 2 ] ], 
      [ [ 4 ], [ -1 ] ], [ [  ], [  ] ], [ [ 1, 2 ], [ -1, -3 ] ], 
      [ [  ], [  ] ], [ [ 3 ], [ -2 ] ], [ [ 14 ], [ 3 ] ], [ [  ], [  ] ], 
      [ [  ], [  ] ], [ [ 9 ], [ -1 ] ], [ [  ], [  ] ] ], 
  [ [ [ 9 ], [ -1 ] ], [ [  ], [  ] ], [ [ 11 ], [ 3 ] ], [ [ 7 ], [ -2 ] ], 
      [ [  ], [  ] ], [ [  ], [  ] ], [ [ 13 ], [ 3 ] ], [ [ 3 ], [ 2 ] ], 
      [ [  ], [  ] ], [ [ 1, 2 ], [ 2, 3 ] ], [ [  ], [  ] ], 
      [ [ 4 ], [ -1 ] ], [ [  ], [  ] ], [ [ 8 ], [ -1 ] ] ], 
  [ [ [ 10 ], [ 1 ] ], [ [  ], [  ] ], [ [ 8 ], [ 2 ] ], [ [ 12 ], [ -3 ] ], 
      [ [  ], [  ] ], [ [  ], [  ] ], [ [ 4 ], [ -2 ] ], [ [ 14 ], [ -3 ] ], 
      [ [ 1, 2 ], [ -2, -3 ] ], [ [  ], [  ] ], [ [ 3 ], [ 1 ] ], 
      [ [  ], [  ] ], [ [ 7 ], [ 1 ] ], [ [  ], [  ] ] ], 
  [ [ [ 11 ], [ -3 ] ], [ [ 11 ], [ 1 ] ], [ [  ], [  ] ], [ [ 9 ], [ 1 ] ], 
      [ [ 13 ], [ 1 ] ], [ [  ], [  ] ], [ [  ], [  ] ], [ [  ], [  ] ], 
      [ [  ], [  ] ], [ [ 3 ], [ -1 ] ], [ [  ], [  ] ], 
      [ [ 1, 2 ], [ 1, 1 ] ], [ [  ], [  ] ], [ [ 6 ], [ -1 ] ] ], 
  [ [ [ 12 ], [ 3 ] ], [ [ 12 ], [ -1 ] ], [ [ 10 ], [ -1 ] ], 
      [ [  ], [  ] ], [ [  ], [  ] ], [ [ 14 ], [ -1 ] ], [ [  ], [  ] ], 
      [ [  ], [  ] ], [ [ 4 ], [ 1 ] ], [ [  ], [  ] ], 
      [ [ 1, 2 ], [ -1, -1 ] ], [ [  ], [  ] ], [ [ 5 ], [ 1 ] ], 
      [ [  ], [  ] ] ], 
  [ [ [  ], [  ] ], [ [ 13 ], [ -1 ] ], [ [  ], [  ] ], [ [  ], [  ] ], 
      [ [  ], [  ] ], [ [ 11 ], [ 1 ] ], [ [  ], [  ] ], [ [ 9 ], [ 1 ] ], 
      [ [  ], [  ] ], [ [ 7 ], [ -1 ] ], [ [  ], [  ] ], [ [ 5 ], [ -1 ] ], 
      [ [  ], [  ] ], [ [ 1, 2 ], [ 1, 2 ] ] ], 
  [ [ [  ], [  ] ], [ [ 14 ], [ 1 ] ], [ [  ], [  ] ], [ [  ], [  ] ], 
      [ [ 12 ], [ -1 ] ], [ [  ], [  ] ], [ [ 10 ], [ -1 ] ], [ [  ], [  ] ], 
      [ [ 8 ], [ 1 ] ], [ [  ], [  ] ], [ [ 6 ], [ 1 ] ], [ [  ], [  ] ], 
      [ [ 1, 2 ], [ -1, -2 ] ], [ [  ], [  ] ] ], -1, 0 ];

gg:=LieAlgebraByStructureConstants(Q2,Table); 
BL:=CanonicalBasis(gg);
H1:=BL[1];;H2:=BL[2];;X1:=BL[3];;X2:=BL[5];;X3:=BL[7];;X4:=BL[9];;X5:=BL[11];;X6:=BL[13];;
Y1:=BL[4];;Y2:=BL[6];;Y3:=BL[8];;Y4:=BL[10];;Y5:=BL[12];;Y6:=BL[14];; H0:=0*H1;

#Lie Algebra of type G2 with the multiplication table on the basis (H_i,X_i,Y_i) identical to the one given in Fulton Harris, p.346.


basekk:=[H1,H2,X1,Y1,X6,Y6];
kk:=Subalgebra(gg,basekk);
basepp:=[X2,X3,X4,X5,Y2,Y3,Y4,Y5];
pp:=Subspace(gg,basepp);
Basepp:=Basis(pp);

#(gg,kk,pp) is the non-trivial symmetric Lie algebra of type G2.

N10A:=X5+Y3;
N10B:=X4+X3; 
# Representants of the two subregular nilpotent K-orbits in pp (dimension 5).


h1:=X4+Y4;
h2:=X2+Y2;
#Representants of the two subregular semisimple K-orbits in pp (up to a scalar). 
#h1 (resp. h2) lies in the semisimple part of a Levi of type A1 associated to a short (resp. long) root
#Dually, the centralizer of h1 (resp. h2) contains a root space associated to a long root (resp. short).

bracketspel:=function(g,Bh1,x)  return Subspace(g,List(Bh1, y->y*x)); end;;
dimgorb:=function(g,x) return Dimension(bracketspel(g,Basis(g),x)); end;;
findEL:=function(g) local Bg, mat, l2,l,x; Bg:=Basis(g); mat:=List(Bg,y->Coefficients(Bg,(Bg[1]*y))); l2:=TraceMat(mat*mat); l:=Sqrt(1/2*l2); x:=LinearCombination(Bg,NullspaceMat(mat-l*mat^0)[1]); return x; end;;
#This function finds a non-zero nilpotent element in an algebra isomorphic to sl2.
#Note that the dimension of the G-orbit of a nilpotent element in a Levi of type A1 associated to a short (resp. long) root is 8 (resp. 6). 
#This will allow us to distinguish the type of any semisimple subregular elements as shown below on h1 and h2
dimgorb(gg,findEL(LieCentralizer(gg,Subspace(gg,[h1]))));
#6
dimgorb(gg,findEL(LieCentralizer(gg,Subspace(gg,[h2]))));
#8

S10A:=SL2Triple(gg,N10A);
M10A:=S10A[1];
H10A:=S10A[2];
S10B:=SL2Triple(gg,N10B);
M10B:=S10B[1];
H10B:=S10B[2];
#The (NX,HX,MX) are SL2-Triple.
MMA:=Subalgebra(gg,[M10A]);
MMB:=Subalgebra(gg,[M10B]);
gMA:=LieCentralizer(gg,MMA);
kMA:=Intersection(kk,gMA);
pMA:=Intersection(pp,gMA);
gMB:=LieCentralizer(gg,MMB);
kMB:=Intersection(kk,gMB);
pMB:=Intersection(pp,gMB);
basePMA:=Basis(pMA);
basePMB:=Basis(pMB);
baseepPMA:=[N10A,basePMA[1],basePMA[2],basePMA[3]];
baseepPMB:=[N10B,basePMB[1],basePMB[2],basePMB[3]];
#The Slodowy slice through NX with respect to the SL2-Triple (NX,HX,MX) can be viewed as {baseepPMX[1]+x1*baseepPMX[2]+x2*baseepPMX[3]+x3*baseepPMX[4]| x1,x2,x3 \in Q2}. 


action:=function(x,y) return x*y; end;;
actionxkk:=function(x) local act; act:=List(basekk, y->action(x,y)); return act; end;;
#function that compute a generating set of the image of the bracket [x,kk] (via a basis of kk). Note that the dimension of this space is dim K.x

coeflist:=function(B,l) local n; n:=List(l,y->Coefficients(B,y)); return n; end;;
coeflist2:=function(B,l) local n; n:=List(l,y->coeflist(B,y)); return n; end;;
actionepPMA:=List(baseepPMA,y->actionxkk(y));
actionepPMB:=List(baseepPMB,y->actionxkk(y));
actionblownmatA:=coeflist2(Basepp,actionepPMA);
actionblownmatB:=coeflist2(Basepp,actionepPMB);
FA:=PolynomialRing(Q2,3);
baseFA:=GeneratorsOfAlgebra(FA);
FA1:=baseFA[1];
FAa:=baseFA[2];
FAb:=baseFA[3];
FAc:=baseFA[4];
actionmatA:=FA1*actionblownmatA[1]+FAa*actionblownmatA[2]+FAb*actionblownmatA[3]+FAc*actionblownmatA[4];
actionmatB:=FA1*actionblownmatB[1]+FAa*actionblownmatB[2]+FAb*actionblownmatB[3]+FAc*actionblownmatB[4];
tactionmatA:=TransposedMat(actionmatA);
tactionmatB:=TransposedMat(actionmatB);
Display(tactionmatA);
Display(tactionmatB);
#matrix of the linear map kk->pp defined via bracketting with the formal element baseepPMX[1]+x1*baseepPMX[2]+x2*baseepPMX[3]+x3*baseepPMX[4] of the Slodowy Slice.
#Note that this matrix is of maximal rank (6) if and only if our element is regular.

matpartiel:=function(mat,l) local matp, i, n, y; matp:=ShallowCopy(mat); for i in [1..Length(l)] do n:=l[i]; y:=Remove(matp,n); od; return matp; end;;
detpartiel:=function(matpp,li) local p, m; return DeterminantMatDivFree(matpartiel(matpp,li)); end;;
multidet:=function(matppp) local ma, i ,j, ip, y; ma:=[]; for i in [2..8] do ip:=i-1; for j in [1..ip] do y:=detpartiel(matppp,[i,j]); Add(ma,y); od; od; return ma; end;;
multidetA:=multidet(tactionmatA);
multidetB:=multidet(tactionmatB);
#Computation of minors of size 6 of tactionmatX. This is a set of equations defining the non-regular (hence subregular) locus in the Slodowy Slice.

multidetAshort:=BasisVectors(Basis(VectorSpace(Rationals,multidetA)));
multidetBshort:=BasisVectors(Basis(VectorSpace(Rationals,multidetB)));
IA:= Ideal( FA, multidetAshort );
ord := MonomialLexOrdering(FAa,FAb,FAc);
GA:=GroebnerBasis( IA, ord );
#[ x_2^2-10/9*x_2*x_3+1/9*x_3^2, x_1 ]
#Simplified list of equations defining the subregular locus in the Slodowy Slice of N10A.
Factors(GA[1]);
#[ x_2-x_3, x_2-1/9*x_3 ]
Factors(GA[2]);
#[ x_1 ]
#The subregular locus is a union of 2 lines. This shows part of the statement of Lemma 4.2 (i)

IB:= Ideal( FA, multidetBshort );
GB:=GroebnerBasis( IB, ord );
#[ x_2*x_3+1/4*x_3^2, x_1^2-6*x_1*x_2 ]
#Simplified list of equations defining the subregular locus in the Slodowy Slice of N10B.
Factors(GB[1]); 
#[ x_3, x_2+1/4*x_3 ]
Factors(GB[2]);
#[ x_1, x_1-6*x_2 ]
#The subregular locus is a union of 4 lines. Same for Lemma 4.2 (ii)



X10A1:=N10A+basePMA[2]+basePMA[3];
#A representant of one line of subregular elements in the Slodowy Slice of N10A
X10A2:=N10A+basePMA[2]+9*basePMA[3];
#A representant of the other line of subregular elements in the Slodowy Slice of N10A
X10B1:=N10B+basePMB[2];
#A representant of one line of subregular elements in the Slodowy Slice of N10B
X10B2:=N10B+6*basePMB[1]+basePMB[2];
#A representant of a second line of subregular elements in the Slodowy Slice of N10B
X10B3:=N10B+basePMB[2]-4*basePMB[3];
#A representant of a third line of subregular elements in the Slodowy Slice of N10B
X10B4:=N10B+6*basePMB[1]+basePMB[2]-4*basePMB[3];
#A representant of the last line of subregular elements in the Slodowy Slice of N10B
X10A:=[X10A1,X10A2];
X10B:=[X10B1,X10B2,X10B3,X10B4];
LX10A:=List(X10A,y->LieCentralizer(gg,Subspace(gg,[y])));
LX10B:=List(X10B,y->LieCentralizer(gg,Subspace(gg,[y])));
#Lists of centralizers in gg of our particular elements. All are of dimension 4 hence the elements considered are indeed subregular.

bracketspsp:=function (g,Bh1,Bh2) return Subalgebra(g,Concatenation(List(Bh1, y->(List(Bh2, z->y*z))))); end;;
bracketspaspa:=function (g,h1,h2) local Bh1,Bh2; return bracketspsp(g,Basis(h1),Basis(h2)); end;;
LpX10A:=List(LX10A,y->bracketspaspa(gg,y,y));
LpX10B:=List(LX10B,y->bracketspaspa(gg,y,y));
#Lists of derived subalgebras of centralizers. The theory says that they are of type A1. There remains to check whether this involves a short or a long root.

dimorbincA:=List(LpX10A,y->dimgorb(gg,findEL(y)));
#[ 8, 6 ]
# Hence the two branches passing through N10A belong to 2 different sheets
dimorbincB:=List(LpX10B,y->dimgorb(gg,findEL(y)));
#[ 6, 6, 6, 8 ]
#One sheet has 3 branches passing through N10B while the other has only one.
#Hence Lemma 4.2 is fully shown at this step.