Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more,
all in one place.
Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more,
all in one place.
| Download
GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
Project: cocalc-sagemath-dev-slelievre
Views: 418346##################################################
InstallGlobalFunction(LieExteriorSquare,
function(L)
local
BasisL, lenBL, SCTL, lisabelian, K, SCTC, u1, u2, u3, u4, l1, l2,
index1, index2, C, t1, t2, t3, t4, t5, t6, i, j, k, m, p,
vectorsI, vectorsII,w1,w2,
zr1, mr1, zr2, mr2, derayeh1, derayeh2,
lenv1, lenv2, lenv3, lenv4, lenv5, lenv6,
e, q, w, v1, v2, lzr1, lzr2, lmr1, lmr2,
q1, q2, tt1, tt2, ww, h, LTL, LVL, t, v7, I, II,
bL, bLTL, g, MLTL, v, vv1, BI, I1, I2, I3,
LenBI, BLTL, BBLTL, liltl, llzr1,
MLVL,BLVL,BBLVL,II1,II2,II3,BII,LenBII,lilvl,bLV,
LL,f,g1,Pair;
lisabelian:=0;
if IsLieAbelian(L) then lisabelian:=1; fi;
K:=L!.LeftActingDomain;
BasisL:=Basis(L);
lenBL:=Length(BasisL);
SCTL:=StructureConstantsTable(BasisL);
SCTC:=EmptySCTable(lenBL^2,0*One(K),"antisymmetric");
for u1 in [1..lenBL] do
for u2 in [1..lenBL] do
for u3 in [1..lenBL] do
for u4 in [1..lenBL] do
l1:=Length(SCTL[u1][u2][1]);
l2:=Length(SCTL[u3][u4][1]);
if l1<>0 then if l2<>0 then
index1:=(u1-1)*lenBL+u2;
index2:=(u3-1)*lenBL+u4;
derayeh1:=[];
for t1 in [1..l1] do
for t2 in [1..l2] do
i:=SCTL[u1][u2][1][t1];
j:=SCTL[u3][u4][1][t2];
m:=(i-1)*lenBL+j;
p:=SCTL[u1][u2][2][t1]*SCTL[u3][u4][2][t2];
Add(derayeh1,p*One(K));
Add(derayeh1,m);
od;
od;
SetEntrySCTable(SCTC,index1,index2,derayeh1);
fi; fi;
od;
od;
od;
od;
C:=AlgebraByStructureConstants(K,SCTC);
vectorsI:=[];
for u1 in [1..lenBL] do
for u2 in [1..lenBL] do
for u3 in [1..lenBL] do
zr1:=[];
mr1:=[];
zr2:=[];
mr2:=[];
lenv1:=Length(SCTL[u1][u2][1]);
if lenv1<>0 then
for t1 in [1..lenv1] do
i:=SCTL[u1][u2][1][t1];
j:=u3;
m:=(i-1)*lenBL+j;
p:=SCTL[u1][u2][2][t1]*1;
Add(zr1,p*One(K));
Add(mr1,m);
od;
fi;
lenv2:=Length(SCTL[u2][u3][1]);
if lenv2<>0 then
for t2 in [1..lenv2] do
i:=u1;
j:=SCTL[u2][u3][1][t2];
m:=(i-1)*lenBL+j;
p:=1*SCTL[u2][u3][2][t2];
e:=0;
if Length(zr1)<>0 then
for q in [1..Length(zr1)] do
if mr1[q]=m then zr1[q]:=zr1[q]-p*One(K); e:=1; fi;
od;
if e=0 then Add(zr1,-1*p*One(K)); Add(mr1,m); fi;
fi;
if Length(zr1)=0 then Add(zr1,-1*p*One(K)); Add(mr1,m); fi;
od;
fi;
lenv3:=Length(SCTL[u1][u3][1]);
if lenv3<>0 then
for t3 in [1..lenv3] do
i:=u2;
j:=SCTL[u1][u3][1][t3];
m:=(i-1)*lenBL+j;
p:=1*SCTL[u1][u3][2][t3];
e:=0;
if Length(zr1)<>0 then
for q in [1..Length(zr1)] do
if mr1[q]=m then zr1[q]:=zr1[q]+p*One(K); e:=1; fi;
od;
if e=0 then Add(zr1,p*One(K)); Add(mr1,m); fi;
fi;
if Length(zr1)=0 then Add(zr1,p*One(K)); Add(mr1,m); fi;
od;
fi;
lenv4:=Length(SCTL[u2][u3][1]);
if lenv4<>0 then
for t4 in [1..lenv2] do
i:=u1;
j:=SCTL[u2][u3][1][t4];
m:=(i-1)*lenBL+j;
p:=1*SCTL[u2][u3][2][t4];
Add(zr2,p*One(K));
Add(mr2,m);
od;
fi;
lenv5:=Length(SCTL[u3][u1][1]);
if lenv5<>0 then
for t5 in [1..lenv5] do
i:=SCTL[u3][u1][1][t5];
j:=u2;
m:=(i-1)*lenBL+j;
p:=SCTL[u3][u1][2][t5]*1;
e:=0;
if Length(zr2)<>0 then
for q in [1..Length(zr2)] do
if mr2[q]=m then zr2[q]:=zr2[q]-p*One(K); e:=1; fi;
od;
if e=0 then Add(zr2,-1*p*One(K)); Add(mr2,m); fi;
fi;
if Length(zr2)=0 then Add(zr2,-1*p*One(K)); Add(mr2,m); fi;
od;
fi;
lenv6:=Length(SCTL[u2][u1][1]);
if lenv6<>0 then
for t6 in [1..lenv6] do
i:=SCTL[u2][u1][1][t6];
j:=u3;
m:=(i-1)*lenBL+j;
p:=SCTL[u2][u1][2][t6]*1;
e:=0;
if Length(zr2)<>0 then
for q in [1..Length(zr2)] do
if mr2[q]=m then zr2[q]:=zr2[q]+p*One(K); e:=1; fi;
od;
if e=0 then Add(zr2,p*One(K)); Add(mr2,m); fi;
fi;
if Length(zr2)=0 then Add(zr2,p*One(K)); Add(mr2,m); fi;
od;
fi;
lzr1:=Length(zr1);
lmr1:=Length(mr1);
v1:=0;
if lzr1<>0 then
v1:=zr1[1]*(Elements(Basis(C))[lenBL^2-mr1[1]+1]);
for q1 in [2..lzr1] do
if zr1[q1]<>0 then
v1:=v1+zr1[q1]*(Elements(Basis(C))[lenBL^2-mr1[q1]+1]);
fi;
od;
fi;
tt1:=0;
for ww in [1..Length(Basis(C))] do
if v1=0*Elements(Basis(C))[ww] then tt1:=1; fi;
od;
w:=0;
for h in [1..Length(vectorsI)] do
if v1=vectorsI[h] then w:=1; fi;
if -1*v1=vectorsI[h] then w:=1; fi;
od;
if v1<>0 then if w=0 then if tt1=0 then Add(vectorsI,v1); fi; fi; fi;
lzr2:=Length(zr2);
lmr2:=Length(mr2);
v2:=0;
if lzr2<>0 then
v2:=zr2[1]*(Elements(Basis(C))[lenBL^2-mr2[1]+1]);
for q2 in [2..lzr2] do
if zr2[q2]<>0 then
v2:=v2+zr2[q2]*(Elements(Basis(C))[lenBL^2-mr2[q2]+1]);
fi;
od;
fi;
tt2:=0;
for ww in [1..Length(Basis(C))] do
if v2=0*Elements(Basis(C))[ww] then tt2:=1; fi;
od;
w:=0;
for h in [1..Length(vectorsI)] do
if v2=vectorsI[h] then w:=1; fi;
if -1*v2=vectorsI[h] then w:=1; fi;
od;
if v2<>0 then if w=0 then if tt2=0 then Add(vectorsI,v2); fi; fi; fi;
od;
od;
od;
I:=Ideal(C,vectorsI);
LTL:=C/I;
#g1:=NaturalHomomorphismByIdeal(C,I);
#LTL:=Image(g1);
vectorsII:=[];
for t in [1..Length(vectorsI)] do
Add(vectorsII,vectorsI[t]);
od;
for i in [1..lenBL] do
w:=(i-1)*lenBL+i;
v7:=Elements(Basis(C))[lenBL^2-w+1];
Add(vectorsII,v7);
od;
for i in [1..lenBL] do
for j in [1..lenBL] do
w1:=(i-1)*lenBL+j;
w2:=(j-1)*lenBL+i;
v7:=Elements(Basis(C))[lenBL^2-w1+1]+Elements(Basis(C))[lenBL^2-w2+1];
Add(vectorsII,v7);
od;
od;
II:=Ideal(C,vectorsII);
#LVL:=C/II;
g1:=NaturalHomomorphismByIdeal(C,II);
LVL:=Image(g1);
MLTL:=[];
for i in [1..Length(Basis(C))] do
v:=Elements(Basis(C))[lenBL^2-i+1];
if not (v in I) then Add(MLTL,v); fi;
od;
BI:=Basis(I);
LenBI:=Length(BI);
BLTL:=[];
BBLTL:=[];
for j in [1..LenBI] do
Add(BBLTL,Elements(BI)[j]);
od;
for i in [1..Length(MLTL)] do
Add(BLTL,MLTL[i]);
Add(BBLTL,MLTL[i]);
I1:=VectorSpace(K,BBLTL);
if Dimension(I1)=LenBI+1 then LenBI:=LenBI+1;
else
Remove(BLTL);
Remove(BBLTL);
fi;
if Length(BLTL)=Dimension(C) then break; fi;
od;
I2:=VectorSpace(K,BLTL);
I3:=VectorSpace(K,Basis(LTL));
liltl:=[];
for i in [1..Length(BLTL)] do
for j in [1..Length(Basis(C))] do
if BLTL[i]=Elements(Basis(C))[lenBL^2-j+1] then
Add(liltl,j);
break;
fi;
od;
od;
bL:=[];
for k in [1..Length(liltl)] do
u1:=Int(liltl[k]/lenBL)+1;
u2:= liltl[k] mod lenBL;
if u2=0 then u2:=lenBL; u1:=u1-1; fi;
u3:=SCTL[u1][u2];
llzr1:=Length(SCTL[u1][u2][1]);
vv1:=0*Elements(BasisL)[1];
if llzr1<>0 then
vv1:=SCTL[u1][u2][2][1]*Elements(BasisL)[lenBL-SCTL[u1][u2][1][1]+1];
for i in [2..llzr1] do
vv1:=vv1+SCTL[u1][u2][2][i]*Elements(BasisL)[lenBL-SCTL[u1][u2][1][i]+1];
od;
fi;
Add(bL,vv1);
od;
bLTL:=Basis(LTL);
g:= AlgebraHomomorphismByImages( LTL, L, bLTL , bL );;
MLVL:=[];
for i in [1..Length(Basis(C))] do
v:=Elements(Basis(C))[lenBL^2-i+1];
if not (v in II) then Add(MLVL,v); fi;
od;
BII:=Basis(II);
LenBII:=Length(BII);
BLVL:=[];
BBLVL:=[];
for j in [1..LenBII] do
Add(BBLVL,Elements(BII)[j]);
od;
for i in [1..Length(MLVL)] do
Add(BLVL,MLVL[i]);
Add(BBLVL,MLVL[i]);
II1:=VectorSpace(K,BBLVL);
if Dimension(II1)=LenBII+1 then LenBII:=LenBII+1;
else
Remove(BLVL);
Remove(BBLVL);
fi;
if Length(BLVL)=Dimension(C) then break; fi;
od;
II2:=VectorSpace(K,BLVL);
II3:=VectorSpace(K,Basis(LVL));
lilvl:=[];
for i in [1..Length(BLVL)] do
for j in [1..Length(Basis(C))] do
if BLVL[i]=Elements(Basis(C))[lenBL^2-j+1] then
Add(lilvl,j);
break;
fi;
od;
od;
bLV:=[];
for k in [1..Length(lilvl)] do
u1:=Int(lilvl[k]/lenBL)+1;
u2:= lilvl[k] mod lenBL;
if u2=0 then u2:=lenBL; u1:=u1-1; fi;
u3:=SCTL[u1][u2];
llzr1:=Length(SCTL[u1][u2][1]);
vv1:=0*Elements(BasisL)[1];
if llzr1<>0 then
vv1:=SCTL[u1][u2][2][1]*Elements(BasisL)[lenBL-SCTL[u1][u2][1][1]+1];
for i in [2..llzr1] do
vv1:=vv1+SCTL[u1][u2][2][i]*Elements(BasisL)[lenBL-SCTL[u1][u2][1][i]+1];
od;
fi;
Add(bLV,vv1);
od;
BLVL:=Basis(LVL);
LL:=LieDerivedSubalgebra(L);
##### f: hom(LwL ---> [L,L]) ##################
f:= AlgebraHomomorphismByImages( LVL, LL, BLVL , bLV );
#g1:= NaturalHomomorphismByIdeal( C, II );
################################
Pair:=function(x,y)
local
z1,z2,z3,z4,l,v1,v,k,i,j;
z1:=Coefficients( Basis(L), x );
z2:=Coefficients( Basis(L), y );
l:=Length(z1);
v:=0*Random(Images(g1,Basis(C)[1]));
for i in [1..l] do
for j in [1..l] do
z3:=z1[i]*z2[j];
if z3<>0 then
k:=(i-1)*lenBL+j;
v1:=Random(Images(g1,Basis(C)[k]));
v:=v+z3*v1;
fi;
od;
od;
return v;
end;
################################
return rec(homomorphism:=f, pairing:=Pair );
end);