#############################################################################
##
## compl.gi CRISP Burkhard Höfling
##
## Copyright © 2000-2002, 2005, 2015 Burkhard Höfling
##
#############################################################################
##
#F PcgsComplementOfChiefFactor(<pcgs>, <hpcgs>, <first>, <npcgs>, <kpcgs>)
##
InstallGlobalFunction("PcgsComplementOfChiefFactor",
function(pcgs, hpcgs, first, npcgs, kpcgs)
local
p, # prime exponent of npcgs
q, # prime dividing the order of the sylow subgroup
r, # integer divisible by p with r mod q = 1
field, # GF(p)
qpcgs, # pc sequence for Q mod K
depths, # depths of elements in qpcgs(wrt pcgs)
cpcgs, # pc sequence for a complement
cdepths, # depths of elements in cpcgs(wrt pcgs)
copied, # true if cpcgs is a shallow copy of qpcgs,
# false as long as they refer to the same object
g, # element to be adjusted
conj, # qgens[k]^g
n, # conj = t * n with t in Q and n in N
e, # exponent vector
lhs, # lhs of linear system of equations
rhs, # rhs of linear system of equations
sol, # solution of the system
j, k, l, # loop indices
tmp; # temp store for result, for debugging only
p := RelativeOrderOfPcElement(npcgs, npcgs[1]);
q := RelativeOrderOfPcElement(pcgs, hpcgs[first]);
Assert(1, p <> q);
field := GF(p);
# compute a pc sequence qpcgs(of length 1) for the full preimage of a Sylow q-subgroup of N/K
# in the group <hpcgs[Length(hpcgs)], N>/K
qpcgs := [];
depths := [];
for g in Reversed(kpcgs) do
if not AddPcElementToPcSequence(pcgs, qpcgs, depths, g) then
Error("Internal Error: PcgsComplementOfChiefFactor, error in kpcgs");
fi;
od;
r := Gcdex(p, q).coeff1 * p;
if not AddPcElementToPcSequence(pcgs, qpcgs, depths, hpcgs[Length(hpcgs)]^r) then
Error("Internal Error: PcgsComplementOfChiefFactor, error in qpcgs");
fi;
depths := [DepthOfPcElement(pcgs, qpcgs[1])]; # depths of elements of qpcgs
# complement and Sylow subgroup coincide
copied:= false;
for j in [Length(hpcgs)-1, Length(hpcgs)-2..1] do
# now extend cpcgs, and if j >= first, also qpcgs, to pc sequences
# representing a complement and a Sylow q-subgroup of
# the group <hpcgs{[j..Length(hpcgs)]}, N>/K
# This is done by finding a product x of elements of npcgs such that
# hpcgs[j]*x normalizes qpcgs(modulo K).
# The exponents of x wrt. npcgs can be found by solving linear equations
g := hpcgs[j];
lhs := [];
rhs := [];
for l in [1..Length(npcgs)] do
lhs[l] := [];
od;
# determine the conjugation action of g = hpcgs[j] on npcgs
for k in [1..Length(qpcgs)] do
conj := qpcgs[k]^g;
n := SiftedPcElementWrtPcSequence(pcgs, qpcgs, depths, conj);
for l in [1..Length(npcgs)] do
e := ExponentsConjugateLayer(npcgs, npcgs[l], conj)* One(field);
e[l] := e[l] - One(field);
Append(lhs[l],e);
od;
Append(rhs, ExponentsOfPcElement(npcgs, n) * One(field));
od;
# now solve the system and adjust g = hpcgs[j]
sol := SolutionMat(lhs , rhs);
g := g * PcElementByExponentsNC(npcgs, List(sol, IntFFE ));;
if j >= first then # we are computing a pcgs for Q and C
g := g^r;
if not AddPcElementToPcSequence(pcgs, qpcgs, depths, g) then
Error("Internal Error: PcgsComplementOfChiefFactor, wrong solution");
fi;
else # Q is found, we only extend C
if not copied then
cpcgs := ShallowCopy(qpcgs);
cdepths := ShallowCopy(depths);
copied := true;
fi;
if not AddPcElementToPcSequence(pcgs, cpcgs, cdepths, g) then
Error("Internal Error: PcgsComplementOfChiefFactor, wrong solution");
fi;
fi;
od;
if not copied then # this only happens if R = H, or equivalently if first = 1
cpcgs := qpcgs;
cdepths := depths;
fi;
tmp := InducedPcgsByPcSequenceNC(pcgs, cpcgs);
Assert(1, CanonicalPcgs(tmp) = CanonicalPcgs(InducedPcgsByGenerators(pcgs, cpcgs)),
Error("Internal Error: PcgsComplementOfChiefFactor, cpcgs is not a pc sequence"));
return tmp;
end);
#############################################################################
##
#F COMPLEMENT_SOLUTION_FUNCTION(<complements>, <pos>)
##
InstallGlobalFunction("COMPLEMENT_SOLUTION_FUNCTION",
function(complements, pos)
local s, w, depth, len, gens, i;
s := Length(complements.mpcgs);
gens := List(complements.nden);
w := complements.oneSolution + complements.solutionSpace[pos];
len := Length(gens);
if not IsBound(complements.denomDepths) then
complements.denomDepths := List(gens, x -> DepthOfPcElement(complements.pcgs, x));
fi;
depth := ShallowCopy(complements.denomDepths);
for i in [s, s-1..1] do
if not AddPcElementToPcSequence(complements.pcgs, gens, depth,
complements.mpcgs[i]
* PcElementByExponents(complements.npcgs,
w{[i,i+s..i+(Length(complements.npcgs)-1)*s]})) then
Error("Internal Error: COMPLEMENT_SOLUTION_FUNCTION, wrong solution");
fi;
od;
gens := InducedPcgsByPcSequenceNC(complements.pcgs, gens);
Assert(1, CanonicalPcgs(gens)
= CanonicalPcgs(InducedPcgsByGenerators(complements.pcgs, gens)),
Error("Internal Error: COMPLEMENT_SOLUTION_FUNCTION, gens is not a pc sequence"));
return gens;
end);
#############################################################################
##
#F EnumeratorOfTriangle(<k>)
##
## enumerates pairs [1,1], [2,1], [2,2], [3,1], [3,2], [3,3], ...
##
BindGlobal("EnumeratorOfTriangle", function(k)
local i, j;
i := QuoInt(1 + RootInt(8*k-1), 2);
j := k - i*(i-1)/2;
return [i,j];
end);
#############################################################################
##
#F ExtendedPcgsComplementsOfCentralModuloPcgsUnderAction(
## <act>, <pcgs>, <gpcgs>, <npcgs>, <kpcgs>, <all>)
##
InstallGlobalFunction(ExtendedPcgsComplementsOfCentralModuloPcgsUnderAction,
function(act, pcgs, gpcgs, npcgs, kpcgs, all)
local
gamma, # exponent vector
delta, # exponent vector
exp, # exponent vector
c, # exponent vector
d, # exponent vector
e, # list of exponent vectors
field, # prime field, its order = exponent
# of factor grp. represented by npcgs
sys, # system of linear equations
row, # row to be added to sys
nreq, # number of equations to be solved
perm, # random permutation of the equations
count, # loop variable
eq, # number of equation to add
eqind, # pair of indices specifying equation
bas, # basis of solution space of linear system
i, j, k, l, # loop variables
r, # length of act
s, # length of gpcgs
n, # length of npcgs
y, # group elements
p, # relative order of a group element
complements, # record storing the result
t; # for measuring the running time
t := Runtime();
if IsGroup(act) then
act := CRISP_SmallGeneratingSet(act);
fi;
r := Length(act);
s := Length(gpcgs);
n := Length(npcgs);
Info(InfoComplement, 1, "complementing(bot =", n, ", top = ", s,
", act = ", r,")");
# set up result record
complements := rec(
pcgs := pcgs,
mpcgs := gpcgs,
npcgs := npcgs,
nden := kpcgs);
# handle some trivial cases
if n = 0 then
complements.nrSolutions := 1;
complements.solutionFunction :=
function(complements, i)
return NumeratorOfModuloPcgs(complements.mpcgs);
end;
Info(InfoComplement, 2, "trivial solution(n = 0)");
Info(InfoComplement, 3, "time = ", Runtime() - t);
return complements;
elif s = 0 then
complements.nrSolutions := 1;
complements.solutionFunction :=
function(complements, i)
return complements.nden;
end;
Info(InfoComplement, 2, "trivial solution(s = 0)");
Info(InfoComplement, 3, "time = ", Runtime() - t);
return complements;
fi;
# prepare a solution for the case when no complement exists
complements.nrSolutions := 0;
complements.solutionFunction := ReturnFail;
# We want to find a vector t over field such that when
# for i = 1..s, the element gpcgs[i] is multiplied by
# npcgs[1]*t[i] + npcgs[2]*t[i+s] + ... + npcgs[n]*t[i+(n-1)*s],
# then the elements of the modified gpcgs satisfy the same relations
# modulo kpcgs which the original elements of gpcgs satisfied modulo
# NumeratorOfModuloPcgs(npcgs)
# The requirements for t translate into a system of linear equations,
# which we now set up.
field := GF(RelativeOrderOfPcElement(npcgs, npcgs[1]));
sys:= LinearSystem(n*s, 1, field, n*s > 20, false);
Info(InfoComplement, 2, "computing linear action on N");
e := [];
nreq := s*(s+1)/2 + r*s;
perm := Random(SymmetricGroup(nreq));
for count in [1..nreq] do
eq := count^perm;
if eq <= r * s then
i := QuoInt(eq-1, r) + 1;
j := eq - r *(i - 1);
# add equations to ensure invariance of the complement under <act>
if not IsBound(e[j]) then
e[j] := [];
for l in [1..n] do
y := npcgs[l]^act[j];
Assert(1, y in Group(Concatenation(npcgs, kpcgs)),
Error("Internal Error: npcgs[l]^act[j] must be in N"));
e[j][l] := ExponentsOfPcElement(npcgs, y) * One(field);
od;
fi;
# express gpcgs[i]^act[j] mod kpcgs as a product of elements
# in gpcgs and npcgs
y := gpcgs[i]^act[j];
exp := ExponentsOfPcElement(gpcgs, y);
delta := exp * One(field);
y := LeftQuotient(PcElementByExponents(gpcgs, exp), y);
Assert(1, y in Group(Concatenation(npcgs, kpcgs)),
Error("Internal Error: gpcgs[i]^act[j]/... must be in N"));
d := ExponentsOfPcElement(npcgs, y) * One(field);
# translate into a linear equation
for k in [1..n] do
row := ShallowCopy(sys.nullrow);
row{[(k-1)*s+1..k*s]} := delta;
for l in [1..n] do
row[(l-1)*s+i] := row[(l-1)*s+i]-e[j][l][k];
od;
if not AddEquation(sys, row, [d[k]]) then
Info(InfoComplement, 2, "no solution");
Info(InfoComplement, 3, "time = ", Runtime() - t);
return complements;
fi;
od;
else # power or conjugate relations of factor group
eqind := EnumeratorOfTriangle(eq - r*s);
i := eqind[1];
j := eqind[2];
if i = j then
# evaluate power relation
# express gpcgs[i]^p mod kpcgs as a product of elements in gpcgs and npcgs
p := RelativeOrderOfPcElement(gpcgs, gpcgs[i]);
y := gpcgs[i]^p;
exp := ExponentsOfPcElement(gpcgs, y);
y := LeftQuotient(PcElementByExponents(gpcgs, exp), y);
Assert(1, y in Group(NumeratorOfModuloPcgs(npcgs)),
Error("Internal Error: gpcgs[i]^p/... must be in N"));
exp[i] := - p;
gamma := exp * One(field);
c := ExponentsOfPcElement(npcgs, y) * One(field);
# translate into a linear equation
for k in [1..n] do
row := ShallowCopy(sys.nullrow);
row{[(k-1)*s+1..k*s]} := gamma;
if not AddEquation(sys, row, [c[k]]) then
Info(InfoComplement, 2, "no solution");
Info(InfoComplement, 3, "time = ", Runtime() - t);
return complements;
fi;
od;
else
# evaluate conjugation relation
# express gpcgs[i]^gpcgs[j] mod kpcgs as a product of elements
# in gpcgs and npcgs
y := gpcgs[i]^gpcgs[j];
exp := ExponentsOfPcElement(gpcgs, y);
y := LeftQuotient(PcElementByExponents(gpcgs, exp), y);
Assert(1, y in Group(Concatenation(npcgs, kpcgs)),
Error("Internal Error: Comm(gpcgs[i], gpcgs[j])/... must be in N"));
exp[i] := exp[i]-1;
gamma := exp * One(field);
c := ExponentsOfPcElement(npcgs, y) * One(field);
# translate into an equation
for k in [1..n] do
row := ShallowCopy(sys.nullrow);
row{[(k-1)*s+1..k*s]} := gamma;
if not AddEquation(sys, row, [c[k]]) then
Info(InfoComplement, 2, "no solution");
Info(InfoComplement, 3, "time = ", Runtime() - t);
return complements;
fi;
od;
fi;
fi;
od;
# now compute a solution of the system
complements.oneSolution := OneSolution(sys,1);
# add a function which generates the pcgs of any complement found
complements.solutionFunction := COMPLEMENT_SOLUTION_FUNCTION;
if all then
bas := BasisNullspaceSolution(sys);
complements.solutionSpace := Enumerator(
VectorSpace(field, bas, complements.oneSolution*Zero(field)));
complements.nrSolutions := Size(field)^Length(bas);
Info(InfoComplement, 2, complements.nrSolutions, " solution(s) found");
else # if we only want one solution, why bother computing the nullspace
complements.solutionSpace := [complements.oneSolution*Zero(field)];
complements.nrSolutions := 1;
Info(InfoComplement, 2, "one solution found(all = false)");
fi;
Info(InfoComplement, 3, "time = ", Runtime() - t);
return complements;
end);
#############################################################################
##
#F PcgsComplementsOfCentralModuloPcgsUnderActionNC(
## <act>, <pcgsnum>, <pcgs>, <mpcgs>, <pcgsdenum>, <all>)
##
InstallGlobalFunction(PcgsComplementsOfCentralModuloPcgsUnderActionNC,
function(act, pcgs, gpcgs, npcgs, kpcgs, all)
local complements;
complements :=
ExtendedPcgsComplementsOfCentralModuloPcgsUnderAction(
act, pcgs, gpcgs, npcgs, kpcgs, all);
return List([1..complements.nrSolutions],
i -> complements.solutionFunction(complements, i));
end);
#############################################################################
##
#F PcgsInvariantComplementsOfElAbModuloPcgs(
## <act>, <pcgsnum>, <pcgs>, <mpcgs>, <pcgsdenum>, <all>)
##
InstallGlobalFunction("PcgsInvariantComplementsOfElAbModuloPcgs",
function(act, pcgs, gpcgs, npcgs, kpcgs, all)
if CentralizesLayer(gpcgs, npcgs) then
return PcgsComplementsOfCentralModuloPcgsUnderActionNC(
act, pcgs, gpcgs, npcgs, kpcgs, all);
else
return [];
fi;
end);
#############################################################################
##
#M ComplementsOfCentralSectionUnderActionNC(<act>,<G>,<N>,<L>,<all>)
##
##
InstallMethod(ComplementsOfCentralSectionUnderActionNC,
"for section of soluble group",
function(famact, famG, famN, famL, famall)
return IsIdenticalObj(famG, famN) and IsIdenticalObj(famN, famL) ;
end,
[IsListOrCollection, IsSolvableGroup and IsFinite, IsSolvableGroup and IsFinite,
IsSolvableGroup and IsFinite, IsBool], 0,
function(act, G, N, L, all)
local cpcgs, complements, pcgs, pcgsL;
pcgs := ParentPcgs(Pcgs(G));
pcgsL:= InducedPcgs(pcgs, L);
cpcgs := PcgsComplementsOfCentralModuloPcgsUnderActionNC(
act, pcgs, ModuloPcgs(G, N), ModuloPcgs(N, L), pcgsL, all);
complements := List(cpcgs, c -> GroupOfPcgs(c));
Assert(2, ForAll(complements, C ->
IsNormal(G, C)
and NormalIntersection(C, N) = L
and Index(G, C) * Index(G, N) = Index(G, L)),
Error("Internal Error: wrong invariant complement(s)"));
if all then
return complements;
else
if Length(complements) > 0 then
return complements[1];
else
return fail;
fi;
fi;
end);
#############################################################################
##
#F ComplementsOfCentralSectionUnderAction(<act>, <G>, <N>, <L>, <all>)
##
## <act> must be a list or group whose elements act on G via ^
##
InstallGlobalFunction("ComplementsOfCentralSectionUnderAction",
function(act, G, N, L, all)
if ForAll(CRISP_SmallGeneratingSet(G), g ->
ForAll(CRISP_SmallGeneratingSet(N), n -> Comm(g, n) in L)) then
return ComplementsOfCentralSectionUnderActionNC(
act, G, N, L, all);
else
Error("G must centralize N/L");
fi;
end);
#############################################################################
##
#M InvariantComplementsOfElAbSection(<act>,<G>,<N>,<L>,<all>)
##
## version where <act> is a list of maps G -> G(which are supposed to
## induce automorphisms on G/L)
##
InstallMethod(InvariantComplementsOfElAbSection,
"for section of finite soluble group",
function(famact, famG, famN, famL, famall)
return IsIdenticalObj(famG, famN) and IsIdenticalObj(famN, famL);
end,
[IsListOrCollection, IsSolvableGroup and IsFinite, IsSolvableGroup and IsFinite,
IsSolvableGroup and IsFinite, IsBool], 0,
function(act, G, N, L, all)
local cpcgs, complements, pcgs, pcgsL;
if IsGroup(act) then
act := CRISP_SmallGeneratingSet(act);
fi;
pcgs := ParentPcgs(Pcgs(G));
pcgsL := InducedPcgs(pcgs, L);
cpcgs := PcgsInvariantComplementsOfElAbModuloPcgs(
act, pcgs, ModuloPcgs(G, N), ModuloPcgs(N, L), pcgsL, all);
complements := List(cpcgs, c -> SubgroupByPcgs(G, c));
Assert(2, ForAll(complements, C ->
IsNormal(G, C)
and NormalIntersection(C, N) = L
and Index(G, C) * Index(G, N) = Index(G, L)
and((FamilyObj(act)=FamilyObj(C) and ForAll(act, a -> C^a = C))
or(FamilyObj(act)<>FamilyObj(C) and ForAll(act, a -> Image(a, C) = C))
)),
Error("Internal Error: wrong normal complement(s)"));
if all then
return complements;
else
if Length(complements) > 0 then
return complements[1];
else
return fail;
fi;
fi;
end);
#############################################################################
##
#F ComplementsMaximalUnderAction(<act>, <ser>, <i>, <j>, <k>, <all>)
##
InstallGlobalFunction("ComplementsMaximalUnderAction",
function(act, ser, i, j, k, all)
local p, complements, newser, l, pcgs;
if i > j or j > k then
Error( "The indices must satisfy i <= j <= k" );
fi;
newser := [PcgsElementaryAbelianSeries(ser[i])];
pcgs := ParentPcgs(newser[1]);
for l in [i+1..k] do
Add(newser, InducedPcgs(pcgs, ser[l]));
od;
complements := PcgsComplementsMaximalUnderAction(
act,
pcgs, newser[1], newser, j-i+1, k-i+1, all);
if all then
return List(complements, GroupOfPcgs);
elif IsEmpty(complements) then
return fail;
else
return GroupOfPcgs(complements[1]);
fi;
end);
################################################################################
###
##
#F PcgsComplementsMaximalUnderAction(<act>, <U>, <ser>, <j>, <k>, <all>)
##
InstallGlobalFunction("PcgsComplementsMaximalUnderAction",
function(act, pcgs, upcgs, ser, j, k, all)
local top, bot, CC, p, q, gens, x, y, complements;
if j = k then
return [upcgs]; # trivial case
fi;
top := upcgs mod ser[j];
if IsEmpty(top) then
return [ser[k]]; # trivial case
fi;
bot := ser[j] mod ser[j+1];
# first compute complements modulo ser[j+1]
CC := []; # assume that there are no complements
if CentralizesLayer(top, bot) then
p := RelativeOrderOfPcElement(top,top[1]);
q := RelativeOrderOfPcElement(bot, bot[1]);
if p <> q then # coprime case
CC := [InducedPcgsByPcSequenceAndGenerators(pcgs, ser[j+1],
List(top, x -> x^q))];
elif ForAll(top, x-> SiftedPcElement(ser[j+1], x^p) = OneOfPcgs(pcgs)) then
# upcgs mod ser[j+1] is an elementary abelian p-group
CC := PcgsComplementsOfCentralModuloPcgsUnderActionNC(act, pcgs, top, bot, ser[j+1], all or j+1 < k);
fi; # else upcgs mod ser[j+1] has exponent p^2, so no complement exists
fi;
Info(InfoComplement, 1, " depth ",k-j-1," ", Length(CC), " complements found");
if j+1 = k then # we are done
return CC;
else # recurse
return Concatenation(List(CC,
C -> PcgsComplementsMaximalUnderAction(act, pcgs, C, ser, j+1, k, true)));
fi;
end);
###################################################################################
##
#E
##
