GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
#(C) Pablo Fernandez Ascariz, 2005-2006
#####################################################################
#####################################################################
#####################################################################
InstallGlobalFunction(LowerCentralSeriesLieAlgebra,
function(X)
local LieAlgebr,LieMap;
#####################################################################
#####################################################################
LieAlgebr:=function(G)
local LCSeries,Lgth,i,AbInvariants,j,aux,QuotLCS,Dim,DimLieAlgebra,Generat,n,ITPair,Bracket,SCTabl,L,NatHom,Homs;
if not IsPcpGroup(G) then
Print("The group must be a pcp group.");
return fail; fi;
########################################################################
NatHom:=function(i)
local NH;
if IsPolycyclicGroup(G) then
NH:=NaturalHomomorphism(LCSeries[i],LCSeries[i+1]);
else
NH:=NaturalHomomorphismByNormalSubgroupNC(LCSeries[i],LCSeries[i+1]);
fi;
return NH;
end;
########################################################################
LCSeries:=LowerCentralSeries(G);
Lgth:=Length(LCSeries);
Dim:=[];
Generat:=[];
Homs:=List([1..Lgth-1],i->NatHom(i));
QuotLCS:=List([1..Lgth-1],i->Range(Homs[i]));
aux:=AbelianInvariants(QuotLCS[1])[1];
for i in [1..Lgth-1] do
AbInvariants:=AbelianInvariants(QuotLCS[i]);
Dim[i]:=Length(AbInvariants);
for j in [1..Length(AbInvariants)] do;
if not AbInvariants[j]=aux then
return "The abelian invariants are not all the same";
fi;
od;
Generat[i]:=GeneratorsOfGroup(QuotLCS[i]);
if not Length(Generat[i])=Dim[i] then
return "Error finding generators of abelian group";
fi;
od;
DimLieAlgebra:=Sum([1..Lgth-1],i->Dim[i]);
########################################################################
ITPair:=function(n)
local s,suma,Term,BasisEl;
if n>DimLieAlgebra then
return [Lgth,1];
fi;
suma:=0;
for s in [1..Lgth-1] do
suma:=suma+Dim[s];
if n<=suma then
Term:=s;
break;
fi;
od;
suma:=suma-Dim[Term];
for s in [1..Dim[Term]] do
if n=suma+s then
BasisEl:=s;
break;
fi;
od;
return [Term,BasisEl];
end;
#######################################################################
#######################################################################
SCTabl:=function(i,j)
local x,y,Bracket,Commut,k,aux,F,Homomor,a,b;
Bracket:=[];
for k in [1..2*DimLieAlgebra] do
if IsOddInt(k)=true then
Bracket[k]:=0;
else
Bracket[k]:=1;
fi;
od;
if ITPair(i)[1]+ITPair(j)[1]>Lgth-1 then
return Bracket;
fi;
if ITPair(i+j)[1]>Lgth-1 then
return Bracket;
fi;
aux:=Sum([1..ITPair(i)[1]+ITPair(j)[1]-1],k->Dim[k]);
x:=ITPair(i);
y:=ITPair(j);
a:=PreImagesRepresentative(Homs[x[1]],Generat[x[1]][x[2]]);
b:=PreImagesRepresentative(Homs[y[1]],Generat[y[1]][y[2]]);
Commut:=a*b*Inverse(a)*Inverse(b);
Commut:=Image(Homs[ITPair(i)[1]+ITPair(j)[1]],Commut);
F:=FreeGroup(Length(Generat[ITPair(i)[1]+ITPair(j)[1]]));
Homomor:=GroupHomomorphismByImagesNC(F,QuotLCS[ITPair(i)[1]+ITPair(j)[1]],GeneratorsOfGroup(F),Generat[ITPair(i)[1]+ITPair(j)[1]]);
Commut:=PreImagesRepresentative(Homomor,Commut);
Commut:=LetterRepAssocWord(Commut);
for k in [1..Length(Commut)] do
Bracket[2*(aux+AbsInt(Commut[k]))-1]:=Bracket[2*(aux+AbsInt(Commut[k]))-1]+SignInt(Commut[k]);
Bracket[2*(aux+AbsInt(Commut[k]))]:=aux+AbsInt(Commut[k]);
od;
return Bracket;
end;
#####################################################################
L:=EmptySCTable(DimLieAlgebra,0,"antisymmetric");
for i in [1..DimLieAlgebra] do
for j in [i..DimLieAlgebra] do
SetEntrySCTable(L,i,j,SCTabl(i,j));
od;od;
if aux=0 then
L:=LieAlgebraByStructureConstants(Integers,L);
else
L:=LieAlgebraByStructureConstants(GF(aux),L);
fi;
return L;
end;
#####################################################################
#####################################################################
####################################################################
####################################################################
LieMap:=function(f)
local Map,Sour,Ran,BasisSour,i,LCSeriesSour,LgthSour,HomsSour,QuotLCSSour,GeneratSour,DimSour,ITPairSour,Imag,
LCSeriesRan,LgthRan,HomsRan,QuotLCSRan,GeneratRan,DimRan,BasisRan;
Sour:=LowerCentralSeriesLieAlgebra(Source(f));
Ran:=LowerCentralSeriesLieAlgebra(Range(f));
BasisSour:=Basis(Sour);
BasisRan:=Basis(Ran);
LCSeriesSour:=LowerCentralSeries(Source(f));
LCSeriesRan:=LowerCentralSeries(Range(f));
LgthSour:=Length(LCSeriesSour);
LgthRan:=Length(LCSeriesRan);
HomsSour:=List([1..LgthSour-1],i->(NaturalHomomorphism(LCSeriesSour[i],LCSeriesSour[i+1])));
HomsRan:=List([1..LgthRan-1],i->(NaturalHomomorphism(LCSeriesRan[i],LCSeriesRan[i+1])));
QuotLCSSour:=List([1..LgthSour-1],i->Range(HomsSour[i]));
QuotLCSRan:=List([1..LgthRan-1],i->Range(HomsRan[i]));
GeneratSour:=[];
GeneratRan:=[];
DimSour:=[];
DimRan:=[];
Imag:=[];
for i in [1..LgthSour-1] do
GeneratSour[i]:=GeneratorsOfGroup(QuotLCSSour[i]);
DimSour[i]:=Length(GeneratSour[i]);
od;
for i in [1..LgthRan-1] do
GeneratRan[i]:=GeneratorsOfGroup(QuotLCSRan[i]);
DimRan[i]:=Length(GeneratRan[i]);
od;
########################################################################
ITPairSour:=function(n)
local s,suma,Term,BasisEl;
suma:=0;
for s in [1..LgthSour-1] do
suma:=suma+DimSour[s];
if n<=suma then
Term:=s;
break;
fi;
od;
suma:=suma-DimSour[Term];
for s in [1..DimSour[Term]] do
if n=suma+s then
BasisEl:=s;
break;
fi;
od;
return [Term,BasisEl];
end;
#######################################################################
####################################################################
Map:=function(n)
local Preim,Img,aux,F,Homomor,k,coef,map,sum,j;
#if n>Length(Basis(Sour)) then
# return fail;
#fi;
if ITPairSour(n)[1]>LgthRan-1 then
return 0*BasisRan[1];
fi;
sum:=0;
aux:=ITPairSour(n);
map:=One(Ran!.LeftActingDomain);
coef:=List([1..DimRan[aux[1]]],i->0);
Preim:=PreImagesRepresentative(HomsSour[aux[1]],GeneratSour[aux[1]][aux[2]]);
Img:=Image(f,Preim);
Img:=Image(HomsRan[aux[1]],Img);
F:=FreeGroup(DimRan[aux[1]]);
Homomor:=GroupHomomorphismByImagesNC(F,QuotLCSRan[aux[1]],GeneratorsOfGroup(F),GeneratRan[aux[1]]);
Img:=PreImagesRepresentative(Homomor,Img);
Img:=LetterRepAssocWord(Img);
if Img=[] then
return 0*BasisRan[1];
fi;
for k in [1..Length(Img)] do
coef[AbsInt(Img[k])]:=coef[AbsInt(Img[k])]+SignInt(Img[k]);
od;
for k in [1..aux[1]-1] do
sum:=sum+DimRan[k];
od;
for k in [1..DimRan[aux[1]]] do
if not coef[k]=0 then
for j in [1..coef[k]] do
map:=map*BasisRan[sum+k];
od;fi;od;
return map;
end;
###################################################################
for i in [1..Length(Basis(Sour))] do
Imag[i]:=Map(i);
od;
return LeftModuleHomomorphismByImagesNC(Sour,Ran,BasisSour,Imag);
end;
###################################################################
###################################################################
if IsGroup(X)=true then
return LieAlgebr(X);
else if IsGroupHomomorphism(X)=true then
return LieMap(X);
else
return fail;
fi;fi;
end);
###################################################################
###################################################################
###################################################################