diff --git a/gap/projective/AnSnOnFDPM.gd b/gap/projective/AnSn/AnSnOnFDPM.gd similarity index 100% rename from gap/projective/AnSnOnFDPM.gd rename to gap/projective/AnSn/AnSnOnFDPM.gd diff --git a/gap/projective/AnSnOnFDPM.gi b/gap/projective/AnSn/AnSnOnFDPM.gi similarity index 100% rename from gap/projective/AnSnOnFDPM.gi rename to gap/projective/AnSn/AnSnOnFDPM.gi diff --git a/gap/projective/blackbox/blackboxClassical.gi b/gap/projective/blackbox/blackboxClassical.gi new file mode 100644 index 000000000..29ea3c4d7 --- /dev/null +++ b/gap/projective/blackbox/blackboxClassical.gi @@ -0,0 +1,1939 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +############################################################################# + + + +################################################################################################### +################################################################################################### +######## Order algorithms ######################################################################### +################################################################################################### +################################################################################################### + + +# All the functions below can also be adjustet for permutation groups. For more details see Magma. + +# TODO: Implement next function +RECOG.IsScalarMatrix := function(g) +local i, j, d, scalar, fld, zero; + + d := NumberRows(g); + fld := FieldOfMatrixList([g]); + zero := Zero(fld); + + scalar := g[1,1]; + if scalar = zero then + return false; + fi; + + for i in [1..d] do + for j in [1..d] do + if (i = j) and g[i,j] <> scalar then + return false; + elif i <> j and g[i,j] <> zero then + return false; + fi; + od; + od; + + return true; + +end; + + +# TODO: Implement next function +RECOG.MyIsAbsolutelyIrreducibleMatrixGroup := function(G) +local module; + + module := GModuleByMats(GeneratorsOfGroup(G), FieldOfMatrixGroup(G)); + return MTX.IsAbsolutelyIrreducible(module); + +end; + + +# If g central in G, return true, else false + +# Original input: (G :: GrpMat, g :: GrpMatElt) -> BoolElt +RECOG.IsCentral := function(G, g) +local gens, ele, one, invg; + + one := One(G); + if g = one then + return true; + fi; + if IsMatrixGroup(G) and IsFinite(FieldOfMatrixGroup(G)) and RECOG.MyIsAbsolutelyIrreducibleMatrixGroup(G) then + return RECOG.IsScalarMatrix(g); + fi; + gens := GeneratorsOfGroup(G); + invg := g^(-1); + for ele in gens do + if ele^(-1)*invg*ele*g <> one then + return false; + fi; + od; + return true; +end; + + +# TODO: Modify input such that it checks that G is an abelian group +# If g central in G, return true, else false + +# Original input: (G :: GrpAb, g :: GrpAbElt) -> BoolElt +RECOG.IsCentralAb := function(G, g) + return true; +end; + + +# TODO: Modify input such that it checks that G is a pc group +# If g central in G, return true, else false + +# Original input: (G :: GrpPC, g :: GrpPCElt) -> BoolElt +RECOG.IsCentralPC := function(G, g) +local one, gens, ele, invg; + + one := One(G); + if g = one then + return true; + fi; + gens := GeneratorsOfGroup(G); + invg := g^(-1); + for ele in gens do + if ele^(-1)*invg*ele*g <> one then + return false; + fi; + od; + return true; +end; + + +# TODO: Find GAP version for function MyPow + +# Original input: (g: CGens := 0) +RECOG.MyPow := function(g, CGens) + # L, T := Can(Matrix(g)); + # _, T, L := PrimaryRationalForm(Matrix(g)); + # TI := T^-1; + # MA := Parent(T); + # x := Parent(L[1, 1]).1; + # P := Generic(Parent(g)); + + # if CGens cmpne 0 then + + # CGens := [T*X*TI: X in CGens]; + + # K := BaseRing(x); + # p := Characteristic(K); + # q := Size(K); + + # return function(n) + # M := <>; + # pos := 1; + # BL := <>; + # posL := []; + # for t in L do + + # # The following is equivalent to setting g to Modexp(x, n, f), + # # but is a bit more efficient (uses smaller exponent). + + # f := t[1]; + # d := Degree(f); + # m := q^d - 1; + # e := t[2]; + # if e gt 1 then + # beta := Ilog(p, e - 1) + 1; + # m *:= p^beta; + # f ^:= e; + # d *:= e; + # fi; + # nm := n mod m; + # g := Modexp(x, nm, f); + + # # assert g eq Modexp(x, n, f); + + + # # f := t[1]^t[2]; + # # d := Degree(f); + # # g := Modexp(x, n, f); + + # # f, g; + + # B := []; + # for i := 0 to d - 1 do + # B cat:= EltseqPad(g, d); + # g := (g*x) mod f; + # od; + + # B := Matrix(d, B); + # Append(~BL, B); + # Append(~posL, pos); + # pos +:= d; + # od; + + # for X in CGens do + # LS := MA!0; + # RS := MA!0; + + # for i := 1 to #BL do + # pos := posL[i]; + # B := BL[i]; + # d := Ncols(B); + # LB := B * RowSubmatrix(X, pos, d); + # InsertBlock(~LS, LB, pos, 1); + # RB := ColumnSubmatrix(X, pos, d) * B; + # InsertBlock(~RS, RB, 1, pos); + # delete LB, RB; + # od; + + # if LS ne RS then + # return false; + # fi; + # od; + + # return true; + # ende function, L; + + # else + + # return function(n) + # M := <>; + # pos := 1; + # S := MA!0; + # for t in L do + # f := t[1]^t[2]; + # g := Modexp(x, n, f); + # # f, g; + # d := Degree(f); + # B := []; + # for i := 0 to d - 1 do + # B cat:= EltseqPad(g, d); + # g := (g*x) mod f; + # od; + # B := Matrix(d, B); + # B := B * RowSubmatrix(T, pos, d); + # InsertBlock(~S, B, pos, 1); + # delete B; + # pos +:= d; + # od; + # return P!(TI*S); + # ende function, L; + + # fi; +end; + + +# TODO: Write the next function + +RECOG.FactoredOrder := function(g) + + return 0; + +end; + + +# smallest n such that g^n is central in H + +# Original input: (H, g : Proof := true) +RECOG.MyCentralOrder := function (H, g, Proof) +local one, flag, o, USE_MyPow2, USE_MyPow, L , pow_ic, mp, fo, proof, primes, p, m, k, found, n, ic, j, h, pow; + + one := One(H); + if g = one then + return [1, true]; + fi; + + if IsMatrixGroup(H) and IsFinite(FieldOfMatrixGroup(H)) and RECOG.MyIsAbsolutelyIrreducibleMatrixGroup(H) then + # TODO: compare ProjectiveOrder functions + #o := ProjectiveOrder(g, Proof); + #flag := o[3]; + #o := o[1]; + o := RECOG.ProjectiveOrder(g); + # TODO: add proof? + flag := true; + return [o, flag]; + fi; + + if RECOG.IsCentral(H, g) then + return [1, true]; + fi; + + USE_MyPow2 := false; + USE_MyPow2 := true ; # and Ngens(H) le 2; + + USE_MyPow := false; + USE_MyPow := true; + + # EOB addition + + if IsPerm(g) then + USE_MyPow := false; + USE_MyPow2 := false; + fi; + + + if USE_MyPow2 then + pow_ic := RECOG.MyPow(g, GeneratorsOfGroup(H)); + L := pow_ic[2]; + pow_ic := pow_ic[1]; + + mp := Lcm(List(L,t -> t[1]^t[2])); + #assert mp eq MinimalPolynomial(g); + fo := RECOG.FactoredOrder(mp, Proof); + #assert fo eq FactoredOrder(g); + if Size(fo) = 1 and fo[1, 2] = 1 then + return [fo[1, 1], Proof]; + fi; + proof := Proof; + else + if IsMatrixGroup(H) and IsFinite (FieldOfMatrixGroup(H)) then + fo := RECOG.FactoredOrder(g, Proof); + proof := fo[2]; + fo := fo[1]; + else + # EOB addition + if IsPerm(g) then + o := Order(g); + fo := Collected(Factors(o)); + else + fo := RECOG.FactoredOrder(g); + fi; + proof := true; + fi; + + # if IsPrime (o) then return o, proof; end if; + if Size(fo) = 1 and fo[1, 2] = 1 then + return [fo[1, 1], proof]; + fi; + + if USE_MyPow then + pow := RECOG.MyPow(g); + fi; + fi; + + # primes := Factorisation (o); + primes := fo; + o := RECOG.FactorizationToInteger(fo); + + for j in [1..Size(primes)] do + p := primes[j][1]; + m := primes[j][2]; + k := 0; + found := false; + repeat + n := o/p; + + if USE_MyPow2 then + ic := pow_ic(n); + else + if USE_MyPow then + h := pow(n); + else + h := g^n; + fi; + ic := RECOG.IsCentral(H, h); + fi; + + if ic then + o := n; + else + found := true; + fi; + + k := k + 1; + until found or (k = m); + od; + + return [o, proof]; +end; + + +# return smallest n such that g^n is central in its parent, +# which can be supplied as the optional argument ParentGroup. +# If Proof is false then accept a multiple of this value; +# the second value returned is true if the answer is exact. + +# Original input: (g:: GrpMatElt: ParentGroup := Parent (g), Proof := true) -> RngIntElt, BoolElt +RECOG.CentralOrder := function (g, ParentGroup, Proof) + + return RECOG.MyCentralOrder(ParentGroup, g, Proof); + +end; + + +# Original input: (g:: GrpMatElt: ParentGroup := Parent (g), Proof := true) -> RngIntElt, BoolElt +RECOG.CentralOrder := function (g) + + return RECOG.ProjectiveOrder(g); + +end; + + +# Original input: G, order: Randomiser := Internal_RandomProcess(G : WordGroup := WordGroup(G)), MaxTries := 100, Central := false, Proof := true +RECOG.MyRandomElementOfOrder := function (G, order, Randomiser, MaxTries, Central, Proof) +local g, q, r, w, i, fct, o, precise; + + if Central then + fct := RECOG.CentralOrder; + else + fct := Order; + fi; + + i := 0; + repeat + g := Random(Randomiser); + w := g[2]; + g := g[1]; + + # compute order + if IsMatrix(g) then + o := fct(g, Proof); + precise := o[2]; + o := o[1]; + q := QuoInt(o, order); + r := o mod order; + #q, r := Quotrem(o, order); + else + o := fct(g); + q := QuoInt(o, order); + r := o mod order; + # q, r := Quotrem(fct(g), order); + precise := true; + fi; + i := i + 1; + until (r = 0) or (i >= MaxTries and MaxTries > 0); + + if r <> 0 then + Print("UserUtil, 1: Element of order", order, "not found in", MaxTries, "attempts"); + return [false, fail, fail, fail]; + fi; + + return [true, g^q, w^q, precise]; +end; + + +# Original input: G, order : Randomiser := Internal_RandomProcess(G : WordGroup := WordGroup(G)), MaxTries := 100 +RECOG.MyRandomElementOfPrimeOrder := function(G, order, Randomiser, MaxTries) +local i, g, w, n, flag; + + i := 0; + repeat + g := Random(Randomiser); + w := g[2]; + g := g[1]; + + n := RECOG.PrimeOrderElement(g, order); + flag := n[2]; + n := n[1]; + i := i + 1; + until flag or (i >= MaxTries and MaxTries > 0); + + if not(flag) then + Print("UserUtil, 1: Element of order", order, "not found in", MaxTries, "attempts"); + return [false, fail, fail]; + fi; + + return [true, g^n, w^n]; +end; + + +# Search for a random element of specified prime order. +# If such is found, then return true, the element, and its SLP. +# MaxTries is the maximum number of random elements that are chosen. +# Randomiser is the random process used to construct these, +# and the SLP for the returned element is in the word group of +# this process. + +# Original input: (G :: GrpMat, order :: RngIntElt : Randomiser := Internal_RandomProcess(G : WordGroup := WordGroup(G)), MaxTries := 100) -> BoolElt, GrpMatElt, GrpSLPElt +RECOG.RandomElementOfPrimeOrder := function(G, order, Randomiser, MaxTries) + + return RECOG.MyRandomElementOfPrimeOrder(G, order, Randomiser, MaxTries); + +end; + + +# Search for a random element of specified order. +# If such is found, then return true, the element, and its SLP. +# If Proof is false, then accept +# an element whose order may be a multiple of the desired order. +# The final value returned indicates whether +# the element is known to have the precise order. +# If Central then search for an element which has this order +# modulo the centre of G. +# MaxTries is the maximum number of random elements that are chosen. +# Randomiser is the random process used to construct these, +# and the SLP for the returned element is in the word group of +# this process. + +# Original input: (G :: GrpMat, order :: RngIntElt : Randomiser := Internal_RandomProcess(G : WordGroup := WordGroup(G)), MaxTries := 100, Central := false, Proof := true) -> BoolElt, GrpMatElt, GrpSLPElt, BoolElt +RECOG.RandomElementOfOrder := function(G, order, Randomiser, MaxTries, Central, Proof) + + return RECOG.MyRandomElementOfOrder(G, order, Central, Randomiser, MaxTries, Proof); + +end; + + +# multiplicative upper bound for order of x + +RECOG.MultiplicativeUpperbound := function (x) +local F, p, q, m, facs, degs, alpha, beta, bound; + + x := StripMemory(x); + F := FieldOfMatrixList([x]); + p := Characteristic(F); + q := Size(F); + m := MinimalPolynomial(x); + facs := Collected(Factors(m)); + degs := List([1..Size(facs)], i -> Degree(facs[i][1])); + alpha := Maximum(List([1..Size(facs)], i -> facs[i][2])); + beta := Log(alpha,p); + if not(p^alpha = beta) then + beta := beta + 1; + fi; + bound := Lcm(List(degs,i-> q^i - 1)) * p^beta; + return bound; +end; + +# obtain an upper bound for the order of x as 2^k * odd, +# where the power k of 2 in the factorisation is correct; +# c^(o * bound) is the identity, o = 2^k and y = c^bound +# bound is odd + +# Aka PseudoOrder algorithm +RECOG.EstimateOrder := function (x) +local bound, k, y, o; + + bound := RECOG.MultiplicativeUpperbound(x); + + # largest odd divisor of upper bound + k := 0; + while (bound mod 2) = 0 do + k := k + 1; + bound := bound/2; + od; + + # obtain element of even order by powering up odd part + if k > 0 then + y := x^bound; + else + y := x^0; + fi; + o := Order(y); + return [bound * o, y, o, bound]; +end; + + +# can we obtain an involution which is a power of x? +# if degree and field is large, then powering up odd +# part of x and computing order of resulting 2-power element +# is faster than computing the order of x */ + +# Original input: (x: w := []) +RECOG.InvolutionIsPower := function (x, w) +local bound, y, o; + # "method 1"; + + bound := RECOG.MultiplicativeUpperbound(x); + # largest odd divisor of upper bound */ + while (bound mod 2) = 0 do + bound := bound/2; + od; + + # obtain element of even order by powering up odd part + y := x^bound; + o := Order (y); + if (o mod 2) = 0 then + y := y^(o/2); + if not(w = []) then + w := w^bound; + w := w^(o/2); + return [true, y, w]; + fi; + return [true, y, fail]; + else + return [false, fail, fail]; + fi; +end; + + +# Original input: y: w := [] +RECOG.OrderToInvolution := function (y, w) +local o; + # "method 2"; + # Order (y, Proof := false); + o := Order(y, false); + if (o mod 2) = 0 then + o := o /2; + y := y^(o); + if not(w = []) then + w := w^(o); + return [true, y, w]; + fi; + return [true, y, fail]; + else + return [false, fail, fail]; + fi; +end; + + + +# Original input: (G: Words := true) +RECOG.GenerateInvolution := function (G, Words) +local x, w, F, p, e, d; + + if Words then + # TODO: Add version with word + x := PseudoRandom(G); + w := x[2]; + x := x[1]; + else + x := PseudoRandom(G); + w := []; + fi; + + F := FieldOfMatrixGroup(G); + p := Characteristic(F); + e := Size(Factors(Size((F)))); + d := Degree(G); + + if d >= 20 and p >= 5 and e >= 1 then + return RECOG.InvolutionIsPower(x, w); + elif d >= 13 and p >= 11 and e >= 2 then + return RECOG.InvolutionIsPower(x, w); + elif d >= 9 and p >= 11 and e >= 4 then + return RECOG.InvolutionIsPower(x, w); + elif d >= 5 and p >= 11 and e >= 4 then + return RECOG.InvolutionIsPower(x, w); + elif d = 4 and p >= 11 and e >= 7 then + return RECOG.InvolutionIsPower(x, w); + elif d = 3 and p >= 11 and e >= 9 then + return RECOG.InvolutionIsPower(x, w); + elif d >= 4 and p = 7 and e >= 8 then + return RECOG.InvolutionIsPower(x, w); + elif d >= 4 and p = 5 and e >= 8 then + return RECOG.InvolutionIsPower(x, w); + elif d >= 4 and p = 3 and e >= 10 then + return RECOG.InvolutionIsPower(x, w); + else + return RECOG.OrderToInvolution(x, w); + fi; +end; + +# Fct can be Order or ProjectiveOrder; search at most Limit times for +# element of (projective) order RequiredOrder; if found return element +# and possibly word, else return false + +# Original input: (G :: Grp, RequiredOrder, Limit:: RngIntElt: Word := true, Fct := Order) -> GrpMatElt +RECOG.ElementOfOrder := function(G, RequiredOrder, Limit, Word, Fct) +local NmrTries, o, exists, g, wg, rem, x; + + if IsMatrixGroup(G) then + Fct := Order; + fi; + + if IsInt(RequiredOrder) then + RequiredOrder := Set([RequiredOrder]); + fi; + + NmrTries := Limit; + rem := false; + repeat + if Word then + # TODO: Add word version here + g := PseudoRandom(G); + wg := g[2]; + g := g[1]; + if IsBool(g) then + return [false, fail]; + fi; + else + g := PseudoRandom(G); + fi; + o := Fct(g); + NmrTries := NmrTries - 1; + for exists in RequiredOrder do + if (o mod exists) = 0 then + rem := true; + fi; + od; + until rem or (NmrTries = 0); + + if rem then + o := o/x; + if Word then + return [g^o, wg^o]; + else + return [g^o, fail]; + fi; + fi; + + return [false, fail]; + +end; + + +# p is a prime. Determine if p divides the order of g and if so +# return true, an element h of order a power of p, a +# multiplicative upper bound for order of h, +# the power of g equal to h, and a flag indicating if the upper bound +# is the true order. + +# Original input: (g :: GrpElt, p :: RngIntElt :Proof := false) -> BoolElt, GrpElt, RngIntElt, RngIntElt, BoolElt +RECOG.PrimePowerOrderElement := function(g, p, Proof) +local k, s, b, n, precise; + + if not IsPrime(p) then + Error("p must be a prime number"); + fi; + + # Avoid integer factorisation if Proof is false, + # obtain multiplicative upper bound + if IsMatrix(g) then + # TODO: Add proof version + n := Order(g, Proof); + precise := n[2]; + n := n[1]; + else + n := Order(g); + precise := true; + fi; + + # TODO: compare next function + k := Valuation(n, p); + s := k[2]; + k := k[1]; + b := g^s; + return [b <> g^0, b, p^k, s, precise]; +end; + + +# p is a prime. Determine if p divides the order of g and if so return true +# and the power of g which gives an element of order p. +# +# The algorithm is Las Vegas polynomial time, in particular it avoids +# integer factorisation. + +# Original input: (g :: GrpElt, p :: RngIntElt) -> BoolElt, RngIntElt +RECOG.PrimeOrderElement := function(g, p) +local flag, b, n, s, precise, r, bounds, i, k; + + flag := RECOG.PrimePowerOrderElement(g, p); + b := flag[2]; + n := flag[3]; + s := flag[4]; + precise := flag[5]; + flag := flag[1]; + + if flag then + if precise then + r := n/p; + flag := IsInt(r); + Assert(flag, true); + + return [true, s * r]; + else + # TODO: Add next function + k := Valuation(n, p); + + # Binary search for the correct power + bounds := [1, k]; + while bounds[2] > bounds[1] do + i := Floor(Sum(bounds)/2); + + if (b^(p^i) = g^0) then + bounds[2] := i; + else + bounds[1] := i + 1; + fi; + od; + + return [true, s * (p^(bounds[1] - 1))]; + fi; + else + return [false, fail]; + fi; +end; + + +# Original input: (G : Randomiser := Internal_RandomProcess(G : WordGroup := WordGroup(G)), MaxTries := 1000) +RECOG.RandomInvolution := function (G, Randomiser, MaxTries) +local flag, g, slp; + + repeat + flag := RECOG.RandomElementOfPrimeOrder(G, 2, Randomiser, MaxTries); + g := flag[2]; + slp := flag[3]; + flag := flag[1]; + until flag; + + return [g, slp]; +end; + +# G \leq GL(d, q). Determines if (P)SL(d, q) is contained in G. The +# algorithm is one-sided Monte Carlo and a positive answer is always +# correct. The error probability is at most ErrorProb. +# +# Randomiser is used to find random elements of G. If Projective is true then +# PSL rather than SL is used. + +# Original input: (G : Randomiser := Internal_RandomProcess(G), ErrorProb := 2^(-100), Projective := false, q := Size(CoefficientRing(G))) +RECOG.IsProbablySL2 := function(G, Randomiser, ErrorProb, Projective, q) +local foundFirst, foundSecond, order, i, prob, nrElements, fct, goodOrder1, goodOrder2; + + foundFirst := false; + foundSecond := false; + i := 0; + + # EOB -- added next line since SL(2, q) = PSL(2, q) when q is even + if (q mod 2) = 0 then + Projective := false; + fi; + + # A crude estimate of the error probability is used + nrElements := Int(Log(ErrorProb) / Log((1 - Phi(q - 1) / (q - 1)) * (1 - Phi(q + 1) / (q + 1)))) + 1; + + nrElements := Maximum([nrElements, 100]); + Print("UserUtil, 2: Checking ", nrElements, " elements\n"); + + if IsMatrixGroup(G) then + # fct := func; + fct := function(g) + return Order(g, false); + end; + else + fct := function(g) + return Order(g); + end; + fi; + + if Projective then + goodOrder1 := (q - 1)/2; + goodOrder2 := (q + 1)/2; + else + goodOrder1 := q-1; + goodOrder2 := q+1; + fi; + + # If we can find elements of order (q ± 1) / 2 then we have PSL(2, q) + repeat + order := fct(Random(Randomiser)); + + if order = goodOrder1 then + foundFirst := true; + elif order = goodOrder2 then + foundSecond := true; + fi; + + i := i + 1; + until i >= nrElements or (foundSecond and foundFirst); + + return (foundFirst and foundSecond); +end; + + +################################################################################################### +################################################################################################### +######## Bray algorithm ########################################################################### +################################################################################################### +################################################################################################### + +# Translated from Magma by DR + +# Original input: G, g, wg: Central := false, Proof := false, NumberRandom := 100, SLPs := [], +# CompletionCheck := func, +# Randomiser := Internal_RandomProcess(G : WordGroup := WordGroup(G)) + +# TODO: Add SLP version +RECOG.MyCentraliserOfInvolution := function(G, g, wg, Central, Proof, NumberRandom, SLPs, CompletionCheck, Randomiser) +local centraliser, element, commutator, q, r, residue, slpMap, word, nGens, fct, R, testset, testgroup, mat, o; + + if Central then + fct := RECOG.CentralOrder; + else + fct := Order; + fi; + + R := Randomiser; + + centraliser := [g]; + nGens := 1; + slpMap := [wg]; + + Info(InfoRecog,3,"Centraliser, 1: Starting Bray algorithm \n"); + repeat + NumberRandom := NumberRandom - 1; + element := R(G); + commutator := g^(-1)*element^(-1)*g*element; + # compute order + o := fct(commutator); + r := o mod 2; + q := Int(o/2); + + if r = 1 then + + Info(InfoRecog,3,"Centraliser, 2: Odd case \n"); + mat := element * commutator^q; + testset := MutableCopyMat(centraliser); + Add(testset, mat); + testgroup := GroupByGenerators(testset); + if Size(SmallGeneratingSet(testgroup)) > nGens then + Add(centraliser, mat); + nGens := nGens + 1; + fi; + + else + Info(InfoRecog,3,"Centraliser, 2: Even case \n"); + mat := commutator^q; + testset := MutableCopyMat(centraliser); + Add(testset, mat); + testgroup := GroupByGenerators(testset); + if Size(SmallGeneratingSet(testgroup)) > nGens then + Add(centraliser, mat); + nGens := nGens + 1; + fi; + + mat := (g^(-1) * element * g * element^(-1))^q; + testset := MutableCopyMat(centraliser); + Add(testset, mat); + testgroup := GroupByGenerators(testset); + if Size(SmallGeneratingSet(testgroup)) > nGens then + Add(centraliser, mat); + nGens := nGens + 1; + fi; + fi; + + Info(InfoRecog,3,"Centraliser, 2: Check centraliser completion \n"); + until CompletionCheck(G, centraliser, g, slpMap) or (NumberRandom = 0); + + Info(InfoRecog,3,"Centraliser, 1: Bray algorithm finished \n"); + + return [centraliser,slpMap]; +end; + + +RECOG.CompletionCheck := function(G,centraliser, g, slp) + + if Size(centraliser) >= 20 then + return true; + else + return false; + fi; + +end; + + +RECOG.MyCentraliserOfInvolutionVersion2 := function(G, g, wg, Central, Proof, NumberRandom, SLPs, CompletionCheck, Randomiser) +local centraliser, element, commutator, q, r, residue, slpMap, word, nGens, fct, R, testset, testgroup, mat, o; + + if Central then + fct := RECOG.CentralOrder; + else + fct := Order; + fi; + + R := Randomiser; + + centraliser := [g]; + nGens := 1; + slpMap := [wg]; + + Info(InfoRecog,3,"Centraliser, 1: Starting Bray algorithm \n"); + repeat + NumberRandom := NumberRandom - 1; + element := R(G); + commutator := g^(-1)*element^(-1)*g*element; + # compute order + o := fct(commutator); + r := o mod 2; + q := Int(o/2); + + if r = 1 then + + Info(InfoRecog,3,"Centraliser, 2: Odd case \n"); + mat := element * commutator^q; + if not(mat in centraliser) then + Add(centraliser, mat); + nGens := nGens + 1; + fi; + + else + Info(InfoRecog,3,"Centraliser, 2: Even case \n"); + mat := commutator^q; + if not(mat in centraliser) then + Add(centraliser, mat); + nGens := nGens + 1; + fi; + + mat := (g^(-1) * element * g * element^(-1))^q; + if not(mat in centraliser) then + Add(centraliser, mat); + nGens := nGens + 1; + fi; + fi; + + Info(InfoRecog,3,"Centraliser, 2: Check centraliser completion \n"); + until CompletionCheck(G, centraliser, g, slpMap) or (NumberRandom = 0); + + Info(InfoRecog,3,"Centraliser, 1: Bray algorithm finished \n"); + + return [centraliser,slpMap]; +end; + + +RECOG.FindSwappingElement := function(G, g, wg, NumberRandom, SLPs, Randomiser) +local centraliser, element, commutator, q, r, residue, slpMap, word, nGens, fct, R, testset, testgroup, mat, o; + + fct := RECOG.CentralOrder; + + R := Randomiser; + + centraliser := [g]; + nGens := 1; + slpMap := [wg]; + + Info(InfoRecog,3,"Centraliser, 1: Starting Bray algorithm \n"); + repeat + NumberRandom := NumberRandom - 1; + element := R(G); + commutator := g^(-1)*element^(-1)*g*element; + # compute order + o := fct(commutator); + r := o mod 2; + q := Int(o/2); + + if r = 1 then + + Info(InfoRecog,3,"Centraliser, 2: Odd case \n"); + mat := element * commutator^q; + if mat^(-1)*g*mat <> g then + return g; + fi; + + if not(mat in centraliser) then + Add(centraliser, mat); + nGens := nGens + 1; + fi; + + else + Info(InfoRecog,3,"Centraliser, 2: Even case \n"); + mat := commutator^q; + if mat^(-1)*g*mat <> g then + return g; + fi; + if not(mat in centraliser) then + Add(centraliser, mat); + nGens := nGens + 1; + fi; + + if mat^(-1)*g*mat <> g then + return g; + fi; + mat := (g^(-1) * element * g * element^(-1))^q; + if not(mat in centraliser) then + Add(centraliser, mat); + nGens := nGens + 1; + fi; + fi; + + Info(InfoRecog,3,"Centraliser, 2: Check centraliser completion \n"); + until (NumberRandom = 0); + + Info(InfoRecog,3,"Centraliser, 1: Bray algorithm finished \n"); + + return fail; +end; + + +# TODO: We need MultiplicativeUpperbound for Projective group elements +RECOG.FindSwappingElementVersion2 := function(G, g, wg, NumberRandom, SLPs, Randomiser) +local centraliser, element, commutator, q, r, residue, slpMap, word, nGens, fct, R, testset, testgroup, mat, o; + + fct := RECOG.CentralOrder; + + R := Randomiser; + + centraliser := [g]; + nGens := 1; + slpMap := [wg]; + + Info(InfoRecog,2,"Centraliser, 1: Starting Bray algorithm \n"); + repeat + NumberRandom := NumberRandom - 1; + element := R(G); + commutator := g^(-1)*element^(-1)*g*element; + # compute order + + o := RECOG.MultiplicativeUpperbound(commutator); + if o mod 2 = 0 then + r := 0; + else + r := 1; + fi; + + if r = 1 then + + o := fct(commutator); + r := o mod 2; + q := Int(o/2); + + Info(InfoRecog,2,"Centraliser, 2: Odd case \n"); + mat := element * commutator^q; + if mat^(-1)*g*mat <> g then + return g; + fi; + + if not(mat in centraliser) then + Add(centraliser, mat); + nGens := nGens + 1; + fi; + + else + Info(InfoRecog,2,"Element not good"); + fi; + + Info(InfoRecog,2,"Centraliser, 2: Check centraliser completion \n"); + until (NumberRandom = 0); + + Info(InfoRecog,2,"Centraliser, 1: Bray algorithm finished \n"); + + return fail; +end; + + +# g is an involution in G, and wg is an SLP for g. +# Return the centraliser C of g in G, and SLPs of the generators of C. +# Randomiser is the random process used to construct the +# elements and the SLP for g must lie in the word group of this process. +# +# The algorithm used is that of John Bray. Since it is Monte Carlo, +# it may return only a subgroup of the centraliser. +# +# If Central then construct the projective centraliser of g. +# The function CompletionCheck is used to determine when we have +# constructed the centraliser. It takes arguments G, C, g +# and SLPs for generators of C as input, and +# returns true or false. By default, the algorithm completes when the +# centraliser has 20 generators or considered NumberRandom elements. + +# Original input: G :: GrpMat, g :: GrpMatElt, wg :: GrpSLPElt : Central := false, NumberRandom := 100, +# CompletionCheck := func, +# Randomiser := Internal_RandomProcess(G : WordGroup := WordGroup(G)) +# Original output: GrpMat, SeqEnum +RECOG.CentraliserOfInvolution := function(G, g, wg, Central, NumberRandom, CompletionCheck, Randomiser) +local fct; + + if Central then + fct := RECOG.ProjectiveOrder; + else + fct := Order; + fi; + + if not(fct(g) = 2) then + Error("Centraliser of involution: must be an involution"); + fi; + + return RECOG.MyCentraliserOfInvolutionVersion2(G, g, wg, Central, false, NumberRandom, [], CompletionCheck, Randomiser); +end; + + +################################################################################################### +################################################################################################### +######## Black box algorithms ##################################################################### +################################################################################################### +################################################################################################### + +RECOG.BlaxBoxGoingDownStepVersion0_SL := function( grp, d, q ) +local e, eprime, B, r, ppdlist, goode, i, j, ppds, f, p, factors, counter, l, one, foundFirst, foundSecond, g, g2, ppds2, min, max; + + # Start by preparing a list of good e and corresponding ppds + factors := Factors(q); + f := Size(factors); + p := factors[1]; + one := One(grp); + foundFirst := false; + ppdlist := []; + #goode := Log2Int(d); ##Do we need this? + + min := 2; + max := Minimum([Log2Int(d), Int(d/2 - 1)]); + + # New test for making B smaller + for e in [min..max] do + #for e in [Maximum([2,Log2Int(d)])..Minimum([5*Log2Int(d), Int(d/2 - 1)])] do + eprime := d - e; + # Factors is bad since the numbers get too large. We need something else to find the ppds + ppds := Factors(PrimitivePrimeDivisors(f*e,p).ppds); + ##### Change + #ppds2 := Factors(PrimitivePrimeDivisors(f*eprime,p).ppds); + #Add(ppdlist,[e,eprime,ppds,ppds2]); + Add(ppdlist,[e,eprime,ppds]); + ##### + od; + + counter := 1; + while counter < 1000 do + g := PseudoRandom(grp); + B := 1; + if (g <> one) then + for l in ppdlist do + B := (q^(l[1])-1)*(q^(l[2])-1); + # This version works + #if (g^(B/(l[3,1])) <> one) and (g^(B/(l[4,1])) <> one) and (g^B = one) then + # break; + #fi; + if (g^B = one) then + break; + fi; + od; + fi; + + if (g^B = one) then + ppds := l[3]; + for i in ppds do + if (i > 1) and ((q^(l[2])-1) mod i <> 0) then + for j in [1..d] do + if (B mod (i^j) = 0) and (g^(B/i^j) <> one) then + #Error("here"); + foundFirst := true; + g := g^(B/i^j); + break; + fi; + od; + fi; + if foundFirst then + break; + fi; + od; + fi; + counter := counter + 1; + if foundFirst then + break; + fi; + od; + + foundSecond := false; + if foundFirst then + counter := 1; + while counter < 1000 do + g2 := PseudoRandom(grp); + B := 1; + if (g2 <> one) then + for l in ppdlist do + B := (q^(l[1])-1)*(q^(l[2])-1); + # This version works + #if (g2^(B/(l[3,1])) <> one) and (g2^(B/(l[4,1])) <> one) and (g2^B = one) then + # break; + #fi; + if (g2^B = one) then + break; + fi; + od; + fi; + + if (g2^B = one) then + ppds := l[3]; + for i in ppds do + if (i > 1) and ((q^(l[2])-1) mod i <> 0) then + for j in [1..d] do + if (B mod (i^j) = 0) and (g2^(B/i^j) <> one) then + foundSecond := true; + g2 := g2^(B/i^j); + break; + fi; + od; + fi; + if foundSecond then + break; + fi; + od; + fi; + counter := counter + 1; + if foundSecond then + break; + fi; + od; + fi; + + if foundFirst and foundSecond then + return [g,g2]; + fi; + + return fail; +end; + + +RECOG.BlaxBoxGoingDownStepVersion1_SL := function( grp, d, q ) +local e, eprime, B, r, ppdlist, goode, i, j, ppds, f, p, factors, counter, l, one, foundFirst, foundSecond, g, g2, ppds2, min, max, firstok, secondok; + + # Start by preparing a list of good e and corresponding ppds + factors := Factors(q); + f := Size(factors); + p := factors[1]; + one := One(grp); + foundFirst := false; + ppdlist := []; + #goode := Log2Int(d); ##Do we need this? + + if d <= 20 then + min := 2; + # 2*Log2Int(d)? + max := Minimum([Log2Int(d), Int(d/2 - 1)]); + else + min := Log2Int(d); + max := Minimum([5*Log2Int(d), Int(d/2 - 1)]); + fi; + + # New test for making B smaller + for e in [min..max] do + #for e in [Maximum([2,Log2Int(d)])..Minimum([5*Log2Int(d), Int(d/2 - 1)])] do + eprime := d - e; + # Factors is bad since the numbers get too large. We need something else to find the ppds + ppds := Factors(PrimitivePrimeDivisors(f*e,p).ppds); + ##### Change + #ppds2 := Factors(PrimitivePrimeDivisors(f*eprime,p).ppds); + #Add(ppdlist,[e,eprime,ppds,ppds2]); + Add(ppdlist,[e,eprime,ppds]); + ##### + od; + + counter := 1; + while counter < 1000 do + g := PseudoRandom(grp); + firstok := false; + if (g <> one) then + for l in ppdlist do + B := (q^(l[1])-1)*(q^(l[2])-1); + # This version works + #if (g^(B/(l[3,1])) <> one) and (g^(B/(l[4,1])) <> one) and (g^B = one) then + # break; + #fi; + if (g^B = one) then + firstok := true; + break; + fi; + od; + fi; + + if firstok then + ppds := l[3]; + for i in ppds do + if (i > 1) and ((q^(l[2])-1) mod i <> 0) then + #### B' := B/(i^j_max); + # B' := B/ppds; + # h := g^B'; + # if g <> one then + # foundFirst := true; + # g := h; + #fi; + for j in [1..d] do + if (B mod (i^j) = 0) and (g^(B/i^j) <> one) then + #Error("here"); + foundFirst := true; + g := g^(B/i^j); + break; + fi; + od; + fi; + if foundFirst then + break; + fi; + od; + fi; + counter := counter + 1; + if foundFirst then + break; + fi; + od; + + foundSecond := false; + if foundFirst then + counter := 1; + secondok := false; + while counter < 1000 do + g2 := PseudoRandom(grp); + if (g2 <> one) then + for l in ppdlist do + B := (q^(l[1])-1)*(q^(l[2])-1); + # This version works + #if (g2^(B/(l[3,1])) <> one) and (g2^(B/(l[4,1])) <> one) and (g2^B = one) then + # break; + #fi; + if (g2^B = one) then + secondok := true; + break; + fi; + od; + fi; + + if secondok then + ppds := l[3]; + for i in ppds do + if (i > 1) and ((q^(l[2])-1) mod i <> 0) then + for j in [1..d] do + if (B mod (i^j) = 0) and (g2^(B/i^j) <> one) then + foundSecond := true; + g2 := g2^(B/i^j); + break; + fi; + od; + fi; + if foundSecond then + break; + fi; + od; + fi; + counter := counter + 1; + if foundSecond then + break; + fi; + od; + fi; + + if foundFirst and foundSecond then + return [g,g2]; + fi; + + return fail; +end; + + +RECOG.BlaxBoxGoingDownStepVersion2_SL := function( grp, d, q ) +local e, eprime, B, r, ppdlist, goode, i, j, ppds, f, p, factors, counter, l, one, foundFirst, foundSecond, g, g2, ppds2, min, max, firstok, secondok, B2, h, NFactors; + + # Start by preparing a list of good e and corresponding ppds + factors := Factors(q); + f := Size(factors); + p := factors[1]; + one := One(grp); + foundFirst := false; + ppdlist := []; + #goode := Log2Int(d); ##Do we need this? + + if d <= 20 then + min := 2; + # 2*Log2Int(d)? + max := Minimum([Log2Int(d), Int(d/2 - 1)]); + else + min := Log2Int(d); + max := Minimum([5*Log2Int(d), Int(d/2 - 1)]); + fi; + + # New test for making B smaller + for e in [min..max] do + #for e in [Maximum([2,Log2Int(d)])..Minimum([5*Log2Int(d), Int(d/2 - 1)])] do + eprime := d - e; + # Factors is bad since the numbers get too large. We need something else to find the ppds + ppds := PrimitivePrimeDivisors(f*e,p).ppds; + ppds := ppds/Gcd(ppds,(q^eprime-1)); + NFactors := PrimeDivisors(ppds); + ppds := Product(NFactors); + ##### Change + #ppds2 := Factors(PrimitivePrimeDivisors(f*eprime,p).ppds); + #Add(ppdlist,[e,eprime,ppds,ppds2]); + Add(ppdlist,[e,eprime,ppds]); + ##### + od; + + counter := 1; + while counter < 1000 do + g := PseudoRandom(grp); + firstok := false; + if (g <> one) then + for l in ppdlist do + B := (q^(l[1])-1)*(q^(l[2])-1); + # This version works + #if (g^(B/(l[3,1])) <> one) and (g^(B/(l[4,1])) <> one) and (g^B = one) then + # break; + #fi; + if (g^B = one) then + firstok := true; + break; + fi; + od; + fi; + + if firstok then + ppds := l[3]; + B2 := B/ppds; + # if ggt((q^e'-1),ppds) = 1 then + # dont continue + h := g^B2; + if h <> one then + foundFirst := true; + g := h; + fi; + fi; + counter := counter + 1; + if foundFirst then + break; + fi; + od; + + foundSecond := false; + if foundFirst then + counter := 1; + secondok := false; + while counter < 1000 do + g2 := PseudoRandom(grp); + if (g2 <> one) then + for l in ppdlist do + B := (q^(l[1])-1)*(q^(l[2])-1); + # This version works + #if (g2^(B/(l[3,1])) <> one) and (g2^(B/(l[4,1])) <> one) and (g2^B = one) then + # break; + #fi; + if (g2^B = one) then + secondok := true; + break; + fi; + od; + fi; + + if secondok then + ppds := l[3]; + # if ggt((q^e'-1),ppds) = 1 then + # dont continue + B2 := B/ppds; + h := g2^B2; + if h <> one then + foundSecond := true; + g2 := h; + fi; + fi; + counter := counter + 1; + if foundSecond then + break; + fi; + od; + fi; + + if foundFirst and foundSecond then + return [g,g2]; + fi; + + return fail; +end; + + +RECOG.BlaxBoxGoingDownStepVersion3_SL := function( grp, d, q ) +local e, eprime, B, r, ppdlist, goode, i, j, ppds, f, p, factors, counter, l, one, foundFirst, foundSecond, g, g2, ppds2, min, max; + + # Start by preparing a list of good e and corresponding ppds + factors := Factors(q); + f := Size(factors); + p := factors[1]; + one := One(grp); + foundFirst := false; + ppdlist := []; + #goode := Log2Int(d); ##Do we need this? + + if d <= 20 then + min := 2; + # 2*Log2Int(d)? + max := Minimum([Log2Int(d), Int(d/2 - 1)]); + else + min := Log2Int(d); + max := Minimum([5*Log2Int(d), Int(d/2 - 1)]); + fi; + + # New test for making B smaller + for e in [min..max] do + #for e in [Maximum([2,Log2Int(d)])..Minimum([5*Log2Int(d), Int(d/2 - 1)])] do + eprime := d - e; + # Factors is bad since the numbers get too large. We need something else to find the ppds + ppds := Factors(PrimitivePrimeDivisors(f*e,p).ppds); + ##### Change + #ppds2 := Factors(PrimitivePrimeDivisors(f*eprime,p).ppds); + #Add(ppdlist,[e,eprime,ppds,ppds2]); + Add(ppdlist,[e,eprime,ppds]); + ##### + od; + + counter := 1; + while counter < 1000 do + g := PseudoRandom(grp); + B := 1; + if (g <> one) then + for l in ppdlist do + B := (q^(l[1])-1)*(q^(l[2])-1); + # This version works + #if (g^(B/(l[3,1])) <> one) and (g^(B/(l[4,1])) <> one) and (g^B = one) then + # break; + #fi; + if (g^B = one) then + break; + fi; + od; + fi; + + if (g^B = one) then + ppds := l[3]; + for i in ppds do + if (i > 1) and ((q^(l[2])-1) mod i <> 0) then + for j in [1..d] do + if (B mod (i^j) = 0) and (g^(B/i^j) <> one) then + #Error("here"); + foundFirst := true; + g := g^(B/i^j); + break; + fi; + od; + fi; + if foundFirst then + break; + fi; + od; + fi; + counter := counter + 1; + if foundFirst then + break; + fi; + od; + + foundSecond := false; + if foundFirst then + counter := 1; + while counter < 1000 do + g2 := PseudoRandom(grp); + B := 1; + if (g2 <> one) then + for l in ppdlist do + B := (q^(l[1])-1)*(q^(l[2])-1); + # This version works + #if (g2^(B/(l[3,1])) <> one) and (g2^(B/(l[4,1])) <> one) and (g2^B = one) then + # break; + #fi; + if (g2^B = one) then + break; + fi; + od; + fi; + + if (g2^B = one) then + ppds := l[3]; + for i in ppds do + if (i > 1) and ((q^(l[2])-1) mod i <> 0) then + for j in [1..d] do + if (B mod (i^j) = 0) and (g2^(B/i^j) <> one) then + foundSecond := true; + g2 := g2^(B/i^j); + break; + fi; + od; + fi; + if foundSecond then + break; + fi; + od; + fi; + counter := counter + 1; + if foundSecond then + break; + fi; + od; + fi; + + if foundFirst and foundSecond then + return [g,g2]; + fi; + + return fail; +end; + + +RECOG.BlaxBoxGoingDownStepVersion4_SL := function( grp, d, q ) +local e, eprime, B, r, ppdlist, goode, i, j, ppds, f, p, factors, counter, l, one, foundFirst, foundSecond, g, g2, ppds2, min, max, h; + + # Start by preparing a list of good e and corresponding ppds + factors := Factors(q); + f := Size(factors); + p := factors[1]; + one := One(grp); + foundFirst := false; + ppdlist := []; + #goode := Log2Int(d); ##Do we need this? + + if d <= 20 then + min := 2; + # 2*Log2Int(d)? + max := Minimum([Log2Int(d), Int(d/2 - 1)]); + else + min := Log2Int(d); + max := Minimum([5*Log2Int(d), Int(d/2 - 1)]); + fi; + + # New test for making B smaller + for e in [min..max] do + #for e in [Maximum([2,Log2Int(d)])..Minimum([5*Log2Int(d), Int(d/2 - 1)])] do + eprime := d - e; + # Factors is bad since the numbers get too large. We need something else to find the ppds + ppds := Factors(PrimitivePrimeDivisors(f*e,p).ppds); + ##### Change + #ppds2 := Factors(PrimitivePrimeDivisors(f*eprime,p).ppds); + #Add(ppdlist,[e,eprime,ppds,ppds2]); + ppds := Collected(ppds); + Add(ppdlist,[e,eprime,ppds]); + ##### + od; + + counter := 1; + while counter < 1000 do + g := PseudoRandom(grp); + B := 1; + if (g <> one) then + for l in ppdlist do + B := (q^(l[1])-1)*(q^(l[2])-1); + # This version works + #if (g^(B/(l[3,1])) <> one) and (g^(B/(l[4,1])) <> one) and (g^B = one) then + # break; + #fi; + if (g^B = one) then + break; + fi; + od; + fi; + + if (g^B = one) then + ppds := l[3]; + for i in ppds do + if (i[1] > 1) and ((q^(l[2])-1) mod i[1] <> 0) then + if (B mod (i[1]^(i[2])) = 0) and (g^(B/i[1]^(i[2])) <> one) then + #Error("here"); + foundFirst := true; + g := g^(B/i[1]^(i[2])); + fi; + fi; + if foundFirst then + break; + fi; + od; + fi; + counter := counter + 1; + if foundFirst then + break; + fi; + od; + + foundSecond := false; + if foundFirst then + counter := 1; + while counter < 1000 do + g2 := PseudoRandom(grp); + B := 1; + if (g2 <> one) then + for l in ppdlist do + B := (q^(l[1])-1)*(q^(l[2])-1); + # This version works + #if (g2^(B/(l[3,1])) <> one) and (g2^(B/(l[4,1])) <> one) and (g2^B = one) then + # break; + #fi; + if (g2^B = one) then + break; + fi; + od; + fi; + + if (g2^B = one) then + ppds := l[3]; + for i in ppds do + if (i[1] > 1) and ((q^(l[2])-1) mod i[1] <> 0) then + if (B mod (i[1]^(i[2])) = 0) and (g2^(B/i[1]^(i[2])) <> one) then + #Error("here"); + foundSecond := true; + g2 := g2^(B/i[1]^(i[2])); + fi; + fi; + if foundSecond then + break; + fi; + od; + fi; + counter := counter + 1; + if foundSecond then + break; + fi; + od; + fi; + + if foundFirst and foundSecond then + return [g,g2]; + fi; + + return fail; +end; + + +RECOG.BlaxBoxGoingDown_SL := function( grp, d, q ) +local currentdim, eps, counter, currentgrp, res, testgrp, infos; + + currentdim := d; + counter := 1; + eps := 1000; + currentgrp := grp; + while (currentdim > 6) and (counter < eps) do + res := RECOG.BlaxBoxGoingDownStepVersion4_SL(currentgrp, currentdim, q); + + if res <> fail then + + # For the next two lines we need a black box naming algorithm + testgrp := RECOG.LinearActionRepresentation(GroupByGenerators(res)); + infos := RecogniseClassical(testgrp); + + # Bug in RecogniseClassical. GAP says its unknown but very often after a second run he knows that its a SL + # (this bug only occurs for larger fields i.e. 2^8) + if infos.isSLContained = "unknown" then + infos := RecogniseClassical(testgrp); + if infos.isSLContained = "unknown" then + infos.isSLContained := false; + fi; + fi; + + if infos.isSLContained then + currentgrp := GroupByGenerators(res); + currentdim := Size(GeneratorsOfGroup(testgrp)[1]); + fi; + + fi; + Display("Infos about current state:"); + Print("currentdim: "); + Display(currentdim); + counter := counter + 1; + od; + + return currentgrp; +end; + + +RECOG.BlackBoxFind2StingrayElement := function( grp, d, q ) +local g, h, counter, epsilon, powercheck, factors, f, p, one, ppds2, ppdsD, B; + + factors := Factors(q); + f := Size(factors); + p := factors[1]; + one := One(grp); + epsilon := 1000; + counter := 1; + + # Initilize PPDs + ppds2 := PrimitivePrimeDivisors(f*2,p).ppds; + if (d mod 2 = 1) then + powercheck := (q^2-1)*(q^(d-2)-1)*q; + #powercheck := (q^2-1)*(q^(d-2)-1); + ppdsD := PrimitivePrimeDivisors(f*(d-2),p).ppds; + else + powercheck := (q^2-1)*(q^(d-3)-1)*q; + #powercheck := (q^2-1)*(q^(d-3)-1); + ppdsD := PrimitivePrimeDivisors(f*(d-3),p).ppds; + fi; + B := powercheck/(ppds2*ppdsD); + Print("check 1"); + + while counter < epsilon do + g := PseudoRandom(grp); + Print("check 2"); + if g^powercheck = one then + Print("check 3"); + h := g^B; + Print("check 4"); + if h <> one then + h := h^ppdsD; + Print("check 5"); + if h <> one then + return h; + fi; + fi; + fi; + counter := counter + 1; + od; + + return fail; + +end; + + + +RECOG.BlackBoxFind2StingrayElementVersion2 := function( grp, d, q ) +local g, h, counter, epsilon, powercheck, factors, f, p, one, ppds2, ppdsD, B, l, testvalue; + + factors := Factors(q); + f := Size(factors); + p := factors[1]; + one := One(grp); + epsilon := 1000; + counter := 1; + + # Initilize PPDs + ppds2 := PrimitivePrimeDivisors(f*2,p).ppds; + if (d mod 2 = 1) then + powercheck := (q^2-1)*(q^d-1); + ppdsD := PrimitivePrimeDivisors(f*d,p).ppds; + else + powercheck := (q^2-1)*(q^(d-1)-1); + ppdsD := PrimitivePrimeDivisors(f*(d-1),p).ppds; + fi; + + #Test + powercheck := (q^2-1)*(q^(d-2)-1); + ppdsD := PrimitivePrimeDivisors(f*(d-2),p).ppds; + testvalue := (q^(d-2)-1)/Gcd((q^2-1)/ppds2,Gcd(q^2-1,q^(d-2)-1)); + + B := powercheck/(ppds2); + + while counter < epsilon do + g := PseudoRandom(grp); + if g^powercheck = one then + if g^(powercheck/ppdsD) <> one and g^(powercheck/ppds2) <> one then + h := g^testvalue; + if h <> one then + return h; + fi; + fi; + fi; + counter := counter + 1; + od; + + return fail; + +end; + + + +RECOG.BlaxBoxFindSL4 := function( grp, d, q ) +local s1, s2, H, check, testgrp, infos; + + s1 := RECOG.BlackBoxFind2StingrayElement(grp, d, q); + check := false; + + repeat + s2 := RECOG.BlackBoxFind2StingrayElement(grp, d, q); + H := GroupByGenerators([s1,s2]); + + # For the next two lines we need a black box naming algorithm + testgrp := RECOG.LinearActionRepresentation(H); + if NumberRows(GeneratorsOfGroup(testgrp)[1]) = 4 then + infos := RecogniseClassical(testgrp); + + # Bug in RecogniseClassical. GAP says its unknown but very often after a second run he knows that its a SL + # (this bug only occurs for larger fields i.e. 2^8) + if infos.isSLContained = "unknown" then + infos.isSLContained := false; + fi; + + if infos.isSLContained then + check := true; + fi; + fi; + until check; + + return GroupByGenerators([s1,s2]); + +end; \ No newline at end of file diff --git a/gap/projective/classicalnatural.gi b/gap/projective/classicalnatural.gi deleted file mode 100644 index e8c92d9a6..000000000 --- a/gap/projective/classicalnatural.gi +++ /dev/null @@ -1,3300 +0,0 @@ -############################################################################# -## -## This file is part of recog, a package for the GAP computer algebra system -## which provides a collection of methods for the constructive recognition -## of groups. -## -## This files's authors include Max Neunhöffer, Ákos Seress. -## -## Copyright of recog belongs to its developers whose names are too numerous -## to list here. Please refer to the COPYRIGHT file for details. -## -## SPDX-License-Identifier: GPL-3.0-or-later -## -## -## Constructive recognition of classical groups in their natural -## representation. -## -############################################################################# - -InstallMethod( CharacteristicPolynomial, "for a memory element matrix", - [ IsMatrix and IsObjWithMemory ], - function(m) - return CharacteristicPolynomial(m!.el); - end ); - -InstallOtherMethod( \-, "for two memory elements", - [ IsMatrix and IsObjWithMemory, IsMatrix and IsObjWithMemory ], - function(m,n) - return m!.el - n!.el; - end ); - -InstallMethod( Eigenspaces, "for a field and a memory element matrix", - [ IsField, IsMatrix and IsObjWithMemory ], - function( f, m ) - return Eigenspaces(f,m!.el); - end ); - -# Obsolete stuff? - -# RECOG.RelativePrimeToqm1Part := function(q,n) -# local x,y; -# x := (q^n-1)/(q-1); -# repeat -# y := x/(q-1); -# x := NumeratorRat(y); -# until DenominatorRat(y) = q-1; -# return x; -# end; -# -# RECOG.SearchForElByCharPolFacts := function(g,f,degs,limit) -# local count,degrees,factors,pol,y; -# count := 0; -# while true do # will be left by return -# if InfoLevel(InfoRecog) >= 3 then Print(".\c"); fi; -# y:=PseudoRandom(g); -# pol:=CharacteristicPolynomial(f,f,StripMemory(y),1); -# factors:=Factors(PolynomialRing(f),pol); -# degrees:=List(factors,Degree); -# SortParallel(degrees,factors); -# if degrees = degs then -# if InfoLevel(InfoRecog) >= 3 then Print("\n"); fi; -# return rec( el := y, factors := factors, degrees := degrees ); -# fi; -# count := count + 1; -# if count >= limit then return fail; fi; -# od; -# end; -# -# RECOG.SL_Even_godownone:=function(g,subspg,q,d) -# local n,y,yy,yyy,ready,order,es,null,subsph,z,x,a,b,c,h,r,divisors,cent,i, -# pol,factors,degrees; -# -# n:=DimensionOfMatrixGroup(g); -# #d:=Dimension(subspg); -# repeat -# ready:=false; -# y:=PseudoRandom(g); -# pol:=CharacteristicPolynomial(GF(q),GF(q),StripMemory(y),1); -# factors:=Factors(pol); -# degrees:=List(factors,Degree); -# if d-1 in degrees then -# order:=Order(y); -# yy:=y^(order/Gcd(order,q-1)); -# if not IsOne(yy) then -# es:= Eigenspaces(GF(q),StripMemory(yy)); -# es:=Filtered(es,x->Dimension(x)=d-1 and IsSubspace(subspg,x)); -# if Length(es)>0 then -# subsph:=es[1]; -# ready:=true; -# fi; -# yyy:=y^(Gcd(order,q-1)); -# fi; -# fi; -# until ready; -# -# cent:=[yyy]; -# for i in [1..4] do -# z:=PseudoRandom(g); -# x:=yy^z; -# a := x; -# b := x^yy; -# c := x^(yy^2); -# h := Group(a,b,c); -# ready:=false; -# repeat -# r:=PseudoRandom(h); -# r:=r^(q*(q+1)); -# if not IsOne(r) and r*yy=yy*r then -# Add(cent,yyy^r); -# ready:=true; -# fi; -# until ready=true; -# od; -# return [Group(cent), subsph]; -# end; -# -# RECOG.SL_FindSL2 := function(g,f) -# local V,a,bas,c,count,ev,gens,genss,genssm,gl4,h,i,j,n,ns,o,pos,pow,pr,q,r, -# res,sl2gens,sl3,slp,std,v,w,y,z,zz; -# q := Size(f); -# n := DimensionOfMatrixGroup(g); -# if q = 2 then -# # We look for a transvection: -# while true do # will be left by break -# r := RECOG.SearchForElByCharPolFacts(g,f,[1,1,n-2],3*n+20); -# if r = fail then return fail; fi; -# y := r.el^(q^(n-2)-1); -# if not IsOne(y) and IsOne(y^2) then break; fi; -# od; -# # Find a good random conjugate: -# repeat -# z := y^PseudoRandom(g); -# until Order(z*y) = 3; -# gens := [y,z]; -# o := IdentityMat(n,f); -# w := []; -# for i in [1..2] do -# for j in [1..n] do -# w[i] := o[j]*gens[i]-o[j]; -# if not IsZero(w[i]) then break; fi; -# od; -# od; -# return [Group(gens),VectorSpace(GF(q),w)]; -# fi; -# if q = 3 and n = 3 then -# std := RECOG.MakeSL_StdGens(3,1,2,3); -# slp := RECOG.FindStdGensUsingBSGS(g,Concatenation(std.s,std.t), -# false,true); -# if slp = fail then return fail; fi; -# h := Group(ResultOfStraightLineProgram(slp,GeneratorsOfGroup(g))); -# o := IdentityMat(3,f); -# return [h,VectorSpace(f,o{[1..2]})]; -# fi; -# if q = 3 and n = 4 then -# std := RECOG.MakeSL_StdGens(3,1,2,4); -# slp := RECOG.FindStdGensUsingBSGS(g,Concatenation(std.s,std.t), -# false,true); -# if slp = fail then return fail; fi; -# h := Group(ResultOfStraightLineProgram(slp,GeneratorsOfGroup(g))); -# o := IdentityMat(4,f); -# return [h,VectorSpace(f,o{[1..2]})]; -# fi; -# if q = 3 then -# # We look for a transvection: -# while true do # will be left by break -# r := RECOG.SearchForElByCharPolFacts(g,f,[1,1,n-2],3*n+20); -# if r = fail then return fail; fi; -# y := r.el^(q^(n-2)-1); -# if not IsOne(y) and IsOne(y^3) then break; fi; -# od; -# # Find a two good random conjugates: -# while true do # will be left by return -# z := y^PseudoRandom(g); -# zz := y^PseudoRandom(g); -# gens := [y,z,zz]; -# o := IdentityMat(n,f); -# ns := []; -# for j in [1..3] do -# for i in [1..n] do -# w := o[i]*gens[j]-o[i]; -# if not IsZero(w) then break; fi; -# od; -# # Since y has order y at least one basis vector is moved. -# ns[j] := w; -# od; -# V := VectorSpace(f,ns); -# bas := Basis(V,ns); -# genss := List(StripMemory(gens), -# x->List(ns,i->Coefficients(bas,i*x))); -# genssm := GeneratorsWithMemory(genss); -# sl3 := Group(genssm); -# pr := ProductReplacer(genssm,rec( maxdepth := 400, scramble := 0, -# scramblefactor := 0 ) ); -# sl3!.pseudorandomfunc := [rec(func := Next,args := [pr])]; -# res := RECOG.SL_FindSL2(sl3,f); -# if res = fail then -# if InfoLevel(InfoRecog) >= 3 then Print("#\c"); fi; -# continue; -# fi; -# slp := SLPOfElms(GeneratorsOfGroup(res[1])); -# sl2gens := ResultOfStraightLineProgram(slp,gens); -# ns := BasisVectors(Basis(res[2])) * ns; -# ConvertToMatrixRep(ns,q); -# return [Group(sl2gens),VectorSpace(f,ns)]; -# od; -# fi; -# if q = 4 and n = 3 then -# std := RECOG.MakeSL_StdGens(2,2,2,3); -# slp := RECOG.FindStdGensUsingBSGS(g,Concatenation(std.s,std.t), -# false,true); -# if slp = fail then return fail; fi; -# h := Group(ResultOfStraightLineProgram(slp,GeneratorsOfGroup(g))); -# o := IdentityMat(3,f); -# return [h,VectorSpace(f,o{[1..2]})]; -# fi; -# if q = 5 and n = 4 then -# std := RECOG.MakeSL_StdGens(5,1,2,4); -# slp := RECOG.FindStdGensUsingBSGS(g,Concatenation(std.s,std.t), -# false,true); -# if slp = fail then return fail; fi; -# h := Group(ResultOfStraightLineProgram(slp,GeneratorsOfGroup(g))); -# o := IdentityMat(4,f); -# return [h,VectorSpace(f,o{[1..2]})]; -# fi; -# if n mod (q-1) <> 0 and q <> 3 then # The generic case: -# # We look for an element with n-1 dimensional eigenspace: -# count := 0; -# while true do # will be left by break -# count := count + 1; -# if count > 20 then return fail; fi; -# r := RECOG.SearchForElByCharPolFacts(g,f,[1,n-1],3*n+20); -# if r = fail then return fail; fi; -# pow := RECOG.RelativePrimeToqm1Part(q,n-1); -# y := r.el^pow; -# o := Order(y); -# if o mod (q-1) = 0 then -# y := y^(o/(q-1)); -# break; -# fi; -# od; -# # Now y has order q-1 and and n-1 dimensional eigenspace -# ev := -Value(r.factors[1],0*Z(q)); -# ns := NullspaceMat(StripMemory(r.el)-ev*StripMemory(One(y))); -# # this is a 1xn matrix now -# ns := ns[1]; -# pos := PositionNonZero(ns); -# ns := (ns[pos]^-1) * ns; -# count := 0; -# while true do # will be left by break -# count := count + 1; -# if count > 20 then return fail; fi; -# a := PseudoRandom(g); -# v := OnLines(ns,a); -# z := y^a; -# if OnLines(v,y) <> v and OnLines(ns,z) <> ns then -# # Now y and z most probably generate a GL(2,q), we need -# # the derived subgroup and then check: -# c := Comm(y,z); -# sl2gens := FastNormalClosure([y,z],[c],1); -# V := VectorSpace(f,[ns,v]); -# bas := Basis(V,[ns,v]); -# genss := List(sl2gens,x->List([ns,v],i->Coefficients(bas,i*x))); -# if RECOG.IsThisSL2Natural(genss,f) then break; fi; -# if InfoLevel(InfoRecog) >= 3 then Print("$\c"); fi; -# else -# if InfoLevel(InfoRecog) >= 3 then Print("-\c"); fi; -# fi; -# od; -# if InfoLevel(InfoRecog) >= 3 then Print("\n"); fi; -# return [Group(sl2gens),VectorSpace(f,[ns,v])]; -# fi; -# # Now q-1 does divide n, we have to do something else: -# # We look for an element with n-2 dimensional eigenspace: -# while true do # will be left by break -# r := RECOG.SearchForElByCharPolFacts(g,f,[1,1,n-2],5*n+20); -# if r = fail then return fail; fi; -# pow := RECOG.RelativePrimeToqm1Part(q,n-2); -# y := r.el^pow; -# o := Order(y); -# if o mod (q-1) = 0 then -# y := y^(o/(q-1)); -# if RECOG.IsScalarMat(y) = false then break; fi; -# fi; -# od; -# # Now y has order q-1 and n-2 dimensional eigenspace -# if r.factors[1] <> r.factors[2] then -# ev := -Value(r.factors[1],0*Z(q)); -# ns := NullspaceMat(StripMemory(r.el)-ev*StripMemory(One(y))); -# if not IsMutable(ns) then ns := MutableCopyMat(ns); fi; -# # this is a 1xn matrix now -# ev := -Value(r.factors[2],0*Z(q)); -# Append(ns,NullspaceMat(StripMemory(r.el)-ev*StripMemory(One(y)))); -# # ns now is a 2xn matrix -# else -# ev := -Value(r.factors[1],0*Z(q)); -# ns := NullspaceMat((StripMemory(r.el) -# -ev*StripMemory(One(y)))^2); -# if not IsMutable(ns) then ns := MutableCopyMat(ns); fi; -# fi; -# -# count := 0; -# while true do # will be left by break -# count := count + 1; -# if count > 20 then return fail; fi; -# if Length(ns) > 2 then ns := ns{[1..2]}; fi; -# a := PseudoRandom(g); -# Append(ns,ns * a); -# if RankMat(ns) < 4 then -# if InfoLevel(InfoRecog) >= 3 then Print("+\c"); fi; -# continue; -# fi; -# z := y^a; -# # Now y and z most probably generate a GL(4,q), we need -# # the derived subgroup and then check: -# V := VectorSpace(f,ns); -# bas := Basis(V,ns); -# genss := List([y,z],x->List(ns,i->Coefficients(bas,i*x))); -# genssm := GeneratorsWithMemory(genss); -# gl4 := Group(genssm); -# pr := ProductReplacer(genssm,rec( maxdepth := 400, scramble := 0, -# scramblefactor := 0 ) ); -# gl4!.pseudorandomfunc := [rec(func := Next,args := [pr])]; -# res := RECOG.SL_FindSL2(gl4,f); -# if res = fail then -# if InfoLevel(InfoRecog) >= 3 then Print("#\c"); fi; -# continue; -# fi; -# slp := SLPOfElms(GeneratorsOfGroup(res[1])); -# sl2gens := ResultOfStraightLineProgram(slp,[y,z]); -# ns := BasisVectors(Basis(res[2])) * ns; -# return [Group(sl2gens),VectorSpace(f,ns)]; -# od; -# return fail; -# end; -# -# -# RECOG.SL_Even_constructdata:=function(g,q) -# local S,a,b,degrees,eva,factors,gens,h,i,n,ns,o,pol,pos,ready,ready2, -# ready3,subgplist,w,ww,y,yy,z; -# -# n:=DimensionOfMatrixGroup(g); -# -# if q=2 then -# repeat -# ready:=false; -# y:=PseudoRandom(g); -# pol:=CharacteristicPolynomial(GF(q),GF(q),StripMemory(y),1); -# factors:=Factors(pol); -# degrees:=List(factors,Degree); -# if SortedList(degrees)=[1,1,n-2] then -# yy := y^(q^(n-2)-1); -# if not IsOne(yy) and IsOne(yy^2) then ready := true; fi; -# fi; -# until ready; -# repeat -# z := yy^PseudoRandom(g); -# until Order(z*yy) = 3; -# o := OneMutable(z); -# i := 1; -# while i <= n do -# w := o[i]*yy-o[i]; -# if not IsZero(w) then break; fi; -# i := i + 1; -# od; -# i := 1; -# while i <= n do -# ww := o[i]*z-o[i]; -# if not IsZero(ww) then break; fi; -# i := i + 1; -# od; -# return [Group(z,yy),VectorSpace(GF(2),[w,ww])]; -# else -# #case of q <> 2 -# repeat -# ready:=false; -# y:=PseudoRandom(g); -# if InfoLevel(InfoRecog) >= 3 then Print(".\c"); fi; -# pol:=CharacteristicPolynomial(GF(q),GF(q),StripMemory(y),1); -# factors:=Factors(pol); -# degrees:=List(factors,Degree); -# if n-1 in degrees then -# yy := y^(RECOG.RelativePrimeToqm1Part(q,n-1)); -# o := Order(yy); -# if o mod (q-1) = 0 then -# yy := yy^(o/(q-1)); -# ready := true; -# fi; -# fi; -# until ready; -# if InfoLevel(InfoRecog) >= 3 then Print("\n"); fi; -# -# ready2:=false; -# ready3:=false; -# repeat -# gens:=[yy]; -# a := PseudoRandom(g); -# b := PseudoRandom(g); -# Add(gens,yy^a); -# Add(gens,yy^b); -# h:=Group(gens); -# if q = 4 then -# S := StabilizerChain(h); -# if not Size(S) in [60480,3*60480] then continue; fi; -# pos := Position(degrees,1); -# eva := -Value(factors[pos],0*Z(q)); -# ns := NullspaceMat(StripMemory(y)-eva*One(StripMemory(y))); -# return [h, -# VectorSpace(GF(q),[ns[1],ns[1]*StripMemory(a),ns[1]*StripMemory(b)])]; -# fi; -# -# # Now check using ppd-elements: -# for i in [1..10] do -# z:=PseudoRandom(h); -# pol:=CharacteristicPolynomial(GF(q),GF(q),StripMemory(z),1); -# factors:=Factors(pol); -# degrees:=List(factors,Degree); -# if Maximum(degrees)=2 then -# ready2:=true; -# elif Maximum(degrees)=3 then -# ready3:=true; -# fi; -# if ready2 and ready3 then -# break; -# fi; -# od; -# if not (ready2 and ready3) then -# ready2:=false; -# ready3:=false; -# fi; -# until ready2 and ready3; -# -# subgplist:=RECOG.SL_Even_godownone(h,VectorSpace(GF(q),One(g)),q,3); -# fi; -# -# return subgplist; -# end; - -RECOG.FindStdGensUsingBSGS := function(g,stdgens,projective,large) - # stdgens generators for the matrix group g - # returns an SLP expressing stdgens in the generators of g - # set projective to true for projective mode - # set large to true if we should not bother finding nice base points! - local S,dim,gens,gm,i,l,strong; - dim := DimensionOfMatrixGroup(g); - if IsObjWithMemory(GeneratorsOfGroup(g)[1]) then - gm := GroupWithMemory(StripMemory(GeneratorsOfGroup(g))); - else - gm := GroupWithMemory(g); - fi; - if HasSize(g) then SetSize(gm,Size(g)); fi; - if large then - S := StabilizerChain(gm,rec( Projective := projective, - Cand := rec( points := One(g), - ops := ListWithIdenticalEntries(dim, OnLines) ) ) ); - else - S := StabilizerChain(gm,rec( Projective := projective ) ); - fi; - strong := ShallowCopy(StrongGenerators(S)); - ForgetMemory(S); - l := List(stdgens,x->SiftGroupElementSLP(S,x)); - gens := EmptyPlist(Length(stdgens)); - for i in [1..Length(stdgens)] do - if not l[i].isone then - return fail; - fi; - Add(gens,ResultOfStraightLineProgram(l[i].slp,strong)); - od; - return SLPOfElms(gens); -end; - -RECOG.ResetSLstd := function(r) - r.left := One(r.a); - r.right := One(r.a); - if not IsBound(r.cache) then - r.cache := [EmptyPlist(100),EmptyPlist(100), - List([1..r.ext],i->[]), # rowopcache - List([1..r.ext],i->[])]; # colopcache - fi; - return r; -end; - -# TODO: document the parameters -RECOG.InitSLstd := function(f,d,s,t,a,b) - local r; - r := rec( f := f, p := Characteristic(f), ext := DegreeOverPrimeField(f), - q := Size(f), d := d, all := Concatenation(s,t,[a],[b]), - one := One(f), One := One(s[1]), s := s, t := t, a := a, b := b ); - return RECOG.ResetSLstd(r); -end; - -RECOG.FindFFCoeffs := function(r,lambda) - return IntVecFFE(Coefficients(CanonicalBasis(r.f),lambda)); -end; - -# TODO: document this; what does "fake" mean???? -# Theory: the fake gens are only used for their memory. Since we are only -# interested in the memory (to produce slps), we use trivial permutations for -# the underlying group elements, so that the multiplication is cheap. -# Verify and then document this. -RECOG.InitSLfake := function(f,d) - local ext,l; - ext := DegreeOverPrimeField(f); - l := ListWithIdenticalEntries(2*ext+2,()); - l := GeneratorsWithMemory(l); - return RECOG.InitSLstd(f,d,l{[1..ext]},l{[ext+1..2*ext]}, - l[2*ext+1],l[2*ext+2]); -end; - -RECOG.DoRowOp_SL := function(m,i,j,lambda,std) - # add lambda times j-th row to i-th row, i<>j - # by left-multiplying with an expression in the standard generators: - # a : e_n -> e_{n-1} -> ... -> e_1 -> (-1)^(n+1) e_n - # b : e_n -> e_{n-1} -> ... -> e_2 -> (-1)^n e_n and e_1 -> e_1 - # s : e_1 -> e_1+ * e_2, e_i -> e_i for i > 1 - # t : e_2 -> e_1+ * e_2, e_i -> e_i for i <> 2 - # s and t are lists of length ext to span over GF(p) all the scalars - # in *. - # Note that V_i = . - # So is an SL_2 in the upper left corner, a is an n-cycle - # b is an n-1 cycle with garbage fixing the first vector - # This only modifies the record std collecting a straight line program. - local Getai,Getbj,coeffs,k,new,newnew; - - Getai := function(l) - local pos; - if l < 0 then pos := std.d - l; - else pos := l; - fi; - if not IsBound(std.cache[1][pos]) then - std.cache[1][pos] := std.a^l; - fi; - return std.cache[1][pos]; - end; - Getbj := function(l) - local pos; - if l < 0 then pos := std.d - l; - else pos := l; - fi; - if not IsBound(std.cache[2][pos]) then - std.cache[2][pos] := std.b^l; - fi; - return std.cache[2][pos]; - end; - - newnew := std.One; - coeffs := RECOG.FindFFCoeffs(std,lambda); - for k in [1..std.ext] do - if not IsZero(coeffs[k]) then - if IsBound(std.cache[3][k][i]) and - IsBound(std.cache[3][k][i][j]) then - new := std.cache[3][k][i][j]; - else; - new := std.One; - if i < j then - # We need to multiply from the left with the element - # a^(i-1) * b^(j-i-1) * s_k * b^-(j-i-1) * a^-(i-1) - # from the left. - if i > 1 then new := Getai(-(i-1)) * new; fi; - if j > i+1 then new := Getbj(-(j-i-1)) * new; fi; - new := std.s[k] * new; - if j > i+1 then new := Getbj(j-i-1) * new; fi; - if i > 1 then new := Getai(i-1) * new; fi; - elif i > j then - # We need to multiply from the left with the element - # a^(j-1) * b^(i-j-1) * t_k * b^-(i-j-1) * a^-(j-1) - # from the left. - if j > 1 then new := Getai(-(j-1)) * new; fi; - if i > j+1 then new := Getbj(-(i-j-1)) * new; fi; - new := std.t[k] * new; - if i > j+1 then new := Getbj(i-j-1) * new; fi; - if j > 1 then new := Getai(j-1) * new; fi; - fi; - if not IsBound(std.cache[3][k][i]) then - std.cache[3][k][i] := []; - fi; - std.cache[3][k][i][j] := new; - fi; - std.left := new^coeffs[k] * std.left; - newnew := new^coeffs[k] * newnew; - fi; - od; - if m <> false and not IsZero(lambda) then m[i] := m[i] + m[j] * lambda; fi; - return newnew; -end; - -RECOG.DoColOp_SL := function(m,i,j,lambda,std) - # add lambda times i-th column to j-th column, i<>j - # by left-multiplying with an expression in the standard generators: - # a : e_n -> e_{n-1} -> ... -> e_1 -> (-1)^(n+1) e_n - # b : e_n -> e_{n-1} -> ... -> e_2 -> (-1)^n e_n and e_1 -> e_1 - # s : e_1 -> e_1+ * e_2, e_i -> e_i for i > 1 - # t : e_2 -> e_1+ * e_2, e_i -> e_i for i <> 2 - # s and t are lists of length ext to span over GF(p) all the scalars - # in *. - # Note that V_i = . - # So is an SL_2 in the upper left corner, a is an n-cycle - # b is an n-1 cycle with garbage fixing the first vector - # This only modifies the record std collecting a straight line program. - local Getai,Getbj,coeffs,k,new,newnew; - - Getai := function(l) - local pos; - if l < 0 then pos := std.d - l; - else pos := l; - fi; - if not IsBound(std.cache[1][pos]) then - std.cache[1][pos] := std.a^l; - fi; - return std.cache[1][pos]; - end; - Getbj := function(l) - local pos; - if l < 0 then pos := std.d - l; - else pos := l; - fi; - if not IsBound(std.cache[2][pos]) then - std.cache[2][pos] := std.b^l; - fi; - return std.cache[2][pos]; - end; - - newnew := std.One; - coeffs := RECOG.FindFFCoeffs(std,lambda); - for k in [1..std.ext] do - if not IsZero(coeffs[k]) then - if IsBound(std.cache[4][k][i]) and - IsBound(std.cache[4][k][i][j]) then - new := std.cache[4][k][i][j]; - else; - new := std.One; - if i < j then - # We need to multiply from the right with the element - # a^(i-1) * b^(j-i-1) * s_k * b^-(j-i-1) * a^-(i-1) - # from the right. - if i > 1 then new := Getai(-(i-1)) * new; fi; - if j > i+1 then new := Getbj(-(j-i-1)) * new; fi; - new := std.s[k] * new; - if j > i+1 then new := Getbj(j-i-1) * new; fi; - if i > 1 then new := Getai(i-1) * new; fi; - elif i > j then - # We need to multiply from the right with the element - # a^(j-1) * b^(i-j-1) * t_k * b^-(i-j-1) * a^-(j-1) - # from the left. - if j > 1 then new := Getai(-(j-1)) * new; fi; - if i > j+1 then new := Getbj(-(i-j-1)) * new; fi; - new := std.t[k] * new; - if i > j+1 then new := Getbj(i-j-1) * new; fi; - if j > 1 then new := Getai(j-1) * new; fi; - fi; - if not IsBound(std.cache[4][k][i]) then - std.cache[4][k][i] := []; - fi; - std.cache[4][k][i][j] := new; - fi; - std.right := std.right * new^coeffs[k]; - newnew := newnew * new^coeffs[k]; - fi; - od; - if m <> false and not IsZero(lambda) then - for k in [1..Length(m)] do - m[k][j] := m[k][j] + m[k][i] * lambda; - od; - fi; - - return newnew; -end; - -RECOG.MakeSL_StdGens := function(p,ext,n,d) - local a,b,f,i,q,s,t,x,res; - f := GF(p,ext); - q := Size(f); - a := IdentityMat(d,f); - a := a{Concatenation([n],[1..n-1],[n+1..d])}; - ConvertToMatrixRep(a,q); - b := IdentityMat(d,f); - b := b{Concatenation([1,n],[2..n-1],[n+1..d])}; - ConvertToMatrixRep(b,q); - if IsEvenInt(n) then - a[1] := -a[1]; - else - b[2] := -b[2]; - fi; - s := []; - t := []; - for i in [0..ext-1] do - x := IdentityMat(d,f); - x[1,2] := Z(p,ext)^i; - Add(s,x); - x := IdentityMat(d,f); - x[2,1] := Z(p,ext)^i; - Add(t,x); - od; - res := rec( s := s, t := t, a := a, b := b, f := f, q := q, p := p, - ext := ext, One := IdentityMat(d,f), one := One(f), - d := d ); - res.all := Concatenation( res.s, res.t, [res.a], [res.b] ); - return res; -end; - -RECOG.ExpressInStd_SL2 := function(m,std) - local mi; - - if IsObjWithMemory(m) then - mi := InverseMutable(StripMemory(m)); - else - mi := InverseMutable(m); - fi; - std.left := std.One; - if not IsOne(mi[1,1]) then - if IsZero(mi[2,1]) then - RECOG.DoRowOp_SL(mi,2,1,std.one,std); - # Now mi[2,1] is non-zero - fi; - RECOG.DoRowOp_SL(mi,1,2,(std.one-mi[1,1])/mi[2,1],std); - fi; - # Now mi[1,1] is equal to one - if not IsZero(mi[2,1]) then - RECOG.DoRowOp_SL(mi,2,1,-mi[2,1],std); - fi; - # Now mi[2,1] is equal to zero and thus mi[2,2] equal to one - if not IsZero(mi[1,2]) then - RECOG.DoRowOp_SL(mi,1,2,-mi[1,2],std); - fi; - # Now mi is the identity matrix, the element collected in std - # is the one to multiply on the left hand side to transform mi to the - # identity. Thus it is equal to m. - return SLPOfElm(std.left); -end; - -RECOG.ExpressInStd_SL := function(m,std) - # m a matrix, std a fake standard generator record with trivial - # generators with memory - local d,i,j,mi,pos; - - if IsObjWithMemory(m) then - mi := InverseMutable(StripMemory(m)); - else - mi := InverseMutable(m); - fi; - std.left := std.One; - d := Length(m); - for i in [1..d] do - if not IsOne(mi[i,i]) then - pos := First([i+1..d],k->not IsZero(mi[k,i])); - if pos = fail then - pos := i+1; - RECOG.DoRowOp_SL(mi,pos,i,std.one,std); - fi; - RECOG.DoRowOp_SL(mi,i,pos,(std.one-mi[i,i])/mi[pos,i],std); - fi; - # Now mi[i,i] is equal to one - for j in Concatenation([1..i-1],[i+1..d]) do - if not IsZero(mi[j,i]) then - RECOG.DoRowOp_SL(mi,j,i,-mi[j,i],std); - fi; - od; - # Now mi[i,i] is the only non-zero entry in the column - od; - # Now mi is the identity matrix, the element collected in std - # is the one to multiply on the left hand side to transform mi to the - # identity. Thus it is equal to m. - return SLPOfElm(std.left); -end; - - - -# BindGlobal("FunnyProductObjsFamily",NewFamily("FunnyProductObjsFamily")); -# DeclareCategory("IsFunnyProductObject", -# IsPositionalObjectRep and IsMultiplicativeElement and -# IsMultiplicativeElementWithInverse ); -# BindGlobal("FunnyProductObjsType", -# NewType(FunnyProductObjsFamily,IsFunnyProductObject)); -# DeclareOperation("FunnyProductObj",[IsObject,IsObject]); -# -# -# InstallOtherMethod( \*, "for two funny product objects", -# [ IsFunnyProductObject, IsFunnyProductObject ], -# function(a,b) -# return Objectify(FunnyProductObjsType,[a![1]+a![2]*b![1],a![2]*b![2]]); -# end ); -# -# InstallOtherMethod( InverseSameMutability, "for a funny product object", -# [ IsFunnyProductObject ], -# function(a) -# local i; -# i := a![2]^-1; -# return Objectify(FunnyProductObjsType,[-i*a![1],i]); -# end ); -# -# InstallOtherMethod( OneMutable, "for a funny product object", -# [ IsFunnyProductObject ], -# function(a) -# return Objectify(FunnyProductObjsType,[Zero(a![1]),OneMutable(a![2])]); -# end ); -# -# InstallMethod( FunnyProductObj, "for two arbitrary objects", -# [ IsObject, IsObject ], -# function(a,b) -# return Objectify(FunnyProductObjsType,[a,b]); -# end ); -# -# FIXME: unused? but see misc/work/DOWORK. -# Perhaps this was / is meant as a replacement for RECOG.FindStdGens_SL -# in even characteristic. -# But in a quick test based on misc/work/DOWORK, the code there -# seems to be faster. -# RECOG.FindStdGens_SL_EvenChar := function(sld,f) -# # gens of sld must be gens for SL(d,q) in its natural rep with memory -# # This function calls RECOG.SL_Even_constructdata and then extends -# # the basis to a basis of the full row space and returns an slp such -# # that the SL(d,q) standard generators with respect to this basis are -# # expressed by the slp in terms of the original generators of sld. -# local V,b,bas,basi,basit,d,data,diffv,diffw,el,ext,fakegens,gens,i,id, -# lambda,mu,n,notinv,nu,nu2,oldyf,oldyy,p,pos,q,resl2,sl2,sl2gens, -# sl2gensf,sl2genss,sl2stdf,slp,slpsl2std,slptosl2,st,std,stdsl2, -# w,x,xf,y,y2f,y3f,yf,yy,yy2,yy3,yyy,yyy2,yyy3,z,zf,zzz,goodguy; -# -# # Some setup: -# p := Characteristic(f); -# q := Size(f); -# ext := DegreeOverPrimeField(f); -# d := DimensionOfMatrixGroup(sld); -# if not IsObjWithMemory(GeneratorsOfGroup(sld)[1]) then -# sld := GroupWithMemory(sld); -# fi; -# -# # First find an SL2 with the space it acts on: -# Info(InfoRecog,2,"Finding an SL2..."); -# #data := RECOG.SL_Even_constructdata(sld,q); -# repeat -# data := RECOG.SL_FindSL2(sld,f); -# until data <> fail; -# bas := ShallowCopy(BasisVectors(Basis(data[2]))); -# sl2 := data[1]; -# slptosl2 := SLPOfElms(GeneratorsOfGroup(sl2)); -# -# # Now compute the natural SL2 action and run constructive recognition: -# sl2gens := StripMemory(GeneratorsOfGroup(sl2)); -# V := VectorSpace(f,bas); -# b := Basis(V,bas); -# sl2genss := List(sl2gens,x->List(BasisVectors(b),v->Coefficients(b,v*x))); -# for i in sl2genss do -# ConvertToMatrixRep(i,q); -# od; -# Info(InfoRecog,2, -# "Recognising this SL2 constructively in 2 dimensions..."); -# sl2genss := GeneratorsWithMemory(sl2genss); -# if IsEvenInt(q) then -# resl2 := RECOG.RecogniseSL2NaturalEvenChar(Group(sl2genss),f,false); -# else -# resl2 := RECOG.RecogniseSL2NaturalOddCharUsingBSGS(Group(sl2genss),f); -# fi; -# slpsl2std := SLPOfElms(resl2.all); -# bas := resl2.bas * bas; -# # We need the actual transvections: -# slp := SLPOfElms([resl2.s[1],resl2.t[1]]); -# st := ResultOfStraightLineProgram(slp,StripMemory(GeneratorsOfGroup(sl2))); -# -# # Extend basis by something invariant under SL2: -# id := IdentityMat(d,f); -# nu := NullspaceMat(StripMemory(st[1]-id)); -# nu2 := NullspaceMat(StripMemory(st[2]-id)); -# Append(bas,SumIntersectionMat(nu,nu2)[2]); -# ConvertToMatrixRep(bas,q); -# basi := bas^-1; -# basit := TransposedMatMutable(basi); -# -# # Now set up fake generators for keeping track what we do: -# fakegens := ListWithIdenticalEntries(Length(GeneratorsOfGroup(sld)),()); -# fakegens := GeneratorsWithMemory(fakegens); -# sl2gensf := ResultOfStraightLineProgram(slptosl2,fakegens); -# sl2stdf := ResultOfStraightLineProgram(slpsl2std,sl2gensf); -# std := RECOG.InitSLstd(f,d,sl2stdf{[1..ext]},sl2stdf{[ext+1..2*ext]}, -# sl2stdf[2*ext+1],sl2stdf[2*ext+2]); -# -# # workrec := rec( n := 2, slnstdf := sl2stdf, bas := bas, basi := basi, -# # std := std, sld := sld, sldf := fakegens, f := f ); -# # -# #Error("... now go on with alternative going up..."); -# -# Info(InfoRecog,2,"Going up to SL_d again..."); -# for n in [Dimension(data[2])..d-1] do -# if InfoLevel(InfoRecog) >= 3 then Print(n," \c"); fi; -# while true do # will be left by break at the end -# x := PseudoRandom(sld); -# slp := SLPOfElm(x); -# xf := ResultOfStraightLineProgram(slp,fakegens); -# # From now on plain matrices, we have to keep track with the -# # fake ones! -# x := StripMemory(x); -# -# # Find a new basis vector: -# y := st[1]^x; -# notinv := First([1..n],i->bas[i]*y<>bas[i]); -# if notinv = fail then continue; fi; # try next x -# w := bas[notinv]*y-bas[notinv]; -# if ForAll(basit{[n+1..d]},v->IsZero(ScalarProduct(v,w))) then -# continue; # try next x -# fi; -# # Now make it so that w is invariant under SL_n by modifying -# # it by something in the span of bas{[1..n]}: -# for i in [1..n] do -# w := w - bas[i] * ScalarProduct(w,basit[i]); -# od; -# if w*y=w then -# if InfoLevel(InfoRecog) >= 3 then Print("!\c"); fi; -# continue; -# fi; -# -# # w is supposed to become the next basis vector number n+1. -# # So we need to throw away one of bas{[n+1..d]}: -# i := First([n+1..d],i->not IsZero(ScalarProduct(w,basit[i]))); -# Remove(bas,i); -# Add(bas,w,n+1); -# # However, we want that the rest of them bas{[n+2..d]} is invariant -# # under y which we can achieve by adding a multiple of w: -# diffw := w*y-w; -# pos := PositionNonZero(diffw); -# for i in [n+2..d] do -# diffv := bas[i]*y-bas[i]; -# if not IsZero(diffv) then -# bas[i] := bas[i] - (diffv[pos]/diffw[pos]) * w; -# fi; -# od; -# basi := bas^-1; -# basit := TransposedMat(basi); -# -# # Compute the action of y-One(y) on Span(bas{[1..n+1]}) -# yy := EmptyPlist(n+1); -# for i in [1..n+1] do -# Add(yy,(bas[i]*y-bas[i])*basi); -# yy[i] := yy[i]{[1..n+1]}; -# od; -# if q > 2 and IsOne(yy[n+1,n+1]) then -# if InfoLevel(InfoRecog) >= 3 then Print("#\c"); fi; -# continue; -# fi; -# ConvertToMatrixRep(yy,q); -# break; -# od; -# yf := xf^-1*std.s[1]*xf; -# -# # make sure that rows n-1 and n are non-zero: -# std.left := std.One; -# std.right := std.One; -# if IsZero(yy[n-1]) then -# RECOG.DoRowOp_SL(yy,n-1,notinv,std.one,std); -# RECOG.DoColOp_SL(yy,n-1,notinv,-std.one,std); -# fi; -# if IsZero(yy[n]) then -# RECOG.DoRowOp_SL(yy,n,notinv,std.one,std); -# RECOG.DoColOp_SL(yy,n,notinv,-std.one,std); -# fi; -# yf := std.left * yf * std.right; -# -# oldyy := MutableCopyMat(yy); -# oldyf := yf; -# -# if q = 2 then -# # In this case y is already good after cleaning out! -# # (remember that y+One(y) has rank 1 and does not fix bas[notinv]) -# std.left := std.One; -# std.right := std.One; -# for i in [1..n-1] do -# lambda := -yy[i,n+1]/yy[n,n+1]; -# RECOG.DoRowOp_SL(yy,i,n,lambda,std); -# RECOG.DoColOp_SL(yy,i,n,-lambda,std); -# od; -# yf := std.left * yf * std.right; -# z := yy+One(yy); -# zf := yf; -# if not IsZero(z[n,n]) or not IsOne(z[n,n+1]) or -# not IsZero(z[n+1,n+1]) or not IsOne(z[n+1,n]) then -# ErrorNoReturn("How on earth could this happen???"); -# fi; -# else # q > 2 -# while true do # will be left by break when we had success! -# # Note that by construction yy[n,n+1] is not zero! -# yy2 := MutableCopyMat(yy); -# std.left := std.One; -# std.right := std.One; -# # We want to be careful not to kill row n: -# repeat -# lambda := PrimitiveRoot(f)^Random(0,q-1); -# until lambda <> -yy2[n,n+1]/yy2[n-1,n+1]; -# RECOG.DoRowOp_SL(yy2,n,n-1,lambda,std); -# RECOG.DoColOp_SL(yy2,n,n-1,-lambda,std); -# mu := lambda; -# y2f := std.left * yf * std.right; -# -# yy3 := MutableCopyMat(yy); -# std.left := std.One; -# std.right := std.One; -# # We want to be careful not to kill row n: -# repeat -# lambda := PrimitiveRoot(f)^Random(0,q-1); -# until (lambda <> -yy3[n,n+1]/yy3[n-1,n+1]) and -# (lambda <> mu or q = 3); -# # in GF(3) there are not enough values! -# RECOG.DoRowOp_SL(yy3,n,n-1,lambda,std); -# RECOG.DoColOp_SL(yy3,n,n-1,-lambda,std); -# y3f := std.left * yf * std.right; -# -# # We now perform conjugations such that the ys leave -# # bas{[1..n-1]} fixed: -# -# # (remember that y-One(y) has rank 1 and does not fix bas[notinv]) -# std.left := std.One; -# std.right := std.One; -# for i in [1..n-1] do -# lambda := -yy[i,n+1]/yy[n,n+1]; -# RECOG.DoRowOp_SL(yy,i,n,lambda,std); -# RECOG.DoColOp_SL(yy,i,n,-lambda,std); -# od; -# yf := std.left * yf * std.right; -# -# std.left := std.One; -# std.right := std.One; -# for i in [1..n-1] do -# lambda := -yy2[i,n+1]/yy2[n,n+1]; -# RECOG.DoRowOp_SL(yy2,i,n,lambda,std); -# RECOG.DoColOp_SL(yy2,i,n,-lambda,std); -# od; -# y2f := std.left * y2f * std.right; -# -# std.left := std.One; -# std.right := std.One; -# for i in [1..n-1] do -# lambda := -yy3[i,n+1]/yy3[n,n+1]; -# RECOG.DoRowOp_SL(yy3,i,n,lambda,std); -# RECOG.DoColOp_SL(yy3,i,n,-lambda,std); -# od; -# y3f := std.left * y3f * std.right; -# -# gens :=[ExtractSubMatrix(yy,[n,n+1],[n,n+1])+IdentityMat(2,f), -# ExtractSubMatrix(yy2,[n,n+1],[n,n+1])+IdentityMat(2,f), -# ExtractSubMatrix(yy3,[n,n+1],[n,n+1])+IdentityMat(2,f)]; -# if RECOG.IsThisSL2Natural(gens,f) = true then break; fi; -# if InfoLevel(InfoRecog) >= 3 then Print("$\c"); fi; -# yy := MutableCopyMat(oldyy); -# yf := oldyf; -# od; -# -# # Now perform a constructive recognition in the SL2 in the lower -# # right corner: -# gens := GeneratorsWithMemory(gens); -# if IsEvenInt(q) then -# resl2 := RECOG.RecogniseSL2NaturalEvenChar(Group(gens),f,gens[1]); -# else -# resl2 := RECOG.RecogniseSL2NaturalOddCharUsingBSGS(Group(gens),f); -# fi; -# stdsl2 := RECOG.InitSLfake(f,2); -# goodguy := Reversed(IdentityMat(2,f)); -# goodguy[1,2] := - goodguy[1,2]; -# slp := RECOG.ExpressInStd_SL2(resl2.bas*goodguy*resl2.basi,stdsl2); -# el := ResultOfStraightLineProgram(slp,resl2.all); -# slp := SLPOfElm(el); -# -# yy := yy+One(yy); -# yy2 := yy2+One(yy2); -# yy3 := yy3+One(yy3); -# yyy := FunnyProductObj(ExtractSubMatrix(yy,[n,n+1],[1..n-1]), -# ExtractSubMatrix(yy,[n,n+1],[n,n+1])); -# yyy2 := FunnyProductObj(ExtractSubMatrix(yy2,[n,n+1],[1..n-1]), -# ExtractSubMatrix(yy2,[n,n+1],[n,n+1])); -# yyy3 := FunnyProductObj(ExtractSubMatrix(yy3,[n,n+1],[1..n-1]), -# ExtractSubMatrix(yy3,[n,n+1],[n,n+1])); -# zzz := ResultOfStraightLineProgram(slp,[yyy,yyy2,yyy3]); -# z := OneMutable(yy); -# CopySubMatrix(zzz![1],z,[1..2],[n,n+1],[1..n-1],[1..n-1]); -# CopySubMatrix(zzz![2],z,[1..2],[n,n+1],[1..2],[n,n+1]); -# zf := ResultOfStraightLineProgram(slp,[yf,y2f,y3f]); -# fi; -# -# std.left := std.One; -# std.right := std.One; -# # Now we clean out the last row of z: -# for i in [1..n-1] do -# if not IsZero(z[n+1,i]) then -# RECOG.DoColOp_SL(z,n,i,-z[n+1,i],std); -# fi; -# od; -# # Now we clean out the second last row of z: -# for i in [1..n-1] do -# if not IsZero(z[n,i]) then -# RECOG.DoRowOp_SL(z,n,i,-z[n,i],std); -# fi; -# od; -# zf := std.left * zf * std.right; -# -# # Now change the standard generators in the fakes: -# std.a := std.a * zf; -# std.b := std.b * zf; -# std.all[std.ext*2+1] := std.a; -# std.all[std.ext*2+2] := std.b; -# RECOG.ResetSLstd(std); -# -# od; -# if InfoLevel(InfoRecog) >= 3 then Print(".\n"); fi; -# return rec( slpstd := SLPOfElms(std.all), bas := bas, basi := basi ); -# end; - -# TODO: which algorithm is this? reference? -RECOG.FindStdGens_SL := function(sld,f) - # gens of sld must be gens for SL(d,q) in its natural rep with memory - # This function calls RECOG.SLn_constructsl2 and then extends - # the basis to a basis of the full row space and calls - # RECOG.SLn_UpStep often enough. Finally it returns an slp such - # that the SL(d,q) standard generators with respect to this basis are - # expressed by the slp in terms of the original generators of sld. - local V,b,bas,basi,basit,d,data,ext,fakegens,id,nu,nu2,p,q,resl2,sl2,sl2gens, - sl2gensf,sl2genss,sl2stdf,slp,slpsl2std,slptosl2,st,std,stdgens,i,ex; - - # Some setup: - p := Characteristic(f); - q := Size(f); - ext := DegreeOverPrimeField(f); - d := DimensionOfMatrixGroup(sld); - if not IsObjWithMemory(GeneratorsOfGroup(sld)[1]) then - sld := GroupWithMemory(sld); - fi; - - # First find an SL2 with the space it acts on: - Info(InfoRecog,2,"Finding an SL2..."); - data := RECOG.SLn_constructsl2(sld,d,q); - - bas := ShallowCopy(BasisVectors(Basis(data[2]))); - sl2 := data[1]; - slptosl2 := SLPOfElms(GeneratorsOfGroup(sl2)); - sl2gens := StripMemory(GeneratorsOfGroup(sl2)); - V := data[2]; - b := Basis(V,bas); - sl2genss := List(sl2gens,x->RECOG.LinearAction(b,f,x)); - - if q in [2,3,4,5,9] then - Info(InfoRecog,2,"In fact found an SL4..."); - stdgens := RECOG.MakeSL_StdGens(p,ext,4,4).all; - slpsl2std := RECOG.FindStdGensUsingBSGS(Group(sl2genss),stdgens, - false,false); - nu := List(sl2gens,x->NullspaceMat(x-One(x))); - ex := SumIntersectionMat(nu[1],nu[2])[2]; - for i in [3..Length(nu)] do - ex := SumIntersectionMat(nu[3],ex); - od; - Append(bas,ex); - ConvertToMatrixRep(bas,q); - basi := bas^-1; - else - # Now compute the natural SL2 action and run constructive recognition: - Info(InfoRecog,2, - "Recognising this SL2 constructively in 2 dimensions..."); - sl2genss := GeneratorsWithMemory(sl2genss); - if IsEvenInt(q) then - resl2 := RECOG.RecogniseSL2NaturalEvenChar(Group(sl2genss),f,false); - else - resl2 := RECOG.RecogniseSL2NaturalOddCharUsingBSGS(Group(sl2genss),f); - fi; - slpsl2std := SLPOfElms(resl2.all); - bas := resl2.bas * bas; - # We need the actual transvections: - slp := SLPOfElms([resl2.s[1],resl2.t[1]]); - st := ResultOfStraightLineProgram(slp, - StripMemory(GeneratorsOfGroup(sl2))); - - # Extend basis by something invariant under SL2: - id := IdentityMat(d,f); - nu := NullspaceMat(StripMemory(st[1]-id)); - nu2 := NullspaceMat(StripMemory(st[2]-id)); - Append(bas,SumIntersectionMat(nu,nu2)[2]); - ConvertToMatrixRep(bas,q); - basi := bas^-1; - fi; - - # Now set up fake generators for keeping track what we do: - fakegens := ListWithIdenticalEntries(Length(GeneratorsOfGroup(sld)),1); - fakegens := GeneratorsWithMemory(fakegens); - sl2gensf := ResultOfStraightLineProgram(slptosl2,fakegens); - sl2stdf := ResultOfStraightLineProgram(slpsl2std,sl2gensf); - std := rec( f := f, d := d, n := 2, bas := bas, basi := basi, - sld := sld, sldf := fakegens, slnstdf := sl2stdf, - p := p, ext := ext ); - Info(InfoRecog,2,"Going up to SL_d again..."); - while std.n < std.d do - RECOG.SLn_UpStep(std); - od; - return rec( slpstd := SLPOfElms(std.slnstdf), - bas := std.bas, basi := std.basi ); -end; - -RECOG.RecogniseSL2NaturalOddCharUsingBSGS := function(g,f) - local ext,p,q,res,slp,std; - p := Characteristic(f); - ext := DegreeOverPrimeField(f); - q := Size(f); - std := RECOG.MakeSL_StdGens(p,ext,2,2); - slp := RECOG.FindStdGensUsingBSGS(g,std.all,false,true); - if slp = fail then - return fail; - fi; - res := rec( g := g, one := One(f), One := One(g), f := f, q := q, - p := p, ext := ext, d := 2, bas := IdentityMat(2,f), - basi := IdentityMat(2,f) ); - res.all := ResultOfStraightLineProgram(slp,GeneratorsOfGroup(g)); - res.s := res.all{[1..ext]}; - res.t := res.all{[ext+1..2*ext]}; - res.a := res.all[2*ext+1]; - res.b := res.all[2*ext+2]; - return res; -end; - -RECOG.RecogniseSL2NaturalEvenChar := function(g,f,torig) - # f a finite field, g equal to SL(2,Size(f)), t either an involution - # or false. - # Returns a set of standard generators for SL_2 and the base change - # to expose it. Works with memory. Uses PseudoRandom. - local a,actpos,am,b,bas,bm,c,can,ch,cm,co,co2,el,ev,eva,evb,evbi,ext,gens, - i,j,k,kk,mas,masi,mat,mati,mb,o,one,os,pos,q,res,s,ss,ssm,t,tb,tm, - tt,ttm,u,v,x,xb,xm; - - q := Size(f); - gens := GeneratorsOfGroup(g); - if torig = false then - for a in gens do - if not IsOne(a) and IsOne(a^2) then - torig := a; - break; - fi; - od; - fi; - if torig = false then - # if no involution t has been given, compute one, using Proposition 4 from - # [KK15]. - repeat - am:=PseudoRandom(g); - until not IsOneProjective(am); - k := Order(am); - if IsEvenInt(k) then - tm := am^(k/2); - else - # find a conjugate of a which does not commute with a. - repeat - bm := am^PseudoRandom(g); - cm := am*bm; - tm := bm*am; - until cm<>tm; - tm := tm^-1 * cm; - if not IsOneProjective(StripMemory(tm)^2) then - tm := cm^((q^2-2)/2) * am; - fi; - fi; - else - tm := torig; - fi; - t := StripMemory(tm); - - Assert(1, IsOne(t^2)); - - ch := Factors(CharacteristicPolynomial(f,f,t,1)); - if Length(ch) <> 2 or ch[1] <> ch[2] then - ErrorNoReturn("matrix is not triagonalizable - this should never happen!"); - fi; - - one := OneMutable(t); - bas := MutableCopyMat(NullspaceMat(Value(ch[1],t))); - Add(bas,one[1]); - if RankMat(bas) < 2 then - bas[2] := one[2]; - fi; - tb := bas*t*bas^-1; - can := CanonicalBasis(f); - tt := [t]; - ttm := [tm]; - mat := [Coefficients(can,tb[2,1])]; - mb := MutableBasis(GF(2),mat); - o := [gens[1]]; - os := [gens[1]]; - actpos := 1; - j := 1; - ext := DegreeOverPrimeField(f); - while Length(tt) < ext do - repeat - repeat - while j > Length(o) do - for k in gens do - kk := o[actpos]*k; - pos := PositionSorted(os,kk); - if pos > Length(os) or os[pos] <> kk then - Add(o,kk); - Add(os,kk,pos); - fi; - od; - actpos := actpos + 1; - od; - xm := o[j]; - j := j + 1; - c := Comm(tm,xm); - until not IsOne(c^2); - xm := xm * c^(((q-1)*(q+1)-1)/2); - x := StripMemory(xm); - xb := bas*x*bas^-1; - co := Coefficients(can,xb[2,1]); - until not IsContainedInSpan(mb,co); - CloseMutableBasis(mb,co); - Add(tt,x); - Add(ttm,xm); - Add(mat,co); - od; - ConvertToMatrixRep(mat,2); - mati := mat^-1; - - # Now we can add an arbitrary multiple of the first row to the - # second and an arbitrary multiple of the second column to the first. - # Therefore we quickly find other complimentary transvections: - ss := []; - ssm := []; - mas := []; - mb := MutableBasis(GF(2),mas,ZeroMutable(mat[1])); - j := 1; - while Length(ss) < ext do - while true do # will be left by break - repeat - while j > Length(o) do - for k in gens do - kk := o[actpos]*k; - pos := PositionSorted(os,kk); - if pos > Length(os) or os[pos] <> kk then - Add(o,kk); - Add(os,kk,pos); - fi; - od; - actpos := actpos + 1; - od; - xm := o[j]; - j := j + 1; - x := MutableCopyMat(bas*StripMemory(xm)*bas^-1); - until not IsZero(x[1,2]); - - if not IsOne(x[2,2]) then - el := (One(f)-x[2,2])/x[1,2]; - co := Coefficients(can,el) * mati; - for i in [1..Length(co)] do - if not IsZero(co[i]) then - xm := ttm[i] * xm; - fi; - od; - x[2] := x[2] + x[1] * el; - if x <> bas*StripMemory(xm)*bas^-1 then - # FIXME: sometimes triggered by RecognizeGroup(GL(2,16)); - ErrorNoReturn("!!!"); - fi; - fi; - # now x[2,2] is equal to One(f) - # we postpone the actual computation of the final x until we - # know it is needed: - co := Coefficients(can,x[1,2]); - if IsContainedInSpan(mb,co) then continue; fi; - # OK, we need it, so let's make it: - el := x[2,1]; - co2 := Coefficients(can,el) * mati; - for i in [1..Length(co2)] do - if not IsZero(co2[i]) then - xm := xm * ttm[i]; - fi; - od; -# TODO: add sanity check here, too??? - x := StripMemory(xm); - # now x[2,1] is equal to Zero(f) and thus x[1,1] is One(f) as well - break; - od; - CloseMutableBasis(mb,co); - Add(ss,x); - Add(ssm,xm); - Add(mas,co); - od; - ConvertToMatrixRep(mas,2); - masi := mas^-1; - - # Now we replace all the s and the t by some products to get rid - # of the base changes: - s := EmptyPlist(ext); - t := EmptyPlist(ext); - for i in [1..ext] do - co := Positions(masi[i],Z(2)); - Add(s,Product(ssm{co})); - co := Positions(mati[i],Z(2)); - Add(t,Product(ttm{co})); - od; - - res := rec( g := g, t := t, s := s, bas := bas, basi := bas^-1, - one := One(f), a := s[1]*t[1]*s[1], b := One(s[1]), - One := One(s[1]), f := f, q := q, p := 2, ext := ext, - d := 2 ); - res.all := Concatenation(res.s,res.t,[res.a],[res.b]); - return res; -end; - -# RECOG.GuessSL2ElmOrder := function(x,f) -# local facts,i,j,o,p,q,r,s,y,z; -# p := Characteristic(f); -# q := Size(f); -# if IsOne(x) then return 1; -# elif IsOne(x^2) then return 2; -# fi; -# if p > 2 then -# y := x^p; -# if IsOne(y) then return p; -# elif IsOddInt(p) and IsOne(y^2) then -# return 2*p; -# fi; -# fi; -# if IsOne(x^(q-1)) then -# facts := Collected(FactInt(q-1:cheap)[1]); -# s := Product(facts,x->x[1]^x[2]); -# r := (q-1)/s; -# else -# facts := Collected(FactInt(q+1:cheap)[1]); -# s := Product(facts,x->x[1]^x[2]); -# r := (q+1)/s; -# fi; -# y := x^r; -# o := r; -# for i in [1..Length(facts)] do -# p := facts[i]; -# j := p[2]-1; -# while j >= 0 do -# z := y^(s/p[1]^(p[2]-j)); -# if not IsOne(z) then break; fi; -# j := j - 1; -# od; -# o := o * p[1]^(j+1); -# od; -# return o; -# end; - -RECOG.GuessProjSL2ElmOrder := function(x,f) - local facts,i,j,o,p,q,r,s,y,z; - p := Characteristic(f); - q := Size(f); - if IsOneProjective(x) then return 1; - elif IsEvenInt(p) and IsOneProjective(x^2) then return 2; - fi; - if p > 2 then - y := x^p; - if IsOneProjective(y) then - return p; - fi; - fi; - if IsOneProjective(x^(q-1)) then - facts := Collected(FactInt(q-1:cheap)[1]); - s := Product(facts,x->x[1]^x[2]); - r := (q-1)/s; - else - facts := Collected(FactInt(q+1:cheap)[1]); - s := Product(facts,x->x[1]^x[2]); - r := (q+1)/s; - fi; - y := x^r; - o := r; - for i in [1..Length(facts)] do - p := facts[i]; - j := p[2]-1; - while j >= 0 do - z := y^(s/p[1]^(p[2]-j)); - if not IsOneProjective(z) then break; fi; - j := j - 1; - od; - o := o * p[1]^(j+1); - od; - return o; -end; - -RECOG.IsThisSL2Natural := function(gens,f) - # Checks quickly whether or not this is SL(2,f). - # The answer is not guaranteed to be correct, this is Las Vegas. - local CheckElm,a,b,clos,coms,i,isabelian,j,l,notA5,p,q,S,seenqm1,seenqp1,x; - - # The following method does not work for q <= 11, as then - # the projective orders are either q+1, or else less than 5. - # Hence seenqm1 never gets set. - CheckElm := function(x) - local o; - o := RECOG.GuessProjSL2ElmOrder(x,f); - if o in [1,2] then - return false; - fi; - if o > 5 then - if notA5 = false then Info(InfoRecog,4,"SL2: Group is not A5"); fi; - notA5 := true; - if seenqp1 and seenqm1 then - return true; - fi; - fi; - if o = p or o <= 5 then - return false; - fi; - if (q+1) mod o = 0 then - if not seenqp1 then - Info(InfoRecog,4,"SL2: Found element of order dividing q+1."); - seenqp1 := true; - if seenqm1 and notA5 then - return true; - fi; - fi; - else - if not seenqm1 then - Info(InfoRecog,4,"SL2: Found element of order dividing q-1."); - seenqm1 := true; - if seenqp1 and notA5 then - return true; - fi; - fi; - fi; - return false; - end; - - if Length(gens) <= 1 then - Info(InfoRecog,4,"SL2: Group cyclic"); - return false; - fi; - - q := Size(f); - p := Characteristic(f); - # For small q, comput the order of the group via a stabilizer chain. - # Note that at this point we are usually working projective, and thus - # scalars are factored out "implicitly". Thus the generators we are - # looking at may generate a group which only contains SL2 as a subgroup. - if q <= 11 then # this could be increased if needed - Info(InfoRecog,4,"SL2: Computing stabiliser chain."); - S := StabilizerChain(Group(gens)); - Info(InfoRecog,4,"SL2: size is ",Size(S)); - return Size(S) mod (q*(q-1)*(q+1)) = 0; - fi; - - seenqp1 := false; - seenqm1 := false; - notA5 := false; - - for i in [1..Length(gens)] do - if CheckElm(gens[i]) then - return true; - fi; - od; - CheckElm(gens[1]*gens[2]); - if Length(gens) >= 3 then - CheckElm(gens[1]*gens[3]); - CheckElm(gens[2]*gens[3]); - fi; - - # First we check the derived group: - coms := EmptyPlist(20); - l := Length(gens); - if l <= 4 then - Info(InfoRecog,4,"SL2: Computing commutators of gens..."); - for i in [1..l-1] do - for j in [i+1..l] do - x := Comm(gens[i],gens[j]); - if CheckElm(x) then - return true; - fi; - Add(coms,x); - od; - od; - else - Info(InfoRecog,4,"SL2: Computing 6 random commutators..."); - for i in [1..6] do - a := RECOG.RandomSubproduct(gens,rec()); - b := RECOG.RandomSubproduct(gens,rec()); - x := Comm(a,b); - if CheckElm(x) then - return true; - fi; - Add(coms,x); - od; - fi; - if ForAll(coms, IsDiagonalMat) then - Info(InfoRecog,4,"SL2: Group is soluble, commutators are central"); - return false; - fi; - Info(InfoRecog,4,"SL2: Computing normal closure..."); - clos := FastNormalClosure(gens,coms,5); - for i in [Length(coms)+1..Length(clos)] do - if CheckElm(clos[i]) then - return true; - fi; - od; - if ForAll(clos{[Length(coms)+1..Length(clos)]}, IsDiagonalMat) then - Info(InfoRecog,4,"SL2: Group is soluble, derived subgroup central"); - return false; - fi; - Info(InfoRecog,4,"SL2: Computing 6 random commutators..."); - isabelian := true; - for i in [1..6] do - a := RECOG.RandomSubproduct(clos,rec()); - b := RECOG.RandomSubproduct(clos,rec()); - x := Comm(a,b); - if RECOG.IsScalarMat(x) = false then isabelian := false; break; fi; - od; - if isabelian then - Info(InfoRecog,4, - "SL2: Group is soluble, derived subgroup abelian mod scalars"); - return false; - fi; - - # Now we know that the group is not dihedral! - return false; -end; - -# The going down method: - -#Version 1.2 - -# finds first element of a list that is relative prime to all others -# input: list=[SL(d,q), d, q, SL(n,q)] acting as a subgroup of some big SL(n,q) -# output: list=[rr, dd] for a ppd(2*dd;q)-element rr -RECOG.SLn_godown:=function(list) - local d, first, q, g, gg, i, r, pol, factors, degrees, newdim, power, rr, ss, - newgroup, colldegrees, exp, count; - - first:=function(list) - local i; - - for i in [1..Length(list)] do - if list[i]>1 and Gcd(list[i],Product(list)/list[i])=1 then - return list[i]; - fi; - od; - - return fail; - end; - - g:=list[1]; - d:=list[2]; - q:=list[3]; - gg:=list[4]; - - Info(InfoRecog,2,"Dimension: ",d); - #find an element with irreducible action of relative prime dimension to - #all other invariant subspaces - #count is just safety, if things go very bad - count:=0; - - repeat - count:=count+1; - if InfoLevel(InfoRecog) >= 3 then Print(".\c"); fi; - r:=PseudoRandom(g); - pol:=CharacteristicPolynomial(r); - factors:=Factors(pol); - degrees:=AsSortedList(List(factors,Degree)); - newdim:=first(degrees); - until (count>10) or (newdim <> fail and newdim<=Maximum(2,d/4)); - - if count>10 then - return fail; - fi; - - # raise r to a power so that acting trivially outside one invariant subspace - degrees:=Filtered(degrees, x->x<>newdim); - colldegrees:=Collected(degrees); - power:=Lcm(List(degrees, x->q^x-1))*q; - # power further to cancel q-part of element order - if degrees[1]=1 then - exp:=colldegrees[1][2]-(DimensionOfMatrixGroup(gg)-d); - if exp>0 then - power:=power*q^exp; - fi; - fi; - rr:=r^power; - - #conjugate rr to hopefully get a smaller dimensional SL - #ss:=rr^PseudoRandom(gg); - #newgroup:=Group(rr,ss); - - return [rr,newdim]; -end; - -# input is (group,dimension,q) -# output is a group element acting irreducibly in two dimensions, and fixing -# a (dimension-2)-dimensional subspace -RECOG.SLn_constructppd2:=function(g,dim,q) - local out, list ; - - list:=[g,dim,q,g]; - repeat - out:=RECOG.SLn_godown(list); - if out=fail or out[1]*out[1]=One(out[1]) then - if InfoLevel(InfoRecog) >= 3 then Print("B\c"); fi; - list:=[g,dim,q,g]; - out:=fail; - else - if out[2]>2 then - list:=[Group(out[1],out[1]^PseudoRandom(g)),2*out[2],q,g]; - fi; - fi; - until out<>fail and out[2]=2; - - return out[1]; - -end; - -RECOG.SLn_constructsl4:=function(g,dim,q,r) - local s,h,count,readydim4,readydim3,ready,u,orderu, - nullr,nulls,nullspacer,nullspaces,int,intbasis,nullintbasis, - newu,newbasis,newbasisinv,newr,news,outputu,mat,i,shorts,shortr; - nullr:=NullspaceMat(r-One(r)); - nullspacer:=VectorSpace(GF(q),nullr); - mat:=One(r); - ready:=false; - repeat - s:=r^PseudoRandom(g); - nulls:=NullspaceMat(s-One(s)); - nullspaces:=VectorSpace(GF(q),nulls); - int:=Intersection(nullspacer,nullspaces); - intbasis:=Basis(int); - newbasis:=[]; - for i in [1..Length(intbasis)] do - Add(newbasis,intbasis[i]); - od; - i:=0; - repeat - i:=i+1; - if not mat[i] in int then - Add(newbasis,mat[i]); - int:=VectorSpace(GF(q),newbasis); - fi; - until Dimension(int)=dim; - ConvertToMatrixRep(newbasis); - newbasisinv:=newbasis^(-1); - newr:=newbasis*r*newbasisinv; - news:=newbasis*s*newbasisinv; - - #shortr, shorts do not need memory - #we shall throw away the computations in h - #check that we have SL(4,q), by non-constructive recognition - shortr:=newr{[dim-3..dim]}{[dim-3..dim]}; - shorts:=news{[dim-3..dim]}{[dim-3..dim]}; - h:=Group(shortr,shorts); - count:=0; - readydim4:=false; - readydim3:=false; - repeat - u:=PseudoRandom(h); - orderu:=Order(u); - if orderu mod ((q^4-1)/(q-1)) = 0 then - readydim4:=true; - elif Gcd(orderu,(q^2+q+1)/Gcd(3,q-1))>1 then - readydim3:=true; - fi; - if readydim4 = true and readydim3 = true then - ready:=true; - break; - fi; - count:=count+1; - until count=30; - until ready=true; - - return Group(r,s); -end; - - -#g=SL(d,q), given as a subgroup of SL(dim,q) -#output: [SL(2,q), and a basis for the 2-dimensional subspace where it acts -RECOG.SLn_godownfromd:=function(g,q,d,dim) - local y,yy,ready,order,es,dims,subsp,z,x,a,b,c,h,vec,vec2, - pol,factors,degrees,comm1,comm2,comm3,image,basis,action,vs,readyqpl1, - readyqm1,count,u,orderu; - - repeat - ready:=false; - y:=PseudoRandom(g); - pol:=CharacteristicPolynomial(y); - factors:=Factors(pol); - degrees:=List(factors,Degree); - if d-1 in degrees then - order:=Order(y); - if order mod (q-1)=0 then - yy:=y^(order/(q-1)); - else - yy:=One(y); - fi; - if not IsOne(yy) then - es:= Eigenspaces(GF(q),yy); - dims:=List(es,Dimension); - if IsSubset(Set([1,d-1,dim-d]),Set(dims)) and - (1 in Set(dims)) then - es:=Filtered(es,x->Dimension(x)=1); - vec:=Basis(es[1])[1]; - if vec*yy=vec then - vec:=Basis(es[2])[1]; - fi; - repeat - z:=PseudoRandom(g); - x:=yy^z; - a:=Comm(x,yy); - b:=a^yy; - c:=a^x; - comm1:= Comm(a,c); - comm2:=Comm(a,b); - comm3:=Comm(b,c); - if comm1<>One(a) and comm2<>One(a) and - comm3<>One(a) and Comm(comm1,comm2)<>One(a) then - vec2:=vec*z; - vs:=VectorSpace(GF(q),[vec,vec2]); - basis:=Basis(vs); - #check that the action in 2 dimensions is SL(2,q) - #by non-constructive recognition, finding elements of - #order (q-1) and (q+1) - #we do not need memory in the group image - action:=List([a,b,c],x->RECOG.LinearAction(basis,q,x)); - image:=Group(action); - count:=0; - readyqpl1:=false; - readyqm1:=false; - repeat - u:=PseudoRandom(image); - orderu:=Order(u); - if orderu = q-1 then - readyqm1:=true; - elif orderu = q+1 then - readyqpl1:=true; - fi; - if readyqm1 = true and readyqpl1 = true then - ready:=true; - break; - fi; - count:=count+1; - until count=20; - fi; - until ready=true; - fi; - fi; - fi; - until ready; - - h:=Group(a,b,c); - subsp:=VectorSpace(GF(q),[vec,vec2]); - return [h,subsp]; - -end; - -#going down from 4 to 2 dimensions, when q=2,3,4,5,9 -#just construct the 4-dimensional invariant space and generators -#for the group acting on it -RECOG.SLn_exceptionalgodown:=function(h,q,dim) - local basis, v, vs, i, gen; - - vs:=VectorSpace(GF(q),One(h)); - basis:=[]; - repeat - if InfoLevel(InfoRecog) >= 3 then Print("C"); fi; - for i in [1..4] do - v:=PseudoRandom(vs); - for gen in GeneratorsOfGroup(h) do - Add(basis,v*gen-v); - od; - od; - basis:=ShallowCopy(SemiEchelonMat(basis).vectors); - until Length(basis)=4; - return [h,VectorSpace(GF(q),basis)]; -end; - - -RECOG.SLn_constructsl2:=function(g,d,q) - local r,h; - - r:=RECOG.SLn_constructppd2(g,d,q); - h:=RECOG.SLn_constructsl4(g,d,q,r); - if not (q in [2,3,4,5,9]) then - return RECOG.SLn_godownfromd(h,q,4,d); - else - return RECOG.SLn_exceptionalgodown(h,q,d); - # return ["sorry only SL(4,q)",h]; - fi; -end; - -# Now the going up code: - -RECOG.LinearAction := function(bas,field,el) - local mat,vecs; - if IsGroup(el) then - return Group(List(GeneratorsOfGroup(el), - x->RECOG.LinearAction(bas,field,x))); - fi; - if IsBasis(bas) then - vecs := BasisVectors(bas); - else - vecs := bas; - bas := Basis(VectorSpace(field,bas),bas); - fi; - mat := List(vecs,v->Coefficients(bas,v*el)); - ConvertToMatrixRep(mat,field); - return mat; -end; - -RECOG.SLn_UpStep := function(w) - # w has components: - # d : size of big SL - # n : size of small SL - # slnstdf : fakegens for SL_n standard generators - # bas : current base change, first n vectors are where SL_n acts - # rest of vecs are invariant under SL_n - # basi : current inverse of bas - # sld : original group with memory generators, PseudoRandom - # delivers random elements - # sldf : fake generators to keep track of what we are doing - # f : field - # The following are filled in automatically if not already there: - # p : characteristic - # ext : q=p^ext - # One : One(slnstdf[1]) - # can : CanonicalBasis(f) - # canb : BasisVectors(can) - # transh : fakegens for the "horizontal" transvections n,i for 1<=i<=n-1 - # entries can be unbound in which case they are made from slnstdf - # transv : fakegens for the "vertical" transvections i,n for 1<=i<=n-1 - # entries can be unbound in which case they are made from slnstdf - # - # We keep the following invariants (going from n -> n':=2n-1) - # bas, basi is a base change to the target base - # slnstdf are SLPs to reach standard generators of SL_n from the - # generators of sld - local DoColOp_n,DoRowOp_n,FixSLn,Fixc,MB,Vn,Vnc,aimdim,c,c1,c1f,cf,cfi, - ci,cii,coeffs,flag,i,id,int1,int3,j,k,lambda,list,mat,newbas,newbasf, - newbasfi,newbasi,newdim,newpart,perm,pivots,pivots2,pos,pow,s,sf, - slp,std,sum1,tf,trans,transd,transr,v,vals,zerovec; - - Info(InfoRecog,3,"Going up: ",w.n," (",w.d,")..."); - - # Before we begin, we upgrade the data structure with a few internal - # things: - - if not IsBound(w.can) then w.can := CanonicalBasis(w.f); fi; - if not IsBound(w.canb) then w.canb := BasisVectors(w.can); fi; - if not IsBound(w.One) then w.One := One(w.slnstdf[1]); fi; - if not IsBound(w.transh) then w.transh := []; fi; - if not IsBound(w.transv) then w.transv := []; fi; - # Update our cache of *,n and n,* transvections because we need them - # all over the place: - std := RECOG.InitSLstd(w.f,w.n, - w.slnstdf{[1..w.ext]}, - w.slnstdf{[w.ext+1..2*w.ext]}, - w.slnstdf[2*w.ext+1], - w.slnstdf[2*w.ext+2]); - for i in [1..w.n-1] do - for k in [1..w.ext] do - pos := (i-1)*w.ext + k; - if not IsBound(w.transh[pos]) then - RECOG.ResetSLstd(std); - RECOG.DoColOp_SL(false,w.n,i,w.canb[k],std); - w.transh[pos] := std.right; - fi; - if not IsBound(w.transv[pos]) then - RECOG.ResetSLstd(std); - RECOG.DoRowOp_SL(false,i,w.n,w.canb[k],std); - w.transv[pos] := std.left; - fi; - od; - od; - Unbind(std); - - # Now we can define two helper functions: - DoColOp_n := function(el,i,j,lambda,w) - # This adds lambda times the i-th column to the j-th column. - # Note that either i or j must be equal to n! - local coeffs,k; - coeffs := IntVecFFE(Coefficients(w.can,lambda)); - if i = w.n then - for k in [1..w.ext] do - if not IsZero(coeffs[k]) then - if IsOne(coeffs[k]) then - el := el * w.transh[(j-1)*w.ext+k]; - else - el := el * w.transh[(j-1)*w.ext+k]^coeffs[k]; - fi; - fi; - od; - elif j = w.n then - for k in [1..w.ext] do - if not IsZero(coeffs[k]) then - if IsOne(coeffs[k]) then - el := el * w.transv[(i-1)*w.ext+k]; - else - el := el * w.transv[(i-1)*w.ext+k]^coeffs[k]; - fi; - fi; - od; - else - ErrorNoReturn("either i or j must be equal to n"); - fi; - return el; - end; - DoRowOp_n := function(el,i,j,lambda,w) - # This adds lambda times the j-th row to the i-th row. - # Note that either i or j must be equal to n! - local coeffs,k; - coeffs := IntVecFFE(Coefficients(w.can,lambda)); - if j = w.n then - for k in [1..w.ext] do - if not IsZero(coeffs[k]) then - if IsOne(coeffs[k]) then - el := w.transv[(i-1)*w.ext+k] * el; - else - el := w.transv[(i-1)*w.ext+k]^coeffs[k] * el; - fi; - fi; - od; - elif i = w.n then - for k in [1..w.ext] do - if not IsZero(coeffs[k]) then - if IsOne(coeffs[k]) then - el := w.transh[(j-1)*w.ext+k] * el; - else - el := w.transh[(j-1)*w.ext+k]^coeffs[k] * el; - fi; - fi; - od; - else - ErrorNoReturn("either i or j must be equal to n"); - fi; - return el; - end; - - # Here everything starts, some more preparations: - - # We compute exclusively in our basis, so we occasionally need an - # identity matrix: - id := IdentityMat(w.d,w.f); - FixSLn := VectorSpace(w.f,id{[w.n+1..w.d]}); - Vn := VectorSpace(w.f,id{[1..w.n]}); - - # First pick an element in SL_n with fixed space of dimension d-n+1: - # We already have an SLP for an n-1-cycle: it is one of the std gens. - # For n=2 we use a transvection for this purpose. - if w.n > 2 then - if IsOddInt(w.n) then - if w.p > 2 then - s := id{Concatenation([1,w.n],[2..w.n-1],[w.n+1..w.d])}; - ConvertToMatrixRepNC(s,w.f); - if IsOddInt(w.n) then s[2] := -s[2]; fi; - sf := w.slnstdf[2*w.ext+2]; - else # in even characteristic we take the n-cycle: - s := id{Concatenation([w.n],[1..w.n-1],[w.n+1..w.d])}; - ConvertToMatrixRepNC(s,w.f); - sf := w.slnstdf[2*w.ext+1]; - fi; - else - ErrorNoReturn("this program only works for odd n or n=2"); - fi; - else - # In this case the n-1-cycle is the identity, so we take a transvection: - s := MutableCopyMat(id); - s[1,2] := One(w.f); - sf := w.slnstdf[1]; - fi; - - # Find a good random element: - w.count := 0; - aimdim := Minimum(2*w.n-1,w.d); - newdim := aimdim - w.n; - while true do # will be left by break - while true do # will be left by break - if InfoLevel(InfoRecog) >= 3 then Print(".\c"); fi; - w.count := w.count + 1; - c1 := PseudoRandom(w.sld); - slp := SLPOfElm(c1); - c1f := ResultOfStraightLineProgram(slp,w.sldf); - # Do the base change into our basis: - c1 := w.bas * c1 * w.basi; - c := s^c1; - cf := sf^c1f; - cfi := cf^-1; - # Now check that Vn + Vn*s^c1 has dimension 2n-1: - Vnc := VectorSpace(w.f,c{[1..w.n]}); - sum1 := ClosureLeftModule(Vn,Vnc); - if Dimension(sum1) = aimdim then - Fixc := VectorSpace(w.f,NullspaceMat(c-One(c))); - int1 := Intersection(Fixc,Vn); - for i in [1..Dimension(int1)] do - v := Basis(int1)[i]; - if not IsZero(v[w.n]) then break; fi; - od; - if IsZero(v[w.n]) then - Info(InfoRecog,2,"Ooops: Component n was zero!"); - continue; - fi; - v := v / v[w.n]; # normalize to 1 in position n - Assert(1,v*c=v); - ci := c^-1; - break; - fi; - od; - - # Now we found our aimdim-dimensional space W. Since SL_n - # has a d-n-dimensional fixed space W_{d-n} and W contains a complement - # of that fixed space, the intersection of W and W_{d-n} has dimension - # newdim. - - # Change basis: - newpart := ExtractSubMatrix(c,[1..w.n-1],[1..w.d]); - # Clean out the first n entries to go to the fixed space of SL_n: - zerovec := Zero(newpart[1]); - for i in [1..w.n-1] do - CopySubVector(zerovec,newpart[i],[1..w.n],[1..w.n]); - od; - MB := MutableBasis(w.f,[],zerovec); - i := 1; - pivots := EmptyPlist(newdim); - while i <= Length(newpart) and NrBasisVectors(MB) < newdim do - if not IsContainedInSpan(MB,newpart[i]) then - Add(pivots,i); - CloseMutableBasis(MB,newpart[i]); - fi; - i := i + 1; - od; - newpart := newpart{pivots}; - newbas := Concatenation(id{[1..w.n-1]},[v],newpart); - if 2*w.n-1 < w.d then - int3 := Intersection(FixSLn,Fixc); - if Dimension(int3) <> w.d-2*w.n+1 then - Info(InfoRecog,2,"Ooops, FixSLn \cap Fixc wrong dimension"); - continue; - fi; - Append(newbas,BasisVectors(Basis(int3))); - fi; - ConvertToMatrixRep(newbas,w.f); - newbasi := newbas^-1; - if newbasi = fail then - Info(InfoRecog,2,"Ooops, Fixc intersected too much, we try again"); - continue; - fi; - ci := newbas * ci * newbasi; - cii := ExtractSubMatrix(ci,[w.n+1..aimdim],[1..w.n-1]); - ConvertToMatrixRep(cii,w.f); - cii := TransposedMat(cii); - # The rows of cii are now what used to be the columns, - # their length is newdim, we need to span the full newdim-dimensional - # row space and need to remember how: - zerovec := Zero(cii[1]); - MB := MutableBasis(w.f,[],zerovec); - i := 1; - pivots2 := EmptyPlist(newdim); - while i <= Length(cii) and NrBasisVectors(MB) < newdim do - if not IsContainedInSpan(MB,cii[i]) then - Add(pivots2,i); - CloseMutableBasis(MB,cii[i]); - fi; - i := i + 1; - od; - if Length(pivots2) = newdim then - cii := cii{pivots2}^-1; - ConvertToMatrixRep(cii,w.f); - c := newbas * c * newbasi; - w.bas := newbas * w.bas; - w.basi := w.basi * newbasi; - break; - fi; - Info(InfoRecog,2,"Ooops, no nice bottom..."); - # Otherwise simply try again - od; - Info(InfoRecog,2," found c1 and c."); - # Now SL_n has to be repaired according to the base change newbas: - - # Now write this matrix newbas as an SLP in the standard generators - # of our SL_n. Then we know which generators to take for our new - # standard generators, namely newbas^-1 * std * newbas. - newbasf := w.One; - for i in [1..w.n-1] do - if not IsZero(v[i]) then - newbasf := DoColOp_n(newbasf,w.n,i,v[i],w); - fi; - od; - newbasfi := newbasf^-1; - w.slnstdf := List(w.slnstdf,x->newbasfi * x * newbasf); - # Now update caches: - w.transh := List(w.transh,x->newbasfi * x * newbasf); - w.transv := List(w.transv,x->newbasfi * x * newbasf); - - # Now consider the transvections t_i: - # t_i : w.bas[j] -> w.bas[j] for j <> i and - # t_i : w.bas[i] -> w.bas[i] + ww - # We want to modify (t_i)^c such that it fixes w.bas{[1..w.n]}: - trans := []; - for i in pivots2 do - # This does t_i - for lambda in w.canb do - # This does t_i : v_j -> v_j + lambda * v_n - tf := w.One; - tf := DoRowOp_n(tf,i,w.n,lambda,w); - # Now conjugate with c: - tf := cfi*tf*cf; - # Now cleanup in column n above row n, the entries there - # are lambda times the stuff in column i of ci: - for j in [1..w.n-1] do - tf := DoRowOp_n(tf,j,w.n,-ci[j,i]*lambda,w); - od; - Add(trans,tf); - od; - od; - - # Now put together the clean ones by our knowledge of c^-1: - transd := []; - for i in [1..Length(pivots2)] do - for lambda in w.canb do - tf := w.One; - vals := BlownUpVector(w.can,cii[i]*lambda); - for j in [1..w.ext * newdim] do - pow := IntFFE(vals[j]); - if not IsZero(pow) then - if IsOne(pow) then - tf := tf * trans[j]; - else - tf := tf * trans[j]^pow; - fi; - fi; - od; - Add(transd,tf); - od; - od; - Unbind(trans); - - # Now to the "horizontal" transvections, first create them as SLPs: - transr := []; - for i in pivots do - # This does u_i : v_i -> v_i + v_n - tf := w.One; - tf := DoColOp_n(tf,w.n,i,One(w.f),w); - # Now conjugate with c: - tf := cfi*tf*cf; - # Now cleanup in rows above row n: - for j in [1..w.n-1] do - tf := DoRowOp_n(tf,j,w.n,-ci[j,w.n],w); - od; - # Now cleanup in rows below row n: - for j in [1..newdim] do - coeffs := IntVecFFE(Coefficients(w.can,-ci[w.n+j,w.n])); - for k in [1..w.ext] do - if not IsZero(coeffs[k]) then - if IsOne(coeffs[k]) then - tf := transd[(j-1)*w.ext + k] * tf; - else - tf := transd[(j-1)*w.ext + k]^coeffs[k] * tf; - fi; - fi; - od; - od; - # Now cleanup column n above row n: - for j in [1..w.n-1] do - tf := DoColOp_n(tf,j,w.n,ci[j,w.n],w); - od; - # Now cleanup row n left of column n: - for j in [1..w.n-1] do - tf := DoRowOp_n(tf,w.n,j,-c[i,j],w); - od; - # Now cleanup column n below row n: - for j in [1..newdim] do - coeffs := IntVecFFE(Coefficients(w.can,ci[w.n+j,w.n])); - for k in [1..w.ext] do - if not IsZero(coeffs[k]) then - if IsOne(coeffs[k]) then - tf := tf * transd[(j-1)*w.ext + k]; - else - tf := tf * transd[(j-1)*w.ext + k]^coeffs[k]; - fi; - fi; - od; - od; - Add(transr,tf); - od; - - # From here on we distinguish three cases: - # * w.n = 2 - # * we finish off the constructive recognition - # * we have to do another step as the next thing - if w.n = 2 then - w.slnstdf[2*w.ext+2] := transd[1]*transr[1]^-1*transd[1]; - w.slnstdf[2*w.ext+1] := w.transh[1]*w.transv[1]^-1*w.transh[1] - *w.slnstdf[2*w.ext+2]; - Unbind(w.transh); - Unbind(w.transv); - w.n := 3; - return w; - fi; - # We can finish off: - if aimdim = w.d then - # In this case we just finish off and do not bother with - # the transvections, we will only need the standard gens: - # Now put together the (newdim+1)-cycle: - # n+newdim -> n+newdim-1 -> ... -> n+1 -> n -> n+newdim - flag := false; - s := w.One; - for i in [1..newdim] do - if flag then - # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: - tf:=transd[(i-1)*w.ext+1]*transr[i]^-1*transd[(i-1)*w.ext+1]; - else - # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: - tf:=transd[(i-1)*w.ext+1]^-1*transr[i]*transd[(i-1)*w.ext+1]^-1; - fi; - s := s * tf; - flag := not flag; - od; - - # Finally put together the new 2n-1-cycle and 2n-2-cycle: - s := s^-1; - w.slnstdf[2*w.ext+1] := w.slnstdf[2*w.ext+1] * s; - w.slnstdf[2*w.ext+2] := w.slnstdf[2*w.ext+2] * s; - Unbind(w.transv); - Unbind(w.transh); - w.n := aimdim; - return w; - fi; - - # Otherwise we do want to go on as the next thing, so we want to - # keep our transvections. This is easily done if we change the - # basis one more time. Note that we know that n is odd here! - - # Put together the n-cycle: - # 2n-1 -> 2n-2 -> ... -> n+1 -> n -> 2n-1 - flag := false; - s := w.One; - for i in [w.n-1,w.n-2..1] do - if flag then - # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: - tf := transd[(i-1)*w.ext+1]*transr[i]^-1*transd[(i-1)*w.ext+1]; - else - # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: - tf := transd[(i-1)*w.ext+1]^-1*transr[i]*transd[(i-1)*w.ext+1]^-1; - fi; - s := s * tf; - flag := not flag; - od; - - # Finally put together the new 2n-1-cycle and 2n-2-cycle: - w.slnstdf[2*w.ext+1] := s * w.slnstdf[2*w.ext+1]; - w.slnstdf[2*w.ext+2] := s * w.slnstdf[2*w.ext+2]; - - list := Concatenation([1..w.n-1],[w.n+1..2*w.n-1],[w.n],[2*w.n..w.d]); - perm := PermList(list); - mat := PermutationMat(perm^-1,w.d,w.f); - ConvertToMatrixRep(mat,w.f); - w.bas := w.bas{list}; - ConvertToMatrixRep(w.bas,w.f); - w.basi := w.basi*mat; - - # Now add the new transvections: - for i in [1..w.n-1] do - w.transh[w.ext*(w.n-1)+w.ext*(i-1)+1] := transr[i]; - od; - Append(w.transv,transd); - w.n := 2*w.n-1; - return w; -end; - -# RECOG.MakeSLSituation := function(p,e,n,d) -# local a,q,r; -# q := p^e; -# a := RECOG.MakeSL_StdGens(p,e,n,d).all; -# Append(a,GeneratorsOfGroup(SL(d,q))); -# a := GeneratorsWithMemory(a); -# r := rec( f := GF(q), d := d, n := n, bas := IdentityMat(d,GF(q)), -# basi := IdentityMat(d,GF(q)), sld := Group(a), -# sldf := a, slnstdf := a{[1..2*e+2]}, p := p, ext := e ); -# return r; -# end; -# -# RECOG.MakeSLTest := function(p,e,n,d) -# local a,fake,q,r; -# q := p^e; -# a := RECOG.MakeSL_StdGens(p,e,n,d).all; -# Append(a,GeneratorsOfGroup(SL(d,q))); -# a := GeneratorsWithMemory(a); -# fake := GeneratorsWithMemory(List([1..Length(a)],i->())); -# r := rec( f := GF(q), d := d, n := n, bas := IdentityMat(d,GF(q)), -# basi := IdentityMat(d,GF(q)), sld := Group(a), -# sldf := fake, slnstdf := fake{[1..2*e+2]}, p := p, ext := e ); -# return r; -# end; -# -# RECOG.MakeSp2n := function(n,p,e) -# # n must be even -# local bas,basch,basi,form,g,gens,gg,i; -# g := Sp(2*n,p^e); -# form := InvariantBilinearForm(g).matrix; -# basch := EmptyPlist(2*n); -# for i in [1..n] do -# basch[i] := 2*i-1; -# basch[2*n+1-i] := 2*i; -# od; -# basi := PermutationMat(PermList(basch),2*n,GF(p,e)); -# bas := basi^-1; -# gens := List(GeneratorsOfGroup(g),x->bas*x*basi); -# form := bas * form * basi; -# gg := Group(gens); -# SetSize(gg,Size(g)); -# SetInvariantBilinearForm(gg,rec(matrix := form)); -# return [gg,form]; -# end; -# -# RECOG.MakeSpnTransvection := function(g,type,i,lambda) -# # g must be Sp(2n,q) as made by RECOG.MakeSpn, this defines n -# # type is either "e" or "f", i is in [0..2n-2] -# # Our basis is (b_1, ..., b_{2n}) = (e_1,f_1,...,e_n,f_n) -# # For type="e", this makes the following transvection: -# # x -> x + lambda * (x,e_n + b) * (e_n + b) -# # where b = b_i for i <> 0 and b = f_n for i = 0 -# # For type="f", this makes the following transvection: -# # x -> x + lambda * (x,f_n + b) * (f_n + b) -# # where b = b_i for i <> 0 and b = 0 for i = 0 -# local f,form,id,j,n,o,v; -# n := DimensionOfMatrixGroup(g)/2; -# f := FieldOfMatrixGroup(g); -# o := One(f); -# id := OneMutable(One(g)); -# v := ZeroMutable(id[1]); -# if type = "e" then -# v[2*n-1] := -o; -# else -# v[2*n] := o; -# fi; -# if i <> 0 then -# v[i] := o; -# fi; -# form := InvariantBilinearForm(g).matrix; -# for j in [1..2*n] do -# id[j] := id[j] + (lambda * (id[j]*form)*v) * v; -# od; -# return id; -# end; -# -# RECOG.ComputeGramSymplecticStandardForm := function(vecs) -# # vecs a matrix of vectors of length 2*n interpreted as written in -# # the standard symplectic form below. -# # This computes the Gram matrix of the vectors vecs using the -# # standard symplectic form, which is defined for the standard -# # basis e_1, f_1, ... e_n, f_n to be -# # (e_i|e_j) = 0, (f_i, f_j) = 0, (e_i,f_j) = \delta_{i,j} -# local f,gram,i,j,k,l,n,one,v,zero; -# l := Length(vecs); -# f := BaseDomain(vecs); -# zero := Zero(f); -# one := One(f); -# gram := ZeroMatrix(l,l,vecs); -# n := RowLength(vecs)/2; -# Assert(1,IsInt(n),ErrorNoReturn("RowLength must be even")); -# for i in [1..l] do -# for j in [i+1..l] do -# v := zero; -# for k in [1,3..2*n-1] do -# v := v + vecs[i,k]*vecs[j,k+1] - vecs[i,k+1]*vecs[j,k]; -# od; -# gram[i,j] := v; -# gram[j,i] := -v; -# od; -# od; -# return gram; -# end; -# -# RECOG.FindSymplecticPairBasis := function(vecs) -# local bas,d,dummy,gram,i,j,k,s; -# d := Length(vecs); -# if IsOddInt(d) then -# return [fail,"odd dimension"]; -# fi; -# gram := RECOG.ComputeGramSymplecticStandardForm(vecs); -# bas := IdentityMatrix(d,vecs); -# for i in [1,3..d-1] do -# j := i+1; -# while j <= d do -# if not IsZero(gram[i,j]) then -# s := gram[i,j]^-1; -# MultRowVector(bas[j],s); -# MultRowVector(gram[j],s); -# for k in [1..d] do -# gram[k,j] := gram[k,j]*s; -# od; -# Assert(1,gram = RECOG.ComputeGramSymplecticStandardForm(bas*vecs)); -# # Now exchange vectors i+1 and j: -# if i+1 <> j then -# bas{[i+1,j]} := bas{[j,i+1]}; -# gram{[i+1,j]} := gram{[j,i+1]}; -# for k in [1..d] do -# dummy := gram[k,i+1]; -# gram[k,i+1] := gram[k,j]; -# gram[k,j] := dummy; -# od; -# Assert(1,gram = RECOG.ComputeGramSymplecticStandardForm(bas*vecs)); -# fi; -# break; -# fi; -# j := j + 1; -# od; -# if j > d then return [fail,"degenerate"]; fi; -# # Now i,i+1 is a symplectic pair, clean out the rest: -# for j in [i+2..d] do -# if not IsZero(gram[i,j]) then -# s := gram[i,j]; -# AddRowVector(bas[j],bas[i+1],-s); -# AddRowVector(gram[j],gram[i+1],-s); -# for k in [1..d] do -# gram[k,j] := gram[k,j] - s*gram[k,i+1]; -# od; -# Assert(1,gram = RECOG.ComputeGramSymplecticStandardForm(bas*vecs)); -# fi; -# if not IsZero(gram[i+1,j]) then -# s := gram[i+1,j]; -# AddRowVector(bas[j],bas[i],s); -# AddRowVector(gram[j],gram[i],s); -# for k in [1..d] do -# gram[k,j] := gram[k,j] + s*gram[k,i]; -# od; -# Assert(1,gram = RECOG.ComputeGramSymplecticStandardForm(bas*vecs)); -# fi; -# od; -# # Now all further vectors are perpendicular to vecs i and i+1 -# od; -# return bas; -# end; -# -# RECOG.SetupSpExperiment := function(n,d,f) -# local em,formg,formh,g,h,ncycle; -# Assert(1,n < d); -# g := RECOG.MakeSp2n(d,Characteristic(f),DegreeOverPrimeField(f)); -# formg := g[2]; -# g := g[1]; -# h := RECOG.MakeSp2n(n,Characteristic(f),DegreeOverPrimeField(f)); -# formh := h[2]; -# h := h[1]; -# em := GroupHomomorphismByFunction(g,h, -# function(x) -# local i; -# i := IdentityMatrix(2*d,formg); -# CopySubMatrix(x,i,[1..2*n],[1..2*n],[1..2*n],[1..2*n]); -# return i; -# end); -# ncycle := PermutationMat(PermList(Concatenation([3,4..2*n],[1,2])),2*d,f); -# return rec(g := g,formg := formg,h := h,formh := formh,em := em, -# ncycle := ncycle, p := Characteristic(f), -# ext := DegreeOverPrimeField(f), d := d, n := n, f := f, -# q := Size(f), id := IdentityMat(2*d,f)); -# end; -# -# # Standard generators of Sp(2n,q) are given by a record with: -# # n n -# # q q=p^e -# # p p -# # ext e -# # f GF(q) -# # can CanonicalBasis(GF(q)) -# # s the element [[0,1],[-1,0]] on -# # delta the element [[zeta,0],[0,zeta^-1]] on -# # v the double-n-cycle (e_1,e_2,...,e_n)(f_1,f_2,...,f_n) -# # ten transvections t_{e_n} -# # a list of ext elements -# # tfn transvections t_{f_n} -# # a list of ext elements -# # tfnei transvections t_{f_n+e_i} (1 <= i <= n-1) -# # each entry is a list of ext elements -# # tfnfi transvections t_{f_n+e_i} (1 <= i <= n-1) -# # each entry is a list of ext elements -# -# RECOG.MakeSpnTfn := function(n,d,f,lambda) -# local t; -# t := IdentityMat(2*d,f); -# t[2*n-1,2*n] := lambda; -# return t; -# end; -# -# RECOG.MakeSpnTfnei := function(n,d,f,i,lambda) -# local t; -# t := IdentityMat(2*d,f); -# t[2*i,2*i-1] := -lambda; -# t[2*i,2*n] := -lambda; -# t[2*n-1,2*i-1] := lambda; -# t[2*n-1,2*n] := lambda; -# return t; -# end; -# -# RECOG.MakeSpnTfnfi := function(n,d,f,i,lambda) -# local t; -# t := IdentityMat(2*d,f); -# t[2*i-1,2*i] := lambda; -# t[2*i-1,2*n] := lambda; -# t[2*n-1,2*i] := lambda; -# t[2*n-1,2*n] := lambda; -# return t; -# end; -# -# RECOG.MakeSpnTen := function(n,d,f,lambda) -# local t; -# t := IdentityMat(2*d,f); -# t[2*n,2*n-1] := -lambda; -# return t; -# end; -# -# RECOG.MakeSpnTenei := function(n,d,f,i,lambda) -# local t; -# t := IdentityMat(2*d,f); -# t[2*i,2*i-1] := -lambda; -# t[2*i,2*n-1] := -lambda; -# t[2*n,2*i-1] := -lambda; -# t[2*n,2*n-1] := -lambda; -# return t; -# end; -# -# RECOG.MakeSpnTenfi := function(n,d,f,i,lambda) -# local t; -# t := IdentityMat(2*d,f); -# t[2*i-1,2*i] := lambda; -# t[2*i-1,2*n-1] := lambda; -# t[2*n,2*i] := -lambda; -# t[2*n,2*n-1] := -lambda; -# return t; -# end; -# -# RECOG.MakeSp_StdGens := function(p,ext,n,d) -# local f,g,id,l,one,q,res,zero,zeta; -# q := p^ext; -# f := GF(p,ext); -# res := rec( q := q, p := p, ext := ext, f := f, n := n, -# can := CanonicalBasis(f) ); -# zero := Zero(f); -# one := One(f); -# zeta := PrimitiveRoot(f); -# id := IdentityMat(2*d,f); -# res.s := MutableCopyMat(id); -# res.s[2*n-1,2*n-1] := zero; -# res.s[2*n-1,2*n] := one; -# res.s[2*n,2*n-1] := -one; -# res.s[2*n,2*n] := zero; -# res.delta := MutableCopyMat(id); -# res.delta[2*n-1,2*n-1] := zeta; -# res.delta[2*n,2*n] := zeta^-1; -# l := Concatenation([3..2*n],[1,2]); -# res.v := PermutationMat(PermList(l),2*d,f); -# res.ten := List([0..ext-1], -# k->RECOG.MakeSpnTen(n,d,f,zeta^k)); -# res.tfn := List([0..ext-1], -# k->RECOG.MakeSpnTfn(n,d,f,zeta^k)); -# res.tfnei := List([1..n-1],i-> -# List([0..ext-1], -# k->RECOG.MakeSpnTfnei(n,d,f,i,zeta^k))); -# res.tfnfi := List([1..n-1],i-> -# List([0..ext-1], -# k->RECOG.MakeSpnTfnfi(n,d,f,i,zeta^k))); -# res.all := Concatenation([res.s,res.delta,res.v], -# res.ten,res.tfn, -# Concatenation(res.tfnei), -# Concatenation(res.tfnfi)); -# return res; -# end; -# -# RECOG.MakeSp_FakeGens := function(p,ext,n) -# local count,f,fake,i,q,res; -# q := p^ext; -# f := GF(p,ext); -# res := rec( q := q, p := p, ext := ext, f := f, n := n, -# can := CanonicalBasis(f) ); -# fake := GeneratorsWithMemory( -# ListWithIdenticalEntries(3+(2*n+2)*ext,1)); -# res.s := fake[1]; -# res.delta := fake[2]; -# res.v := fake[3]; -# count := 3; -# res.tfn := fake{[count+1..count+ext]}; -# count := count + ext; -# res.ten := fake{[count+1..count+ext]}; -# count := count + ext; -# res.tfnei := EmptyPlist(n-1); -# for i in [1..n-1] do -# Add(res.tfnei,fake{[count+1..count+ext]}); -# count := count + ext; -# od; -# res.tfnfi := EmptyPlist(n-1); -# for i in [1..n-1] do -# Add(res.tfnfi,fake{[count+1..count+ext]}); -# count := count + ext; -# od; -# res.all := fake; -# return res; -# end; -# -# RECOG.SpMakeImage_en := -# function(v,s,M,usencycle) -# # v is a vector over F_q of length at least 2n and v[2n-1]=1. -# # s is a set of standard generators of Sp(2n,q) (see above). -# # This func. makes an element t of Sp(2n,q) that maps v to e_n and fixes -# # f_n. The result t is expressed as a product in the standard generators -# # of Sp(2n,q) in s (see above). If M is not equal to fail then it must -# # be a matrix of mutable vectors over F_q of at least length 2n and it is -# # modified as if it were multiplied by t. This means that if M is -# # a mutable identity matrix of size at least 2n x 2n, then it will -# # contain the matrix of t after the operation in its upper left corner. -# # usencycle must be either true or false. If it is set to true, -# # the n-cycle amongst the standard generators is used resulting -# # in shorter products. If usencycle is false, then the n-cycle is -# # not used, note that this does not work for q=2. -# # The function returns t and changes M if not equal to fail. -# local Morig,coeff,ei,ext,fI,i,k,l,n,one,sc,sc2,si,t,vorig,zero,zeta; -# -# # We want to put together an element that maps v to e_n and fixes f_n: -# # At the same time we map M under the result whilst building it up. -# # We start with (v,M) and apply transvections... -# t := s.tfn[1]^0; # start here -# n := s.n; -# zero := Zero(s.f); -# one := One(s.f); -# zeta := PrimitiveRoot(s.f); -# ext := s.ext; -# Assert(1,IsOne(v[2*n-1])); -# vorig := ShallowCopy(v); -# if M <> fail then Morig := MutableCopyMat(M); fi; -# for i in [1..s.n-1] do -# ei := 2*i-1; # these are the coordinates to modify -# fI := 2*i; -# coeff := one; -# if IsZero(one+v[ei]) and IsZero(one-v[fI]) then -# if usencycle then -# t := t * s.tfn[1]^(s.v^i); -# v[fI] := v[fI] + v[ei]; -# if M <> fail then -# for l in [1..Length(M)] do -# M[l,fI] := M[l,fI] + M[l,ei]; -# od; -# fi; -# else -# if Size(s.f) = 2 then -# ErrorNoReturn("This does not work for GF(2)."); -# fi; -# t := t * s.delta; -# v[2*n-1] := v[2*n-1] * zeta; -# v[2*n] := v[2*n] * zeta^-1; -# if M <> fail then -# for l in [1..Length(M)] do -# M[l,2*n-1] := M[l,2*n-1] * zeta; -# M[l,2*n] := M[l,2*n] * zeta^-1; -# od; -# fi; -# coeff := zeta; -# fi; -# Assert(1,v=vorig*t and (M = fail or Morig*t=M),ErrorNoReturn("Hallo 0")); -# fi; -# if IsZero(v[ei]) or not IsZero(coeff-v[fI]) then -# # The first easy case: -# # First kill v[ei] if need be: -# if not IsZero(v[ei]) then -# sc := -v[ei]/(coeff-v[fI]); -# si := IntVecFFE(Coefficients(s.can,sc)); -# for k in [1..ext] do -# t := t * s.tfnei[i,k]^si[k]; -# od; -# v[2*n] := v[2*n] - v[ei]; -# v[ei] := zero; -# if M <> fail then -# for l in [1..Length(M)] do -# sc2 := sc * (M[l,2*n-1]-M[l,fI]); -# M[l,ei] := M[l,ei] + sc2; -# M[l,2*n] := M[l,2*n] + sc2; -# od; -# fi; -# Assert(1,v=vorig*t and (M = fail or Morig*t=M),ErrorNoReturn("Hallo 1")); -# fi; -# # Now kill v[fI] if need be: -# if not IsZero(v[fI]) then -# sc := -v[fI]/coeff; -# si := IntVecFFE(Coefficients(s.can,sc)); -# for k in [1..ext] do -# t := t * s.tfnfi[i,k]^si[k]; -# od; -# v[2*n] := v[2*n] - v[fI]; -# v[fI] := zero; -# if M <> fail then -# for l in [1..Length(M)] do -# sc2 := sc * (M[l,2*n-1]+M[l,ei]); -# M[l,fI] := M[l,fI] + sc2; -# M[l,2*n] := M[l,2*n] + sc2; -# od; -# fi; -# Assert(1,v=vorig*t and (M = fail or Morig*t=M),ErrorNoReturn("Hallo 2")); -# fi; -# elif not IsZero(one+v[ei]) then -# # The second easy case: -# # Here v[fI] = 1 and v[ei] <> 0: -# # First kill v[fI]: -# sc := -v[fI]/(coeff+v[ei]); -# si := IntVecFFE(Coefficients(s.can,sc)); -# for k in [1..ext] do -# t := t * s.tfnfi[i,k]^si[k]; -# od; -# v[2*n] := v[2*n] - v[fI]; -# v[fI] := zero; -# if M <> fail then -# for l in [1..Length(M)] do -# sc2 := sc * (M[l,2*n-1]+M[l,ei]); -# M[l,fI] := M[l,fI] + sc2; -# M[l,2*n] := M[l,2*n] + sc2; -# od; -# fi; -# Assert(1,v=vorig*t and (M = fail or Morig*t=M),ErrorNoReturn("Hallo 3")); -# # Now kill v[ei] if need be: -# sc := -v[ei]/coeff; -# si := IntVecFFE(Coefficients(s.can,sc)); -# for k in [1..ext] do -# t := t * s.tfnei[i,k]^si[k]; -# od; -# v[2*n] := v[2*n] - v[ei]; -# v[ei] := zero; -# if M <> fail then -# for l in [1..Length(M)] do -# sc2 := sc * (M[l,2*n-1]-M[l,fI]); -# M[l,ei] := M[l,ei] + sc2; -# M[l,2*n] := M[l,2*n] + sc2; -# od; -# fi; -# Assert(1,v=vorig*t and (M = fail or Morig*t=M),ErrorNoReturn("Hallo 4")); -# fi; -# if coeff = zeta then -# # Fix the e_n coefficient again: -# t := t * s.delta^-1; -# v[2*n-1] := v[2*n-1] * zeta^-1; -# v[2*n] := v[2*n] * zeta; -# if M <> fail then -# for l in [1..Length(M)] do -# M[l,2*n-1] := M[l,2*n-1] * zeta^-1; -# M[l,2*n] := M[l,2*n] * zeta; -# od; -# fi; -# Assert(1,v=vorig*t and (M = fail or Morig*t=M),ErrorNoReturn("Hallo 5")); -# fi; -# od; -# # Finally arrange fn component to 0: -# if not IsZero(v[2*n]) then -# sc := -v[2*n]; -# si := IntVecFFE(Coefficients(s.can,sc)); -# for k in [1..ext] do -# t := t * s.tfn[k]^si[k]; -# od; -# v[2*n] := zero; -# if M <> fail then -# for l in [1..Length(M)] do -# M[l,2*n] := M[l,2*n] + M[l,2*n-1] * sc; -# od; -# fi; -# Assert(1,v=vorig*t and (M = fail or Morig*t=M),ErrorNoReturn("Hallo 6")); -# fi; -# return t; -# end; -# -# RECOG.SpMakeImage_enfn := function(v,w,s,usencycle) -# local t,ttt; -# # This produces an element of Sp(2n,q) mapping v to e_n and w to f_n -# # as a product of the standard generators. Obviously, the pair (v,w) -# # must be a symplectic pair, furthermore, the e_n-component of v -# # must be one. -# # This function destroys v and w, it uses the ncycle if and only if -# # usencycle is true. -# t := RECOG.SpMakeImage_en(v,s,[w],usencycle); -# # We have achieved that t maps v to e_n and w is changed according -# # to the action to t on it. -# # Now we want to find a tt that maps w to f_n and fixes e_n, since -# # we have s.s mapping e_n to f_n and f_n to -e_n, we can use a ttt -# # mapping w*s.s^-1 to e_n and fixing f_n, and set tt := s.s^-1 * ttt * s.s. -# # Recall that (e_n,w) is a symplectic pair since (int[1],int[2]) was. -# Assert(1,IsOne(w[2*s.n])); -# # Compute w*s.s^-1: -# w[2*s.n] := -w[2*s.n-1]; -# w[2*s.n-1] := One(s.f); -# ttt := RECOG.SpMakeImage_en(w,s,fail,usencycle); -# t := t * s.s^-1 * ttt * s.s; -# return t; -# end; -# -# RECOG.DoSpExperiment := function(r) -# local Vn,Vnc,bas,bigbas,bigbasi,c,c1,fixc,i,int,int2,int3,perp,s,sum,suminter,suminter2,suminter3,t,tt,ttt,u,v,vecs,w,zeta; -# c1 := PseudoRandom(r.g); -# c := r.ncycle^c1; -# Vn := ExtractSubMatrix(r.id,[1..2*r.n],[1..2*r.d]); -# Vnc := ExtractSubMatrix(c,[1..2*r.n],[1..2*r.d]); -# suminter := SumIntersectionMat(Vn,Vnc); -# sum := suminter[1]; -# ConvertToMatrixRep(sum,r.f); -# vecs := suminter[2]; -# ConvertToMatrixRep(vecs,r.f); -# if Length(vecs) <> 2 then -# return ["Vn \cap Vnc not 2-dim",c1]; -# fi; -# if RankMat(ExtractSubMatrix(vecs,[1,2],[2*r.n-1,2*r.n])) < 2 then -# return ["Vn \cap Vnc cannot replace ",c1]; -# fi; -# if IsZero(vecs[1,2*r.n-1]) then -# vecs[1] := vecs[1]+vecs[2]; -# fi; -# MultRowVector(vecs[1],vecs[1,2*r.n-1]^-1); -# bas := RECOG.FindSymplecticPairBasis(vecs); -# if bas[1] = fail then -# return ["Vn \cap Vnc degenerate",c1]; -# fi; -# int := bas*vecs; -# perp := ExtractSubMatrix(r.id,[2*r.n+1..2*r.d],[1..2*r.d]); -# suminter2 := SumIntersectionMat(sum,perp); -# vecs := suminter2[2]; -# ConvertToMatrixRep(vecs,r.f); -# if Length(vecs) <> 2*r.n-2 then -# return ["(Vn + Vnc) \cap Vnperp not 2*n-2-dim",c1]; -# fi; -# bas := RECOG.FindSymplecticPairBasis(vecs); -# if bas[1] = fail then -# return ["(Vn + Vnc) \cap Vnperp degenerate",c1]; -# fi; -# int2 := bas * vecs; -# if 2*r.n-1 < r.d then -# fixc := NullspaceMat(c-One(c)); -# suminter3 := SumIntersectionMat(fixc,perp); -# vecs := suminter3[2]; -# ConvertToMatrixRep(vecs); -# if Length(vecs) <> 2*r.d - 4*r.n + 2 then -# return ["Fixc \cap Vnperp not 2*d-4*n+2-dim",c1]; -# fi; -# bas := RECOG.FindSymplecticPairBasis(vecs); -# if bas[1] = fail then -# return ["Fixc \cap Vnperp degenerate",c1]; -# fi; -# int3 := bas*vecs; -# else -# int3 := []; -# fi; -# # Now we find a product of transvections mapping -# # int[1] to e_n and fixing f_n, we keep track where int[2] is going. -# s := RECOG.MakeSp_StdGens(Characteristic(r.f), -# DegreeOverPrimeField(r.f),r.n,r.d); -# zeta := PrimitiveRoot(r.f); -# v := ShallowCopy(int[1]); -# w := ShallowCopy(int[2]); -# t := RECOG.SpMakeImage_enfn(v,w,s,true); -# # We have achieved that t^-1*c*t fixes e_n and f_n. -# c := t^-1 * c * t; -# -# # Now we need to find the new nice basis vectors n_1, ..., n_2*n-2 -# # they ought to be a symplectic basis when mapped with c and then -# # truncated to coordinates 2*n+1..2*d -# vecs := ExtractSubMatrix(c,[1..2*r.n-2],[2*r.n+1..2*r.d]); -# bas := RECOG.FindSymplecticPairBasis(vecs); -# vecs := bas * ExtractSubMatrix(c,[1..2*r.n-2],[1..2*r.d]); -# # We shall clean out the first 2*n entries of these vectors later on, -# # however, for the time being we keep them for cleaning purposes: -# u := EmptyPlist(2*r.n-2); -# for i in [1..2*r.n-2] do -# v := ZeroMutable(v); -# CopySubVector(bas[i],v,[1..2*r.n-2],[1..2*r.n-2]); -# v[2*r.n-1] := One(r.f); -# ttt := RECOG.SpMakeImage_en(v,s,fail,true); -# # Now clean it in the upper right and lower left corner: -# w := ZeroMutable(w); -# CopySubVector(vecs[i],w,[1..2*r.n-2],[1..2*r.n-2]); -# w[2*r.n-1] := One(r.f); -# tt := RECOG.SpMakeImage_en(w,s,fail,true); -# u[i] := List(s.ten,t->t^(ttt^-1*c*tt)); -# od; -# CopySubMatrix(ZeroMatrix(2*r.n-2,2*r.n,vecs),vecs, -# [1..2*r.n-2],[1..2*r.n-2],[1..2*r.n],[1..2*r.n]); -# bigbas := Concatenation(ExtractSubMatrix(r.id,[1..2*r.n],[1..2*r.d]), -# vecs, -# int3); -# bigbasi := bigbas^-1; -# if bigbasi = fail then -# return ["bigbas is singular",c1]; -# fi; -# return rec( bigbas := bigbas, bigbasi := bigbasi, c := c, c1 := c1, -# t := t, std := s, u := u ); -# end; -# -# RECOG.FindOrder3Element := function(g) -# local a,f,fa,m,o,p,pp,ppp,q,x,y; -# f := FieldOfMatrixGroup(g); -# q := Size(f); -# p := Characteristic(f); -# while true do -# Print(":\c"); -# x := PseudoRandom(g); -# m := MinimalPolynomial(x); -# fa := Collected(Factors(PolynomialRing(f),m)); -# o := Lcm(List(fa,p->q^Degree(p[1])-1)); -# pp := Maximum(List(fa,x->x[2])); -# ppp := p; -# while ppp < pp do -# ppp := ppp * p; -# od; -# while true do -# Print("-\c"); -# a := QuotientRemainder(Integers,o,3); -# if a[2] <> 0 then break; fi; -# o := a[1]; -# od; -# x := x^(o*ppp); -# if IsOne(x) then continue; fi; -# while true do -# Print("+\c"); -# y := x^3; -# if IsOne(y) then break; fi; -# x := y; -# od; -# break; -# od; -# Print("!\n"); -# # Now x is an element of Order 3 -# return x; -# end; -# -# RECOG.MovedSpace := function(g) -# local gens,sp; -# gens := GeneratorsOfGroup(g); -# sp := SemiEchelonMat(Concatenation(List(gens,x->x-One(x)))).vectors; -# return sp; -# end; -# -# RECOG.FixedSpace := function(g) -# local gens,i,inter,sp; -# gens := GeneratorsOfGroup(g); -# sp := List(gens,x->NullspaceMat(x-One(x))); -# if Length(sp) = 1 then -# ConvertToMatrixRep(sp[1],FieldOfMatrixGroup(g)); -# return sp[1]; -# fi; -# inter := SumIntersectionMat(sp[1],sp[2])[2]; -# for i in [3..Length(sp)] do -# inter := SumIntersectionMat(inter,sp[i])[2]; -# od; -# ConvertToMatrixRep(inter,FieldOfMatrixGroup(g)); -# return inter; -# end; -# -# RECOG.guck := function ( w ) -# local i; -# for i in w.slnstdf do -# Display( w.bas * i * w.basi ); -# od; -# if IsBound( w.transh ) then -# for i in [ 1 .. Length( w.transh ) ] do -# Print( i, "\n" ); -# if IsBound(w.transh[i]) then -# Display( w.bas * w.transh[i] * w.basi ); -# fi; -# od; -# fi; -# if IsBound( w.transv ) then -# for i in [ 1 .. Length( w.transv ) ] do -# Print( i, "\n" ); -# if IsBound(w.transv[i]) then -# Display( w.bas * w.transv[i] * w.basi ); -# fi; -# od; -# fi; -# return; -# end; - -# Now the code for writing SLPs: - -SLPforElementFuncsProjective.PSL2 := function(ri,x) - local det,log,slp,y,z,pos,s; - ri!.fakegens.count := ri!.fakegens.count + 1; - if ri!.fakegens.count > 1000 then - ri!.fakegens := RECOG.InitSLfake(ri!.field,2); - ri!.fakegens.count := 0; - fi; - y := ri!.nicebas * x * ri!.nicebasi; - det := DeterminantMat(y); - if not IsOne(det) then - z := PrimitiveRoot(ri!.field); - log := LogFFE(det,z); - y := y * z^(-log*ri!.gcd.coeff1/ri!.gcd.gcd); - fi; - # At this point, y has determinant 1; but we consider it modulo scalars. - # To make sure that different coset reps behave the same, we scale it - # with a suitable primitive d-th root of unity. - if not IsBound(ri!.normlist) then - ri!.normlist := RECOG.SetupNormalisationListForPSLd(ri!.field, - ri!.gcd.gcd); - fi; - pos := PositionNonZero(y[1]); - s := RECOG.NormaliseScalarForPSLd(y[1,pos],ri!.normlist); - slp := RECOG.ExpressInStd_SL2(s * y,ri!.fakegens); - return slp; -end; - -# s: a non-zero scalar -# list: a list of certain primitive roots of unity, as -# computed by SetupNormalisationListForPSLd -# -# This function considers s and all its multiples by the elements in -# list, and picks the smallest of them. It returns the multiplicator -# used to obtain that element from s. -RECOG.NormaliseScalarForPSLd := function(s,list) - local min,minmul,t,u; - min := s; - minmul := s^0; - for t in list do - u := s*t; - if u < min then - min := u; - minmul := t; - fi; - od; - return minmul; -end; - -# f: a finite field -# d: a positive integer -# -# Returns a list of primitive d-th roots of unity. -RECOG.SetupNormalisationListForPSLd := function(f,d) - local e,i,list,z; - list := EmptyPlist(d); - z := PrimitiveRoot(f)^((Size(f)-1)/d); - e := z; - for i in [1..d-1] do - Add(list,e); - e := e * z; - od; - return list; -end; - -# el: a field element -# d: a positive integer (typically ri!.gcd.gcd) -# f: a galois field (typically ri!.field) -# -# Compute a primitive d-th root of el in the field f. -# TODO: This function copies the code from RootFFE, which will -# appear in GAP 4.9. Once GAP 4.9 is out, we can switch -# to using RootFFE directly. -RECOG.ComputeRootInFiniteField := function(el, d, f) - local z, e, m, p, a; - if IsZero(el) or IsOne(el) then - return el; - fi; - z := PrimitiveRoot(f); - m := Size(f) - 1; - e := LogFFE(el, z); - p := GcdInt(m, e); - d := d mod m; - a := GcdInt(m, d); - if p mod a <> 0 then - return fail; - fi; - a := e * (a / d mod (m / p)) / a mod m; - return z ^ a; -end; - -# Express an element of PSL_d as an slp in terms of standard generators. -SLPforElementFuncsProjective.PSLd := function(ri,x) - local det,pos,root,s,slp,y; - ri!.fakegens.count := ri!.fakegens.count + 1; - if ri!.fakegens.count > 1000 then - ri!.fakegens := RECOG.InitSLfake(ri!.field,ri!.dimension); - ri!.fakegens.count := 0; - fi; - y := ri!.nicebas * x * ri!.nicebasi; - det := DeterminantMat(y); - if not IsOne(det) then - # At this point, y is in the kernel of the determinant map *mod scalars*. - # That means that det may not be 1 -- it can be any d-th power. - # We thus can compute a d-th root of 1/det, and scale y with it, - # in order to obtain a matrix with determinant 1 in the same - # projective class. - root := RECOG.ComputeRootInFiniteField(1/det,Length(y),ri!.field); - if root = fail then - return fail; - fi; - y := y * root; - fi; - # At this point, y has determinant 1; but we consider it modulo scalars. - # To make sure that different coset reps behave the same, we scale it - # with a suitable primitive d-th root of unity. - if not IsBound(ri!.normlist) then - ri!.normlist := RECOG.SetupNormalisationListForPSLd(ri!.field, - ri!.gcd.gcd); - fi; - pos := PositionNonZero(y[1]); - s := RECOG.NormaliseScalarForPSLd(y[1,pos],ri!.normlist); - slp := RECOG.ExpressInStd_SL(s * y,ri!.fakegens); - return slp; -end; - -#! @BeginChunk ClassicalNatural -#! TODO -#! @EndChunk -BindRecogMethod(FindHomMethodsProjective, "ClassicalNatural", -"check whether it is a classical group in its natural representation", -function(ri, g) - local changed,classical,d,det,ext,f,gcd,gens,gg,gm,i,p,pr,q,root,std,stdg,z; - d := ri!.dimension; - f := ri!.field; - q := Size(f); - p := Characteristic(f); - RECOG.SetPseudoRandomStamp(g,"ClassicalNatural"); - - # First check whether we are applicable: - if d = 2 then - if not RECOG.IsThisSL2Natural(GeneratorsOfGroup(g),f) then - Info(InfoRecog,2,"ClassicalNatural: Is not PSL_2."); - return fail; # FIXME: fail = TemporaryFailure here really correct? - fi; - else - classical := RecogniseClassical(g); - if classical.isSLContained <> true then - Info(InfoRecog,2,"ClassicalNatural: Is not PSL."); - return fail; # FIXME: fail = TemporaryFailure here really correct? - fi; - fi; - - # Now get rid of nasty determinants: - gens := ShallowCopy(GeneratorsOfGroup(g)); - changed := false; - z := Z(q); - gcd := Gcdex(d,q-1); - for i in [1..Length(gens)] do - det := DeterminantMat(gens[i]); - if not IsOne(det) then - root := RECOG.ComputeRootInFiniteField(det,gcd.gcd,f); - if root = fail then - ErrorNoReturn("Should not have happened, 15634, tell Max!"); - fi; - gens[i] := gens[i] * root; - changed := true; - fi; - od; - if changed then - gg := GroupWithGenerators(gens); - gm := GroupWithMemory(gens); - pr := ProductReplacer(GeneratorsOfGroup(gm),rec(maxdepth := 500)); - gm!.pseudorandomfunc := [rec( func := Next, args := [pr] )]; - else - gg := g; - gm := Group(ri!.gensHmem); - gm!.pseudorandomfunc := [rec(func := function(ri,name,bool) - return RandomElm(ri,name,bool).el; - end, - args := [ri,"ClassicalNatural",true])]; - fi; - - if d = 2 then - # We only have to check for (P)SL_2 since otherwise the subfield - # method will detect it. Note that this is a projective method, - # but a projective group contains PSL_2 if and only if the matrix - # group generated by the same matrices (possibly scaled to make - # the determinant to be 1) contains SL_2. - - # This is (P)SL2, lets set up the recognition: - Info(InfoRecog,2,"ClassicalNatural: this is PSL_2!"); - if IsEvenInt(q) then - std := RECOG.RecogniseSL2NaturalEvenChar(gm,f,false); - ri!.comment := "PSL2Even"; - else - std := RECOG.RecogniseSL2NaturalOddCharUsingBSGS(gm,f); - ri!.comment := "PSL2Odd"; - fi; - Setslptonice(ri,SLPOfElms(std.all)); - ri!.nicebas := std.bas; - ri!.nicebasi := std.basi; - SetNiceGens(ri,List(StripMemory(std.all),x->std.basi*x*std.bas)); - ri!.fakegens := RECOG.InitSLfake(f,2); - ri!.fakegens.count := 0; - ri!.gcd := gcd; - SetFilterObj(ri,IsLeaf); - SetSize(ri,(q+1)*(q-1)*q/GcdInt(2,q-1)); - SetIsRecogInfoForSimpleGroup(ri, q>3); - Setslpforelement(ri,SLPforElementFuncsProjective.PSL2); - return Success; - else # bigger than 2: - if classical.isSLContained = true then - # Do not run the generic code in small cases: - if (q^d-1)/(q-1) <= 1000 or d = 3 then - # FIXME: Note d=3 currently has a problem in the SL2-finder. - Info(InfoRecog,2,"Classical natural: SL(",d,",",q,"): small ", - "case, handing over to Schreier-Sims."); - ri!.comment := Concatenation("SL(",String(d),",",String(q),")", - "_StabilizerChain"); - return FindHomMethodsProjective.StabilizerChainProj(ri,g); - fi; - Info(InfoRecog,2,"ClassicalNatural: this is PSL_n!"); - std := RECOG.FindStdGens_SL(gm,f); - Setslptonice(ri,std.slpstd); - ri!.nicebas := std.bas; - ri!.nicebasi := std.basi; - ext := DegreeOverPrimeField(f); - stdg := RECOG.MakeSL_StdGens(p,ext,d,d); - SetNiceGens(ri,List(StripMemory(stdg.all), - x->std.basi*x*std.bas)); - ri!.fakegens := RECOG.InitSLfake(f,d); - ri!.fakegens.count := 0; - ri!.comment := "PSLd"; - ri!.gcd := gcd; - SetFilterObj(ri,IsLeaf); - SetSize(ri,Product([0..d-1],i->(q^d-q^i))/((q-1)*gcd.gcd)); - SetIsRecogInfoForSimpleGroup(ri,true); - Setslpforelement(ri,SLPforElementFuncsProjective.PSLd); - return Success; - fi; - fi; - - return fail; # FIXME: fail = TemporaryFailure here really correct? - -end); diff --git a/gap/projective/constructive_recognition/O/BaseCase.gi b/gap/projective/constructive_recognition/O/BaseCase.gi new file mode 100644 index 000000000..5213aefe8 --- /dev/null +++ b/gap/projective/constructive_recognition/O/BaseCase.gi @@ -0,0 +1,32 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +############################################################################# + + + +############################################################################# +############################################################################# +######## BaseCase algorithm for orthogonal groups ########################### +############################################################################# +############################################################################# + + + +# Find isomorphism from POmega(5,q) to PSp(4,q) and +# use constructive recognition of PSp(4,q) +RECOG.ConstructiveRecognitionOfSO6 := function(h,q,form) + + # TODO + +end; diff --git a/gap/projective/constructive_recognition/O/GoingDown.gi b/gap/projective/constructive_recognition/O/GoingDown.gi new file mode 100644 index 000000000..1ef78e0db --- /dev/null +++ b/gap/projective/constructive_recognition/O/GoingDown.gi @@ -0,0 +1,122 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +############################################################################# + + + +############################################################################# +############################################################################# +######## GoingDown method for orthogonal groups ############################# +############################################################################# +############################################################################# + + + +RECOG.SO_godownToDimension6 := function(h,q) +local counter, ele, x, x2, ord, invo, found, cent, product, eigenspace, Minuseigenspace, newbasis, dimeigen, dimMinuseigen, r1, r2, result; + + # First we construct an involution i in h + + found := false; + for counter in [1..100] do + ele := PseudoRandom(h); + x := RECOG.EstimateOrder(ele); + x2 := x[2]; + ord := x[3]; + if x2 <> One(h) then + invo := x2^(ord/2); + else + invo := One(h); + fi; + + if invo <> One(h) and invo^2 = One(h) then + eigenspace := Eigenspaces(GF(q),invo); + if Size(eigenspace) <> 1 then + Minuseigenspace := eigenspace[2]; + eigenspace := eigenspace[1]; + dimeigen := Dimension(eigenspace); + dimMinuseigen := Dimension(Minuseigenspace); + if dimeigen = 6 or dimMinuseigen = 6 then + found := true; + break; + fi; + fi; + fi; + od; + + if not(found) then + Error("could not find an involution"); + fi; + + newbasis := MutableCopyMat(BasisVectors(Basis(eigenspace))); + Append(newbasis,BasisVectors(Basis(Minuseigenspace))); + + # Second we compute the two factors by computing the centralizer of the involution i + + cent := RECOG.CentraliserOfInvolution(h,invo,[],true,100,RECOG.CompletionCheck,PseudoRandom); + product := GroupByGenerators(cent[1]); + + # Third we continue as in "Constructive recognition of classical groups in odd characteristic" part 11 to find generator + + if dimeigen = 6 then + r1 := [1..dimeigen]; + r2 := [7,8]; + else + r1 := [dimeigen+1..8]; + r2 := [1,2]; + fi; + for counter in [1..100] do + result := RECOG.ConstructSmallSub(r1, r2, product, newbasis, g -> RecogniseClassical(g).isSOContained); + if result <> fail then + break; + fi; + od; + + return result; + +end; + + + +RECOG.SOn_constructso2:=function(g,d,q,form) +local r,h,basechange,basechange2,slp,liftbasechange2,liftr; + + r := RECOG.constructppdTwoStingray(g,d,q,"O",form); + Info(InfoRecog,2,"Finished main GoingDown, i.e. we found a stringray element which operates irreducible on a 8 dimensional subspace. \n"); + # Remark D.R.: at this point we know that h is isomorphic to Omega(8,q) + Info(InfoRecog,2,"Succesful. "); + Info(InfoRecog,2,"Current Dimension: 8\n"); + Info(InfoRecog,2,"Next goal: Generate Omega(4,q). \n"); + if IsEvenInt(q) then + basechange := RECOG.ComputeBlockBaseChangeMatrix(GeneratorsOfGroup(r),d,q); + liftr := List(GeneratorsOfGroup(r),x->x^(basechange^(-1))); + return [GroupByGenerators(liftr),basechange]; + else + # For now, compute a base change into the stingray matrices + basechange := RECOG.ComputeBlockBaseChangeMatrix(GeneratorsOfGroup(r),d,q); + #slp := SLPOfElms(GeneratorsOfGroup(r)); + + r := RECOG.SO_godownToDimension6(RECOG.ExtractSmallerGroup(GeneratorsOfGroup(r),basechange,8)[1],q); + basechange2 := RECOG.ComputeBlockBaseChangeMatrix(r[1],8,q); + liftbasechange2 := RECOG.LiftGroup([basechange2],8,q,d)[2,1]; + liftr := RECOG.LiftGroup(r[1],8,q,d)[2]; + + liftr := List(liftr,x->x^(liftbasechange2^(-1))); + #slp := CompositionOfStraightLinePrograms(SLPOfElms(r[1]),slp); + # Remark D.R.: at this point we know that h is isomorphic to Sp(6,q) + + return [GroupByGenerators(liftr),liftbasechange2*basechange]; + # return ["sorry only SL(4,q)",h]; + fi; +end; diff --git a/gap/projective/constructive_recognition/O/GoingUp.gi b/gap/projective/constructive_recognition/O/GoingUp.gi new file mode 100644 index 000000000..316541eb4 --- /dev/null +++ b/gap/projective/constructive_recognition/O/GoingUp.gi @@ -0,0 +1,1026 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +############################################################################# + + + +############################################################################# +############################################################################# +######## GoingUp method for orthogonal groups ############################### +############################################################################# +############################################################################# + + + +# change input into H again +RECOG.Omegan_UpStep := function(H,G,n,basechange) +# w has components: +# d : size of big SL +# n : size of small SL +# slnstdf : fakegens for SL_n standard generators +# bas : current base change, first n vectors are where SL_n acts +# rest of vecs are invariant under SL_n +# basi : current inverse of bas +# sld : original group with memory generators, PseudoRandom +# delivers random elements +# sldf : fake generators to keep track of what we are doing +# f : field +# The following are filled in automatically if not already there: +# p : characteristic +# ext : q=p^ext +# One : One(slnstdf[1]) +# can : CanonicalBasis(f) +# canb : BasisVectors(can) +# transh : fakegens for the "horizontal" transvections n,i for 1<=i<=n-1 +# entries can be unbound in which case they are made from slnstdf +# transv : fakegens for the "vertical" transvections i,n for 1<=i<=n-1 +# entries can be unbound in which case they are made from slnstdf +# +# We keep the following invariants (going from n -> n':=2n-1) +# bas, basi is a base change to the target base +# slnstdf are SLPs to reach standard generators of SL_n from the +# generators of sld +local d, id, FixSpn, Vn, q, p, F, t, GM, counter, aimdim, newdim, c1, c, ci, sum1, int1, i, v1, v2, v3, L1, L2, newpart, zerovec, MB, newbas, newbasi, int3, pivots, cii, pivots2, + newbasechange, trans, tf, lambda, killer, transr, gamma1, gamma2, gamma3, gamma4, gamma0, zeta, k, beta, vectorw, normx, PermMat, PermMat2, HBig, HBigGens, H2n, HSmall, transd, + WrongForm, ChangeToCorrectForm, ChangeToCorrectFormBig, extract, ChangeToCorrectForm2, ChangeToCorrectFormBig2, FormValue, killervalue, killersupport, vectorlist, VC, VCBasis, HFake, + LinearCombinationVector, s, flag, v, PermMat3, fixv, factors, ext, vectorlistindex, vectorlist2, vectorlistele, indexlist, VCBuildBasis, CanonicalVC,form, + ChangeToCorrectFormBig22, ciT, basechangeBackUp; + + F := FieldOfMatrixGroup(H); + d := Size(GeneratorsOfGroup(G)[1]); + q := Size(F); + factors := Factors(q); + p := Factors(q)[1]; + ext := Size(factors); + + # Here everything starts, some more preparations: + + # We compute exclusively in our basis, so we occasionally need an + # identity matrix: + id := IdentityMat(d,F); + FixSpn := VectorSpace(F,id{[n+1..d]}); + Vn := VectorSpace(F,id{[1..n]}); + + Info(InfoRecog,2,"Current dimension: " ); + Info(InfoRecog,2,n); + Info(InfoRecog,2,"\n"); + Info(InfoRecog,2,"New dimension: "); + Info(InfoRecog,2,Minimum(2*n-4,d)); + Info(InfoRecog,2,"\n"); + #aimdim := Minimum(2*n-2,d); + #newdim := aimdim - n; + aimdim := Minimum(2*n-4,d); + newdim := aimdim - n; + form := PreservedSesquilinearForms(Omega(1,n,q))[1]!.matrix; + counter := 0; + basechangeBackUp := MutableCopyMat(basechange); + + Info(InfoRecog,2,"Preparation done."); + + # Generalise the next step + t := IdentityMat(d,F); + if n = 4 then + t[1,2] := One(F); + t[3,4] := -1*One(F); + t[1,4] := PrimitiveElement(F)^3; + fi; + + if n = 6 then + t[1,2] := One(F); + t[1,3] := One(F); + t[2,3] := One(F); + t[4,5] := -1*One(F); + t[5,6] := -1*One(F); + t := PermutationMat((1,2,3)(6,5,4),d,F); + t := PermutationMat((2,3)(4,5),d,F); + fi; + + if n > 6 then + v := Zero(F) * IdentityMat( n, F ); + v[n/2][1] := One(F); + v{[1..(n/2)-1]}{[2..n/2]} := IdentityMat((n/2)-1,F); + v[n/2+1][n] := One(F); + v{[(n/2)+2..n]}{[(n/2)+1..n-1]} := IdentityMat((n/2)-1,F); + t{[1..n]}{[1..n]} := v; + t := PermutationMat((2,3,4)(5,7,6),d,F); + #Display(t); + #Display(t^basechange in G); + fi; + + Info(InfoRecog,2,"Step 1 done."); + + # Find a good random element: + while true do # will be left by break + while true do # will be left by break + counter := counter + 1; + if InfoLevel(InfoRecog) >= 3 then Print(".\c"); fi; + c1 := PseudoRandom(G); + + # Do the base change into our basis: + c1 := c1^((basechange)^(-1)); + c := t^c1; + + # Now check that Vn + Vn*s^c1 has dimension 2n-1: + sum1 := SumIntersectionMat(c{[1..n]},id{[1..n]}); + + if Size(sum1[1]) = aimdim then + + int1 := SumIntersectionMat(RECOG.FixspaceMat(c),id{[1..n]})[2]; + + for i in [1..Size(int1)] do + v1 := int1[i]; + if not(IsZero(v1[1])) then break; fi; + od; + for i in [1..Size(int1)] do + v2 := int1[i]; + if (v1 <> v2) and not(IsZero(v2[n])) then break; fi; + od; + if (v1 = v2) or IsZero(v1[1]) or IsZero(v2[n]) then + Info(InfoRecog,2,"Ooops: Component n was zero!"); + continue; + fi; + + v1 := v1 / v1[1]; # normalize to 1 in position 1 + Assert(1,v1*c=v1); + + v2 := v2 / v2[n]; # normalize to 1 in position n + Assert(1,v2*c=v2); + + if v1{[1..n]}*form*v1{[1..n]} = Zero(F) and v2{[1..n]}*form*v2{[1..n]} = Zero(F) then + + L1 := IdentityMat(d,F); + L2 := IdentityMat(d,F); + + for i in [2..n-1] do + L1[1,i] := v1[i]; + L1[n-i+1,n] := -1*v1[i]; + od; + if v1[n] <> Zero(F) then + L1[1,n] := v1[n]; + fi; + + c := L1*c*L1^(-1); + int1 := SumIntersectionMat(RECOG.FixspaceMat(c),id{[1..n]})[2]; + for i in [1..Size(int1)] do + v2 := int1[i]; + if not(IsZero(v2[n])) then break; fi; + od; + + if IsZero(v2[n]) then + Info(InfoRecog,2,"Ooops: Component n was zero!"); + continue; + fi; + + v2 := v2 / v2[n]; # normalize to 1 in position n + Assert(1,v2*c=v2); + + if v2{[1..n]}*form*v2{[1..n]} = Zero(F) then + + for i in [2..n-1] do + L2[n,i] := v2[i]; + L2[n-i+1,1] := -1*v2[i]; + od; + if v2[1] <> Zero(F) then + L2[n,1] := v2[1]; + fi; + + c := L2*c*L2^(-1); + ci := c^-1; + break; + fi; + Display("fail"); + fi; + Display("fail"); + fi; + # Display(counter); + od; + + Info(InfoRecog,2,"Step 2 done."); + + # Now we found our aimdim-dimensional space W. Since Sp_n + # has a d-n-dimensional fixed space W_{d-n} and W contains a complement + # of that fixed space, the intersection of W and W_{d-n} has dimension + # newdim. + + # Change basis: + newpart := ExtractSubMatrix(c,[2..(n-1)],[1..(d)]); + # Clean out the first n entries to go to the fixed space of Sp_n: + zerovec := Zero(newpart[1]); + for i in [1..(n-2)] do + CopySubVector(zerovec,newpart[i],[1..n],[1..n]); + od; + MB := MutableBasis(F,[],zerovec); + i := 1; + pivots := EmptyPlist(newdim); + while i <= Length(newpart) and NrBasisVectors(MB) < newdim do + if not(IsContainedInSpan(MB,newpart[i])) then + Add(pivots,i); + CloseMutableBasis(MB,newpart[i]); + fi; + i := i + 1; + od; + newpart := newpart{pivots}; + newbas := Concatenation(id{[1..n]},newpart); + if 2*n-2 < d then + int3 := SumIntersectionMat(RECOG.FixspaceMat(c),id{[n+1..d]})[2]; + if Size(int3) <> d - aimdim then + Info(InfoRecog,2,"Ooops, FixSLn \cap Fixc wrong dimension"); + continue; + fi; + Append(newbas,int3); + fi; + ConvertToMatrixRep(newbas,Size(F)); + newbasi := newbas^-1; + if newbasi = fail then + Info(InfoRecog,2,"Ooops, Fixc intersected too much, we try again"); + continue; + fi; + + ci := newbas * ci * newbasi; + + cii := ExtractSubMatrix(ci,[n+1..aimdim],[2..n-1]); + ConvertToMatrixRep(cii,Size(F)); + cii := TransposedMat(cii); + # The rows of cii are now what used to be the columns, + # their length is newdim, we need to span the full newdim-dimensional + # row space and need to remember how: + zerovec := Zero(cii[1]); + MB := MutableBasis(F,[],zerovec); + i := 1; + pivots2 := EmptyPlist(newdim); + while i <= Length(cii) and NrBasisVectors(MB) < newdim do + if not(IsContainedInSpan(MB,cii[i])) then + Add(pivots2,i); + CloseMutableBasis(MB,cii[i]); + fi; + i := i + 1; + od; + if Length(pivots2) = newdim then + cii := cii{pivots2}^-1; + ConvertToMatrixRep(cii,F); + c := newbas * c * newbasi; + newbasechange := newbas*basechange; + + Info(InfoRecog,2,"Start of form change"); + + # Transform the form into standard form + + # TODO: Base change not completely correct yet + HFake := RECOG.LiftGroup(GeneratorsOfGroup(Omega(1,n,q)),n,q,d)[1]; + HBigGens := List(GeneratorsOfGroup(HFake),MutableCopyMat); + Append(HBigGens,GeneratorsOfGroup(HFake^c)); + HBig := GroupByGenerators(HBigGens); + basechange := newbasechange; + HSmall := GroupByGenerators(List(GeneratorsOfGroup(HBig),x->x{[1..aimdim]}{[1..aimdim]})); + WrongForm := PreservedSesquilinearForms(HSmall)[1]; + FormValue := (WrongForm!.matrix)[1,n]; + extract := BilinearFormByMatrix((FormValue^(-1)*WrongForm!.matrix){[n+1..aimdim]}{[n+1..aimdim]}, F ); + ChangeToCorrectForm := BaseChangeToCanonical(extract); + ChangeToCorrectFormBig := IdentityMat(aimdim,F); + ChangeToCorrectFormBig{[n+1..aimdim]}{[n+1..aimdim]} := ChangeToCorrectForm; + ChangeToCorrectFormBig2 := IdentityMat(d,F); + ChangeToCorrectFormBig2{[1..aimdim]}{[1..aimdim]} := ChangeToCorrectFormBig^(-1); + HBig := HBig^ChangeToCorrectFormBig2; + c := ChangeToCorrectFormBig2^(-1) * c * ChangeToCorrectFormBig2; + basechange := ChangeToCorrectFormBig2^(-1)*basechange; + + if aimdim - n > 2 then + # TODO: Adjust next line to omega groups + ChangeToCorrectFormBig22 := RECOG.ComputeCorrectingPermutationMatSpTwo(d,F,n,aimdim); + HBig := HBig^ChangeToCorrectFormBig22; + c := ChangeToCorrectFormBig22^(-1) * c * ChangeToCorrectFormBig22; + basechange := ChangeToCorrectFormBig22^(-1)*basechange; + fi; + + # TODO: Try hack + HFake := RECOG.LiftGroup(GeneratorsOfGroup(Omega(1,n,q)),n,q,d)[1]; + HBigGens := List(GeneratorsOfGroup(HFake),MutableCopyMat); + Append(HBigGens,GeneratorsOfGroup(HFake^c)); + HBig := GroupByGenerators(HBigGens); + HSmall := GroupByGenerators(List(GeneratorsOfGroup(HBig),x->x{[1..aimdim]}{[1..aimdim]})); + WrongForm := PreservedSesquilinearForms(HSmall)[1]; + FormValue := (WrongForm!.matrix)[1,n]; + extract := BilinearFormByMatrix((FormValue^(-1)*WrongForm!.matrix){[n+1..aimdim]}{[n+1..aimdim]}, F ); + + if (extract!.matrix)[1,1] = Zero(F) then + ChangeToCorrectForm := BaseChangeToCanonical(extract); + ChangeToCorrectFormBig := IdentityMat(aimdim,F); + ChangeToCorrectFormBig{[n+1..aimdim]}{[n+1..aimdim]} := ChangeToCorrectForm; + ChangeToCorrectFormBig2 := IdentityMat(d,F); + ChangeToCorrectFormBig2{[1..aimdim]}{[1..aimdim]} := ChangeToCorrectFormBig^(-1); + HBig := HBig^ChangeToCorrectFormBig2; + c := ChangeToCorrectFormBig2^(-1) * c * ChangeToCorrectFormBig2; + basechange := ChangeToCorrectFormBig2^(-1)*basechange; + + if aimdim - n > 2 then + # TODO: Adjust next line to omega groups + ChangeToCorrectFormBig22 := RECOG.ComputeCorrectingPermutationMatSpTwo(d,F,n,aimdim); + HBig := HBig^ChangeToCorrectFormBig22; + c := ChangeToCorrectFormBig22^(-1) * c * ChangeToCorrectFormBig22; + basechange := ChangeToCorrectFormBig22^(-1)*basechange; + fi; + + ci := c^-1; + ciT := TransposedMat(ci); + + Info(InfoRecog,2,"End of form change"); + + break; + else + Info(InfoRecog,2,"End of form change"); + basechange := basechangeBackUp; + fi; + fi; + Info(InfoRecog,2,"Ooops, no nice bottom or the wrong orhtogonal group..."); + # Otherwise simply try again + od; + + + # Now consider the transvections t_i: + # t_i : w.bas[j] -> w.bas[j] for j <> i and + # t_i : w.bas[i] -> w.bas[i] + ww + # We want to modify (t_i)^c such that it fixes w.bas{[1..w.n]}: + if not(IsEvenInt(aimdim)) then + trans := []; + vectorlist := []; + for i in [1..(n-2)] do + # This does t_i + for lambda in [One(F)] do + # This does t_i : v_j -> v_j + lambda * v_n + tf := IdentityMat(d,F); + tf[i+1,n] := lambda; + tf[1,n-i] := -1*(lambda); + # Now conjugate with c: + tf := ci*tf*c; + # Now cleanup in column n above row n, the entries there + # are lambda times the stuff in column i of ci: + #for j in [1..w.n-1] do + # tf := DoRowOp_n(tf,j,w.n,-ci[j,i]*lambda,w); + #od; + killer := IdentityMat(d,F); + for killervalue in [2..n-1] do + killersupport := IdentityMat(d,F); + killersupport[1,killervalue] := (-1)*tf[1,killervalue]; + killersupport[n-killervalue+1,n] := (tf[1,killervalue]); + #Display(killersupport); + killer := killer*killersupport; + od; + #killer{[1..n]}{[1..n]} := tf{[1..n]}{[1..n]}^(-1); + #if (killer^newbasechange)^testchange in SO(1,d,q) then + # tf := killer*tf; + #else + # Error("this should not happen."); + #fi; + Add(vectorlist,tf{[n+1..aimdim]}{[n]}); + Add(trans,tf); + od; + od; + + # For now vector space variant. but change that! + VC := VectorSpace(GF(p),vectorlist); + + # If we are finishing up, then we have to take a linear independent subset + if aimdim < 2*n-4 then + vectorlist2 := []; + indexlist := []; + for vectorlistindex in [1..Size(vectorlist)] do + vectorlistele := vectorlist[vectorlistindex]; + VCBuildBasis:=VectorSpace( GF(p), Concatenation(vectorlist2,[vectorlistele]) ); + if Dimension(VCBuildBasis) > Length(vectorlist2) then + Add(vectorlist2,vectorlistele); + Add(indexlist,vectorlistindex); + fi; + if Length(vectorlist2) = Dimension(VC) then + break; + fi; + od; + VCBasis := Basis(VC,vectorlist2); + else + VCBasis := Basis(VC,vectorlist); + fi; + + # # Now put together the clean ones by our knowledge of c^-1: + transd := []; + CanonicalVC := BasisVectors(CanonicalBasis(VC)); + for i in CanonicalVC do + LinearCombinationVector := Coefficients(VCBasis,i); + tf := IdentityMat(d,F); + + # TODO: We need to take the substitute trans[lambda] by trans[indexlist[lambda]] or something like that + for lambda in [1..Size(LinearCombinationVector)] do + tf := tf*trans[lambda]^Int(LinearCombinationVector[lambda]); + od; + killer{[1..n]}{[1..n]} := tf{[1..n]}{[1..n]}^(-1); + if not(Position(CanonicalVC,i) in [Size(CanonicalVC)/2,Size(CanonicalVC)/2 + 1]) then + #if killer^newbasechange in G then + # tf := killer*tf; + #else + # Error("this should not happen."); + #fi; + fi; + Add(transd,tf); + od; + Unbind(trans); + + Info(InfoRecog,2,"Step 5 done"); + + # Now to the "horizontal" transvections, first create them as SLPs: + transr := []; + trans := []; + vectorlist := []; + for lambda in [One(F)] do + # This does t_i + for i in [2..(n-1)] do + # This does t_i : v_j -> v_j + lambda * v_n + tf := IdentityMat(d,F); + tf[i,1] := lambda; + tf[n,n-i+1] := -1*(lambda); + # Now conjugate with c: + tf := ci*tf*c; + # Now cleanup in column n above row n, the entries there + # are lambda times the stuff in column i of ci: + #for j in [1..w.n-1] do + # tf := DoRowOp_n(tf,j,w.n,-ci[j,i]*lambda,w); + #od; + killer := IdentityMat(d,F); + for killervalue in [2..n-1] do + killersupport := IdentityMat(d,F); + killersupport[killervalue,1] := (-1)*tf[killervalue,1]; + killersupport[n,n-killervalue+1] := (tf[killervalue,1]); + #Display(killersupport); + killer := killer*killersupport; + od; + #killer{[1..n]}{[1..n]} := tf{[1..n]}{[1..n]}^(-1); + #if killer^newbasechange in G then + # tf := killer*tf; + #else + # Error("this should not happen."); + #fi; + Add(vectorlist,tf{[n]}{[n+1..aimdim]}); + Add(trans,tf); + od; + od; + + # For now vector space variant. but change that! + VC := VectorSpace(GF(p),vectorlist); + if aimdim < 2*n-4 then + vectorlist2 := []; + indexlist := []; + for vectorlistindex in [1..Size(vectorlist)] do + vectorlistele := vectorlist[vectorlistindex]; + VCBuildBasis:=VectorSpace( GF(p), Concatenation(vectorlist2,[vectorlistele]) ); + if Dimension(VCBuildBasis) > Length(vectorlist2) then + Add(vectorlist2,vectorlistele); + Add(indexlist,vectorlistindex); + fi; + if Length(vectorlist2) = Dimension(VC) then + break; + fi; + od; + VCBasis := Basis(VC,vectorlist2); + else + VCBasis := Basis(VC,vectorlist); + fi; + + CanonicalVC := BasisVectors(CanonicalBasis(VectorSpace(F,IdentityMat(aimdim-n,F)))); + for i in CanonicalVC do + LinearCombinationVector := Coefficients(VCBasis,[i]); + tf := IdentityMat(d,F); + for lambda in [1..Size(LinearCombinationVector)] do + tf := tf*trans[indexlist[lambda]]^Int(LinearCombinationVector[lambda]); + od; + killer{[1..n]}{[1..n]} := tf{[1..n]}{[1..n]}^(-1); + if not(Position(CanonicalVC,i) = (Size(CanonicalVC)+1)/2) then + #if killer^newbasechange in G then + # tf := killer*tf; + #else + # Error("this should not happen."); + #fi; + fi; + Add(transr,tf); + od; + Unbind(trans); + + Info(InfoRecog,2,"Step 6 done"); + + # From here on we distinguish three cases: + # * w.n = 2 + # * we finish off the constructive recognition + # * we have to do another step as the next thing + if n = 4 then + #w.slnstdf[2*w.ext+2] := transd[1]*transr[1]^-1*transd[1]; + #w.slnstdf[2*w.ext+1] := w.transh[1]*w.transv[1]^-1*w.transh[1] + # *w.slnstdf[2*w.ext+2]; + #Unbind(w.transh); + #Unbind(w.transv); + #w.n := 3; + flag := false; + s := IdentityMat(d,F); + PermMat3 := PermutationMat((3,5)(6,4),d,F); + v := PermutationMat((1,2)(3,4),d,F); + #PermMat3 := PermutationMat((3,5)(6,4),20,GF(5)); + # w.ext = 2? + #for i in [n-1,n-3..1] do + flag := false; + for i in [2] do + if flag then + # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + tf := transd[(i-1)*ext+1]*transr[i]^-1*transd[(i-1)*ext+1]; + else + # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + #Display(transd[(i-1)*1+1]*transr[i]^-1*transd[(i-1)*1+1]); + tf := transd[(i-1)*ext+1]^-1*transr[i]*transd[(i-1)*ext+1]^-1; + fi; + #Display(tf); + #Display((tf^(v^2))^(PermMat3^(-1))); + s := s * tf; + flag := not(flag); + od; + + fixv := IdentityMat(d,F); + fixv[1,1] := -1*One(F); + fixv[4,4] := -1*One(F); + newbasechange := PermMat3^(-1)*basechange; + #Display((v*s*fixv)^(PermMat3^(-1))); + # Now compute v*s + Info(InfoRecog,2,"Step 7 done"); + Error("here"); + #return w; + fi; + # We can finish off: + # if aimdim = w.GoalDim then + # # In this case we just finish off and do not bother with + # # the transvections, we will only need the standard gens: + # # Now put together the (newdim+1)-cycle: + # # n+newdim -> n+newdim-1 -> ... -> n+1 -> n -> n+newdim + # flag := false; + # s := w.One; + # for i in [1..newdim] do + # if flag then + # # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + # tf:=transd[(i-1)*w.ext+1]*transr[i]^-1*transd[(i-1)*w.ext+1]; + # else + # # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + # tf:=transd[(i-1)*w.ext+1]^-1*transr[i]*transd[(i-1)*w.ext+1]^-1; + # fi; + # s := s * tf; + # flag := not(flag); + # od; + + # # Finally put together the new 2n-1-cycle and 2n-2-cycle: + # s := s^-1; + # w.slnstdf[2*w.ext+1] := w.slnstdf[2*w.ext+1] * s; + # w.slnstdf[2*w.ext+2] := w.slnstdf[2*w.ext+2] * s; + # Unbind(w.transv); + # Unbind(w.transh); + # w.n := aimdim; + # Display("Step 7 done"); + # return w; + # fi; + + # Otherwise we do want to go on as the next thing, so we want to + # keep our transvections. This is easily done if we change the + # basis one more time. Note that we know that n is odd here! + + # Put together the n-cycle: + # 2n-1 -> 2n-2 -> ... -> n+1 -> n -> 2n-1 + + # TODO: WE HAVE TO COMBINE THE v-CYCLE DIFFERENTLY HERE + + flag := false; + s := IdentityMat(d,F); + #PermMat3 := PermutationMat((4,7,10,6,9,5,8),20,GF(5)); + PermMat3 := RECOG.ComputeCorrectingPermutationMatOdd(d,F,n,aimdim); + Display(PermMat3); + + # TODO: Last step of building v in odd dimension + Error("here"); + v := Zero(F) * IdentityMat( d, F ); + v[n/2][1] := One(F); + v{[1..(n/2)-1]}{[2..n/2]} := IdentityMat((n/2)-1,F); + v[n/2+1][n] := One(F); + v{[(n/2)+2..n]}{[(n/2)+1..n-1]} := IdentityMat((n/2)-1,F); + v{[n+1..d]}{[n+1..d]} := IdentityMat(d-n,F); + #Display(t); + #Display(t^basechange in G); + #PermMat3 := PermutationMat((3,5)(6,4),20,GF(5)); + # w.ext = 2? + #for i in [n-1,n-3..1] do + #for i in [Size(transr)-1,Size(transr)-3..5] do + for i in [n-2,n-3..(n/2)] do + if flag then + # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + # TODO: Replace 2 by size of extension to get the correct matrices of transd (we want the ones with 1 and -1 at the transvection positions) + tf := transd[(i-1)*ext+1]*transr[i]^-1*transd[(i-1)*ext+1]; + else + # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + # TODO: Replace 2 by size of extension to get the correct matrices of transd (we want the ones with 1 and -1 at the transvection positions) + tf := transd[(i-1)*ext+1]^-1*transr[i]*transd[(i-1)*ext+1]^-1; + fi; + #Display(tf); + #Display((tf^(v^2))^(PermMat3^(-1))); + #Display(tf); + s := s * tf; + flag := not(flag); + od; + + #Display(((v*s)^(-1))^(PermMat3)); + newbasechange := PermMat3^(-1)*basechange; + # Now compute v*s + # Info(InfoRecog,2,"Step 7 done"); + Error("here"); + + # # Finally put together the new 2n-1-cycle and 2n-2-cycle: + # w.slnstdf[2*w.ext+1] := s * w.slnstdf[2*w.ext+1]; + # w.slnstdf[2*w.ext+2] := s * w.slnstdf[2*w.ext+2]; + + # list := Concatenation([1..w.n-1],[w.n+1..2*w.n-1],[w.n],[2*w.n..w.d]); + # perm := PermList(list); + # mat := PermutationMat(perm^-1,w.d,w.f); + # ConvertToMatrixRep(mat,w.f); + # w.bas := w.bas{list}; + # ConvertToMatrixRep(w.bas,w.f); + # w.basi := w.basi*mat; + + # # Now add the new transvections: + # for i in [1..w.n-1] do + # w.transh[w.ext*(w.n-1)+w.ext*(i-1)+1] := transr[i]; + # od; + # Append(w.transv,transd); + # w.n := 2*w.n-1; + + #if( aimdim = 5) then + # Error("here"); + #fi; + else + trans := []; + vectorlist := []; + for i in [1..(n-2)] do + # This does t_i + for lambda in [One(F)] do + # This does t_i : v_j -> v_j + lambda * v_n + tf := IdentityMat(d,F); + tf[i+1,n] := lambda; + tf[1,n-i] := -1*(lambda); + # Now conjugate with c: + tf := ci*tf*c; + # Now cleanup in column n above row n, the entries there + # are lambda times the stuff in column i of ci: + #for j in [1..w.n-1] do + # tf := DoRowOp_n(tf,j,w.n,-ci[j,i]*lambda,w); + #od; + killer := IdentityMat(d,F); + for killervalue in [2..n-1] do + killersupport := IdentityMat(d,F); + killersupport[1,killervalue] := (-1)*tf[1,killervalue]; + killersupport[n-killervalue+1,n] := (tf[1,killervalue]); + #Display(killersupport); + killer := killer*killersupport; + od; + #killer{[1..n]}{[1..n]} := tf{[1..n]}{[1..n]}^(-1); + if killer{[1..n]}{[1..n]} in Omega(1,n,q) then + tf := killer*tf; + else + Error("this should not happen."); + fi; + Add(vectorlist,tf{[n+1..aimdim]}{[n]}); + Add(trans,tf); + od; + od; + + # For now vector space variant. but change that! + VC := VectorSpace(GF(p),vectorlist); + + # If we are finishing up, then we have to take a linear independent subset + if aimdim < 2*n-2 then + vectorlist2 := []; + indexlist := []; + for vectorlistindex in [1..Size(vectorlist)] do + vectorlistele := vectorlist[vectorlistindex]; + VCBuildBasis:=VectorSpace( GF(p), Concatenation(vectorlist2,[vectorlistele]) ); + if Dimension(VCBuildBasis) > Length(vectorlist2) then + Add(vectorlist2,vectorlistele); + Add(indexlist,vectorlistindex); + fi; + if Length(vectorlist2) = Dimension(VC) then + break; + fi; + od; + VCBasis := Basis(VC,vectorlist2); + else + VCBasis := Basis(VC,vectorlist); + fi; + + # # Now put together the clean ones by our knowledge of c^-1: + transd := []; + for i in BasisVectors(CanonicalBasis(VC)) do + LinearCombinationVector := Coefficients(VCBasis,i); + tf := IdentityMat(d,F); + + # TODO: We need to take the substitute trans[lambda] by trans[indexlist[lambda]] or something like that + for lambda in [1..Size(LinearCombinationVector)] do + tf := tf*trans[indexlist[lambda]]^Int(LinearCombinationVector[lambda]); + od; + killer{[1..n]}{[1..n]} := tf{[1..n]}{[1..n]}^(-1); + if RECOG.IsInOmega(Omega(1,d,q),killer^basechange) then + tf := killer*tf; + else + Error("this should not happen."); + fi; + Add(transd,tf); + od; + + Unbind(trans); + + Info(InfoRecog,2,"Step 5 done"); + + # Now to the "horizontal" transvections, first create them as SLPs: + transr := []; + trans := []; + vectorlist := []; + for lambda in [One(F)] do + # This does t_i + for i in [2..(n-1)] do + # This does t_i : v_j -> v_j + lambda * v_n + tf := IdentityMat(d,F); + tf[i,1] := lambda; + tf[n,n-i+1] := -1*(lambda); + # Now conjugate with c: + tf := ci*tf*c; + # Now cleanup in column n above row n, the entries there + # are lambda times the stuff in column i of ci: + #for j in [1..w.n-1] do + # tf := DoRowOp_n(tf,j,w.n,-ci[j,i]*lambda,w); + #od; + killer := IdentityMat(d,F); + for killervalue in [2..n-1] do + killersupport := IdentityMat(d,F); + killersupport[killervalue,1] := (-1)*tf[killervalue,1]; + killersupport[n,n-killervalue+1] := (tf[killervalue,1]); + #Display(killersupport); + killer := killer*killersupport; + od; + #killer{[1..n]}{[1..n]} := tf{[1..n]}{[1..n]}^(-1); + if killer{[1..n]}{[1..n]} in Omega(1,n,q) then + tf := killer*tf; + else + Error("this should not happen."); + fi; + Add(vectorlist,tf{[n]}{[n+1..aimdim]}); + Add(trans,tf); + od; + od; + + # For now vector space variant. but change that! + # For now vector space variant. but change that! + VC := VectorSpace(GF(p),vectorlist); + if aimdim < 2*n-2 then + vectorlist2 := []; + indexlist := []; + for vectorlistindex in [1..Size(vectorlist)] do + vectorlistele := vectorlist[vectorlistindex]; + VCBuildBasis:=VectorSpace( GF(p), Concatenation(vectorlist2,[vectorlistele]) ); + if Dimension(VCBuildBasis) > Length(vectorlist2) then + Add(vectorlist2,vectorlistele); + Add(indexlist,vectorlistindex); + fi; + if Length(vectorlist2) = Dimension(VC) then + break; + fi; + od; + VCBasis := Basis(VC,vectorlist2); + else + VCBasis := Basis(VC,vectorlist); + fi; + + for i in BasisVectors(CanonicalBasis(VectorSpace(F,IdentityMat(n-4,F)))) do + LinearCombinationVector := Coefficients(VCBasis,[i]); + tf := IdentityMat(d,F); + for lambda in [1..Size(LinearCombinationVector)] do + tf := tf*trans[indexlist[lambda]]^Int(LinearCombinationVector[lambda]); + od; + killer{[1..n]}{[1..n]} := tf{[1..n]}{[1..n]}^(-1); + if killer{[1..n]}{[1..n]} in Omega(1,n,q) then + tf := killer*tf; + else + Error("this should not happen."); + fi; + Add(transr,tf); + od; + Unbind(trans); + + Info(InfoRecog,2,"Step 6 done"); + + # From here on we distinguish three cases: + # * w.n = 2 + # * we finish off the constructive recognition + # * we have to do another step as the next thing + if n = 6 then + #w.slnstdf[2*w.ext+2] := transd[1]*transr[1]^-1*transd[1]; + #w.slnstdf[2*w.ext+1] := w.transh[1]*w.transv[1]^-1*w.transh[1] + # *w.slnstdf[2*w.ext+2]; + #Unbind(w.transh); + #Unbind(w.transv); + #w.n := 3; + flag := false; + s := IdentityMat(d,F); + PermMat3 := PermutationMat((4,7,5,8,6),d,F); + v := PermutationMat((1,2,3)(4,6,5),d,F); + #PermMat3 := PermutationMat((3,5)(6,4),20,GF(5)); + # w.ext = 2? + #for i in [n-1,n-3..1] do + flag := false; + for i in [2] do + if flag then + # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + tf := transd[(i-1)*ext+1]*transr[i]^-1*transd[(i-1)*ext+1]; + else + # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + #Display(transd[(i-1)*1+1]*transr[i]^-1*transd[(i-1)*1+1]); + tf := transd[(i-1)*ext+1]^-1*transr[i]*transd[(i-1)*ext+1]^-1; + fi; + #Display(tf); + #Display((tf^(v^2))^(PermMat3^(-1))); + s := s * tf; + flag := not(flag); + od; + + # Now compute v*s + fixv := IdentityMat(d,F); + fixv[1,1] := -1*One(F); + fixv[6,6] := -1*One(F); + newbasechange := PermMat3*basechange; + Display((v*s*fixv)^(PermMat3^(-1))); + Info(InfoRecog,2,"Step 7 done"); + return newbasechange; + #return w; + fi; + # We can finish off: + # if aimdim = w.GoalDim then + # # In this case we just finish off and do not bother with + # # the transvections, we will only need the standard gens: + # # Now put together the (newdim+1)-cycle: + # # n+newdim -> n+newdim-1 -> ... -> n+1 -> n -> n+newdim + # flag := false; + # s := w.One; + # for i in [1..newdim] do + # if flag then + # # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + # tf:=transd[(i-1)*w.ext+1]*transr[i]^-1*transd[(i-1)*w.ext+1]; + # else + # # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + # tf:=transd[(i-1)*w.ext+1]^-1*transr[i]*transd[(i-1)*w.ext+1]^-1; + # fi; + # s := s * tf; + # flag := not(flag); + # od; + + # # Finally put together the new 2n-1-cycle and 2n-2-cycle: + # s := s^-1; + # w.slnstdf[2*w.ext+1] := w.slnstdf[2*w.ext+1] * s; + # w.slnstdf[2*w.ext+2] := w.slnstdf[2*w.ext+2] * s; + # Unbind(w.transv); + # Unbind(w.transh); + # w.n := aimdim; + # Display("Step 7 done"); + # return w; + # fi; + + # Otherwise we do want to go on as the next thing, so we want to + # keep our transvections. This is easily done if we change the + # basis one more time. Note that we know that n is odd here! + + # Put together the n-cycle: + # 2n-1 -> 2n-2 -> ... -> n+1 -> n -> 2n-1 + flag := false; + s := IdentityMat(d,F); + #PermMat3 := PermutationMat((4,7,10,6,9,5,8),20,GF(5)); + PermMat3 := RECOG.ComputeCorrectingPermutationMat(d,F,n,aimdim); + PermMat3 := PermutationMat((5,9)(6,10)(7,11)(8,12),d,F); + #Display(PermMat3); + v := Zero(F) * IdentityMat( d, F ); + v[n/2][1] := One(F); + v{[1..(n/2)-1]}{[2..n/2]} := IdentityMat((n/2)-1,F); + v[n/2+1][n] := One(F); + v{[(n/2)+2..n]}{[(n/2)+1..n-1]} := IdentityMat((n/2)-1,F); + v{[n+1..d]}{[n+1..d]} := IdentityMat(d-n,F); + #Display(t); + #Display(t^basechange in G); + #PermMat3 := PermutationMat((3,5)(6,4),20,GF(5)); + # w.ext = 2? + #for i in [n-1,n-3..1] do + #for i in [Size(transr)-1,Size(transr)-3..5] do + for i in [n-4,n-5..((n/2)-1)] do + if flag then + # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + # TODO: Replace 2 by size of extension to get the correct matrices of transd (we want the ones with 1 and -1 at the transvection positions) + tf := transd[(i-1)*ext+1]*transr[i]^-1*transd[(i-1)*ext+1]; + else + # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + # TODO: Replace 2 by size of extension to get the correct matrices of transd (we want the ones with 1 and -1 at the transvection positions) + tf := transd[(i-1)*ext+1]^-1*transr[i]*transd[(i-1)*ext+1]^-1; + fi; + #Display(tf); + #Display((tf^(v^2))^(PermMat3^(-1))); + Display(tf); + s := s * tf; + flag := not(flag); + od; + + #Display(((v*s)^(-1))^(PermMat3)); + newbasechange := PermMat3^(-1)*basechange; + # Now compute v*s + #Info(InfoRecog,2,"Step 7 done"); + Error("here"); + + # # Finally put together the new 2n-1-cycle and 2n-2-cycle: + # w.slnstdf[2*w.ext+1] := s * w.slnstdf[2*w.ext+1]; + # w.slnstdf[2*w.ext+2] := s * w.slnstdf[2*w.ext+2]; + + # list := Concatenation([1..w.n-1],[w.n+1..2*w.n-1],[w.n],[2*w.n..w.d]); + # perm := PermList(list); + # mat := PermutationMat(perm^-1,w.d,w.f); + # ConvertToMatrixRep(mat,w.f); + # w.bas := w.bas{list}; + # ConvertToMatrixRep(w.bas,w.f); + # w.basi := w.basi*mat; + + # # Now add the new transvections: + # for i in [1..w.n-1] do + # w.transh[w.ext*(w.n-1)+w.ext*(i-1)+1] := transr[i]; + # od; + # Append(w.transv,transd); + # w.n := 2*w.n-1; + + #if( aimdim = 5) then + # Error("here"); + #fi; + fi; + + Info(InfoRecog,2,"Step 7 done"); + # return w; +end; + + + +RECOG.TestSpaceForSingularPoints := function(U,form,F) +local v, w1, w2; + + w1 := Zero(U); + w2 := Zero(U); + + for v in U do + if w1 = Zero(U) then + if v*form*v = Zero(F) then + w1 := v; + fi; + else + if v*form*v = Zero(F) and not(v in VectorSpace(F,[w1])) then + w2 := v; + return true; + fi; + fi; + od; + + return false; + +end; + + +RECOG.TestOmega4DimensionalSpace := function(d,q,type,tries) +local V, G, form, i, j, gens, v; + + G := Omega(type,d,q); + form := (PreservedSesquilinearForms(G)[1])!.matrix; + V := VectorSpace(GF(q),IdentityMat(d,GF(q))); + + i := 1; + while i < tries do + gens := []; + while Size(gens) < 4 do + v := PseudoRandom(V); + if Size(gens) = 0 then + gens := [v]; + else + if not(v in VectorSpace(GF(q),gens)) then + Add(gens,v); + fi; + fi; + od; + Display(RECOG.TestSpaceForSingularPoints(VectorSpace(GF(q),gens), form, GF(q))); + gens := []; + i := i + 1; + od; + +end; \ No newline at end of file diff --git a/gap/projective/constructive_recognition/O/main.gi b/gap/projective/constructive_recognition/O/main.gi new file mode 100644 index 000000000..3f3519427 --- /dev/null +++ b/gap/projective/constructive_recognition/O/main.gi @@ -0,0 +1,140 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +############################################################################# + + + +############################################################################# +############################################################################# +######## Main function for orthogonal groups ################################ +############################################################################# +############################################################################# + + + +RECOG.FindStdGens_Orthogonal := function(sld) + + return RECOG.FindStdGens_Orthogonal2(sld,DimensionOfMatrixGroup(sld)); + +end; + + + +RECOG.FindStdGens_Orthogonal2 := function(sld,IsoDim) + +# Group generated by input must be isomorphic Sp(IsoDim,q) + +# gens of sld must be gens for Sp(d,q) in its natural rep with memory +# This function calls RECOG.SLn_constructsl2 and then extends +# the basis to a basis of the full row space and calls +# RECOG.SLn_UpStep often enough. Finally it returns an slp such +# that the Sp(d,q) standard generators with respect to this basis are +# expressed by the slp in terms of the original generators of sld. +local V,b,bas,basi,basit,d,data,ext,fakegens,id,nu,nu2,p,q,resl2,sl2,sp4gens,bigcorrection, + sl2gensf,sl2genss,omega6stdf,slp,slpsl2std,slptosl2,st,std,stdgens,i,ex,f,form,smallomega6,basechange,myslp,omega6gens,omega6,WrongForm,correctForm1,correctForm2; + + # Some setup: + f := FieldOfMatrixGroup(sld); + p := Characteristic(f); + q := Size(f); + ext := DegreeOverPrimeField(f); + d := DimensionOfMatrixGroup(sld); + form := RECOG.SymmetricBilinearForm(sld); + if not(IsObjWithMemory(GeneratorsOfGroup(sld)[1])) then + sld := GroupWithMemory(sld); + fi; + + # First find an Sp2 with the space it acts on; + Info(InfoRecog,2,"Finding an Omega4..."); + Info(InfoRecog,2,"-----"); + Info(InfoRecog,2,"Start of the GoingDown Algorithm."); + data := RECOG.SOn_constructso2(sld,d,q,form); + if data = fail then + return TemporaryFailure; + fi; + Info(InfoRecog,2,"The GoingDown Algorithm was successful."); + Info(InfoRecog,2,"-----"); + + if IsEvenInt(q) then + smallomega6 := RECOG.ExtractSmallerGroup(GeneratorsOfGroup(data[1]),IdentityMat(20,GF(q)),8); + WrongForm := PreservedSesquilinearForms(smallomega6[1])[1]; + correctForm1 := BaseChangeToCanonical(WrongForm); + correctForm2 := BaseChangeToCanonical(PreservedSesquilinearForms(Omega(1,8,q))[1]); + omega6 := smallomega6[1]^(correctForm1^(-1)*correctForm2); + bigcorrection := IdentityMat(d,GF(q)); + bigcorrection{[1..8]}{[1..8]} := (correctForm2)^(-1)*correctForm1; + basechange := bigcorrection*data[2]; + omega6gens := GeneratorsOfGroup(omega6); + omega6 := RECOG.LiftGroup(GeneratorsOfGroup(omega6),8,q,d)[2]; + Error("here"); + else + smallomega6 := RECOG.ExtractSmallerGroup(GeneratorsOfGroup(data[1]),IdentityMat(20,GF(q)),6); + Info(InfoRecog,2,"Start of constructive recognition of Omega(6,q)"); + i := 1; + omega6gens := fail; + while i < 10 and omega6gens = fail do + #if not(IsEvenInt(q)) then + # sp4gens := RECOG.FindStdGensSp4(smallsp4[1],d,q); + #else + WrongForm := PreservedSesquilinearForms(smallomega6[1])[1]; + correctForm1 := BaseChangeToCanonical(WrongForm); + correctForm2 := BaseChangeToCanonical(PreservedSesquilinearForms(Omega(1,6,q))[1]); + omega6 := smallomega6[1]^(correctForm1^(-1)*correctForm2); + bigcorrection := IdentityMat(d,GF(q)); + bigcorrection{[1..6]}{[1..6]} := (correctForm2)^(-1)*correctForm1; + basechange := bigcorrection*data[2]; + #stdgens := RECOG.MakeSp_StdGens(p,ext,8,8).all; + #sp8gens := RECOG.FindStdGensUsingBSGS(sp8,stdgens,false,false); + #if Size(sp8) <> 197406720 and 174182400 <> Size(sp8) then + #fi; + omega6gens := GeneratorsOfGroup(omega6); + #fi; + #i := i +1; + od; + if omega6gens = fail then + Info(InfoRecog,2,"-----"); + Info(InfoRecog,2,"Constructive recognition of Sp(4,q) failed. Restart."); + Info(InfoRecog,2,"-----"); + return TemporaryFailure; + fi; + omega6 := RECOG.LiftGroup(GeneratorsOfGroup(omega6),6,q,d)[2]; + Error("here"); + fi; + + + # We need an additional check to make sure that we have an omega 6 as our last group + + + + #basechange := sp4gens[2]*data[2]; + #myslp := CompositionOfStraightLinePrograms(sp4gens[3],myslp); + #Info(InfoRecog,2,"Constructive recognition of Sp(4,q) was successful."); + #Info(InfoRecog,2,"-----"); + + #fakegens := ListWithIdenticalEntries(Length(GeneratorsOfGroup(sld)), ()); + #fakegens := GeneratorsWithMemory(fakegens); + #sp4stdf := ResultOfStraightLineProgram(myslp,fakegens); + #std := rec( f := f, d := d, GoalDim := IsoDim, n := 4, bas := basechange, basi := basechange^(-1), + # sld := sld, sldf := fakegens, spnstdf := sp4stdf, + # p := p, ext := ext ); + #Info(InfoRecog,2,"Going up to Sp_d again..."); + #Info(InfoRecog,2,"-----"); + #Info(InfoRecog,2,"Start of the GoingUp Algorithm"); + #while std.n < std.GoalDim do + # RECOG.Spn_UpStep(std); + #od; + #Info(InfoRecog,2,"The GoingUp Algorithm was successful."); + #Info(InfoRecog,2,"-----"); + #return rec( slpstd := SLPOfElms(std.spnstdf), bas := std.bas, basi := std.basi ); + end; diff --git a/gap/projective/constructive_recognition/SL/BaseCase.gi b/gap/projective/constructive_recognition/SL/BaseCase.gi new file mode 100644 index 000000000..48097c375 --- /dev/null +++ b/gap/projective/constructive_recognition/SL/BaseCase.gi @@ -0,0 +1,477 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +############################################################################# + + + +################################################################################################### +################################################################################################### +######## Constructive recognition SL(2,q) in natural representation ############################### +################################################################################################### +################################################################################################### + + + +# TODO: Add MSLPs to these algorithms +# This algorithm is an implementation of the paper +# "Fast Recognition of Classical Groups over Large Fields" +# by Marston Conder and Charles Leedham-Green +RECOG.ConstructiveRecognitionSL2NaturalRepresentation := function(G, q, epsilon) +local F, factors, counter, one, factor, foundEle, passed, max, eigenvalues, eigenvalues2, eigenvectors, eigenvectors2, A, B, rand, foundConjugate, test, BDiag, C, basechange, v, d, CC, check, i, j, D, DD, T, S, o, t1, t2, zero, slp; + + factors := PrimeDivisors(q-1); + counter := 1; + F := GF(q); + + if not(IsObjWithMemory(GeneratorsOfGroup(G)[1])) then + G := GroupWithMemory(G); + fi; + + one := One(G); + zero := Zero(F); + max := Int(1/epsilon); + while counter < max do + + # Step 1: Find random element of order q-1 + # foundEle := false; + # while not(foundEle) do + # A := PseudoRandom(G); + # if A^(q-1) = one then + # passed := true; + # for factor in factors do + # if A^((q-1)/factor) = one then + # passed := false; + # break; + # fi; + # od; + # if passed then + # foundEle := true; + # else + # counter := counter + 1; + # fi; + # else + # counter := counter +1; + # fi; + # if counter >= max then + # return fail; + # fi; + #od; + + # Step 1: Find random element of order q-1 (first improvement based on magma code) + foundEle := false; + while not(foundEle) do + A := PseudoRandom(G); + o := Order (A); + if (o mod (q - 1) = 0) then + A := A^(o/(q - 1)); + foundEle := true; + else + counter := counter +1; + fi; + if counter >= max then + return fail; + fi; + od; + + # Step 2: Eigenvectors and eigenvalues + eigenvalues := RootsOfPolynomial(CharacteristicPolynomial(A)); + # Note eigenvalues[1] = eigenvalues[2]^(-1) + eigenvectors := [1,2]; + eigenvectors[1] := RECOG.EigenspaceMat(StripMemory(A), eigenvalues[1]); + eigenvectors[2] := RECOG.EigenspaceMat(StripMemory(A), eigenvalues[2]); + + # Step 3: Conjugate of A that does not intersect with A's eigenspaces + foundConjugate := false; + eigenvectors2 := [1,2]; + while not(foundConjugate) do + rand := PseudoRandom(G); + B := A^rand; + eigenvectors2[1] := RECOG.EigenspaceMat(StripMemory(B), eigenvalues[1]); + eigenvectors2[2] := RECOG.EigenspaceMat(StripMemory(B), eigenvalues[2]); + test := []; + Append(test,eigenvectors[1]); + Append(test,eigenvectors2[1]); + if NullspaceMat(test) = [] then + test := []; + Append(test,eigenvectors[2]); + Append(test,eigenvectors2[2]); + if NullspaceMat(test) = [] then + basechange := [eigenvectors2[1,1],eigenvectors2[2,1]]; + t1 := eigenvectors[1,1] * basechange^(-1); + t2 := eigenvectors[2,1] * basechange^(-1); + if (t1[1] <> zero) and (t1[2] <> zero) and (t2[1] <> zero) and (t2[2] <> zero) then + foundConjugate := true; + else + counter := counter + 1; + fi; + else + counter := counter + 1; + fi; + else + counter := counter + 1; + fi; + + if counter >= max then + return fail; + fi; + od; + + # Step 4: Find suitable C + BDiag := IdentityMat(2,GF(q)); + BDiag[1,1] := eigenvalues[1]; + BDiag[2,2] := eigenvalues[2]; + v := eigenvectors[1,1] * basechange^(-1); + d := v[2] * v[1]^-1; + + S := IdentityMat(2,F); + while S = one do + foundEle := false; + while not(foundEle) do + C := PseudoRandom(G); + CC := basechange * C * basechange^(-1); + if ((CC[1,2]-d*CC[1,1])) <> zero and ((d^2*CC[2,1] - d * CC[2,2]) <> zero) then + check := (d^2*CC[2,1] - d * CC[2,2])/(CC[1,2]-d*CC[1,1]); + if not(Zero(F) = check) and IsSquareFFE(F,check) then + i := LogFFE(check,eigenvalues[1])/2; + foundEle := true; + else + counter := counter + 1; + fi; + else + counter := counter + 1; + fi; + + if counter >= max then + return fail; + fi; + od; + S := A^(-1) * (B^i*C)^(-1) * A * (B^i*C); + od; + + # Step 5: Find suitable D + v := eigenvectors[2,1] * basechange^(-1); + d := v[2] * v[1]^-1; + + T := IdentityMat(2,F); + while T = one do + foundEle := false; + while not(foundEle) do + D := PseudoRandom(G); + DD := basechange * D * basechange^(-1); + if ((DD[1,2]-d*DD[1,1]) <> zero) and ((d^2*DD[2,1] - d * DD[2,2]) <> zero) then + check := (d^2*DD[2,1] - d * DD[2,2])/(DD[1,2]-d*DD[1,1]); + if not(Zero(F) = check) and IsSquareFFE(F,check) then + j := LogFFE(check,eigenvalues[1])/2; + foundEle := true; + else + counter := counter + 1; + fi; + else + counter := counter + 1; + fi; + + if counter >= max then + return fail; + fi; + od; + T := A^(-1) * (B^j*D)^(-1) * A * (B^j*D); + od; + + basechange := [eigenvectors[1,1],eigenvectors[2,1]]; + basechange[2] := basechange[2] * Determinant(basechange)^(-1); + + slp := SLPOfElms([A,S,T]); + + A := basechange * A * basechange^(-1); + S := basechange * S * basechange^(-1); + T := basechange * T * basechange^(-1); + + return [[A,S,T],basechange,slp]; + od; + + return fail; + +end; + + + +# Note that we use the discrete logarithm to normalise the primitive element at position [1,1]. But this is not necessarly as the entry at position [1,1] is primitive. +# Hence, this function can be adapted to larger fields by avoiding the normalisation step +RECOG.ConstructiveRecognitionSL2NaturalRepresentationCompleteBasis := function(list,F,q,p,f) +local w, k, Diag, coeffs, coeff, cong, t, s, SC, i, res, res2, A, S, T, upper, lower, basis, slp; + + list := GeneratorsWithMemory(list); + + A := list[1]; + S := list[2]; + T := list[3]; + + # Normalisation step + w := PrimitiveElement(F); + k := LogFFE(w,A[1,1]); + Diag := A^k; + + t := T[1,2]; + basis := [1..f]; + for i in [0..f-1] do + basis[i+1] := w^(2*i); + od; + basis := Basis(F,basis); + coeffs := Coefficients(basis,t^(-1)); + + # standard basis element [1, 1, 0, 1] + res := A^0; + for i in [0..f-1] do + coeff := Int(coeffs[i+1]); + cong := Diag^(-i); + res := res * ((T^(cong))^coeff); + od; + upper := [1..f]; + upper[1] := res; + + # set up complete basis for upper triangular matrices + #UB := [GL(2, E) ! [1, x^(2 * i), 0, 1]: i in [0..e - 1]]; + #wUB := [wUS^(wD^-i): i in [0..e - 1]]; + for i in [1..f-1] do + upper[i+1] := res^(Diag^(-i)); + od; + + s := S[2,1]; + coeffs := Coefficients(basis,s^(-1)); + + # standard basis element [1, 0, 1, 1] + res2 := A^0; + for i in [0..f-1] do + coeff := Int(coeffs[i+1]); + cong := Diag^(i); + res2 := res2 * ((S^(cong))^coeff); + od; + lower := [1..f]; + lower[1] := res2; + + # set up complete basis for lower triangular matrices + for i in [1..f-1] do + lower[i+1] := res2^(Diag^(i)); + od; + + slp := SLPOfElms(Concatenation([Diag],upper,lower)); + + return [[Diag,upper,lower],slp]; + +end; + + +################################################################################################### +################################################################################################### +######## Rewriting SL(2,q) ######################################################################## +################################################################################################### +################################################################################################### + + +# Note that we use the discrete logarithm to normalise the primitive element at position [1,1]. But this is not necessarly as the entry at position [1,1] is primitive. +# Hence, this function can be adapted to larger fields by avoiding the normalisation step +RECOG.RewritingSL2 := function(gens,F,q,p,f,ele) +local list, re, ell, mat, base, i, coeff, wMat, l1, l2, stdgens; + + stdgens := StripMemory(gens); + stdgens := Concatenation([stdgens[1]],stdgens[2],stdgens[3]); + stdgens := GeneratorsWithMemory(stdgens); + l1 := stdgens{[2..f+1]}; + l2 := stdgens{[f+2..Size(stdgens)]}; + stdgens := [stdgens[1],l1,l2]; + + base := [1..f]; + for i in [1..f] do + base[i] := (stdgens[2,i])[1,2]; + od; + base := Basis(F,base); + re := stdgens[1]^0; + + if ele[1,2] = Zero(F) then + re := re*stdgens[2,1]; + mat := IdentityMat(2,F); + mat[1,2] := One(F); + ele := ele*mat; + fi; + + if not(ele[1,1] = One(F)) then + ell := (1-ele[1,1])*ele[1,2]^(-1); + mat := IdentityMat(2,F); + mat[2,1] := ell; + ele := ele*mat; + coeff := Coefficients(base,ell); + wMat := stdgens[1]^0; + for i in [1..f] do + wMat := wMat*(stdgens[3,i])^Int(coeff[i]); + od; + re := re*wMat; + fi; + + ell := -1*ele[1,2]; + mat := IdentityMat(2,F); + mat[1,2] := ell; + ele := ele*mat; + coeff := Coefficients(base,ell); + wMat := stdgens[1]^0; + for i in [1..f] do + wMat := wMat*(stdgens[2,i])^Int(coeff[i]); + od; + re := re*wMat; + + if not(ele[2,1] = Zero(F)) then + ell := -1 * ele[2,1]; + mat := IdentityMat(2,F); + mat[2,1] := ell; + ele := mat*ele; + coeff := Coefficients(base,ell); + wMat := stdgens[1]^0; + for i in [1..f] do + wMat := wMat*(stdgens[3,i])^Int(coeff[i]); + od; + re := re*wMat; + fi; + + return SLPOfElm(re^(-1)); +end; + + + +################################################################################################### +################################################################################################### +######## Constructive Recognition of SL(4,q) (Leedham-Green and O'Brien algorithm) ################ +################################################################################################### +################################################################################################### + + + +# Input: X where is isomorphic to SL(4,q), F where X are dxd matrices over F_q = F (q = p^f prime power) +RECOG.OneEvenSL4 := function(X,F) + local d, G, g, h, foundStrongInvoluation, order, gensCentraliser, EPlus; + + d := 4; + G := GroupByGenerators(X); + foundStrongInvoluation := false; + while not(foundStrongInvoluation) do + g := PseudoRandom(G); + order := Order(g); + if (order mod 2 = 0) then + h := g^(order/2); + EPlus := RECOG.FixspaceMat(h); + if Size(EPlus) = 2 then + foundStrongInvoluation := true; + fi; + fi; + od; + + gensCentraliser := RECOG.InvolutionCentraliser(G,h,100); + # TODO: Compute generating set for OmegaX(E) (see paper from LGO) + + #TODO: CONTINUE HERE + +end;; + + + +# Input: h an involuation in a BB group G, natural number N > 0 +RECOG.InvolutionCentraliser := function(G, h, N) + local C, i, g; + + C := [1..N]; + for i in [1..N] do + g := PseudoRandom(G); + C[i] := RECOG.ChFromg(h,g); + od; + + return DuplicateFreeList(C); +end;; + + + +# Input: h and g group elements of the same group. Returns an element as in Bray's Lemma +RECOG.ChFromg := function(h,g) + local order, com; + + com := h^(-1)*g^(-1)*h*g; + order := Order(com); + + if (order mod 2 = 0) then + return com^(order/2); + else + return com^((order+1)/2)*g^(-1); + fi; +end;; + + + +################################################################################################### +################################################################################################### +######## Older algorithms ######################################################################### +################################################################################################### +################################################################################################### + + + +RECOG.RecogniseSL2NaturalOddCharUsingBSGS := function(g,f) + local ext,p,q,res,slp,std; + p := Characteristic(f); + ext := DegreeOverPrimeField(f); + q := Size(f); + std := RECOG.MakeSL_StdGens(p,ext,2,2); + slp := RECOG.FindStdGensUsingBSGS(g,std.all,false,true); + if slp = fail then return fail; fi; + res := rec( g := g, one := One(f), One := One(g), f := f, q := q, + p := p, ext := ext, d := 2, bas := IdentityMat(2,f), + basi := IdentityMat(2,f) ); + res.all := ResultOfStraightLineProgram(slp,GeneratorsOfGroup(g)); + res.s := res.all{[1..ext]}; + res.t := res.all{[ext+1..2*ext]}; + res.a := res.all[2*ext+1]; + res.b := res.all[2*ext+2]; + return res; +end; + + + +RECOG.FindStdGensUsingBSGS := function(g,stdgens,projective,large) + # stdgens generators for the matrix group g + # returns an SLP expressing stdgens in the generators of g + # set projective to true for projective mode + # set large to true if we should not bother finding nice base points! + local S,dim,gens,gm,i,l,strong; + dim := DimensionOfMatrixGroup(g); + if IsObjWithMemory(GeneratorsOfGroup(g)[1]) then + gm := GroupWithMemory(StripMemory(GeneratorsOfGroup(g))); + else + gm := GroupWithMemory(g); + fi; + if HasSize(g) then SetSize(gm,Size(g)); fi; + if large then + S := StabilizerChain(gm,rec( Projective := projective, + Cand := rec( points := One(g), + ops := ListWithIdenticalEntries(dim, OnLines) ) ) ); + else + S := StabilizerChain(gm,rec( Projective := projective ) ); + fi; + strong := ShallowCopy(StrongGenerators(S)); + ForgetMemory(S); + l := List(stdgens,x->SiftGroupElementSLP(S,x)); + gens := EmptyPlist(Length(stdgens)); + for i in [1..Length(stdgens)] do + if not l[i].isone then + return fail; + fi; + Add(gens,ResultOfStraightLineProgram(l[i].slp,strong)); + od; + return SLPOfElms(gens); +end; diff --git a/gap/projective/constructive_recognition/SL/GoingDown.gi b/gap/projective/constructive_recognition/SL/GoingDown.gi new file mode 100644 index 000000000..9507c126c --- /dev/null +++ b/gap/projective/constructive_recognition/SL/GoingDown.gi @@ -0,0 +1,698 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +############################################################################# + + + +############################################################################# +############################################################################# +######## GoingDown method for special linear groups ######################### +############################################################################# +############################################################################# + + + +# TODO: Work on comments and documentation + + + +# Find random element s = r^PseudRandom(g) such that is isomorphic to SL(4,q) +# and check whether they are isomorphic +RECOG.SLn_constructsl4:=function(g,dim,q,r) + local s,h,count,readydim4,readydim3,ready,u,orderu, + nullr,nulls,nullspacer,nullspaces,int,intbasis,nullintbasis, + newu,newbasis,newbasisinv,newr,news,outputu,mat,i,shorts,shortr; + nullr:=RECOG.FixspaceMat(r); + nullspacer:=VectorSpace(GF(q),nullr); + mat:=One(r); + ready:=false; + repeat + s:=r^PseudoRandom(g); + nulls:=RECOG.FixspaceMat(s); + nullspaces:=VectorSpace(GF(q),nulls); + int:=Intersection(nullspacer,nullspaces); + intbasis:=Basis(int); + newbasis:=[]; + for i in [1..Length(intbasis)] do + Add(newbasis,intbasis[i]); + od; + i:=0; + repeat + i:=i+1; + if not mat[i] in int then + Add(newbasis,mat[i]); + int:=VectorSpace(GF(q),newbasis); + fi; + until Dimension(int)=dim; + ConvertToMatrixRep(newbasis); + newbasisinv:=newbasis^(-1); + newr:=newbasis*r*newbasisinv; + news:=newbasis*s*newbasisinv; + + #shortr, shorts do not need memory + #we shall throw away the computations in h + #check that we have SL(4,q), by non-constructive recognition + + # Remark D.R.: Tries to reduce matrix multiplications + # by working with 4 dimensional matrices + shortr:=newr{[dim-3..dim]}{[dim-3..dim]}; + shorts:=news{[dim-3..dim]}{[dim-3..dim]}; + h:=Group(shortr,shorts); + count:=0; + readydim4:=false; + readydim3:=false; + repeat + u:=PseudoRandom(h); + orderu:=Order(u); + if orderu mod ((q^4-1)/(q-1)) = 0 then + readydim4:=true; + elif Gcd(orderu,(q^2+q+1)/Gcd(3,q-1))>1 then + readydim3:=true; + fi; + if readydim4 = true and readydim3 = true then + ready:=true; + break; + fi; + count:=count+1; + until count=30; + until ready=true; + + return Group(r,s); +end; + + + +#g=SL(d,q), given as a subgroup of SL(dim,q) +#output: [SL(2,q), and a basis for the 2-dimensional subspace where it acts +RECOG.SLn_godownfromd:=function(g,q,d,dim) + local y,yy,ready,order,es,dims,subsp,z,x,a,b,c,h,vec,vec2, + pol,factors,degrees,comm1,comm2,comm3,image,basis,action,vs,readyqpl1, + readyqm1,count,u,orderu; + + repeat + ready:=false; + y:=PseudoRandom(g); + pol:=CharacteristicPolynomial(y); + factors:=Factors(pol); + degrees:=List(factors,Degree); + if d-1 in degrees then + order:=Order(y); + if order mod (q-1)=0 then + yy:=y^(order/(q-1)); + else + yy:=One(y); + fi; + if not IsOne(yy) then + es:= Eigenspaces(GF(q),yy); + dims:=List(es,Dimension); + if IsSubset(Set([1,d-1,dim-d]),Set(dims)) and + (1 in Set(dims)) then + es:=Filtered(es,x->Dimension(x)=1); + vec:=Basis(es[1])[1]; + if vec*yy=vec then + vec:=Basis(es[2])[1]; + fi; + repeat + z:=PseudoRandom(g); + x:=yy^z; + a:=Comm(x,yy); + b:=a^yy; + c:=a^x; + comm1:= Comm(a,c); + comm2:=Comm(a,b); + comm3:=Comm(b,c); + if comm1<>One(a) and comm2<>One(a) and + comm3<>One(a) and Comm(comm1,comm2)<>One(a) then + vec2:=vec*z; + vs:=VectorSpace(GF(q),[vec,vec2]); + basis:=Basis(vs); + #check that the action in 2 dimensions is SL(2,q) + #by non-constructive recognition, finding elements of + #order (q-1) and (q+1) + #we do not need memory in the group image + action:=List([a,b,c],x->RECOG.LinearAction(basis,q,x)); + image:=Group(action); + count:=0; + readyqpl1:=false; + readyqm1:=false; + repeat + u:=PseudoRandom(image); + orderu:=Order(u); + if orderu = q-1 then + readyqm1:=true; + elif orderu = q+1 then + readyqpl1:=true; + fi; + if readyqm1 = true and readyqpl1 = true then + ready:=true; + break; + fi; + count:=count+1; + until count=20; + fi; + until ready=true; + fi; + fi; + fi; + until ready; + + h:=Group(a,b,c); + subsp:=VectorSpace(GF(q),[vec,vec2]); + Info(InfoRecog,2,"New Dimension: 2"); + return [h,subsp]; + +end; + + + +#going down from 4 to 2 dimensions, when q=2,3,4,5,9 +#just construct the 4-dimensional invariant space and generators +#for the group acting on it +RECOG.SLn_exceptionalgodown:=function(h,q,dim) + local basis, v, vs, i, gen; + + vs:=VectorSpace(GF(q),One(h)); + basis:=[]; + repeat + if InfoLevel(InfoRecog) >= 3 then Print("C"); fi; + for i in [1..4] do + v:=PseudoRandom(vs); + for gen in GeneratorsOfGroup(h) do + Add(basis,v*gen-v); + od; + od; + basis:=ShallowCopy(SemiEchelonMat(basis).vectors); + until Length(basis)=4; + Info(InfoRecog,2,"New Dimension: 2"); + return [h,VectorSpace(GF(q),basis)]; +end; + + + +RECOG.SLn_constructsl2:=function(g,d,q) + local r,h; + + r := RECOG.constructppdTwoStingray(g,d,q,"SL",fail); + Info(InfoRecog,2,"Finished main GoingDown, i.e. we found a stringray element which operates irreducible on a 2 dimensional subspace. \n"); + Info(InfoRecog,2,"Next goal: Find an random element s.t. the two elements generate SL(4,q). \n"); + h := RECOG.SLn_constructsl4(g,d,q,r); + # Remark D.R.: at this point we know that h is isomorphic to SL(4,q) + Info(InfoRecog,2,"Succesful. "); + Info(InfoRecog,2,"Current Dimension: 4\n"); + Info(InfoRecog,2,"Next goal: Generate SL(2,q). \n"); + if not (q in [2,3,4,5,9]) then + return RECOG.SLn_godownfromd(h,q,4,d); + else + return RECOG.SLn_exceptionalgodown(h,q,d); + fi; +end; + + + +############################################################################## +# The going down method while constructing smaller matrices: +############################################################################## + + + +RECOG.CheckNewStingrayGroupSmallerMatrices := function(g1,dim1,base1,eigenspace1,g2,dim2,base2,eigenspace2,q) + local baseSum, b, action1, action2, fld, module, eigenspaceintersection; + + baseSum := ShallowCopy(base1); + Append(baseSum,base2); + + if NullspaceMat(baseSum) <> [] then + return [false,[]]; + fi; + + fld := GF(q); + b := Basis(VectorSpace(fld,baseSum),baseSum); + action1 := List(baseSum,v->Coefficients(b,v*g1)); + action2 := List(baseSum,v->Coefficients(b,v*g2)); + module := GModuleByMats( [action1,action2], fld ); + if MTX.IsIrreducible(module) then + eigenspaceintersection := SumIntersectionMat(eigenspace1,eigenspace2)[2]; + return [true,[action1,action2],BasisVectors(b),eigenspaceintersection]; + else + return [false,[]]; + fi; +end; + + + +RECOG.ConstructSL4SmallerMatrices := function(g1,g2,q) + local baseSum, b, action1, action2, fld, module, base, EleBase, fixbase, ele, eigenspace1, eigenspace2, eigenspaceintersection; + + base := []; + fld := GF(q); + for ele in [g1,g2] do + fixbase := RECOG.FixspaceMat(TransposedMat(ele)); + EleBase := NullspaceMat(TransposedMat(fixbase)); + Append(base,EleBase); + od; + + eigenspace1 := RECOG.FixspaceMat(StripMemory(g1)); + eigenspace2 := RECOG.FixspaceMat(StripMemory(g2)); + eigenspaceintersection := SumIntersectionMat(eigenspace1,eigenspace2)[2]; + + b := Basis(VectorSpace(fld,base),base); + action1 := List(base,v->Coefficients(b,v*g1)); + action2 := List(base,v->Coefficients(b,v*g2)); + return [GroupByGenerators([action1,action2]),BasisVectors(b),eigenspaceintersection]; +end; + + + +RECOG.SLn_godownStingrayWithSmallerMatrices:=function(list) +local d, first, q, p, g, i, r, pol, factors, degrees, newdim, power, rr, ss, + newgroup, colldegrees, exp, count, check, ocount, beta, NiList, Maxi, qFactors, irrfact, invbase, oneEigenspace, maxdim; + + first := function(list) + local i, j, goodElement; + for i in [1..Length(list)] do + if list[i]>1 then + if Gcd(list[i],Product(list)/list[i]) < list[i] then + return i; + else + goodElement := true; + for j in [1..Length(list)] do + if not(j = i) and Gcd(list[i],list[j]) = list[i] then + goodElement := false; + break; + fi; + od; + if goodElement then + return i; + fi; + fi; + fi; + od; + return fail; + end; + + g:=list[1]; + d:=list[2]; + q:=list[3]; + qFactors:=Factors(q); + p := qFactors[1]; + if d <= 700 then + maxdim := Maximum([Log2Int(d),3]); + else + # Test a heuristic + maxdim := Int(d/20); + fi; + + # Overall count. Replace by formula and unequality + ocount := 0; + while ocount < 100 do + + Info(InfoRecog,2,"Dimension: ",d); + #find an element with irreducible action of relative prime dimension to + #all other invariant subspaces + #count is just safety, if things go very bad + count:=0; + + repeat + count:=count+1; + if InfoLevel(InfoRecog) >= 3 then Print(".\c"); fi; + r:=PseudoRandom(g); + pol:=CharacteristicPolynomial(r); + factors:=Factors(pol); + degrees:=List(factors,Degree); + newdim:=first(degrees); + until (count>100) or (newdim <> fail and (degrees[newdim] < maxdim)); + # Be careful if Log2Int(d) = 2! In this case we search for stingray elements with k < 2. Hence use newdim < Maximum([Log2Int(d),3]) + + if count>100 then + return fail; + fi; + + # Split result from first: + irrfact := factors[newdim]; + newdim := degrees[newdim]; + + if newdim > 2 then + # Check whether the stingray candidate is a ppd-stingray element + check := RECOG.IsPpdStingrayElement(p,Length(qFactors),newdim,irrfact); + if check then + + # raise r to a power so that acting trivially outside one invariant irreducible subspace + NiList := Collected(degrees); + NiList := Filtered(NiList,x->not(x[1] = newdim)); + colldegrees := List(NiList,x->x[1]); + NiList := List(NiList,x->x[2]); + Maxi := Maximum(NiList); + beta := LogInt(Maxi,p); + if not(p^beta = Maxi) then + beta := beta + 1; + fi; + + # power further to cancel q-part of element order + power := Lcm(List(colldegrees, x->q^x-1))*p^beta; + rr:=r^power; + + invbase := NullspaceMat(TransposedMat(RECOG.FixspaceMat(TransposedMat(StripMemory(rr))))); + oneEigenspace := RECOG.FixspaceMat(StripMemory(rr)); + return [rr,newdim,invbase,oneEigenspace]; + + fi; + else + NiList := Collected(degrees); + NiList := Filtered(NiList,x->not(x[1] = newdim)); + colldegrees := List(NiList,x->x[1]); + NiList := List(NiList,x->x[2]); + Maxi := Maximum(NiList); + beta := LogInt(Maxi,p); + if not(p^beta = Maxi) then + beta := beta + 1; + fi; + + # power further to cancel q-part of element order + power := Lcm(List(colldegrees, x->q^x-1))*p^beta; + rr:=r^power; + + invbase := NullspaceMat(TransposedMat(RECOG.FixspaceMat(TransposedMat(StripMemory(rr))))); + if Size(invbase) = 2 then + oneEigenspace := RECOG.FixspaceMat(StripMemory(rr)); + return [rr,newdim,invbase,oneEigenspace]; + fi; + fi; + + ocount := ocount + 1; + od; + + return fail; + +end; + + + +RECOG.SLn_constructppdTwoStingraySmallerMatrices:=function(g,dim,q) +local out, list, out2, currentdim, check, slplist, slpToSmallerGroup, baselist, eigenspacelist; + + Info(InfoRecog,2,"Current Dimension: "); + Info(InfoRecog,2,dim); + Info(InfoRecog,2,"\n"); + + list:=[g,dim,q,g]; + slplist:=[]; + currentdim := dim; + baselist:=[]; + eigenspacelist := []; + repeat + out:=RECOG.SLn_godownStingrayWithSmallerMatrices(list); + if out=fail or out[1]*out[1]=One(out[1]) then + if InfoLevel(InfoRecog) >= 3 then Print("B\c"); fi; + Info(InfoRecog,2,"Restart. \n"); + Info(InfoRecog,2,"Current Dimension: "); + Info(InfoRecog,2,dim); + Info(InfoRecog,2,"\n"); + list:=[g,dim,q,g]; + slplist:=[]; + baselist:=[]; + eigenspacelist := []; + out:=fail; + else + if out[2]>2 then + repeat + out2:=RECOG.SLn_godownStingrayWithSmallerMatrices(list); + if out2=fail or out2[1]*out2[1]=One(out2[1]) then + if InfoLevel(InfoRecog) >= 3 then Print("B\c"); fi; + list:=[g,dim,q,g]; + slplist:=[]; + baselist:=[]; + eigenspacelist := []; + out2:=fail; + fi; + until out2<>fail and out2[2] > 2; + check := RECOG.CheckNewStingrayGroupSmallerMatrices(out[1],out[2],out[3],out[4],out2[1],out2[2],out2[3],out2[4],q); + if check[1] then + # At this point we can use the smaller matrices and use them during the next loop body execution + slpToSmallerGroup := SLPOfElms([out[1],out2[1]]); + Add(slplist,slpToSmallerGroup); + Add(baselist,check[3]); + Add(eigenspacelist,check[4]); + list:=[GroupWithMemory(check[2]),out[2]+out2[2],q,g]; + currentdim := list[2]; + + # We still have to compute the vector space on which the matrices act in the input group + + Info(InfoRecog,2,"Debug Info:\n"); + Info(InfoRecog,2,"Dimension FirstElement: "); + Info(InfoRecog,2,out[2]); + Info(InfoRecog,2,"\n"); + Info(InfoRecog,2,"Dimension SecondElement: "); + Info(InfoRecog,2,out2[2]); + Info(InfoRecog,2,"\n"); + Info(InfoRecog,2,"End Debug Info. \n"); + + Info(InfoRecog,2,"New Dimension: "); + Info(InfoRecog,2,out[2]+out2[2]); + Info(InfoRecog,2,"\n"); + else + if InfoLevel(InfoRecog) >= 3 then Print("B\c"); fi; + Info(InfoRecog,2,"Restart. \n"); + Info(InfoRecog,2,"Current Dimension: "); + Info(InfoRecog,2,dim); + Info(InfoRecog,2,"\n"); + list:=[g,dim,q,g]; + slplist:=[]; + baselist:=[]; + eigenspacelist := []; + out:=fail; + fi; + fi; + fi; + until out<>fail and out[2]=2; + + return [out[1],list[1],list[2],slplist,baselist,eigenspacelist]; + +end; + + + +RECOG.SLn_constructsl2WithSmallerMatrices:=function(g,d,q) +local r,h,slp,sl2,baselist,gens,b,sl2gens,sl2genss,f,eigenspacelist,subspaces,eigenspace1,eigenspace2,eigenspace3,eigenspaceintersection; + + r := RECOG.SLn_constructppdTwoStingraySmallerMatrices(g,d,q); + slp:=r[4]; + baselist:=r[5]; + eigenspacelist:=r[6]; + Info(InfoRecog,2,"Finished main GoingDown, i.e. we found a stringray element which operates irreducible on a 2 dimensional subspace. \n"); + Info(InfoRecog,2,"Next goal: Find an random element s.t. the two elements generate SL(4,q). \n"); + h := RECOG.SLn_constructsl4(r[2],r[3],q,r[1]); + Add(slp,SLPOfElms(GeneratorsOfGroup(h))); + #h := RECOG.LinearActionRepresentationSmallerMatrices(h); + #Add(baselist,h[3]); + h := GeneratorsOfGroup(h); + h := RECOG.ConstructSL4SmallerMatrices(h[1],h[2],q); + Add(baselist,h[2]); + Add(eigenspacelist,h[3]); + h[1] := GroupWithMemory(h[1]); + #Error("here"); + # Remark D.R.: at this point we know that h is isomorphic to SL(4,q) + Info(InfoRecog,2,"Succesful. "); + Info(InfoRecog,2,"Current Dimension: 4\n"); + Info(InfoRecog,2,"Next goal: Generate SL(2,q). \n"); + if not (q in [2,3,4,5,9]) then + sl2 := RECOG.SLn_godownfromd(h[1],q,4,h[2]); + b := Basis(sl2[2]); + f := GF(q); + sl2gens := StripMemory(GeneratorsOfGroup(sl2[1])); + Add(eigenspacelist,RECOG.FixspaceMat(sl2gens[1])); + #eigenspace1 := RECOG.FixspaceMat(sl2gens[1]); + #eigenspace2 := RECOG.FixspaceMat(sl2gens[2]); + #eigenspace3 := RECOG.FixspaceMat(sl2gens[3]); + #eigenspaceintersection := SumIntersectionMat(eigenspace1,eigenspace2)[2]; + #eigenspaceintersection := SumIntersectionMat(eigenspaceintersection,eigenspace3)[2]; + #Add(eigenspacelist,eigenspaceintersection); + # Test by DR: + #sl2genss := List(sl2gens,x-> List(b,v->Coefficients(b,v*x))); + sl2genss := List(sl2gens,x->RECOG.LinearAction(b,f,x)); + Add(slp,SLPOfElms(GeneratorsOfGroup(sl2[1]))); + Add(baselist,BasisVectors(Basis(sl2[2]))); + # Add(eigenspacelist,RECOG.FixspaceMat(sl2gens[1])); + # Just for tests: Add(eigenspacelist,RECOG.FixspaceMat(TransposedMat(sl2gens[1]))); + Add(sl2,RECOG.ConnectSLPs(slp)); + Add(sl2,sl2genss); + subspaces := RECOG.Computesl2Subspace(baselist,eigenspacelist); + sl2[2] := subspaces[1]; + Add(sl2,subspaces[2]); + # Error("why"); + return sl2; + else + sl2 := RECOG.SLn_exceptionalgodown(h[1],q,h[2]); + b := Basis(sl2[2]); + f := GF(q); + sl2gens := StripMemory(GeneratorsOfGroup(sl2[1])); + sl2genss := List(sl2gens,x->RECOG.LinearAction(b,f,x)); + Add(slp,SLPOfElms(GeneratorsOfGroup(sl2[1]))); + Add(baselist,BasisVectors(Basis(sl2[2]))); + #Add(eigenspacelist,RECOG.FixspaceMat(sl2gens[1])); + Add(sl2,RECOG.ConnectSLPs(slp)); + Add(sl2,sl2genss); + subspaces := RECOG.Computesl2Subspace(baselist,eigenspacelist); + sl2[2] := subspaces[1]; + Add(sl2,subspaces[2]); + return sl2; + # return ["sorry only SL(4,q)",h]; + fi; +end; + + + +RECOG.ConnectSLPs:=function(slps) +local slp, currentslp, i; + + if Size(slps) = 0 then + Error("This should not happen."); + elif Size(slps) = 1 then + return slps[1]; + else + slp := slps[1]; + for i in [2..Size(slps)] do + slp := CompositionOfStraightLinePrograms(slps[i],slp); + od; + return slp; + fi; + +end; + + + +RECOG.Computesl2Subspace:=function(generators,eigenspaceGenerators) +local result, i, gens, j, combination, vec, comb, zerovec, sl2eigenspacebase, newsl2eigenspacevectors, ele; + + if Size(generators) = 1 then + # We started with a SL(4,q) + # Just return the 2-dimensional subspace + + # TODO return eigenspacebase!!! See else case + + sl2eigenspacebase := eigenspaceGenerators[1]; + zerovec := ZeroOfBaseDomain(result) * result[1]; + for ele in eigenspaceGenerators[2] do + vec := zerovec; + for j in [1..Size(ele)] do + vec := vec + ele[j] * result[j]; + od; + Add(sl2eigenspacebase,vec); + od; + + return [generators[1],sl2eigenspacebase]; + else + # We start with the 1xd vectors + result := generators[1]; + sl2eigenspacebase := eigenspaceGenerators[1]; + zerovec := ZeroOfBaseDomain(result) * result[1]; + for ele in eigenspaceGenerators[2] do + vec := zerovec; + for j in [1..Size(ele)] do + vec := vec + ele[j] * result[j]; + od; + Add(sl2eigenspacebase,vec); + od; + + for i in [2..Size(generators)] do + combination := generators[i]; + gens := []; + for comb in combination do + vec := zerovec; + for j in [1..Size(comb)] do + vec := vec + comb[j] * result[j]; + od; + Add(gens,vec); + od; + if i+1 <= Size(eigenspaceGenerators) then + for ele in eigenspaceGenerators[i+1] do + vec := zerovec; + for j in [1..Size(ele)] do + vec := vec + ele[j] * result[j]; + od; + Add(sl2eigenspacebase,vec); + od; + fi; + result := gens; + od; + + return [result,sl2eigenspacebase]; + fi; + +end; + + +############################################################################## +# LGO approach for GoingDown to Dimension 2 +############################################################################## + + + +RECOG.SL_godownToDimension2WithInvolutions := function(h,q) +local counter, ele, ele2, x, x2, ord, invo, found, cent, product, productEle, fact1, fact2, eigenspace, result, +Minuseigenspace, newbasis, dimeigen, dimMinuseigen, gens, SL2, reco, SL2sub, pseudoorderlist, cord1, cord2, r1, r2; + + # First we construct an involution i in h + + found := false; + for counter in [1..100] do + ele := PseudoRandom(h); + x := RECOG.EstimateOrder(ele); + x2 := x[2]; + ord := x[3]; + if x2 <> One(h) then + invo := x2^(ord/2); + else + invo := One(h); + fi; + + if invo <> One(h) and invo^2 = One(h) then + eigenspace := Eigenspaces(GF(q),invo); + if Size(eigenspace) <> 1 then + Minuseigenspace := eigenspace[2]; + eigenspace := eigenspace[1]; + dimeigen := Dimension(eigenspace); + dimMinuseigen := Dimension(Minuseigenspace); + if dimeigen = 2 then + found := true; + break; + fi; + fi; + fi; + od; + + if not(found) then + Error("could not find an involution"); + fi; + + newbasis := MutableCopyMat(BasisVectors(Basis(eigenspace))); + Append(newbasis,BasisVectors(Basis(Minuseigenspace))); + + # Second we compute the two factors by computing the centralizer of the involution i + + cent := RECOG.CentraliserOfInvolution(h,invo,[],false,100,RECOG.CompletionCheck,PseudoRandom); + product := GroupByGenerators(cent[1]); + + # Third we continue as in "Constructive recognition of classical groups in odd characteristic" part 11 to find generator + + r1 := [1,2]; + r2 := [3,4]; + for counter in [1..100] do + result := RECOG.ConstructSmallSub(r1, r2, product, newbasis, g -> RECOG.IsThisSL2Natural(GeneratorsOfGroup(g),GF(q))); + if result <> fail then + break; + fi; + od; + + return fail; +end; diff --git a/gap/projective/constructive_recognition/SL/GoingUp.gi b/gap/projective/constructive_recognition/SL/GoingUp.gi new file mode 100644 index 000000000..cc8022394 --- /dev/null +++ b/gap/projective/constructive_recognition/SL/GoingUp.gi @@ -0,0 +1,547 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +############################################################################# + + + +############################################################################# +############################################################################# +######## GoingUp method for special linear groups ########################### +############################################################################# +############################################################################# + + + +RECOG.SLn_UpStep := function(w) +# w has components: +# d : size of big SL +# n : size of small SL +# slnstdf : fakegens for SL_n standard generators +# bas : current base change, first n vectors are where SL_n acts +# rest of vecs are invariant under SL_n +# basi : current inverse of bas +# sld : original group with memory generators, PseudoRandom +# delivers random elements +# sldf : fake generators to keep track of what we are doing +# f : field +# The following are filled in automatically if not already there: +# p : characteristic +# ext : q=p^ext +# One : One(slnstdf[1]) +# can : CanonicalBasis(f) +# canb : BasisVectors(can) +# transh : fakegens for the "horizontal" transvections n,i for 1<=i<=n-1 +# entries can be unbound in which case they are made from slnstdf +# transv : fakegens for the "vertical" transvections i,n for 1<=i<=n-1 +# entries can be unbound in which case they are made from slnstdf +# +# We keep the following invariants (going from n -> n':=2n-1) +# bas, basi is a base change to the target base +# slnstdf are SLPs to reach standard generators of SL_n from the +# generators of sld +local DoColOp_n,DoRowOp_n,FixSLn,Fixc,MB,Vn,Vnc,aimdim,c,c1,c1f,cf,cfi, + ci,cii,coeffs,flag,i,id,int1,int3,j,k,lambda,list,mat,newbas,newbasf, + newbasfi,newbasi,newdim,newpart,perm,pivots,pivots2,pos,pow,s,sf, + slp,std,sum1,tf,trans,transd,transr,v,vals,zerovec,counter; + + Info(InfoRecog,3,"Going up: ",w.n," (",w.d,")..."); + + # Before we begin, we upgrade the data structure with a few internal + # things: + + if not(IsBound(w.can)) then w.can := CanonicalBasis(w.f); fi; + if not(IsBound(w.canb)) then w.canb := BasisVectors(w.can); fi; + if not(IsBound(w.One)) then w.One := One(w.slnstdf[1]); fi; + if not(IsBound(w.transh)) then w.transh := []; fi; + if not(IsBound(w.transv)) then w.transv := []; fi; + # Update our cache of *,n and n,* transvections because we need them + # all over the place: + std := RECOG.InitSLstd(w.f,w.n, + w.slnstdf{[1..w.ext]}, + w.slnstdf{[w.ext+1..2*w.ext]}, + w.slnstdf[2*w.ext+1], + w.slnstdf[2*w.ext+2]); + for i in [1..w.n-1] do + for k in [1..w.ext] do + pos := (i-1)*w.ext + k; + if not(IsBound(w.transh[pos])) then + RECOG.ResetSLstd(std); + RECOG.DoColOp_SL(false,w.n,i,w.canb[k],std); + w.transh[pos] := std.right; + fi; + if not(IsBound(w.transv[pos])) then + RECOG.ResetSLstd(std); + RECOG.DoRowOp_SL(false,i,w.n,w.canb[k],std); + w.transv[pos] := std.left; + fi; + od; + od; + + Unbind(std); + + # Now we can define two helper functions: + DoColOp_n := function(el,i,j,lambda,w) + # This adds lambda times the i-th column to the j-th column. + # Note that either i or j must be equal to n! + local coeffs,k; + coeffs := IntVecFFE(Coefficients(w.can,lambda)); + if i = w.n then + for k in [1..w.ext] do + if not(IsZero(coeffs[k])) then + if IsOne(coeffs[k]) then + el := el * w.transh[(j-1)*w.ext+k]; + elif not(IsZero(coeffs[k])) then + el := el * w.transh[(j-1)*w.ext+k]^coeffs[k]; + fi; + fi; + od; + elif j = w.n then + for k in [1..w.ext] do + if not(IsZero(coeffs[k])) then + if IsOne(coeffs[k]) then + el := el * w.transv[(i-1)*w.ext+k]; + else + el := el * w.transv[(i-1)*w.ext+k]^coeffs[k]; + fi; + fi; + od; + else + Error("either i or j must be equal to n"); + fi; + return el; + end; + DoRowOp_n := function(el,i,j,lambda,w) + # This adds lambda times the j-th row to the i-th row. + # Note that either i or j must be equal to n! + local coeffs,k; + coeffs := IntVecFFE(Coefficients(w.can,lambda)); + if j = w.n then + for k in [1..w.ext] do + if not(IsZero(coeffs[k])) then + if IsOne(coeffs[k]) then + el := w.transv[(i-1)*w.ext+k] * el; + else + el := w.transv[(i-1)*w.ext+k]^coeffs[k] * el; + fi; + fi; + od; + elif i = w.n then + for k in [1..w.ext] do + if not(IsZero(coeffs[k])) then + if IsOne(coeffs[k]) then + el := w.transh[(j-1)*w.ext+k] * el; + else + el := w.transh[(j-1)*w.ext+k]^coeffs[k] * el; + fi; + fi; + od; + else + Error("either i or j must be equal to n"); + fi; + return el; + end; + + # Here everything starts, some more preparations: + + # We compute exclusively in our basis, so we occasionally need an + # identity matrix: + id := IdentityMat(w.d,w.f); + FixSLn := VectorSpace(w.f,id{[w.n+1..w.d]}); + Vn := VectorSpace(w.f,id{[1..w.n]}); + + Info(InfoRecog,2,"Current dimension: " ); + Info(InfoRecog,2,w.n); + Info(InfoRecog,2,"\n"); + Info(InfoRecog,2,"New dimension: "); + Info(InfoRecog,2,Minimum(2*w.n-1,w.GoalDim)); + Info(InfoRecog,2,"\n"); + + Info(InfoRecog,2,"Preparation done."); + + ## + ## Step 1 + ## + + # First pick an element in SL_n with fixed space of dimension d-n+1: + # We already have an SLP for an n-1-cycle: it is one of the std gens. # <-- NOTE: this text matches the current paper, but not the code + # For n=2 we use a transvection for this purpose. + if w.n > 2 then + if IsOddInt(w.n) then + if w.p > 2 then + s := id{Concatenation([1,w.n],[2..w.n-1],[w.n+1..w.d])}; + ConvertToMatrixRepNC(s,w.f); + if IsOddInt(w.n) then s[2] := -s[2]; fi; + sf := w.slnstdf[2*w.ext+2]; + else # in even characteristic we take the n-cycle: # <-- NOTE: what happens here if we don't??? + s := id{Concatenation([w.n],[1..w.n-1],[w.n+1..w.d])}; + ConvertToMatrixRepNC(s,w.f); + sf := w.slnstdf[2*w.ext+1]; + fi; + else + Error("this program only works for odd n or n=2"); + fi; + else + # In this case the n-1-cycle is the identity, so we take a transvection: + s := MutableCopyMat(id); + s[1,2] := One(w.f); + sf := w.slnstdf[1]; + fi; + + Info(InfoRecog,2,"Step 1 done."); + + # Find a good random element: + w.count := 0; + aimdim := Minimum(2*w.n-1,w.GoalDim); + newdim := aimdim - w.n; + counter := 0; + while true do # will be left by break + + ## + ## Step 2 + ## + v := fail; + repeat + counter := counter + 1; + if InfoLevel(InfoRecog) >= 3 then Print(".\c"); fi; + w.count := w.count + 1; + c1 := PseudoRandom(w.sld); # TODO: can't we do better by using a conjugate of s?? + + # Do the base change into our basis: + #c1 := w.bas * c1 * w.basi; + c := s^(w.bas * c1 * w.basi); + + # Check how these elements look like. Where is the SLP and what elements do we really use + + # Now check that Vn + Vn*s^c1 has dimension 2n-1: + sum1 := SumIntersectionMat(id{[1..w.n]}, c{[1..w.n]}); + if Size(sum1[1]) = aimdim then + # intersect Fix(c) = Nullspace(c-id) with V_n in order to + # find a suitable vector which we can later to our basis + int1 := SumIntersectionMat(RECOG.FixspaceMat(c),id{[1..w.n]})[2]; + v := First(int1, v -> not IsZero(v[w.n])); + if v = fail then + Info(InfoRecog,2,"Ooops: Component n was zero!"); + fi; + fi; + until v <> fail; + + v := v / v[w.n]; # normalize to 1 in position n + Assert(1,v*c=v); + + # now that we have our c and c1, compute some associated + # values for later use + ci := c^-1; + slp := SLPOfElm(c1); + c1f := ResultOfStraightLineProgram(slp,w.sldf); + cf := sf^c1f; + cfi := cf^-1; + + Info(InfoRecog,2,"Step 2 done."); + + ## + ## Steps 3 and 4 + ## + + # Now we found our aimdim-dimensional space W. Since SL_n + # has a d-n-dimensional fixed space W_{d-n} and W contains a complement + # of that fixed space, the intersection of W and W_{d-n} has dimension + # newdim. + + # Change basis: + newpart := ExtractSubMatrix(c,[1..(w.n-1)],[1..(w.d)]); + # Clean out the first n entries to go to the fixed space of SL_n: + zerovec := Zero(newpart[1]); + for i in [1..(w.n-1)] do + CopySubVector(zerovec,newpart[i],[1..w.n],[1..w.n]); + od; + MB := MutableBasis(w.f,[],zerovec); + i := 1; + pivots := EmptyPlist(newdim); + while i <= Length(newpart) and NrBasisVectors(MB) < newdim do + if not(IsContainedInSpan(MB,newpart[i])) then + Add(pivots,i); + CloseMutableBasis(MB,newpart[i]); + fi; + i := i + 1; + od; + newpart := newpart{pivots}; + newbas := Concatenation(id{[1..w.n-1]},[v],newpart); + if 2*w.n-1 < w.d then + + # intersect Fix(c) with F_{d-n} + int3 := SumIntersectionMat(RECOG.FixspaceMat(c),id{[w.n+1..w.d]})[2]; + if Size(int3) <> w.d - aimdim then + Info(InfoRecog,2,"Ooops, FixSLn \cap Fixc wrong dimension"); + continue; + fi; + Append(newbas,int3); + fi; + ConvertToMatrixRep(newbas,Size(w.f)); + newbasi := newbas^-1; + if newbasi = fail then + Info(InfoRecog,2,"Ooops, Fixc intersected too much, we try again"); + continue; + fi; + + ci := newbas * ci * newbasi; + cii := ExtractSubMatrix(ci,[w.n+1..aimdim],[1..w.n-1]); + ConvertToMatrixRep(cii,Size(w.f)); + cii := TransposedMat(cii); + # The rows of cii are now what used to be the columns, + # their length is newdim, we need to span the full newdim-dimensional + # row space and need to remember how: + zerovec := Zero(cii[1]); + MB := MutableBasis(w.f,[],zerovec); + i := 1; + pivots2 := EmptyPlist(newdim); + while i <= Length(cii) and NrBasisVectors(MB) < newdim do + if not(IsContainedInSpan(MB,cii[i])) then + Add(pivots2,i); + CloseMutableBasis(MB,cii[i]); + fi; + i := i + 1; + od; + if Length(pivots2) = newdim then + break; + fi; + Info(InfoRecog,2,"Ooops, no nice bottom..."); + # Otherwise simply try again + od; + + cii := cii{pivots2}^-1; + ConvertToMatrixRep(cii,w.f); + c := newbas * c * newbasi; + w.bas := newbas * w.bas; + w.basi := w.basi * newbasi; + + + Info(InfoRecog,2," found c1 and c."); + # Now SL_n has to be repaired according to the base change newbas: + + # Now write this matrix newbas as an SLP in the standard generators + # of our SL_n. Then we know which generators to take for our new + # standard generators, namely newbas^-1 * std * newbas. + + newbasf := w.One; + for i in [1..w.n-1] do + if not(IsZero(v[i])) then + newbasf := DoColOp_n(newbasf,w.n,i,v[i],w); + fi; + od; + newbasfi := newbasf^-1; + w.slnstdf := List(w.slnstdf,x->newbasfi * x * newbasf); + # Now update caches: + w.transh := List(w.transh,x->newbasfi * x * newbasf); + w.transv := List(w.transv,x->newbasfi * x * newbasf); + + Info(InfoRecog,2,"Step 3 and 4 done"); + + ## + ## Step 5 + ## + + # Now consider the transvections t_i: + # t_i : w.bas[j] -> w.bas[j] for j <> i and + # t_i : w.bas[i] -> w.bas[i] + ww + # We want to modify (t_i)^c such that it fixes w.bas{[1..w.n]}: + trans := []; + for i in pivots2 do + # This does t_i + for lambda in w.canb do + # This does t_i : v_j -> v_j + lambda * v_n + tf := w.One; + tf := DoRowOp_n(tf,i,w.n,lambda,w); + # Now conjugate with c: + tf := cfi*tf*cf; + # Now cleanup in column n above row n, the entries there + # are lambda times the stuff in column i of ci: + for j in [1..w.n-1] do + tf := DoRowOp_n(tf,j,w.n,-ci[j,i]*lambda,w); + od; + Add(trans,tf); + od; + od; + + # Now put together the clean ones by our knowledge of c^-1: + transd := []; + for i in [1..Length(pivots2)] do + for lambda in w.canb do + tf := w.One; + vals := BlownUpVector(w.can,cii[i]*lambda); + for j in [1..w.ext * newdim] do + pow := IntFFE(vals[j]); + if not(IsZero(pow)) then + if IsOne(pow) then + tf := tf * trans[j]; + else + tf := tf * trans[j]^pow; + fi; + fi; + od; + Add(transd,tf); + od; + od; + Unbind(trans); + + Info(InfoRecog,2,"Step 5 done"); + + ## + ## Step 6 + ## + + # Now to the "horizontal" transvections, first create them as SLPs: + transr := []; + for i in pivots do + # This does u_i : v_i -> v_i + v_n + tf := w.One; + tf := DoColOp_n(tf,w.n,i,One(w.f),w); + # Now conjugate with c: + tf := cfi*tf*cf; + # Now cleanup in rows above row n: + for j in [1..w.n-1] do + tf := DoRowOp_n(tf,j,w.n,-ci[j,w.n],w); + od; + # Now cleanup in rows below row n: + for j in [1..newdim] do + coeffs := IntVecFFE(Coefficients(w.can,-ci[w.n+j,w.n])); + for k in [1..w.ext] do + if not(IsZero(coeffs[k])) then + if IsOne(coeffs[k]) then + tf := transd[(j-1)*w.ext + k] * tf; + else + tf := transd[(j-1)*w.ext + k]^coeffs[k] * tf; + fi; + fi; + od; + od; + + # Now cleanup column n above row n: + for j in [1..w.n-1] do + tf := DoColOp_n(tf,j,w.n,ci[j,w.n],w); + od; + + # Now cleanup row n left of column n: + for j in [1..w.n-1] do + tf := DoRowOp_n(tf,w.n,j,-c[i,j],w); + od; + + # Now cleanup column n below row n: + for j in [1..newdim] do + coeffs := IntVecFFE(Coefficients(w.can,ci[w.n+j,w.n])); + for k in [1..w.ext] do + if not(IsZero(coeffs[k])) then + if IsOne(coeffs[k]) then + tf := tf * transd[(j-1)*w.ext + k]; + else + tf := tf * transd[(j-1)*w.ext + k]^coeffs[k]; + fi; + fi; + od; + od; + Add(transr,tf); + od; + + Info(InfoRecog,2,"Step 6 done"); + + ## + ## Step 7 + ## + + # From here on we distinguish three cases: + # * w.n = 2 + # * we finish off the constructive recognition + # * we have to do another step as the next thing + if w.n = 2 then + w.slnstdf[2*w.ext+2] := transd[1]*transr[1]^-1*transd[1]; + w.slnstdf[2*w.ext+1] := w.transh[1]*w.transv[1]^-1*w.transh[1] + *w.slnstdf[2*w.ext+2]; + Unbind(w.transh); + Unbind(w.transv); + w.n := 3; + Info(InfoRecog,2,"Step 7 done"); + return w; + fi; + # We can finish off: + if aimdim = w.GoalDim then + # In this case we just finish off and do not bother with + # the transvections, we will only need the standard gens: + # Now put together the (newdim+1)-cycle: + # n+newdim -> n+newdim-1 -> ... -> n+1 -> n -> n+newdim + flag := false; + s := w.One; + for i in [1..newdim] do + if flag then + # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + tf:=transd[(i-1)*w.ext+1]*transr[i]^-1*transd[(i-1)*w.ext+1]; + else + # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + tf:=transd[(i-1)*w.ext+1]^-1*transr[i]*transd[(i-1)*w.ext+1]^-1; + fi; + s := s * tf; + flag := not(flag); + od; + + # Finally put together the new 2n-1-cycle and 2n-2-cycle: + s := s^-1; + w.slnstdf[2*w.ext+1] := w.slnstdf[2*w.ext+1] * s; + w.slnstdf[2*w.ext+2] := w.slnstdf[2*w.ext+2] * s; + Unbind(w.transv); + Unbind(w.transh); + w.n := aimdim; + Info(InfoRecog,2,"Step 7 done"); + return w; + fi; + + # Otherwise we do want to go on as the next thing, so we want to + # keep our transvections. This is easily done if we change the + # basis one more time. Note that we know that n is odd here! + + # Put together the n-cycle: + # 2n-1 -> 2n-2 -> ... -> n+1 -> n -> 2n-1 + flag := false; + s := w.One; + for i in [w.n-1,w.n-2..1] do + if flag then + # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + tf := transd[(i-1)*w.ext+1]*transr[i]^-1*transd[(i-1)*w.ext+1]; + else + # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + tf := transd[(i-1)*w.ext+1]^-1*transr[i]*transd[(i-1)*w.ext+1]^-1; + fi; + s := s * tf; + flag := not(flag); + od; + + # Finally put together the new 2n-1-cycle and 2n-2-cycle: + w.slnstdf[2*w.ext+1] := s * w.slnstdf[2*w.ext+1]; + w.slnstdf[2*w.ext+2] := s * w.slnstdf[2*w.ext+2]; + + list := Concatenation([1..w.n-1],[w.n+1..2*w.n-1],[w.n],[2*w.n..w.d]); + perm := PermList(list); + mat := PermutationMat(perm^-1,w.d,w.f); + ConvertToMatrixRep(mat,w.f); + w.bas := w.bas{list}; + ConvertToMatrixRep(w.bas,w.f); + w.basi := w.basi*mat; + + # Now add the new transvections: + for i in [1..w.n-1] do + w.transh[w.ext*(w.n-1)+w.ext*(i-1)+1] := transr[i]; + od; + Append(w.transv,transd); + w.n := 2*w.n-1; + + Info(InfoRecog,2,"Step 7 done"); + return w; +end; diff --git a/gap/projective/constructive_recognition/SL/main.gi b/gap/projective/constructive_recognition/SL/main.gi new file mode 100644 index 000000000..96cb3968a --- /dev/null +++ b/gap/projective/constructive_recognition/SL/main.gi @@ -0,0 +1,228 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +############################################################################# + + + +############################################################################# +############################################################################# +######## Main function for special linear groups ############################ +############################################################################# +############################################################################# + + + +RECOG.FindStdGens_SL := function(sld) + + # Group generated by input must be isomorphic SL(d,q) + + # gens of sld must be gens for SL(d,q) in its natural rep with memory + # This function calls RECOG.SLn_constructsl2 and then extends + # the basis to a basis of the full row space and calls + # RECOG.SLn_UpStep often enough. Finally it returns an slp such + # that the SL(d,q) standard generators with respect to this basis are + # expressed by the slp in terms of the original generators of sld. + local V,b,bas,basi,basit,d,data,ext,fakegens,id,nu,nu2,p,q,resl2,sl2,sl2gens, + sl2gensf,sl2genss,sl2stdf,slp,slpsl2std,slptosl2,st,std,stdgens,i,ex,f; + + # Some setup: + f := FieldOfMatrixGroup(sld); + p := Characteristic(f); + q := Size(f); + ext := DegreeOverPrimeField(f); + d := DimensionOfMatrixGroup(sld); + if not(IsObjWithMemory(GeneratorsOfGroup(sld)[1])) then + sld := GroupWithMemory(sld); + fi; + + # First find an SL2 with the space it acts on; + Info(InfoRecog,2,"Finding an SL2..."); + Info(InfoRecog,2,"-----"); + Info(InfoRecog,2,"Start of the GoingDown Algorithm."); + data := RECOG.SLn_constructsl2(sld,d,q); + Info(InfoRecog,2,"The GoingDown Algorithm was successful."); + Info(InfoRecog,2,"-----"); + + bas := ShallowCopy(BasisVectors(Basis(data[2]))); + sl2 := data[1]; + slptosl2 := SLPOfElms(GeneratorsOfGroup(sl2)); + sl2gens := StripMemory(GeneratorsOfGroup(sl2)); + V := data[2]; + b := Basis(V,bas); + sl2genss := List(sl2gens,x->RECOG.LinearAction(b,f,x)); + + Info(InfoRecog,2,"-----"); + Info(InfoRecog,2,"Solving the base case"); + if q in [2,3,4,5,9] then + Info(InfoRecog,2,"In fact found an SL4..."); + stdgens := RECOG.MakeSL_StdGens(p,ext,4,4).all; + slpsl2std := RECOG.FindStdGensUsingBSGS(Group(sl2genss),stdgens, + false,false); + nu := List(sl2gens,x->RECOG.FixspaceMat(x)); + ex := SumIntersectionMat(nu[1],nu[2])[2]; + for i in [3..Length(nu)] do + ex := SumIntersectionMat(nu[3],ex); + od; + Append(bas,ex); + ConvertToMatrixRep(bas,q); + basi := bas^-1; + else + # Now compute the natural SL2 action and run constructive recognition: + Info(InfoRecog,2, + "Recognising this SL2 constructively in 2 dimensions..."); + sl2genss := GeneratorsWithMemory(sl2genss); + if IsEvenInt(q) then + resl2 := RECOG.RecogniseSL2NaturalEvenChar(Group(sl2genss),f,false); + else + resl2 := RECOG.RecogniseSL2NaturalOddCharUsingBSGS(Group(sl2genss),f); + fi; + slpsl2std := SLPOfElms(resl2.all); + bas := resl2.bas * bas; + # We need the actual transvections: + slp := SLPOfElms([resl2.s[1],resl2.t[1]]); + st := ResultOfStraightLineProgram(slp, + StripMemory(GeneratorsOfGroup(sl2))); + + # Extend basis by something invariant under SL2: + id := IdentityMat(d,f); + nu := NullspaceMat(StripMemory(st[1]-id)); + nu2 := NullspaceMat(StripMemory(st[2]-id)); + Append(bas,SumIntersectionMat(nu,nu2)[2]); + ConvertToMatrixRep(bas,q); + basi := bas^-1; + fi; + Info(InfoRecog,2,"Finished the base case."); + Info(InfoRecog,2,"-----"); + + # Now set up fake generators for keeping track what we do: + fakegens := ListWithIdenticalEntries(Length(GeneratorsOfGroup(sld)),()); + fakegens := GeneratorsWithMemory(fakegens); + sl2gensf := ResultOfStraightLineProgram(slptosl2,fakegens); + sl2stdf := ResultOfStraightLineProgram(slpsl2std,sl2gensf); + std := rec( f := f, d := d, GoalDim := d, n := 2, bas := bas, basi := basi, + sld := sld, sldf := fakegens, slnstdf := sl2stdf, + p := p, ext := ext ); + Info(InfoRecog,2,"Going up to SL_d again..."); + Info(InfoRecog,2,"-----"); + Info(InfoRecog,2,"Start of the GoingUp Algorithm"); + while std.n < std.GoalDim do + RECOG.SLn_UpStep(std); + od; + Info(InfoRecog,2,"The GoingUp Algorithm was successful."); + Info(InfoRecog,2,"-----"); + return rec( slpstd := SLPOfElms(std.slnstdf), + bas := std.bas, basi := std.basi ); +end; + + + +RECOG.FindStdGensSmallerMatrices_SL := function(sld) + + # Group generated by input must be isomorphic SL(d,q) + + # gens of sld must be gens for SL(d,q) in its natural rep with memory + # This function calls RECOG.SLn_constructsl2 and then extends + # the basis to a basis of the full row space and calls + # RECOG.SLn_UpStep often enough. Finally it returns an slp such + # that the SL(d,q) standard generators with respect to this basis are + # expressed by the slp in terms of the original generators of sld. + local V,b,bas,basi,basit,d,data,ext,fakegens,id,nu,nu2,p,q,resl2,sl2,sl2gens, + sl2gensf,sl2genss,sl2stdf,slp,slpsl2std,slptosl2,st,std,stdgens,i,ex,f; + + # Some setup: + f := FieldOfMatrixGroup(sld); + p := Characteristic(f); + q := Size(f); + ext := DegreeOverPrimeField(f); + d := DimensionOfMatrixGroup(sld); + if not(IsObjWithMemory(GeneratorsOfGroup(sld)[1])) then + sld := GroupWithMemory(sld); + #### Added by DR! Optimize this line! + ### second argument for length of list, third argument for number of shuffles + Group_InitPseudoRandom(sld,Size(GeneratorsOfGroup(sld))+2,5); + # Noch weniger initialisierungen testen + # TODO: Wenn initialisiert, nicht nochmal, if hinzufügen + fi; + + # First find an SL2 with the space it acts on; + Info(InfoRecog,2,"Finding an SL2..."); + Info(InfoRecog,2,"-----"); + Info(InfoRecog,2,"Start of the GoingDown Algorithm."); + data := RECOG.SLn_constructsl2WithSmallerMatrices(sld,d,q); + Info(InfoRecog,2,"The GoingDown Algorithm was successful."); + Info(InfoRecog,2,"-----"); + + bas := ShallowCopy(data[2]); + sl2 := data[1]; + slptosl2 := data[3]; + sl2gens := StripMemory(GeneratorsOfGroup(sl2)); + b := Basis(VectorSpace(GF(q),bas),bas); + sl2genss := data[4]; + + Info(InfoRecog,2,"-----"); + Info(InfoRecog,2,"Solving the base case"); + if q in [2,3,4,5,9] then + Info(InfoRecog,2,"In fact found an SL4..."); + stdgens := RECOG.MakeSL_StdGens(p,ext,4,4).all; + slpsl2std := RECOG.FindStdGensUsingBSGS(Group(sl2genss),stdgens, + false,false); + Append(bas,data[5]); + ConvertToMatrixRep(bas,q); + basi := bas^-1; + else + # Now compute the natural SL2 action and run constructive recognition: + Info(InfoRecog,2, + "Recognising this SL2 constructively in 2 dimensions..."); + sl2genss := GeneratorsWithMemory(sl2genss); + if IsEvenInt(q) then + resl2 := RECOG.RecogniseSL2NaturalEvenChar(Group(sl2genss),f,false); + else + resl2 := RECOG.RecogniseSL2NaturalOddCharUsingBSGS(Group(sl2genss),f); + fi; + slpsl2std := SLPOfElms(resl2.all); + if resl2.bas <> [[1,0],[0,1]]*One(f) then + Error("So i have to deal with this case..."); + # RECOG.FindStdGensSmallerMatrices_SL(SL(200,2^6),200); gives an example for this case. So we have + # to add at least one more base change + else + #bas := resl2.bas * bas; + # We need the actual transvections: + slp := SLPOfElms([resl2.s[1],resl2.t[1]]); + Append(bas,data[5]); + ConvertToMatrixRep(bas,q); + basi := bas^-1; + fi; + fi; + Info(InfoRecog,2,"Finished the base case."); + Info(InfoRecog,2,"-----"); + + # Now set up fake generators for keeping track what we do: + fakegens := ListWithIdenticalEntries(Length(GeneratorsOfGroup(sld)),()); + fakegens := GeneratorsWithMemory(fakegens); + sl2gensf := ResultOfStraightLineProgram(slptosl2,fakegens); + sl2stdf := ResultOfStraightLineProgram(slpsl2std,sl2gensf); + std := rec( f := f, d := d, GoalDim := d, n := 2, bas := bas, basi := basi, + sld := sld, sldf := fakegens, slnstdf := sl2stdf, + p := p, ext := ext ); + Info(InfoRecog,2,"Going up to SL_d again..."); + Info(InfoRecog,2,"-----"); + Info(InfoRecog,2,"Start of the GoingUp Algorithm"); + while std.n < std.GoalDim do + RECOG.SLn_UpStep(std); + od; + Info(InfoRecog,2,"The GoingUp Algorithm was successful."); + Info(InfoRecog,2,"-----"); + return rec( slpstd := SLPOfElms(std.slnstdf), + bas := std.bas, basi := std.basi ); +end; diff --git a/gap/projective/constructive_recognition/SL/sl2_BlackBox.gi b/gap/projective/constructive_recognition/SL/sl2_BlackBox.gi new file mode 100644 index 000000000..db11537ea --- /dev/null +++ b/gap/projective/constructive_recognition/SL/sl2_BlackBox.gi @@ -0,0 +1,637 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +############################################################################# + + + +################################################################################################### +################################################################################################### +######## Solve Symmetric Powers (Ducs Code) ####################################################### +################################################################################################### +################################################################################################### + + + +# TODO: Use this for the constructive recognition of SL(2,q) + +# Code has been written by Duc Khuat during his Bachelors thesis +# This partly implements an algorithm based on the paper ”Constructive Recognition of SL(2, q)” by Leedham Green and E. A. O’Brien. +# For q being a p-power, the algorithm can only be applied to representations where the degree is smaller than p. + +## computes for an element of SL(2,q) its representation in the n-th symmetric power +## F is the field +## n-th symmetric power +## A element of SL(2,q) +## return : Matrix of dimension n+1 corresponding to the action of SL(2,q) on T_n represented in the basis ( x^n, ...., y^n) +RECOG.SymPowRepSL2 :=function(F,n, A) + local res,i,t,k,sum; + res := IdentityMat(n+1,F); + for i in [0..n] do + for t in [0..n] do + sum :=0; + for k in [0..i] do + if n-i-(t-k) > -1 and t-k > -1 then + sum:= sum + Binomial(n-i,t-k)*Binomial(i,k)* (A[1][1])^(t-k)*(A[2][1])^k*(A[1][2])^(n -i -(t-k))*(A[2][2])^(i-k); + fi; + od; + res[i+1][n-t+1]:= sum; + od; + od; + return res; +end;; + + + +## randomly looks for an element of order q-1. +##input: +## G the group where we look randomly for an element of order n. +## n the order of g. +## return g an element with order n, and the number of tries. +RECOG.RandomElementOfOrder:= function(G, n) + local nrTries ,g; nrTries := 0; + while nrTries < 1000 do + g := PseudoRandom(G); + if (Order(g) = n) then + return [g, nrTries]; + fi; + nrTries := nrTries +1; + od; + ####### Added by Daniel Rademacher ####### + return ["fail", "fail"]; + ########################################## + ErrorNoReturn ( " No element of order ", n, " has been found.\n"); +end ;; + + + +## z^r is the eigenvalue of g on natural module. +## find the unique (up to multiplication of -1) element in Z_q-1, to obtain the expected set of exponents, namely {-n, -n+2, ..., n-2, n }. +##input: +## g has order q-1 and q-1 eigenvectors. +## E is the set of exponent of eigenvalues in respect to a fixed primitve element of the field ## F the underlying field F of order q. +## r in the unit group of Z_{q-1} such that E*(r^{-1}) = { -s,-s+2, ..., s-2,s} +## return M matrix with eigenvectors as rows such that the i-th row is the eigenvector to -s + 2(i-1) for i =1 , ..., s+1. +RECOG.OrderEigenvectors := function(g , E ,F, r) + local + i, # every row of M. + s, # Eigenvector of g + M, # Output Matrix + EVs, # Eigenvectors of g. + z; + z:= PrimitiveElement(F); + M := []; + EVs := Eigenvectors(F,g); + for i in [ 1 .. DimensionsMat(g)[1]] do + for s in EVs do + if s*g = (z^(E[i]*r))*s then + M[i] := s; + fi; + od; + od; + return M; +end;; + + + +## find k such that List([0..n], x -> (n-2*x) mod (q-1)) * k = E. +## this k is unique, up to adding (q-1) multiples. +## input: +## E is the set of exponent of eigenvalues in respect to a fixed primitve element of the field +## n the n-th symmetric power. +## q the order of the underlying field. +## return k such that E = k * {-s,-s+2,..., s-2, s}. +## Note: k is unique up to sign for the considered cases. +RECOG.EVNatRep := function(E,n,q) + local k,l ,res, Exp; + res := 0; + Exp:=List([0..n], x -> (n-2*x) mod (q-1)); + for k in PrimeResidues(q-1) do + l := OrderMod(k,q-1)-1; # inverse of k in Z_q-1. + if Set(E*(k^l) mod (q-1)) = Set(Exp) then + res := k; + break; + fi; + od; + return res; +end;; + + + +## Symmetric Power Basis ### +## representation of SL(2,q) in GL(T_n) for n < p. +## find an element g having N distinct eigenvalues; +## if G is symmetric power of SL(2, q) n = G. And h conjugated to g. + con , # random conjugation element + i, # iterating through columns + mu_i , # coefficients of basis element + abZero , # if ab = 0 we take the last row, if ab not zero, we takte the first row of h. + ab, # coefficents to + mu_bet # coefficents to + ; + F := FieldOfMatrixGroup(G); + z:= PrimitiveElement(F); + n := DimensionsMat(PseudoRandom(G))[1] -1; + q := Size(F); + p := Characteristic(F); + k :=1; + if q < 6 or ((p mod 2 = 1) and q = p and p > 6 and n > (p-7)/2 and (not (p = 13 and n =4) )) then + ErrorNoReturn (" Exceptional Case , use another method "); + fi; + if (Size(PseudoRandom(G)) mod 2 = 0) then + g := RECOG.RandomElementOfOrder(G,q-1)[1]; + else + g:= RECOG.RandomElementOfOrder(G,(q-1)/2)[1]; + fi; + ####### Added by me ####### + if g = "fail" then + return ["fail"]; + fi; + ########################### + Ek:= List(Eigenvalues(F,g), x -> LogFFE(x,z)); + k := RECOG.EVNatRep(Ek,n,q); + M:= RECOG.OrderEigenvectors(g,List([0..n], x -> (n-2*x) mod (q-1) ), F, k); + ####### Added by me ####### + if M = [] then + return ["fail"]; + fi; + ########################### + #correct coefficients of ( x^(n-2)y^2,..,y^n) + con := IdentityMat(n+1,F); + while g*g^con = g^con*g do + con:= PseudoRandom(G); + od; + h := M*g^con*M^(-1); # = G. + if not (h[1] in Subspace(VectorSpace(F,g), [IdentityMat(n+1,F)[1]]) or h[1] in Subspace(VectorSpace(F,g), [IdentityMat(n+1,F)[n+1] ])) then + abZero :=1; + else + abZero := n+1; + fi; + ab := h[abZero][1] / (n^(-1)* h[abZero][2]); mu_bet := z^0; + for i in [2..n] do + mu_i := mu_bet*Binomial(n,i-1)^(-1)*ab^(-1)* h[abZero][i] /(Binomial(n,i)^(-1)*h[abZero][i+1]); + mu_bet := mu_i; + M[i+1]:= mu_i^(-1)*M[i+1]; + od; + return [M,g]; +end ;; + + + +## For a symmetric power G and elm of G construct image in PSL(2,q). +## input: G symmetric power of SL(2,q) of degree n < p. +## elm arbitrary matrix in G. +## Trafo the basis of the form (x^n, ..., y^n) for some element of order q-1 and eigenvectors x and y on the natrual module of SL(2,q). +## return: image of elm in PSL(2,q) for one possible homomorphism of +RECOG.HomToPSL := function (G, elm, Trafo, nOdd) + local + F, # field of matrix group + n, # degree of the symmetric power + z, # primitives element of the field + M, # the basis of the form (x^n,..., y^n) + h, # elm represented in M + k, # exponend of a^2 or d^2 + ba,ca,da,a2,a,cd,bd,d2,d,bc,c2,c, #quotients ba = b/a. + V; + F:= FieldOfMatrixGroup(G); z:= PrimitiveElement(F); + M :=Trafo; + n:= Size(M)-1; + h := M * elm * M^(-1); + V:= VectorSpace(F,M); # equals F^(n+1) + if not h[1] in Subspace(V,[IdentityMat(n+1, F)[n+1]]) then #check if a=0 + ba := (h[1][2]*n^(-1))/ h[1][1]; + ca := h[2][1]/ h[1][1]; + da := h[2][2]/h[1][1] - (n-1)*ba*ca; a2 :=1/ (da - ba*ca); k:=LogFFE(a2,z); + if nOdd then + a := h[1][1]/(a2)^(QuoInt(n,2)); + elif k mod 2 = 0 then + a := z^(k/2); + else + ErrorNoReturn("Something is wrong."); + fi; + return [[a,ba*a],[ca*a,da*a]]; + elif not h[n+1] in Subspace(V,[IdentityMat(n+1,F)[1] ]) then #check if d =0 + cd := (h[n+1][n]*n^(-1))/h[n+1][n+1]; bd := h[n][n+1] / h[n+1][n+1]; + d2 :=1 / ( - bd * cd); + k := LogFFE(d2,z); + if nOdd then + d := h[n+1][n+1] / (d2)^(QuoInt(n,2)); + elif k mod 2 = 0 then d := z^(k/2); + else + ErrorNoReturn("Something is wrong."); + fi; + return [[0,bd*d],[cd*d,d]]; + else + #if a=d=0 + bc := h[1][n+1]/ h[2][n]; c2 := -(bc)^(-1); + k := LogFFE(c2,z); + if nOdd then + c := h[n+1][1] / (c2)^(QuoInt(n,2)); + elif k mod 2 = 0 then + c := z^(k/2); + else + ErrorNoReturn("Something is wrong."); + fi; + return [[0,bc*c],[c,0]]; + fi; +end;; + + + +## MAIN FUNCTION +## G n-th symmetric power of SL(2,q) in GL(T_n) for n < p. +## return [homomorphism from G to PSL(2,q), homomorphism from SL(2,q) to G] +RECOG.RecTest := function(G) + local Trafo ,d, F; + Trafo:= RECOG.SymmetricPowerBasis(G)[1]; + if Trafo = "fail" then + return fail; + fi; + F:= FieldOfMatrixGroup(G); # underlying field + d:= Size(PseudoRandom(G))-1; # d-th symmetric power + return [x-> RECOG.HomToPSL(G,x,Trafo, d mod 2 = 1), x->Trafo^(-1)*RECOG.SymPowRepSL2(F,d,x)*Trafo]; +end;; + + + +################################################################################################### +################################################################################################### +######## Decomposition of Tensor Products ######################################################### +################################################################################################### +################################################################################################### + + + +# given sequence E of elements of finite field, construct certain +# arithmetic progressions; if MaxAP is true, give up as soon as +# we find one of length #E */ + +# If unset: MaxAP := false +RECOG.FindAPs := function (E, deg, p, MaxAP) +local AP, first, x, y, index, d, list, i, term; + + if Size(E) <= 1 then + return []; + fi; + + AP := []; + for first in [1..Size(E)] do + x := E[first]; + for index in [1..Size(E)] do + if index <> first then + y := E[index]; + d := y - x; + list := [x, y]; + if ((deg mod 2) = 0) then + Append (AP, list); + fi; + for i in [3..Size(E)] do + if MaxAP = false and Size(list) >= p then + break; + fi; + term := list[i - 1] + d; + if (term in E) and not(term in list) then + list[i] := term; + if ((deg mod i) = 0) then + Append (AP, list); + fi; + else + break; + fi; + od; + if MaxAP and Size(list) = Size(E) then + return [list]; + fi; + fi; + od; + od; + + return Set(AP); + #return SetToSequence (Set (AP)); + +end; + + + +RECOG.RandomElementOfOrderModuleCentre := function(G, required, MaxTries, Central) +local nrTries ,g, ord, centre; + + nrTries := 0; + centre := Centre(G.group); + while nrTries < MaxTries do + g := PseudoRandom(G.group); + ord := Order(g); + if (ord = 2*required) then + if (g^(required) in centre) then + return [true, g, nrTries]; + fi; + Display("nop"); + #return [true, g, nrTries]; + fi; + nrTries := nrTries +1; + od; + ####### Added by Daniel Rademacher ####### + return ["fail", "fail", nrTries]; + +end; + + + +# construct space determined by g and arithmetic progression a +# of its eigenvalues, and send space to FindPoint + +RECOG.ProcessSequence := function(G, g, a) +local F, w, ev, Space, CB, Status, gens, vec; + + F := G.fld; + w := PrimitiveElement(F); + ev := List(a, x-> w^(Int(x))); + # Maybe this line means to make one list with all the spaces? If yes, modify other lines like this too.... Space := &+[Eigenspace (g, e): e in ev]; + Space := List(ev, e -> RECOG.EigenspaceMat(g,e)); + gens := []; + for vec in Space do + Append(gens,vec); + od; + Space := VectorSpace(F,gens); + CB := "unknown"; + Status := false; + Space := RECOG.GeneralFindPoint(G, Space, Dimension(Space), Status, CB, true); + Status := Space[2]; + CB := Space[3]; + Space := Space[1]; + return [Status, CB]; +end; + + + +RECOG.StoreDetails := function(G, Result) +local U,W, CB; + CB := Result[1]; + RECOG.SetTensorProductFlag(G, true); + RECOG.SetTensorBasis(G, CB); + U := RECOG.ConstructTensorFactors(G, Result); + W := U[2]; + U := U[1]; + RECOG.SetTensorFactors (G, [U, W]); +end; + + + +# G is a tensor product of symmetric powers of SL(2, q) +# twisted under action of Frobenius maps; +# decompose one symmetric power + +RECOG.DecomposeTensor := function (G, F) +local d, p, f, q, i, factors, g, list, u, w, NmrTries, required, lambda, original, eigenvectors, multiplicity, nmr, E, least, flag, Result, index, first, step, a, x, y, term, lp, Zq, primitiveEle; + + # TODO: Add check whether G is already prepared + G := RECOG.PrepareTensor(G); + + d := G.d; + if d = 2 then + return [false,false]; + fi; + + q := Size(F); + f := Factors(q); + p := f[1]; + f := Size(f); + + if ( ( p mod 2 = 1) and ((f = 2 and (d in [(p - 1)^2, p * (p - 1)])) or (d = p^f))) or (p = 2 and f = 2 and d = 4) then + Print("sl2q: Need special version of DecomposeTensor for these cases \n"); + return fail; + + # TODO: NON-GENERIC CASES. DEAL WITH THEM LATER + + # if d mod p = 0 then + # factors := [[p, Int(d/p)]]; + # elif d mod (p - 1) = 0 then + # factors := [[p - 1, Int(d/(p - 1))]]; + # fi; + # # TODO: Need is Tensor + # flag := RECOG.IsTensor(G, factors); + # if flag then + # list := RECOG.TensorDimensions(G); + # u := list[1]; + # w := list[2]; + # #TODO: Write this in GAP + # #Result := ; + # return [true, Result]; + # else + # return [false,false]; + # fi; + fi; + + NmrTries := 100; + if p = 2 then + required := (q-1); + else + required := (q-1)/2; + fi; + flag := RECOG.RandomElementOfOrderModuleCentre(G, required, NmrTries, true); + g := flag[2]; + flag := flag[1]; + if not(flag) then + Print("sl2q: Failed to find element of order ", required); + return [false, false]; + fi; + + lambda := Eigenvalues(F,g); + #eigenvectors := Eigenvectors(F,g); + original := Size(lambda); + Print("sl2q: Number of eigenvalues is ", original, "\n"); + + lambda := List([1..original], i -> [lambda[i],Size(RECOG.EigenspaceMat(g,lambda[i]))]); + lambda := Filtered(lambda, x -> x[2] = 1); + + Print("sl2q: Number of eigenvalues of multiplicity 1 = ", Size(lambda), "\n"); + if Size(lambda) <= 1 then + Print("sl2q: Too few eigenvalues left \n"); + return [false, false]; + fi; + + # are there multiplicities in eigenvalues? + multiplicity := Size(lambda) < original; + + primitiveEle := PrimitiveElement(GF(q)); + E := List(lambda, x -> LogFFE(primitiveEle,x[1])); + Zq := ZmodnZ(q-1); + E := List(E, x-> ZmodnZObj(ElementsFamily(FamilyObj(Zq)),x)); + + nmr := 0; + + # largest prime dividing d + lp := Maximum(Factors(d)); + + # minimum length of AP if multiplicity among EVs + least := (p + 1)/2; + + # construct arithmetic progressions of length ell, + # where ell is at most p and ell is a multiple of lp; + # if multiplicity-free then ell is proper divisor of d; + # if not, then ell >= least + + for first in [1..Size(E)] do + x := E[first]; + for index in [1..Size(E)] do + if index = first then + continue; + fi; + y := E[index]; + step := y - x; + a := [x, y]; + if d mod Size(a) = 0 then + if (multiplicity and Size(a) >= least) or (not(multiplicity) and Size(a) mod lp = 0) then + flag := RECOG.ProcessSequence(G, g, a); + Result := flag[2]; + flag := flag[1]; + nmr := nmr + 1; + if flag then + RECOG.StoreDetails (G, Result); + Print("sl2q: Arithmetic progression is ", a); + Print("sl2q: Number of calls to FindPoint is", nmr); + return [true, Result]; + fi; + fi; + fi; + + # construct APs of length at most p; if the length + # of the AP properly divides the degree of G, + # then send space to FindPoint + for i in [3..p] do + term := a[i - 1] + step; + if not(term in E) then + break; + fi; + if (term in a) then + break; + fi; + a[i] := term; + if Size(a) > (d/2) then + break; + fi; + if (d mod Size(a)) = 0 then + if (multiplicity and Size(a) >= least) or (not(multiplicity) and (Size(a) mod lp) = 0) then + flag := RECOG.ProcessSequence(G, g, a); + Display("process 1"); + Result := flag[2]; + flag := flag[1]; + nmr := nmr + 1; + if flag then + Print("sl2q: Arithmetic progression is ", a); + Print("sl2q: Number of calls to FindPoint is", nmr); + RECOG.StoreDetails(G, Result); + return [true, Result]; + fi; + fi; + fi; + od; + od; + od; + + return [false,false]; + +end; + + + +################################################################################################### +################################################################################################### +######## Symmetric Powers and Twisted Tensor Products ############################################# +################################################################################################### +################################################################################################### + + + +RECOG.SymmetricPowerSL2 := function (q, n) +local G, fld, gens, res, g; + + gens := GeneratorsOfGroup(SL(2,q)); + res := []; + fld := GF(q); + for g in gens do + Add(res,RECOG.SymPowRepSL2(q,n,g)); + od; + return GroupByGenerators(res); + #return ActionGroup (A); +end; + +# given matrix x, return result of applying Frobenius automorphism +# x[i][j] --> x[i][j]^n to it +RECOG.GammaLMatrix:=function(x,d,n) +local G,i,j,y; + + if not(IsMutable(x)) then + x := MutableCopyMat(x); + fi; + + for i in [1..d] do + for j in [1..d] do + x[i,j] := x[i,j]^n; + od; + od; + return x; +end; + + + +RECOG.TwistedSymmetricPower:=function(q,s,f) +local F,Gens,S,Twisted,p,i,d; + F:=GF(q); + p:=Characteristic(F); + S:=RECOG.SymmetricPowerSL2(q,s); + Gens:=GeneratorsOfGroup(S); + d := NumberRows(Gens[1]); + Twisted:=List([1..Size(Gens)],i->RECOG.GammaLMatrix(Gens[i],d,p^f)); + return GroupByGenerators(Twisted); +end; + + + +# tensor product of twisted symmetric powers defined +# over GF (p^e); s lists the symmetric powers, +# f is the twisting via powers of the Frobenius +# automorphism to be applied to each symmetric power +RECOG.SymmetricPowerExample:=function(p,e,s,f) +local F,q,G,L,T2,i,gens,j,gens2; + F:=GF(p^e); + q:= p^e; + L:=SL(2,F); + G:=RECOG.TwistedSymmetricPower(q,s[1],f[1]); + if Size(s) = 1 then + return G; + fi; + for i in [2..Size(s)] do + T2:=RECOG.TwistedSymmetricPower(q,s[i],f[i]); + gens := GeneratorsOfGroup(G); + gens2 := [1..Size(gens)]; + for j in [1..Size(gens)] do + gens2[j] := KroneckerProduct(gens[j],GeneratorsOfGroup(T2)[j]); + od; + G:=GroupByGenerators(gens2); + od; + return G; +end; diff --git a/gap/projective/constructive_recognition/SU/BaseCase.gi b/gap/projective/constructive_recognition/SU/BaseCase.gi new file mode 100644 index 000000000..c7e64726c --- /dev/null +++ b/gap/projective/constructive_recognition/SU/BaseCase.gi @@ -0,0 +1,203 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +############################################################################# + + +############################################################################# +############################################################################# +######## Constructive recognition SU(4,q) in natural representation ######### +############################################################################# +############################################################################# + + +# The code here is from Brooksbank and Clarksen +# Note that the papers are not correct and we have to modify a lot in order to get the functions running +# We mark every point, where we differ from the paper + + + +RECOG.ConstructiveRecognitionSU4NaturalRepresentation := function(G, q, epsilon) + + # TODO: Needs SU3 + +end; + + + +RECOG.IsMersennePrimeNumber := function(p) +local i; + + i := 0; + while 2^i-1 <= p do + if p = 2^i-1 then + return true; + fi; + i := i + 1; + od; + + return false; + +end; + + + +RECOG.IsFermat := function(p) +local F; + + F := List([0..4], i -> 2^(2^i)+1 ); + return p in F; + +end; + + + +RECOG.IsPowerOfTwo := function(j) +local SmallPowersOfTwo; + + SmallPowersOfTwo := List([1..100], i -> 2^i ); + return j in SmallPowersOfTwo; + +end; + + + +RECOG.IsSpecialPPDElement:=function(a,F,j,p,n) + + if n = 1 then + if RECOG.IsFermat(p) then + return ((j mod 4) = 0); + else + return RECOG.IsPowerOfTwo(j); + fi; + else + if p = 2 and n = 6 then + if j mod 21 = 0 then + return true; + else + return false; + fi; + elif n = 2 and RECOG.IsMersennePrimeNumber(p) then + if j mod 4 = 0 then + return true; + else + return false; + fi; + else + if IsPpdElement(F,a,2,p,n/2) <> false then + return true; + fi; + fi; + fi; + + return false; + +end; + + + + +# TODO: Deal with even characteristic +# TODO: Avoid computing Order (ask Alice!) +# Input: natural < X > = SU(3,q) +# Output: standard generators of SU(3,q) as words in X +RECOG.RecogniseNaturalSU3:=function(G, q) +local p, s, F, i, a, k, fact, DivisorOrder, found, ord, b, H, L, LL, g, moveToSL, module, res, t; + + fact := Factors(q); + p := fact[1]; + k := Size(fact); + s := RECOG.FindSForSLSUIsomorphism(q); + F := GF(q^2); + + i := 1; + found := false; + while i < 10 do + t := PseudoRandom(G); + a := t^(2*(q-1)); + ord := Order(t); + if RECOG.IsSpecialPPDElement(t,F,ord,p,2*k) and RECOG.IsSpecialPPDElement(t,F,ord,p,k) then + found := true; + break; + fi; + i := i + 1; + od; + + if not(found) then + return TemporaryFailure; + fi; + + i := 1; + found := false; + while i < 10 do + g := PseudoRandom(G); + b := a^g; + H := GroupByGenerators([a,b]); + L := RECOG.DerivedSubgroupMonteCarlo(H,20); + module := GModuleByMats(GeneratorsOfGroup(L), F); + if not(MTX.IsIrreducible(module)) and Size(L) = Size(SL(2,q)) then + LL := RECOG.LinearActionRepresentation(L); + moveToSL := List(GeneratorsOfGroup(LL),x->RECOG.IsomorphismFromSU2ToSL2(x,q,s)); + Error("here"); + res := RECOG.ConstructiveRecognitionSL2NaturalRepresentation(GroupByGenerators(moveToSL),q,0.001); + res := RECOG.ConstructiveRecognitionSL2NaturalRepresentationCompleteBasis(res,GF(q),q,p,k/2); + fi; + i := i + 1; + od; + + if not(found) then + Display("nichts gefunden"); + Error("here"); + fi; + + Error("here"); + +end; + + + +RECOG.FindSForSLSUIsomorphism := function(q) +local a; + + a := PrimitiveElement(GF(q^2)); + return a^q-a; + +end; + + + +RECOG.IsomorphismFromSU2ToSL2:=function(g,q,s) +local mat; + + mat := IdentityMat(2,GF(q)); + mat[1,1] := g[1,1]; + mat[2,2] := g[2,2]; + mat[1,2] := s*g[1,2]; + mat[2,1] := s^(-1)*g[2,1]; + return mat; + +end; + + + +RECOG.IsomorphismFromSL2ToSU2:=function(g,q,s) +local mat; + + mat := IdentityMat(2,GF(q)); + mat[1,1] := g[1,1]; + mat[2,2] := g[2,2]; + mat[1,2] := s^(-1)*g[1,2]; + mat[2,1] := s*g[2,1]; + return mat; + +end; \ No newline at end of file diff --git a/gap/projective/constructive_recognition/SU/GoingDown.gi b/gap/projective/constructive_recognition/SU/GoingDown.gi new file mode 100644 index 000000000..1167e5ecb --- /dev/null +++ b/gap/projective/constructive_recognition/SU/GoingDown.gi @@ -0,0 +1,253 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +############################################################################# + + + +############################################################################# +############################################################################# +######## GoingDown method for unitary groups ################################ +############################################################################# +############################################################################# + + +# TODO: Work on comments and documentation + + + +RECOG.SU_godownToDimension4 := function(h,q) +local counter, ele, x, x2, ord, invo, found, cent, product, eigenspace, Minuseigenspace, newbasis, dimeigen, dimMinuseigen, r1, r2, result; + + if not(IsObjWithMemory(GeneratorsOfGroup(h)[1])) then + h := GroupWithMemory(h); + fi; + + # First we construct an involution i in h + + found := false; + for counter in [1..100] do + ele := PseudoRandom(h); + x := RECOG.EstimateOrder(ele); + x2 := x[2]; + ord := x[3]; + if x2 <> One(h) then + invo := x2^(ord/2); + else + invo := One(h); + fi; + + if invo <> One(h) and invo^2 = One(h) then + eigenspace := Eigenspaces(GF(q),invo); + if Size(eigenspace) <> 1 then + Minuseigenspace := eigenspace[2]; + eigenspace := eigenspace[1]; + dimeigen := Dimension(eigenspace); + dimMinuseigen := Dimension(Minuseigenspace); + if dimeigen < 3 or dimMinuseigen < 3 then + found := true; + break; + fi; + fi; + fi; + od; + + if not(found) then + Error("could not find an involution"); + fi; + + newbasis := MutableCopyMat(BasisVectors(Basis(eigenspace))); + Append(newbasis,BasisVectors(Basis(Minuseigenspace))); + + # Second we compute the two factors by computing the centralizer of the involution i + + cent := RECOG.CentraliserOfInvolution(h,invo,[],true,100,RECOG.CompletionCheck,PseudoRandom); + product := GroupByGenerators(cent[1]); + + # Third we continue as in "Constructive recognition of classical groups in odd characteristic" part 11 to find generator + + if dimeigen > 3 then + r1 := [1..dimeigen]; + r2 := [5,6]; + else + r1 := [dimeigen+1..6]; + r2 := [1,2]; + fi; + for counter in [1..100] do + result := RECOG.ConstructSmallSub(r1, r2, product, newbasis, g -> RecogniseClassical(g).isSUContained); + if result <> fail then + break; + fi; + od; + + return result; + +end; + + + +RECOG.IsSU2TauElement := function(tau,q,list) +local entry, foundFirst, foundSecond, ppd2k, ppd6k, ord, prime; + + ord := Order(tau); + for entry in list do + foundFirst := false; + foundSecond := false; + + ppd2k := entry[2]; + for prime in ppd2k do + if (ord mod prime = 0) then + foundFirst := true; + break; + fi; + od; + + if foundFirst then + ppd6k := entry[3]; + for prime in ppd6k do + if (ord mod prime = 0) then + return true; + fi; + od; + fi; + + od; + + return false; + +end; + + + +RECOG.SU_godownToDimension2 := function(h,q,form) +local tau, a, b, g, counter, testgroup, derivedtestgroup, preparelist, k, newentry, ppd, new, p; + + counter := 1; + + preparelist := []; + p := Factors(q)[1]; + # TODO: Adjust to ppd# elements. See Dissertation Kenneth Clarkson (Eamonns student) + if (q mod 2 = 0) then + # TODO + else + for k in [1..10] do + new := [k]; + ppd := PrimitivePrimeDivisors( 2*k, p ); + Add(new,PrimeDivisors(ppd.ppds)); + ppd := PrimitivePrimeDivisors( 6*k, p ); + Add(new,PrimeDivisors(ppd.ppds)); + Add(preparelist,new); + od; + fi; + + Info(InfoRecog,2,"Precomputation finished"); + + while counter < 100 do + tau := PseudoRandom(h); + if RECOG.IsSU2TauElement(tau,q,preparelist) and (Order(tau^(2*(q-Sqrt(q)+1))) <> 1) then + a := tau^(2*(q-Sqrt(q)+1)); + #a := tau^(2*(q^2-q+1)); + Info(InfoRecog,2,"Found tau"); + while counter < 100 do + g := PseudoRandom(h); + b := a^g; + testgroup := GroupByGenerators([a,b]); + derivedtestgroup := CommutatorSubgroup(testgroup,testgroup); + if Size(derivedtestgroup) = Size(SL(2,Sqrt(q))) then + Info(InfoRecog,2,"Found SU(2,q)"); + return derivedtestgroup; + fi; + counter := counter + 1; + od; + fi; + counter := counter + 1; + od; + + if counter >= 100 then + return fail; + fi; + +end; + + + +RECOG.SUn_constructsu2:=function(g,d,q,form) +local r,h,basechange, basechange2, basechange3, liftbasechange2, liftbasechange3, liftr; + + if IsEvenInt(q) then + r := RECOG.constructppdTwoStingray(g,d,q,"SU",form); + Error("here"); + fi; + + r := RECOG.constructppdTwoStingray(g,d,q,"SU",form); + Info(InfoRecog,2,"Finished main GoingDown, i.e. we found a stringray element which operates irreducible on a 2 dimensional subspace. \n"); + Info(InfoRecog,2,"Next goal: Find an random element s.t. the two elements generate SU(4,q). \n"); + + # For now, compute a base change into the stingray matrices + basechange := RECOG.ComputeBlockBaseChangeMatrix(GeneratorsOfGroup(r),d,q); + + r := RECOG.SU_godownToDimension4(RECOG.ExtractSmallerGroup(GeneratorsOfGroup(r),basechange,6)[1],q); + basechange2 := RECOG.ComputeBlockBaseChangeMatrix(r[1],6,q); + # Remark D.R.: at this point we know that h is isomorphic to SU(4,q) + Info(InfoRecog,2,"Succesful. "); + Info(InfoRecog,2,"Current Dimension: 4\n"); + Info(InfoRecog,2,"Next goal: Generate SU(2,q). \n"); + + r := RECOG.SU_godownToDimension2(RECOG.ExtractSmallerGroup(r[1],basechange2,4)[1],q,form); + basechange3 := RECOG.ComputeBlockBaseChangeMatrix(GeneratorsOfGroup(r),4,q); + + liftbasechange2 := RECOG.LiftGroup([basechange2],6,q,d)[2,1]; + liftbasechange3 := RECOG.LiftGroup([basechange3],4,q,d)[2,1]; + + liftr := RECOG.LiftGroup(GeneratorsOfGroup(r),4,q,d)[2]; + liftr[1] := liftr[1]^(liftbasechange3^(-1)); + liftr[2] := liftr[2]^(liftbasechange3^(-1)); + + return [GroupByGenerators(liftr),liftbasechange3*liftbasechange2*basechange,[basechange,liftbasechange2,liftbasechange3]]; +end; + + + +RECOG.SUn_constructsu4:=function(g,d,q,form) +local r,h,basechange, basechange2, basechange3, liftbasechange2, liftbasechange3, liftr,slp; + + if IsEvenInt(q) then + r := RECOG.constructppdTwoStingray(g,d,q,"SU",form); + Error("here"); + fi; + + r := RECOG.constructppdTwoStingray(g,d,q,"SU",form); + slp := SLPOfElms(GeneratorsOfGroup(r)); + Info(InfoRecog,2,"Finished main GoingDown, i.e. we found a stringray element which operates irreducible on a 2 dimensional subspace. \n"); + Info(InfoRecog,2,"Next goal: Find an random element s.t. the two elements generate SU(4,q). \n"); + + # For now, compute a base change into the stingray matrices + basechange := RECOG.ComputeBlockBaseChangeMatrix(GeneratorsOfGroup(r),d,q); + + r := RECOG.SU_godownToDimension4(RECOG.ExtractSmallerGroup(GeneratorsOfGroup(r),basechange,6)[1],q); + slp := CompositionOfStraightLinePrograms(SLPOfElms(r[1]),slp); + basechange2 := RECOG.ComputeBlockBaseChangeMatrix(r[1],6,q); + # Remark D.R.: at this point we know that h is isomorphic to SU(4,q) + Info(InfoRecog,2,"Succesful. "); + Info(InfoRecog,2,"Current Dimension: 4\n"); + + liftbasechange2 := RECOG.LiftGroup([basechange2],6,q,d)[2,1]; + + liftr := RECOG.LiftGroup(r[1],6,q,d)[2]; + liftr[1] := liftr[1]^(liftbasechange2^(-1)); + liftr[2] := liftr[2]^(liftbasechange2^(-1)); + + return [GroupByGenerators(liftr),liftbasechange2*basechange,[basechange,liftbasechange2],slp]; +end; + + diff --git a/gap/projective/constructive_recognition/SU/GoingUp.gi b/gap/projective/constructive_recognition/SU/GoingUp.gi new file mode 100644 index 000000000..7e7d868ff --- /dev/null +++ b/gap/projective/constructive_recognition/SU/GoingUp.gi @@ -0,0 +1,2526 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +############################################################################# + + + +############################################################################# +############################################################################# +######## GoingUp method for unitary groups ################################## +############################################################################# +############################################################################# + + + +RECOG.SolveNormEquationSilly := function(F,phi,value) +local x; + + for x in Elements(F) do + if x <> Zero(F) and x*x^phi = value then + return x; + fi; + od; + + return fail; + +end; + + + +RECOG.SolveMyBachelorEquationSilly := function(F,phi,value) +local x; + + for x in Elements(F) do + if x <> Zero(F) and x+x^phi+value*value^phi = Zero(F) then + return x; + fi; + od; + + return fail; + +end; + + + +RECOG.BaseChangeToCorrectForm := function(form,n,aimdim,one) +local value, vectors, i, basechange, v1, v2; + + value := (form!.matrix)[1,n]; + vectors := []; + for i in [n+1 .. aimdim] do + Add(vectors,one[i]); + od; + + v1 := vectors[1]; + v2 := Last(vectors); + Remove(vectors,1); + Remove(vectors,Position(vectors,v2)); + Error("here"); + + return basechange; + +end; + + + +RECOG.ComputeCorrectingPermutationMat := function(d,F,n,aimdim) +local list, half, plus, minus, next, current; + + half := n/2; + plus := aimdim-n; + minus := aimdim - half; + list := [half+1]; + current := list[1]; + next := current + plus; + if next > aimdim then + next := next - minus; + fi; + while not(next in list) do + Add(list,next); + current := next; + next := current + plus; + if next > aimdim then + next := next - minus; + fi; + od; + + return PermutationMat(CycleFromList(list),d,F); + +end; + + +RECOG.ComputeCorrectingPermutationMatOdd := function(d,F,n,aimdim) +local list, half; + + list := Concatenation([n+1..aimdim],[(n/2)+1..n]); + + return PermutationMat(MappingPermListList([(n/2)+1..aimdim],list)^(-1),d,F); + +end; + + + +# change input into H again +RECOG.SUn_UpStep := function(H,G,n,basechange,phi) +# w has components: +# d : size of big SL +# n : size of small SL +# slnstdf : fakegens for SL_n standard generators +# bas : current base change, first n vectors are where SL_n acts +# rest of vecs are invariant under SL_n +# basi : current inverse of bas +# sld : original group with memory generators, PseudoRandom +# delivers random elements +# sldf : fake generators to keep track of what we are doing +# f : field +# The following are filled in automatically if not already there: +# p : characteristic +# ext : q=p^ext +# One : One(slnstdf[1]) +# can : CanonicalBasis(f) +# canb : BasisVectors(can) +# transh : fakegens for the "horizontal" transvections n,i for 1<=i<=n-1 +# entries can be unbound in which case they are made from slnstdf +# transv : fakegens for the "vertical" transvections i,n for 1<=i<=n-1 +# entries can be unbound in which case they are made from slnstdf +# +# We keep the following invariants (going from n -> n':=2n-1) +# bas, basi is a base change to the target base +# slnstdf are SLPs to reach standard generators of SL_n from the +# generators of sld +local d, id, q, p, F, t, GM, counter, aimdim, newdim, c1, c, ci, sum1, int1, i, v1, v2, v3, L1, L2, newpart, zerovec, MB, newbas, newbasi, int3, pivots, cii, pivots2, + newbasechange, trans, tf, lambda, killer, transr, gamma1, gamma2, gamma3, gamma4, gamma0, zeta, k, beta, vectorw, normx, PermMat, PermMat2, HBig, HBigGens, H2n, HSmall, transd, + WrongForm, ChangeToCorrectForm, ChangeToCorrectFormBig, extract, ChangeToCorrectForm2, ChangeToCorrectFormBig2, FormValue, killervalue, killersupport, vectorlist, VC, VCBasis, + LinearCombinationVector, s, flag, v, PermMat3, fixv, factors, ext, vectorlistindex, vectorlist2, vectorlistele, indexlist, VCBuildBasis, CanonicalVC; + + F := FieldOfMatrixGroup(H); + d := Size(GeneratorsOfGroup(G)[1]); + q := Size(F); + factors := Factors(q); + p := factors[1]; + ext := Size(factors); + + # Here everything starts, some more preparations: + + # We compute exclusively in our basis, so we occasionally need an + # identity matrix: + id := IdentityMat(d,F); + + Info(InfoRecog,2,"Current dimension: " ); + Info(InfoRecog,2,n); + Info(InfoRecog,2,"\n"); + Info(InfoRecog,2,"New dimension: "); + Info(InfoRecog,2,Minimum(2*n-2,d)); + Info(InfoRecog,2,"\n"); + aimdim := Minimum(2*n-2,d); + newdim := aimdim - n; + counter := 0; + + Info(InfoRecog,2,"Preparation done."); + + # Generalise the next step + t := IdentityMat(d,F); + if n = 4 then + t[1,2] := One(F); + t[3,4] := -1*One(F); + t[1,4] := PrimitiveElement(F)^3; + fi; + + if n = 6 then + t[1,2] := One(F); + t[1,3] := One(F); + t[2,3] := One(F); + t[4,5] := -1*One(F); + t[5,6] := -1*One(F); + t := PermutationMat((1,2,3)(6,5,4),d,F); + fi; + + if n > 6 then + v := Zero(F) * IdentityMat( n, F ); + v[n/2][1] := One(F); + v{[1..(n/2)-1]}{[2..n/2]} := IdentityMat((n/2)-1,F); + v[n/2+1][n] := One(F); + v{[(n/2)+2..n]}{[(n/2)+1..n-1]} := IdentityMat((n/2)-1,F); + t{[1..n]}{[1..n]} := v; + #Display(t); + #Display(t^basechange in G); + fi; + + Info(InfoRecog,2,"Step 1 done."); + + # Find a good random element: + while true do # will be left by break + while true do # will be left by break + counter := counter + 1; + if InfoLevel(InfoRecog) >= 3 then Print(".\c"); fi; + c1 := PseudoRandom(G); + + # Do the base change into our basis: + c1 := c1^(basechange^(-1)); + c := t^c1; + + # Now check that Vn + Vn*s^c1 has dimension 2n-1: + sum1 := SumIntersectionMat(c{[1..n]},id{[1..n]}); + + if Size(sum1[1]) = aimdim then + + int1 := SumIntersectionMat(RECOG.FixspaceMat(c),id{[1..n]})[2]; + + for i in [1..Size(int1)] do + v1 := int1[i]; + if not(IsZero(v1[1])) then break; fi; + od; + for i in [1..Size(int1)] do + v2 := int1[i]; + if (v1 <> v2) and not(IsZero(v2[n])) then break; fi; + od; + if (v1 = v2) or IsZero(v1[1]) or IsZero(v2[n]) then + Info(InfoRecog,2,"Ooops: Component n was zero!"); + continue; + fi; + + v1 := v1 / v1[1]; # normalize to 1 in position 1 + Assert(1,v1*c=v1); + + v2 := v2 / v2[n]; # normalize to 1 in position n + Assert(1,v2*c=v2); + + v1 := v1 + (-1) * v1[n] * v2; + v2 := v2 + (-1) * v2[1] * v1; + + # Actually we don't need gamma3 here + gamma1 := Zero(F); + gamma2 := One(F); + gamma3 := One(F); + gamma4 := Zero(F); + for k in [2..n-1] do + gamma1 := gamma1 + v2[k]*(v2[n-k+1])^phi; + od; + + if gamma1 = Zero(F) then + Info(InfoRecog,2,"Ooops: gamma1 was zero!"); + continue; + fi; + + for k in [2..n-1] do + gamma4 := gamma4 + v1[k]*(v1[n-k+1])^phi; + od; + for k in [2..n-1] do + gamma2 := gamma2 + v2[k]*(v1[n-k+1])^phi; + od; + for k in [2..n-1] do + gamma3 := gamma3 + v1[k]*(v2[n-k+1])^phi; + od; + + gamma0 := RECOG.SolveNormEquationSilly(F,phi,gamma1); + zeta := gamma2*gamma0^(-1); + normx := RECOG.SolveNormEquationSilly(F,phi,zeta*zeta^phi-gamma4); + + if zeta*zeta^phi-gamma4 = Zero(F) then + Info(InfoRecog,2,"Ooops: zeta*zeta^phi-gamma4 was zero!"); + continue; + fi; + + beta := (normx-zeta^phi)*gamma0^(-1); + + vectorw := v1 + beta * v2; + + L1 := IdentityMat(d,F); + for i in [2..n-1] do + L1[1,i] := vectorw[i]; + L1[n-i+1,n] := -1*vectorw[i]^phi; + od; + L1[1,n] := beta; + + if not(L1^basechange in G) then + Info(InfoRecog,2,"Ooops: Component not useable!"); + Print("foul play"); + Error("here"); + continue; + fi; + + c := L1*c*L1^(-1); + int1 := SumIntersectionMat(RECOG.FixspaceMat(c),id{[1..n]})[2]; + for i in [1..Size(int1)] do + v2 := int1[i]; + if not(IsZero(v2[n])) then break; fi; + od; + + if IsZero(v2[n]) then + Info(InfoRecog,2,"Ooops: Component n was zero!"); + continue; + fi; + + v1 := id[1]; + v2 := v2 / v2[n]; # normalize to 1 in position n + Assert(1,v2*c=v2); + + v2 := v2 + (-1) * v2[1] * v1; + + gamma1 := Zero(F); + for k in [2..n-1] do + gamma1 := gamma1 + v2[k]*(v2[n-k+1])^phi; + od; + normx := RECOG.SolveNormEquationSilly(F,phi,gamma1); + beta := RECOG.SolveMyBachelorEquationSilly(F,phi,normx); + + vectorw := v2 + beta * v1; + + L2 := IdentityMat(d,F); + for i in [2..n-1] do + L2[n,i] := vectorw[i]; + L2[n-i+1,1] := -1*vectorw[i]^phi; + od; + L2[n,1] := beta; + + if not(L2^basechange in G) then + Info(InfoRecog,2,"Ooops: Component not useable!"); + Print("foul play"); + Error("here"); + continue; + fi; + + c := L2*c*L2^(-1); + ci := c^-1; + break; + fi; + # Display(counter); + od; + + Info(InfoRecog,2,"Step 2 done."); + + # Now we found our aimdim-dimensional space W. Since SL_n + # has a d-n-dimensional fixed space W_{d-n} and W contains a complement + # of that fixed space, the intersection of W and W_{d-n} has dimension + # newdim. + + # Change basis: + newpart := ExtractSubMatrix(c,[2..(n-1)],[1..(d)]); + # Clean out the first n entries to go to the fixed space of SL_n: + zerovec := Zero(newpart[1]); + for i in [1..(n-2)] do + CopySubVector(zerovec,newpart[i],[1..n],[1..n]); + od; + MB := MutableBasis(F,[],zerovec); + i := 1; + pivots := EmptyPlist(newdim); + while i <= Length(newpart) and NrBasisVectors(MB) < newdim do + if not(IsContainedInSpan(MB,newpart[i])) then + Add(pivots,i); + CloseMutableBasis(MB,newpart[i]); + fi; + i := i + 1; + od; + + newpart := newpart{pivots}; + newbas := Concatenation(id{[1..n]},newpart); + if 2*n-2 < d then + + int3 := SumIntersectionMat(RECOG.FixspaceMat(c),id{[n+1..d]})[2]; + + if Size(int3) <> d - aimdim then + Info(InfoRecog,2,"Ooops, FixSLn \cap Fixc wrong dimension"); + #Error("neues beispiel"); + continue; + fi; + Append(newbas,int3); + + fi; + ConvertToMatrixRep(newbas,Size(F)); + newbasi := newbas^-1; + if newbasi = fail then + Info(InfoRecog,2,"Ooops, Fixc intersected too much, we try again"); + continue; + fi; + + ci := newbas * ci * newbasi; + + cii := ExtractSubMatrix(ci,[n+1..aimdim],[2..n-1]); + ConvertToMatrixRep(cii,Size(F)); + cii := TransposedMat(cii); + # The rows of cii are now what used to be the columns, + # their length is newdim, we need to span the full newdim-dimensional + # row space and need to remember how: + zerovec := Zero(cii[1]); + MB := MutableBasis(F,[],zerovec); + i := 1; + pivots2 := EmptyPlist(newdim); + while i <= Length(cii) and NrBasisVectors(MB) < newdim do + if not(IsContainedInSpan(MB,cii[i])) then + Add(pivots2,i); + CloseMutableBasis(MB,cii[i]); + fi; + i := i + 1; + od; + if Length(pivots2) = newdim then + cii := cii{pivots2}^-1; + ConvertToMatrixRep(cii,F); + + c := newbas * c * newbasi; + newbasechange := newbas*basechange; + break; + fi; + Info(InfoRecog,2,"Ooops, no nice bottom..."); + # Otherwise simply try again + od; + + HBigGens := List(GeneratorsOfGroup(H),MutableCopyMat); + Append(HBigGens,GeneratorsOfGroup(H^c)); + HBig := GroupByGenerators(HBigGens); + basechange := newbasechange; + #Display(RecogniseClassical(RECOG.LinearActionRepresentation(HBig))); + HSmall := GroupByGenerators(List(GeneratorsOfGroup(HBig),x->x{[1..aimdim]}{[1..aimdim]})); + WrongForm := PreservedSesquilinearForms(HSmall)[1]; + extract := HermitianFormByMatrix((WrongForm!.matrix){[n+1..aimdim]}{[n+1..aimdim]}, F ); + FormValue := (WrongForm!.matrix)[1,n]; + ChangeToCorrectForm := BaseChangeToCanonical(extract); + ChangeToCorrectFormBig := IdentityMat(aimdim,F); + ChangeToCorrectFormBig{[n+1..aimdim]}{[n+1..aimdim]} := ChangeToCorrectForm; + + PermMat := One(SymmetricGroup(aimdim)); + if IsEvenInt(aimdim) then + for i in [1..(n/2)] do + PermMat := PermMat*(i,n-i+1); + od; + for i in [n+1..(n+aimdim)/2] do + PermMat := PermMat*(i,aimdim-i+n+1); + od; + PermMat := PermutationMat(PermMat,d,F); + PermMat2 := One(SymmetricGroup(aimdim)); + for i in [1..aimdim/2] do + PermMat2 := PermMat2*(i,aimdim-i+1); + od; + PermMat2 := PermutationMat(PermMat2,d,F); + else + for i in [1..(n/2)] do + PermMat := PermMat*(i,n-i+1); + od; + for i in [n+1..(n-1+aimdim)/2] do + PermMat := PermMat*(i,aimdim-i+n+1); + od; + PermMat := PermutationMat(PermMat,d,F); + PermMat2 := One(SymmetricGroup(aimdim)); + for i in [1..(aimdim-1)/2] do + PermMat2 := PermMat2*(i,aimdim-i+1); + od; + PermMat2 := PermutationMat(PermMat2,d,F); + fi; + + WrongForm := IdentityMat(aimdim,F); + WrongForm{[n+1..aimdim]}{[n+1..aimdim]} := FormValue*PermMat{[n+1..aimdim]}{[n+1..aimdim]}; + ChangeToCorrectForm2 := BaseChangeToCanonical(HermitianFormByMatrix(WrongForm, F )); + ChangeToCorrectFormBig2 := IdentityMat(d,F); + ChangeToCorrectFormBig2{[1..aimdim]}{[1..aimdim]} := ChangeToCorrectFormBig^(-1)*ChangeToCorrectForm2; + HBig := HBig^ChangeToCorrectFormBig2; + basechange := ChangeToCorrectFormBig2^(-1)*basechange; + + while true do # will be left by break + while true do # will be left by break + counter := counter + 1; + if InfoLevel(InfoRecog) >= 3 then Print(".\c"); fi; + + c1 := PseudoRandom(HBig); + c := t^c1; + + # Now check that Vn + Vn*s^c1 has dimension 2n-2: + sum1 := SumIntersectionMat(c{[1..n]},id{[1..n]}); + + if Size(sum1[1]) = aimdim then + + int1 := SumIntersectionMat(RECOG.FixspaceMat(c),id{[1..n]})[2]; + + for i in [1..Size(int1)] do + v1 := int1[i]; + if not(IsZero(v1[1])) then break; fi; + od; + for i in [1..Size(int1)] do + v2 := int1[i]; + if (v1 <> v2) and not(IsZero(v2[n])) then break; fi; + od; + if (v1 = v2) or IsZero(v1[1]) or IsZero(v2[n]) then + Info(InfoRecog,2,"Ooops: Component n was zero!"); + continue; + fi; + + v1 := v1 / v1[1]; # normalize to 1 in position 1 + Assert(1,v1*c=v1); + + v2 := v2 / v2[n]; # normalize to 1 in position n + Assert(1,v2*c=v2); + + v1 := v1 + (-1) * v1[n] * v2; + v2 := v2 + (-1) * v2[1] * v1; + + # Actually we don't need gamma3 here + gamma1 := Zero(F); + gamma2 := One(F); + gamma3 := One(F); + gamma4 := Zero(F); + for k in [2..n-1] do + gamma1 := gamma1 + v2[k]*(v2[n-k+1])^phi; + od; + + if gamma1 = Zero(F) then + Info(InfoRecog,2,"Ooops: gamma1 was zero!"); + continue; + fi; + + for k in [2..n-1] do + gamma4 := gamma4 + v1[k]*(v1[n-k+1])^phi; + od; + for k in [2..n-1] do + gamma2 := gamma2 + v2[k]*(v1[n-k+1])^phi; + od; + for k in [2..n-1] do + gamma3 := gamma3 + v1[k]*(v2[n-k+1])^phi; + od; + + gamma0 := RECOG.SolveNormEquationSilly(F,phi,gamma1); + zeta := gamma2*gamma0^(-1); + normx := RECOG.SolveNormEquationSilly(F,phi,zeta*zeta^phi-gamma4); + + if zeta*zeta^phi-gamma4 = Zero(F) then + Info(InfoRecog,2,"Ooops: zeta*zeta^phi-gamma4 was zero!"); + continue; + fi; + + beta := (normx-zeta^phi)*gamma0^(-1); + + vectorw := v1 + beta * v2; + + L1 := IdentityMat(d,F); + for i in [2..n-1] do + L1[1,i] := vectorw[i]; + L1[n-i+1,n] := -1*vectorw[i]^phi; + od; + L1[1,n] := beta; + + if not(L1^basechange in G) then + Info(InfoRecog,2,"Ooops: Component not useable!"); + Print("foul play"); + Error("here"); + continue; + fi; + + c := L1*c*L1^(-1); + int1 := SumIntersectionMat(RECOG.FixspaceMat(c),id{[1..n]})[2]; + for i in [1..Size(int1)] do + v2 := int1[i]; + if not(IsZero(v2[n])) then break; fi; + od; + + if IsZero(v2[n]) then + Info(InfoRecog,2,"Ooops: Component n was zero!"); + continue; + fi; + + v1 := id[1]; + v2 := v2 / v2[n]; # normalize to 1 in position n + Assert(1,v2*c=v2); + + v2 := v2 + (-1) * v2[1] * v1; + + gamma1 := Zero(F); + for k in [2..n-1] do + gamma1 := gamma1 + v2[k]*(v2[n-k+1])^phi; + od; + normx := RECOG.SolveNormEquationSilly(F,phi,gamma1); + beta := RECOG.SolveMyBachelorEquationSilly(F,phi,normx); + + vectorw := v2 + beta * v1; + + L2 := IdentityMat(d,F); + for i in [2..n-1] do + L2[n,i] := vectorw[i]; + L2[n-i+1,1] := -1*vectorw[i]^phi; + od; + L2[n,1] := beta; + + if not(L2^basechange in G) then + Info(InfoRecog,2,"Ooops: Component not useable!"); + Print("foul play"); + Error("here"); + continue; + fi; + + c := L2*c*L2^(-1); + ci := c^-1; + break; + fi; + od; + + Info(InfoRecog,2,"Step 2 done."); + + break; + od; + + Info(InfoRecog,2," found c1 and c."); + + Info(InfoRecog,2,"Step 3 and 4 done"); + + # Now consider the transvections t_i: + # t_i : w.bas[j] -> w.bas[j] for j <> i and + # t_i : w.bas[i] -> w.bas[i] + ww + # We want to modify (t_i)^c such that it fixes w.bas{[1..w.n]}: + if not(IsEvenInt(aimdim)) then + trans := []; + vectorlist := []; + for i in [1..(n-2)] do + # This does t_i + for lambda in [One(F),PrimitiveElement(GF(25))] do + # This does t_i : v_j -> v_j + lambda * v_n + tf := IdentityMat(d,F); + tf[i+1,n] := lambda; + tf[1,n-i] := -1*(lambda^phi); + # Now conjugate with c: + tf := ci*tf*c; + # Now cleanup in column n above row n, the entries there + # are lambda times the stuff in column i of ci: + #for j in [1..w.n-1] do + # tf := DoRowOp_n(tf,j,w.n,-ci[j,i]*lambda,w); + #od; + killer := IdentityMat(d,F); + for killervalue in [2..n-1] do + killersupport := IdentityMat(d,F); + killersupport[1,killervalue] := (-1)*tf[1,killervalue]; + killersupport[n-killervalue+1,n] := (tf[1,killervalue])^phi; + #Display(killersupport); + killer := killer*killersupport; + od; + #killer{[1..n]}{[1..n]} := tf{[1..n]}{[1..n]}^(-1); + if killer^newbasechange in G then + tf := killer*tf; + else + Error("this should not happen."); + fi; + Add(vectorlist,tf{[n+1..aimdim]}{[n]}); + Add(trans,tf); + od; + od; + + # For now vector space variant. but change that! + VC := VectorSpace(GF(p),vectorlist); + + # If we are finishing up, then we have to take a linear independent subset + if aimdim < 2*n-2 then + vectorlist2 := []; + indexlist := []; + for vectorlistindex in [1..Size(vectorlist)] do + vectorlistele := vectorlist[vectorlistindex]; + VCBuildBasis:=VectorSpace( GF(p), Concatenation(vectorlist2,[vectorlistele]) ); + if Dimension(VCBuildBasis) > Length(vectorlist2) then + Add(vectorlist2,vectorlistele); + Add(indexlist,vectorlistindex); + fi; + if Length(vectorlist2) = Dimension(VC) then + break; + fi; + od; + VCBasis := Basis(VC,vectorlist2); + else + VCBasis := Basis(VC,vectorlist); + fi; + + # # Now put together the clean ones by our knowledge of c^-1: + transd := []; + CanonicalVC := BasisVectors(CanonicalBasis(VC)); + for i in CanonicalVC do + LinearCombinationVector := Coefficients(VCBasis,i); + tf := IdentityMat(d,F); + + # TODO: We need to take the substitute trans[lambda] by trans[indexlist[lambda]] or something like that + for lambda in [1..Size(LinearCombinationVector)] do + tf := tf*trans[lambda]^Int(LinearCombinationVector[lambda]); + od; + killer{[1..n]}{[1..n]} := tf{[1..n]}{[1..n]}^(-1); + if not(Position(CanonicalVC,i) in [Size(CanonicalVC)/2,Size(CanonicalVC)/2 + 1]) then + if killer^newbasechange in G then + tf := killer*tf; + else + Error("this should not happen."); + fi; + fi; + Add(transd,tf); + od; + Unbind(trans); + + Info(InfoRecog,2,"Step 5 done"); + + # Now to the "horizontal" transvections, first create them as SLPs: + transr := []; + trans := []; + vectorlist := []; + for lambda in [One(F),PrimitiveElement(GF(25))] do + # This does t_i + for i in [2..(n-1)] do + # This does t_i : v_j -> v_j + lambda * v_n + tf := IdentityMat(d,F); + tf[i,1] := lambda; + tf[n,n-i+1] := -1*(lambda^phi); + # Now conjugate with c: + tf := ci*tf*c; + # Now cleanup in column n above row n, the entries there + # are lambda times the stuff in column i of ci: + #for j in [1..w.n-1] do + # tf := DoRowOp_n(tf,j,w.n,-ci[j,i]*lambda,w); + #od; + killer := IdentityMat(d,F); + for killervalue in [2..n-1] do + killersupport := IdentityMat(d,F); + killersupport[killervalue,1] := (-1)*tf[killervalue,1]; + killersupport[n,n-killervalue+1] := (tf[killervalue,1])^phi; + #Display(killersupport); + killer := killer*killersupport; + od; + #killer{[1..n]}{[1..n]} := tf{[1..n]}{[1..n]}^(-1); + if killer^newbasechange in G then + tf := killer*tf; + else + Error("this should not happen."); + fi; + Add(vectorlist,tf{[n]}{[n+1..aimdim]}); + Add(trans,tf); + od; + od; + + # For now vector space variant. but change that! + VC := VectorSpace(GF(p),vectorlist); + if aimdim < 2*n-2 then + vectorlist2 := []; + indexlist := []; + for vectorlistindex in [1..Size(vectorlist)] do + vectorlistele := vectorlist[vectorlistindex]; + VCBuildBasis:=VectorSpace( GF(p), Concatenation(vectorlist2,[vectorlistele]) ); + if Dimension(VCBuildBasis) > Length(vectorlist2) then + Add(vectorlist2,vectorlistele); + Add(indexlist,vectorlistindex); + fi; + if Length(vectorlist2) = Dimension(VC) then + break; + fi; + od; + VCBasis := Basis(VC,vectorlist2); + else + VCBasis := Basis(VC,vectorlist); + fi; + + CanonicalVC := BasisVectors(CanonicalBasis(VectorSpace(F,IdentityMat(aimdim-n,F)))); + for i in CanonicalVC do + LinearCombinationVector := Coefficients(VCBasis,[i]); + tf := IdentityMat(d,F); + for lambda in [1..Size(LinearCombinationVector)] do + tf := tf*trans[indexlist[lambda]]^Int(LinearCombinationVector[lambda]); + od; + killer{[1..n]}{[1..n]} := tf{[1..n]}{[1..n]}^(-1); + if not(Position(CanonicalVC,i) = (Size(CanonicalVC)+1)/2) then + if killer^newbasechange in G then + tf := killer*tf; + else + Error("this should not happen."); + fi; + fi; + Add(transr,tf); + od; + Unbind(trans); + + Info(InfoRecog,2,"Step 6 done"); + + # From here on we distinguish three cases: + # * w.n = 2 + # * we finish off the constructive recognition + # * we have to do another step as the next thing + if n = 4 then + #w.slnstdf[2*w.ext+2] := transd[1]*transr[1]^-1*transd[1]; + #w.slnstdf[2*w.ext+1] := w.transh[1]*w.transv[1]^-1*w.transh[1] + # *w.slnstdf[2*w.ext+2]; + #Unbind(w.transh); + #Unbind(w.transv); + #w.n := 3; + flag := false; + s := IdentityMat(d,F); + PermMat3 := PermutationMat((3,5)(6,4),d,F); + v := PermutationMat((1,2)(3,4),d,F); + #PermMat3 := PermutationMat((3,5)(6,4),20,GF(5)); + # w.ext = 2? + #for i in [n-1,n-3..1] do + flag := false; + for i in [2] do + if flag then + # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + tf := transd[(i-1)*ext+1]*transr[i]^-1*transd[(i-1)*ext+1]; + else + # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + #Display(transd[(i-1)*1+1]*transr[i]^-1*transd[(i-1)*1+1]); + tf := transd[(i-1)*ext+1]^-1*transr[i]*transd[(i-1)*ext+1]^-1; + fi; + #Display(tf); + #Display((tf^(v^2))^(PermMat3^(-1))); + s := s * tf; + flag := not(flag); + od; + + fixv := IdentityMat(d,F); + fixv[1,1] := -1*One(F); + fixv[4,4] := -1*One(F); + newbasechange := PermMat3^(-1)*basechange; + #Display((v*s*fixv)^(PermMat3^(-1))); + # Now compute v*s + Info(InfoRecog,2,"Step 7 done"); + Error("here"); + #return w; + fi; + # We can finish off: + # if aimdim = w.GoalDim then + # # In this case we just finish off and do not bother with + # # the transvections, we will only need the standard gens: + # # Now put together the (newdim+1)-cycle: + # # n+newdim -> n+newdim-1 -> ... -> n+1 -> n -> n+newdim + # flag := false; + # s := w.One; + # for i in [1..newdim] do + # if flag then + # # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + # tf:=transd[(i-1)*w.ext+1]*transr[i]^-1*transd[(i-1)*w.ext+1]; + # else + # # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + # tf:=transd[(i-1)*w.ext+1]^-1*transr[i]*transd[(i-1)*w.ext+1]^-1; + # fi; + # s := s * tf; + # flag := not(flag); + # od; + + # # Finally put together the new 2n-1-cycle and 2n-2-cycle: + # s := s^-1; + # w.slnstdf[2*w.ext+1] := w.slnstdf[2*w.ext+1] * s; + # w.slnstdf[2*w.ext+2] := w.slnstdf[2*w.ext+2] * s; + # Unbind(w.transv); + # Unbind(w.transh); + # w.n := aimdim; + # Display("Step 7 done"); + # return w; + # fi; + + # Otherwise we do want to go on as the next thing, so we want to + # keep our transvections. This is easily done if we change the + # basis one more time. Note that we know that n is odd here! + + # Put together the n-cycle: + # 2n-1 -> 2n-2 -> ... -> n+1 -> n -> 2n-1 + + # TODO: WE HAVE TO COMBINE THE v-CYCLE DIFFERENTLY HERE + + flag := false; + s := IdentityMat(d,F); + #PermMat3 := PermutationMat((4,7,10,6,9,5,8),20,GF(5)); + PermMat3 := RECOG.ComputeCorrectingPermutationMatOdd(d,F,n,aimdim); + Display(PermMat3); + + # TODO: Last step of building v in odd dimension + Error("here"); + v := Zero(F) * IdentityMat( d, F ); + v[n/2][1] := One(F); + v{[1..(n/2)-1]}{[2..n/2]} := IdentityMat((n/2)-1,F); + v[n/2+1][n] := One(F); + v{[(n/2)+2..n]}{[(n/2)+1..n-1]} := IdentityMat((n/2)-1,F); + v{[n+1..d]}{[n+1..d]} := IdentityMat(d-n,F); + #Display(t); + #Display(t^basechange in G); + #PermMat3 := PermutationMat((3,5)(6,4),20,GF(5)); + # w.ext = 2? + #for i in [n-1,n-3..1] do + #for i in [Size(transr)-1,Size(transr)-3..5] do + for i in [n-2,n-3..(n/2)] do + if flag then + # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + # TODO: Replace 2 by size of extension to get the correct matrices of transd (we want the ones with 1 and -1 at the transvection positions) + tf := transd[(i-1)*ext+1]*transr[i]^-1*transd[(i-1)*ext+1]; + else + # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + # TODO: Replace 2 by size of extension to get the correct matrices of transd (we want the ones with 1 and -1 at the transvection positions) + tf := transd[(i-1)*ext+1]^-1*transr[i]*transd[(i-1)*ext+1]^-1; + fi; + #Display(tf); + #Display((tf^(v^2))^(PermMat3^(-1))); + #Display(tf); + s := s * tf; + flag := not(flag); + od; + + #Display(((v*s)^(-1))^(PermMat3)); + newbasechange := PermMat3^(-1)*basechange; + # Now compute v*s + # Info(InfoRecog,2,"Step 7 done"); + Error("here"); + + # # Finally put together the new 2n-1-cycle and 2n-2-cycle: + # w.slnstdf[2*w.ext+1] := s * w.slnstdf[2*w.ext+1]; + # w.slnstdf[2*w.ext+2] := s * w.slnstdf[2*w.ext+2]; + + # list := Concatenation([1..w.n-1],[w.n+1..2*w.n-1],[w.n],[2*w.n..w.d]); + # perm := PermList(list); + # mat := PermutationMat(perm^-1,w.d,w.f); + # ConvertToMatrixRep(mat,w.f); + # w.bas := w.bas{list}; + # ConvertToMatrixRep(w.bas,w.f); + # w.basi := w.basi*mat; + + # # Now add the new transvections: + # for i in [1..w.n-1] do + # w.transh[w.ext*(w.n-1)+w.ext*(i-1)+1] := transr[i]; + # od; + # Append(w.transv,transd); + # w.n := 2*w.n-1; + + #if( aimdim = 5) then + # Error("here"); + #fi; + else + trans := []; + vectorlist := []; + for i in [1..(n-2)] do + # This does t_i + for lambda in [One(F),PrimitiveElement(GF(25))] do + # This does t_i : v_j -> v_j + lambda * v_n + tf := IdentityMat(d,F); + tf[i+1,n] := lambda; + tf[1,n-i] := -1*(lambda^phi); + # Now conjugate with c: + tf := ci*tf*c; + # Now cleanup in column n above row n, the entries there + # are lambda times the stuff in column i of ci: + #for j in [1..w.n-1] do + # tf := DoRowOp_n(tf,j,w.n,-ci[j,i]*lambda,w); + #od; + killer := IdentityMat(d,F); + for killervalue in [2..n-1] do + killersupport := IdentityMat(d,F); + killersupport[1,killervalue] := (-1)*tf[1,killervalue]; + killersupport[n-killervalue+1,n] := (tf[1,killervalue])^phi; + #Display(killersupport); + killer := killer*killersupport; + od; + #killer{[1..n]}{[1..n]} := tf{[1..n]}{[1..n]}^(-1); + if killer^newbasechange in G then + tf := killer*tf; + else + Error("this should not happen."); + fi; + Add(vectorlist,tf{[n+1..aimdim]}{[n]}); + Add(trans,tf); + od; + od; + + # For now vector space variant. but change that! + VC := VectorSpace(GF(p),vectorlist); + + # If we are finishing up, then we have to take a linear independent subset + if aimdim < 2*n-2 then + vectorlist2 := []; + indexlist := []; + for vectorlistindex in [1..Size(vectorlist)] do + vectorlistele := vectorlist[vectorlistindex]; + VCBuildBasis:=VectorSpace( GF(p), Concatenation(vectorlist2,[vectorlistele]) ); + if Dimension(VCBuildBasis) > Length(vectorlist2) then + Add(vectorlist2,vectorlistele); + Add(indexlist,vectorlistindex); + fi; + if Length(vectorlist2) = Dimension(VC) then + break; + fi; + od; + VCBasis := Basis(VC,vectorlist2); + else + VCBasis := Basis(VC,vectorlist); + fi; + + # # Now put together the clean ones by our knowledge of c^-1: + transd := []; + for i in BasisVectors(CanonicalBasis(VC)) do + LinearCombinationVector := Coefficients(VCBasis,i); + tf := IdentityMat(d,F); + + # TODO: We need to take the substitute trans[lambda] by trans[indexlist[lambda]] or something like that + for lambda in [1..Size(LinearCombinationVector)] do + tf := tf*trans[lambda]^Int(LinearCombinationVector[lambda]); + od; + killer{[1..n]}{[1..n]} := tf{[1..n]}{[1..n]}^(-1); + if killer^newbasechange in G then + tf := killer*tf; + else + Error("this should not happen."); + fi; + Add(transd,tf); + od; + Unbind(trans); + + Info(InfoRecog,2,"Step 5 done"); + + # Now to the "horizontal" transvections, first create them as SLPs: + transr := []; + trans := []; + vectorlist := []; + for lambda in [One(F),PrimitiveElement(GF(25))] do + # This does t_i + for i in [2..(n-1)] do + # This does t_i : v_j -> v_j + lambda * v_n + tf := IdentityMat(d,F); + tf[i,1] := lambda; + tf[n,n-i+1] := -1*(lambda^phi); + # Now conjugate with c: + tf := ci*tf*c; + # Now cleanup in column n above row n, the entries there + # are lambda times the stuff in column i of ci: + #for j in [1..w.n-1] do + # tf := DoRowOp_n(tf,j,w.n,-ci[j,i]*lambda,w); + #od; + killer := IdentityMat(d,F); + for killervalue in [2..n-1] do + killersupport := IdentityMat(d,F); + killersupport[killervalue,1] := (-1)*tf[killervalue,1]; + killersupport[n,n-killervalue+1] := (tf[killervalue,1])^phi; + #Display(killersupport); + killer := killer*killersupport; + od; + #killer{[1..n]}{[1..n]} := tf{[1..n]}{[1..n]}^(-1); + if killer^newbasechange in G then + tf := killer*tf; + else + Error("this should not happen."); + fi; + Add(vectorlist,tf{[n]}{[n+1..aimdim]}); + Add(trans,tf); + od; + od; + + # For now vector space variant. but change that! + VC := VectorSpace(GF(p),vectorlist); + VCBasis := Basis(VC,vectorlist); + + for i in BasisVectors(CanonicalBasis(VectorSpace(F,IdentityMat(n-2,F)))) do + LinearCombinationVector := Coefficients(VCBasis,[i]); + tf := IdentityMat(d,F); + for lambda in [1..Size(LinearCombinationVector)] do + tf := tf*trans[lambda]^Int(LinearCombinationVector[lambda]); + od; + killer{[1..n]}{[1..n]} := tf{[1..n]}{[1..n]}^(-1); + if killer^newbasechange in G then + tf := killer*tf; + else + Error("this should not happen."); + fi; + Add(transr,tf); + od; + Unbind(trans); + + Info(InfoRecog,2,"Step 6 done"); + + # From here on we distinguish three cases: + # * w.n = 2 + # * we finish off the constructive recognition + # * we have to do another step as the next thing + if n = 4 then + #w.slnstdf[2*w.ext+2] := transd[1]*transr[1]^-1*transd[1]; + #w.slnstdf[2*w.ext+1] := w.transh[1]*w.transv[1]^-1*w.transh[1] + # *w.slnstdf[2*w.ext+2]; + #Unbind(w.transh); + #Unbind(w.transv); + #w.n := 3; + flag := false; + s := IdentityMat(d,F); + PermMat3 := PermutationMat((3,5)(6,4),d,F); + v := PermutationMat((1,2)(3,4),d,F); + #PermMat3 := PermutationMat((3,5)(6,4),20,GF(5)); + # w.ext = 2? + #for i in [n-1,n-3..1] do + flag := false; + for i in [2] do + if flag then + # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + tf := transd[(i-1)*ext+1]*transr[i]^-1*transd[(i-1)*ext+1]; + else + # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + #Display(transd[(i-1)*1+1]*transr[i]^-1*transd[(i-1)*1+1]); + tf := transd[(i-1)*ext+1]^-1*transr[i]*transd[(i-1)*ext+1]^-1; + fi; + #Display(tf); + #Display((tf^(v^2))^(PermMat3^(-1))); + s := s * tf; + flag := not(flag); + od; + + fixv := IdentityMat(d,F); + fixv[1,1] := -1*One(F); + fixv[4,4] := -1*One(F); + newbasechange := PermMat3^(-1)*basechange; + #Display((v*s*fixv)^(PermMat3^(-1))); + # Now compute v*s + Info(InfoRecog,2,"Step 7 done"); + Error("here"); + #return w; + fi; + # We can finish off: + # if aimdim = w.GoalDim then + # # In this case we just finish off and do not bother with + # # the transvections, we will only need the standard gens: + # # Now put together the (newdim+1)-cycle: + # # n+newdim -> n+newdim-1 -> ... -> n+1 -> n -> n+newdim + # flag := false; + # s := w.One; + # for i in [1..newdim] do + # if flag then + # # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + # tf:=transd[(i-1)*w.ext+1]*transr[i]^-1*transd[(i-1)*w.ext+1]; + # else + # # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + # tf:=transd[(i-1)*w.ext+1]^-1*transr[i]*transd[(i-1)*w.ext+1]^-1; + # fi; + # s := s * tf; + # flag := not(flag); + # od; + + # # Finally put together the new 2n-1-cycle and 2n-2-cycle: + # s := s^-1; + # w.slnstdf[2*w.ext+1] := w.slnstdf[2*w.ext+1] * s; + # w.slnstdf[2*w.ext+2] := w.slnstdf[2*w.ext+2] * s; + # Unbind(w.transv); + # Unbind(w.transh); + # w.n := aimdim; + # Display("Step 7 done"); + # return w; + # fi; + + # Otherwise we do want to go on as the next thing, so we want to + # keep our transvections. This is easily done if we change the + # basis one more time. Note that we know that n is odd here! + + # Put together the n-cycle: + # 2n-1 -> 2n-2 -> ... -> n+1 -> n -> 2n-1 + flag := false; + s := IdentityMat(d,F); + #PermMat3 := PermutationMat((4,7,10,6,9,5,8),20,GF(5)); + PermMat3 := RECOG.ComputeCorrectingPermutationMat(d,F,n,aimdim); + #Display(PermMat3); + v := Zero(F) * IdentityMat( d, F ); + v[n/2][1] := One(F); + v{[1..(n/2)-1]}{[2..n/2]} := IdentityMat((n/2)-1,F); + v[n/2+1][n] := One(F); + v{[(n/2)+2..n]}{[(n/2)+1..n-1]} := IdentityMat((n/2)-1,F); + v{[n+1..d]}{[n+1..d]} := IdentityMat(d-n,F); + #Display(t); + #Display(t^basechange in G); + #PermMat3 := PermutationMat((3,5)(6,4),20,GF(5)); + # w.ext = 2? + #for i in [n-1,n-3..1] do + #for i in [Size(transr)-1,Size(transr)-3..5] do + for i in [n-2,n-3..(n/2)] do + if flag then + # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + # TODO: Replace 2 by size of extension to get the correct matrices of transd (we want the ones with 1 and -1 at the transvection positions) + tf := transd[(i-1)*ext+1]*transr[i]^-1*transd[(i-1)*ext+1]; + else + # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + # TODO: Replace 2 by size of extension to get the correct matrices of transd (we want the ones with 1 and -1 at the transvection positions) + tf := transd[(i-1)*ext+1]^-1*transr[i]*transd[(i-1)*ext+1]^-1; + fi; + #Display(tf); + #Display((tf^(v^2))^(PermMat3^(-1))); + #Display(tf); + s := s * tf; + flag := not(flag); + od; + + #Display(((v*s)^(-1))^(PermMat3)); + newbasechange := PermMat3^(-1)*basechange; + # Now compute v*s + #Info(InfoRecog,2,"Step 7 done"); + Error("here"); + + # # Finally put together the new 2n-1-cycle and 2n-2-cycle: + # w.slnstdf[2*w.ext+1] := s * w.slnstdf[2*w.ext+1]; + # w.slnstdf[2*w.ext+2] := s * w.slnstdf[2*w.ext+2]; + + # list := Concatenation([1..w.n-1],[w.n+1..2*w.n-1],[w.n],[2*w.n..w.d]); + # perm := PermList(list); + # mat := PermutationMat(perm^-1,w.d,w.f); + # ConvertToMatrixRep(mat,w.f); + # w.bas := w.bas{list}; + # ConvertToMatrixRep(w.bas,w.f); + # w.basi := w.basi*mat; + + # # Now add the new transvections: + # for i in [1..w.n-1] do + # w.transh[w.ext*(w.n-1)+w.ext*(i-1)+1] := transr[i]; + # od; + # Append(w.transv,transd); + # w.n := 2*w.n-1; + + #if( aimdim = 5) then + # Error("here"); + #fi; + fi; + + Info(InfoRecog,2,"Step 7 done"); + # return w; +end; + + + + + + + + + +RECOG.WriteUpperKillerAsWordSU := function(L,n,d,onef,trans1,trans2,diag,v,u,s,q,f,alpha,p,phi) +local tf, value, i, j, omega, basis, coeffs, coeff, trans, shift, one, t, turn, V, q1; + + #one := IdentityMat(n,GF(q)); + shift := v*u; + + omega := PrimitiveElement(GF(q)); + basis := [1..f]; + for i in [0..f-1] do + basis[i+1] := omega^i; + od; + basis := Basis(GF(q),basis); + + for i in [2..(n/2)] do + value := L[1,i]; + coeffs := Coefficients(basis,value); + for j in [1..f] do + coeff := Int(coeffs[j]); + onef := onef * trans1[(i-2)*f+j]^coeff; + od; + #t := IdentityMat(n,GF(q)); + #t[1,i] := value; + #t[n-i+1,n] := -1*value; + #one := one*t; + od; + + for i in [2..(n/2)] do + value := L[1,(n/2)+i-1]; + coeffs := Coefficients(basis,value); + for j in [1..f] do + coeff := Int(coeffs[j]); + onef := onef * trans2[(i-2)*f+j]^coeff; + od; + #t := IdentityMat(n,GF(q)); + #t[1,(n/2)+i-1] := value; + #t[n-((n/2)+i-1)+1,n] := value; + #one := one*t; + od; + + value := L[1,n]-RECOG.ComputeCornerEntrySU2((L{[1]}{[2..n-1]})[1],n-2,GF(q),phi); + + #value := L[1,n]-one[1,n]; + basis := [1..(f/2)-1]; + q1 := Sqrt(q); + for i in [0..(f/2)-1] do + basis[i+1] := alpha^(-q1)*(omega^(q1+1))^i; + od; + V := VectorSpace(GF(p),basis); + basis := Basis(V,basis); + coeffs := Coefficients(basis,value); + for j in [1..f/2] do + coeff := Int(coeffs[j]); + onef := onef * diag[j]^coeff; + od; + + return onef; + +end; + + +RECOG.WriteUpperKillerAsWordSU2 := function(L,n,d,onef,trans1,trans2,diag,v,u,s,q,f,alpha,p,phi) +local tf, value, i, j, omega, basis, coeffs, coeff, trans, shift, one, t, turn, V, q1; + + #one := IdentityMat(n,GF(q)); + shift := v*u; + + omega := PrimitiveElement(GF(q)); + basis := [1..f]; + for i in [0..f-1] do + basis[i+1] := omega^i; + od; + basis := Basis(GF(q),basis); + + for i in [2..(n/2)] do + value := L[1,i]; + coeffs := Coefficients(basis,value); + for j in [1..f] do + coeff := Int(coeffs[j]); + onef := onef * trans1[(i-2)*f+j]^coeff; + od; + #t := IdentityMat(n,GF(q)); + #t[1,i] := value; + #t[n-i+1,n] := -1*value; + #one := one*t; + od; + + for i in [2..(n/2)] do + value := L[1,(n/2)+i-1]; + coeffs := Coefficients(basis,value); + for j in [1..f] do + coeff := Int(coeffs[j]); + onef := onef * trans2[(i-2)*f+j]^coeff; + od; + #t := IdentityMat(n,GF(q)); + #t[1,(n/2)+i-1] := value; + #t[n-((n/2)+i-1)+1,n] := value; + #one := one*t; + od; + + value := RECOG.ComputeCornerEntrySU((L{[1]}{[2..n-1]})[1],n-2,GF(q),phi); + + return [onef,value]; + +end; + + + + +RECOG.WriteLowerKillerAsWordSU := function(L,n,d,onef,trans1,trans2,diag,v,u,s,q,f,alpha,p,phi) +local tf, value, i, j, omega, basis, coeffs, coeff, trans, shift, one, t, turn, V, q1; + + #one := IdentityMat(n,GF(q)); + shift := v*u; + + omega := PrimitiveElement(GF(q)); + basis := [1..f]; + for i in [0..f-1] do + basis[i+1] := omega^i; + od; + basis := Basis(GF(q),basis); + + for i in [2..(n/2)] do + value := L[i,1]; + coeffs := Coefficients(basis,value); + for j in [1..f] do + coeff := Int(coeffs[j]); + onef := onef * trans1[(i-2)*f+j]^coeff; + od; + #t := IdentityMat(n,GF(q)); + #t[i,1] := value; + #t[n,n-i+1] := -1*value; + #one := one*t; + od; + + for i in [2..(n/2)] do + value := L[(n/2)+i-1,1]; + coeffs := Coefficients(basis,value); + for j in [1..f] do + coeff := Int(coeffs[j]); + onef := onef * trans2[(i-2)*f+j]^coeff; + od; + #t := IdentityMat(n,GF(q)); + #t[(n/2)+i-1,1] := value; + #t[n,n-((n/2)+i-1)+1] := value; + #one := one*t; + od; + + q1 := Sqrt(q); + value := alpha*alpha^q1*(L[n,1]-(RECOG.ComputeCornerEntrySU((TransposedMat(L){[1]}{[2..n-1]})[1],n-2,GF(q),phi))); + #value := -1*(L[n,1]-one[n,1]); + basis := [1..(f/2)-1]; + for i in [0..(f/2)-1] do + basis[i+1] := alpha^(-q1)*(omega^(q1+1))^i; + od; + V := VectorSpace(GF(p),basis); + basis := Basis(V,basis); + coeffs := Coefficients(basis,value); + turn := diag[1]^0; + for j in [1..f/2] do + coeff := Int(coeffs[j]); + turn := turn * diag[j]^coeff; + od; + turn := turn^s; + onef := onef*turn; + + return onef; + +end; + + +RECOG.WriteLowerKillerAsWordSU2 := function(L,n,d,onef,trans1,trans2,diag,v,u,s,q,f,alpha,p,phi) +local tf, value, i, j, omega, basis, coeffs, coeff, trans, shift, one, t, turn, V; + + #one := IdentityMat(n,GF(q)); + shift := v*u; + + omega := PrimitiveElement(GF(q)); + basis := [1..f]; + for i in [0..f-1] do + basis[i+1] := omega^i; + od; + basis := Basis(GF(q),basis); + + for i in [2..(n/2)] do + value := L[i,1]; + coeffs := Coefficients(basis,value); + for j in [1..f] do + coeff := Int(coeffs[j]); + onef := onef * trans1[(i-2)*f+j]^coeff; + od; + #t := IdentityMat(n,GF(q)); + #t[i,1] := value; + #t[n,n-i+1] := -1*value; + #one := one*t; + od; + + for i in [2..(n/2)] do + value := L[(n/2)+i-1,1]; + coeffs := Coefficients(basis,value); + for j in [1..f] do + coeff := Int(coeffs[j]); + onef := onef * trans2[(i-2)*f+j]^coeff; + od; + #t := IdentityMat(n,GF(q)); + #t[(n/2)+i-1,1] := value; + #t[n,n-((n/2)+i-1)+1] := value; + #one := one*t; + od; + + value := RECOG.ComputeCornerEntrySU((TransposedMat(L){[1]}{[2..n-1]})[1],n-2,GF(q),phi); + + return [onef,value]; + +end; + + + +RECOG.ComputeCornerEntrySU := function(list, length, F, phi) +local value, i; + + value := Zero(F); + for i in [1..length/2] do + value := value + -1*(list[i])^phi * (list[length-i+1]); + od; + + return value; + +end; + + + +RECOG.ComputeCornerEntrySU2 := function(list, length, F, phi) +local value, i; + + value := Zero(F); + for i in [1..length/2] do + value := value + (list[i]) * -1*(list[length-i+1])^phi; + od; + + return value; + +end; + + + +RECOG.ComputeCornerEntryProductSU := function(list1, list2, entry, F, k) +local skalar, times; + + if k >= 2 then + skalar := list1 * list2; + times := (k-1)*(k)/2; + return k*entry+skalar*times; + else + return entry; + fi; + +end; + + + +# change input into H again +RECOG.SUn_UpStepWithSLP := function(w) +# w has components: +# d : size of big SL +# n : size of small SL +# slnstdf : fakegens for SL_n standard generators +# bas : current base change, first n vectors are where SL_n acts +# rest of vecs are invariant under SL_n +# basi : current inverse of bas +# sld : original group with memory generators, PseudoRandom +# delivers random elements +# sldf : fake generators to keep track of what we are doing +# f : field +# The following are filled in automatically if not already there: +# p : characteristic +# ext : q=p^ext +# One : One(slnstdf[1]) +# can : CanonicalBasis(f) +# canb : BasisVectors(can) +# transh : fakegens for the "horizontal" transvections n,i for 1<=i<=n-1 +# entries can be unbound in which case they are made from slnstdf +# transv : fakegens for the "vertical" transvections i,n for 1<=i<=n-1 +# entries can be unbound in which case they are made from slnstdf +# +# We keep the following invariants (going from n -> n':=2n-1) +# bas, basi is a base change to the target base +# slnstdf are SLPs to reach standard generators of SL_n from the +# generators of sld +local d, id, q, p, F, t, GM, counter, aimdim, newdim, c1, c, ci, sum1, int1, i, v1, v2, v3, L1, L2, newpart, zerovec, MB, newbas, newbasi, int3, pivots, cii, pivots2, + newbasechange, trans, tf, lambda, killer, transr, gamma1, gamma2, gamma3, gamma4, gamma0, zeta, k, beta, vectorw, normx, PermMat, PermMat2, HBig, HBigGens, H2n, HSmall, transd, + WrongForm, ChangeToCorrectForm, ChangeToCorrectFormBig, extract, ChangeToCorrectForm2, ChangeToCorrectFormBig2, FormValue, killervalue, killersupport, vectorlist, VC, VCBasis, + LinearCombinationVector, s, flag, v, PermMat3, fixv, factors, ext, vectorlistindex, vectorlist2, vectorlistele, indexlist, VCBuildBasis, CanonicalVC, n, phi, basechange, G, H, + shift, pos, initele, pos2, tw, alpha, alphad, primitive, basis, shiftele, coeffs, j, coeff, cw, L1w, L2w, cwi, slp, c1w, ciT, HFake, transw, vectorlistscalar, tfw, killerw, storeposition, + diagonalentrylist, currentvector, tfvalue, difftransv, begintransv, newtransv; + + Info(InfoRecog,3,"Going up: ",w.n," (",w.d,")..."); + + # Before we begin, we upgrade the data structure with a few internal + # things: + + H := GroupByGenerators(w.sunstdf); + G := w.sld; + n := w.n; + phi := w.phi; + basechange := w.bas; + + d := w.d; + p := w.p; + ext := w.ext; + q := p^ext; + F := GF(q); + + primitive := PrimitiveElement(GF(q)); + alpha := w.alpha; + alphad := alpha^(-Sqrt(q)); + + basis := [1..ext]; + for i in [0..ext-1] do + basis[i+1] := primitive^i; + od; + basis := Basis(F,basis); + + if not(IsBound(w.can)) then w.can := CanonicalBasis(w.f); fi; + if not(IsBound(w.canb)) then w.canb := BasisVectors(w.can); fi; + if not(IsBound(w.One)) then w.One := One(w.sunstdf[1]); fi; + if not(IsBound(w.transh1)) then w.transh1 := []; fi; + if not(IsBound(w.transv1)) then w.transv1 := []; fi; + w.transv2 := []; + w.transh2 := []; + + for k in [1..w.ext] do + pos := k; + if not(IsBound(w.transh1[pos])) then + w.transh1[pos] := w.sunstdf[k]; + fi; + if not(IsBound(w.transv1[pos])) then + w.transv1[pos] := w.sunstdf[w.ext + k]; + fi; + od; + + shift := w.sunstdf[2*w.ext + (w.ext/2) + 1] * w.sunstdf[2*w.ext + (w.ext/2) + 2]; + for i in [3..(w.n)/2] do + for k in [1..w.ext] do + pos := (i-2)*w.ext + k; + if not(IsBound(w.transh1[pos])) then + # TODO: Remove initele + initele := One(w.sunstdf[1]); + initele := (initele * w.transh1[pos-w.ext])^shift; + w.transh1[pos] := initele; + fi; + if not(IsBound(w.transv1[pos])) then + # TODO: Remove initele + initele := One(w.sunstdf[1]); + initele := (initele * w.transv1[pos-w.ext])^shift; + w.transv1[pos] := initele; + fi; + od; + od; + + for k in [1..w.ext] do + pos := k; + if not(IsBound(w.transv2[pos])) then + initele := One(w.sunstdf[1]); + beta := -1*(primitive^(k-1))^phi*alpha; + shiftele := One(w.sunstdf[1]); + coeffs := Coefficients(basis,beta); + for j in [1..ext] do + coeff := Int(coeffs[j]); + shiftele := shiftele * w.transh1[((w.n)/2-2)*w.ext+j]^coeff; + od; + initele := (initele * shiftele)^w.sunstdf[2*w.ext + (w.ext/2) + 3]; + w.transv2[pos] := initele; + fi; + if not(IsBound(w.transh2[pos])) then + initele := One(w.sunstdf[1]); + beta := -1*(primitive^(k-1))^phi*alpha^(-1); + shiftele := One(w.sunstdf[1]); + coeffs := Coefficients(basis,beta); + for j in [1..ext] do + coeff := Int(coeffs[j]); + shiftele := shiftele * w.transv1[((w.n)/2-2)*w.ext+j]^coeff; + od; + initele := (initele * shiftele)^w.sunstdf[2*w.ext + (w.ext/2) + 3]; + w.transh2[pos] := initele; + fi; + od; + + shift := shift^(-1); + for i in [3..(w.n)/2] do + for k in [1..w.ext] do + pos := (i-2)*w.ext + k; + if not(IsBound(w.transh2[pos])) then + initele := One(w.sunstdf[1]); + initele := (initele * w.transh2[pos-w.ext])^shift; + w.transh2[pos] := initele; + fi; + if not(IsBound(w.transv2[pos])) then + initele := One(w.sunstdf[1]); + initele := (initele * w.transv2[pos-w.ext])^shift; + w.transv2[pos] := initele; + fi; + od; + od; + + # Here everything starts, some more preparations: + + # We compute exclusively in our basis, so we occasionally need an + # identity matrix: + id := IdentityMat(d,F); + + Info(InfoRecog,2,"Current dimension: " ); + Info(InfoRecog,2,n); + Info(InfoRecog,2,"\n"); + Info(InfoRecog,2,"New dimension: "); + Info(InfoRecog,2,Minimum(2*n-2,d)); + Info(InfoRecog,2,"\n"); + + Info(InfoRecog,2,"Preparation done."); + + # Next step also correct for characteristic 2? + if p = 2 then + Error("todo"); + else + t := PermutationMat(CycleFromList([1..n/2])*CycleFromList(Reversed([(n/2)+1..n])),d,F); + tw := w.sunstdf[2*w.ext + (w.ext/2)+1]; + fi; + + Info(InfoRecog,2,"Step 1 done."); + + # Find a good random element: + w.count := 0; + aimdim := Minimum(2*n-2,d); + newdim := aimdim - n; + counter := 0; + + Info(InfoRecog,2,"Step 1 done."); + + # Find a good random element: + while true do # will be left by break + while true do # will be left by break + counter := counter + 1; + if InfoLevel(InfoRecog) >= 3 then Print(".\c"); fi; + c1 := PseudoRandom(G); + + # Do the base change into our basis: + c := t^(w.bas * c1 * w.basi); + + # Now check that Vn + Vn*s^c1 has dimension 2n-1: + sum1 := SumIntersectionMat(c{[1..n]},id{[1..n]}); + + if Size(sum1[1]) = aimdim then + + int1 := SumIntersectionMat(RECOG.FixspaceMat(c),id{[1..n]})[2]; + + for i in [1..Size(int1)] do + v1 := int1[i]; + if not(IsZero(v1[1])) then break; fi; + od; + for i in [1..Size(int1)] do + v2 := int1[i]; + if (v1 <> v2) and not(IsZero(v2[n])) then break; fi; + od; + if (v1 = v2) or IsZero(v1[1]) or IsZero(v2[n]) then + Info(InfoRecog,2,"Ooops: Component n was zero!"); + continue; + fi; + + v1 := v1 / v1[1]; # normalize to 1 in position 1 + Assert(1,v1*c=v1); + + v2 := v2 / v2[n]; # normalize to 1 in position n + Assert(1,v2*c=v2); + + v1 := v1 + (-1) * v1[n] * v2; + v2 := v2 + (-1) * v2[1] * v1; + + # Actually we don't need gamma3 here + gamma1 := Zero(F); + gamma2 := One(F); + gamma3 := One(F); + gamma4 := Zero(F); + for k in [2..n-1] do + gamma1 := gamma1 + v2[k]*(v2[n-k+1])^phi; + od; + + if gamma1 = Zero(F) then + Info(InfoRecog,2,"Ooops: gamma1 was zero!"); + continue; + fi; + + for k in [2..n-1] do + gamma4 := gamma4 + v1[k]*(v1[n-k+1])^phi; + od; + for k in [2..n-1] do + gamma2 := gamma2 + v2[k]*(v1[n-k+1])^phi; + od; + for k in [2..n-1] do + gamma3 := gamma3 + v1[k]*(v2[n-k+1])^phi; + od; + + gamma0 := RECOG.SolveNormEquationSilly(F,phi,gamma1); + zeta := gamma2*gamma0^(-1); + normx := RECOG.SolveNormEquationSilly(F,phi,zeta*zeta^phi-gamma4); + + if zeta*zeta^phi-gamma4 = Zero(F) then + Info(InfoRecog,2,"Ooops: zeta*zeta^phi-gamma4 was zero!"); + continue; + fi; + + beta := (normx-zeta^phi)*gamma0^(-1); + + vectorw := v1 + beta * v2; + + L1 := IdentityMat(d,F); + for i in [2..n-1] do + L1[1,i] := vectorw[i]; + L1[n-i+1,n] := -1*vectorw[i]^phi; + od; + L1[1,n] := beta; + + if not(L1^basechange in SU(d,Sqrt(q))) then + Info(InfoRecog,2,"Ooops: Component not useable!"); + Print("foul play"); + Error("here"); + continue; + fi; + + c := L1*c*L1^(-1); + int1 := SumIntersectionMat(RECOG.FixspaceMat(c),id{[1..n]})[2]; + for i in [1..Size(int1)] do + v2 := int1[i]; + if not(IsZero(v2[n])) then break; fi; + od; + + if IsZero(v2[n]) then + Info(InfoRecog,2,"Ooops: Component n was zero!"); + continue; + fi; + + v1 := id[1]; + v2 := v2 / v2[n]; # normalize to 1 in position n + Assert(1,v2*c=v2); + + v2 := v2 + (-1) * v2[1] * v1; + + gamma1 := Zero(F); + for k in [2..n-1] do + gamma1 := gamma1 + v2[k]*(v2[n-k+1])^phi; + od; + normx := RECOG.SolveNormEquationSilly(F,phi,gamma1); + beta := RECOG.SolveMyBachelorEquationSilly(F,phi,normx); + + vectorw := v2 + beta * v1; + + L2 := IdentityMat(d,F); + for i in [2..n-1] do + L2[n,i] := vectorw[i]; + L2[n-i+1,1] := -1*vectorw[i]^phi; + od; + L2[n,1] := beta; + + if not(L2^basechange in SU(d,Sqrt(q))) then + Info(InfoRecog,2,"Ooops: Component not useable!"); + Print("foul play"); + Error("here"); + continue; + fi; + + c := L2*c*L2^(-1); + ci := c^-1; + break; + fi; + # Display(counter); + od; + + # We have to write L1 and L2 as words in spnstdf + L1w := RECOG.WriteUpperKillerAsWordSU(L1,n,d,w.One,w.transh1,w.transh2,w.sunstdf{[2*ext+1..(2*ext+ext/2)]},w.sunstdf[2*w.ext + (w.ext/2)+1],w.sunstdf[2*w.ext + (w.ext/2)+2],w.sunstdf[2*w.ext + (w.ext/2)+3],q,ext,alpha,p,phi); + L2w := RECOG.WriteLowerKillerAsWordSU(L2,n,d,w.One,w.transv1,w.transv2,w.sunstdf{[2*ext+1..(2*ext+ext/2)]},w.sunstdf[2*w.ext + (w.ext/2)+1],w.sunstdf[2*w.ext + (w.ext/2)+2],w.sunstdf[2*w.ext + (w.ext/2)+3],q,ext,alpha,p,phi); + + # Save the SLP for c + slp := SLPOfElm(c1); + c1w := ResultOfStraightLineProgram(slp,w.sldf); + cw := tw^c1w; + cw := L1w*cw*L1w^(-1); + cw := L2w*cw*L2w^(-1); + cwi := cw^-1; + + Info(InfoRecog,2,"Step 2 done."); + + # Now we found our aimdim-dimensional space W. Since SL_n + # has a d-n-dimensional fixed space W_{d-n} and W contains a complement + # of that fixed space, the intersection of W and W_{d-n} has dimension + # newdim. + + # Change basis: + newpart := ExtractSubMatrix(c,[2..(n-1)],[1..(d)]); + # Clean out the first n entries to go to the fixed space of SL_n: + zerovec := Zero(newpart[1]); + for i in [1..(n-2)] do + CopySubVector(zerovec,newpart[i],[1..n],[1..n]); + od; + MB := MutableBasis(F,[],zerovec); + i := 1; + pivots := EmptyPlist(newdim); + while i <= Length(newpart) and NrBasisVectors(MB) < newdim do + if not(IsContainedInSpan(MB,newpart[i])) then + Add(pivots,i); + CloseMutableBasis(MB,newpart[i]); + fi; + i := i + 1; + od; + + newpart := newpart{pivots}; + newbas := Concatenation(id{[1..n]},newpart); + if 2*n-2 < d then + + int3 := SumIntersectionMat(RECOG.FixspaceMat(c),id{[n+1..d]})[2]; + + if Size(int3) <> d - aimdim then + Info(InfoRecog,2,"Ooops, FixSLn \cap Fixc wrong dimension"); + #Error("neues beispiel"); + continue; + fi; + Append(newbas,int3); + + fi; + ConvertToMatrixRep(newbas,Size(F)); + newbasi := newbas^-1; + if newbasi = fail then + Info(InfoRecog,2,"Ooops, Fixc intersected too much, we try again"); + continue; + fi; + + ci := newbas * ci * newbasi; + + cii := ExtractSubMatrix(ci,[n+1..aimdim],[2..n-1]); + ConvertToMatrixRep(cii,Size(F)); + cii := TransposedMat(cii); + # The rows of cii are now what used to be the columns, + # their length is newdim, we need to span the full newdim-dimensional + # row space and need to remember how: + zerovec := Zero(cii[1]); + MB := MutableBasis(F,[],zerovec); + i := 1; + pivots2 := EmptyPlist(newdim); + while i <= Length(cii) and NrBasisVectors(MB) < newdim do + if not(IsContainedInSpan(MB,cii[i])) then + Add(pivots2,i); + CloseMutableBasis(MB,cii[i]); + fi; + i := i + 1; + od; + if Length(pivots2) = newdim then + cii := cii{pivots2}^-1; + ConvertToMatrixRep(cii,F); + + c := newbas * c * newbasi; + newbasechange := newbas*basechange; + w.bas := newbas * w.bas; + w.basi := w.basi * newbasi; + break; + fi; + Info(InfoRecog,2,"Ooops, no nice bottom..."); + # Otherwise simply try again + od; + + Info(InfoRecog,2,"Begin with form change"); + + HFake := RECOG.LiftGroup(GeneratorsOfGroup(SU(n,Sqrt(q))),n,q,d)[1]; + HBigGens := List(GeneratorsOfGroup(HFake),MutableCopyMat); + Append(HBigGens,GeneratorsOfGroup(HFake^c)); + HBig := GroupByGenerators(HBigGens); + basechange := newbasechange; + #Display(RecogniseClassical(RECOG.LinearActionRepresentation(HBig))); + HSmall := GroupByGenerators(List(GeneratorsOfGroup(HBig),x->x{[1..aimdim]}{[1..aimdim]})); + WrongForm := PreservedSesquilinearForms(HSmall)[1]; + extract := HermitianFormByMatrix((WrongForm!.matrix){[n+1..aimdim]}{[n+1..aimdim]}, F ); + FormValue := (WrongForm!.matrix)[1,n]; + ChangeToCorrectForm := BaseChangeToCanonical(extract); + ChangeToCorrectFormBig := IdentityMat(aimdim,F); + ChangeToCorrectFormBig{[n+1..aimdim]}{[n+1..aimdim]} := ChangeToCorrectForm; + + PermMat := One(SymmetricGroup(aimdim)); + if IsEvenInt(aimdim) then + for i in [1..(n/2)] do + PermMat := PermMat*(i,n-i+1); + od; + for i in [n+1..(n+aimdim)/2] do + PermMat := PermMat*(i,aimdim-i+n+1); + od; + PermMat := PermutationMat(PermMat,d,F); + PermMat2 := One(SymmetricGroup(aimdim)); + for i in [1..aimdim/2] do + PermMat2 := PermMat2*(i,aimdim-i+1); + od; + PermMat2 := PermutationMat(PermMat2,d,F); + else + for i in [1..(n/2)] do + PermMat := PermMat*(i,n-i+1); + od; + for i in [n+1..(n-1+aimdim)/2] do + PermMat := PermMat*(i,aimdim-i+n+1); + od; + PermMat := PermutationMat(PermMat,d,F); + PermMat2 := One(SymmetricGroup(aimdim)); + for i in [1..(aimdim-1)/2] do + PermMat2 := PermMat2*(i,aimdim-i+1); + od; + PermMat2 := PermutationMat(PermMat2,d,F); + fi; + + WrongForm := IdentityMat(aimdim,F); + WrongForm{[n+1..aimdim]}{[n+1..aimdim]} := FormValue*PermMat{[n+1..aimdim]}{[n+1..aimdim]}; + ChangeToCorrectForm2 := BaseChangeToCanonical(HermitianFormByMatrix(WrongForm, F )); + ChangeToCorrectFormBig2 := IdentityMat(d,F); + ChangeToCorrectFormBig2{[1..aimdim]}{[1..aimdim]} := ChangeToCorrectFormBig^(-1)*ChangeToCorrectForm2; + HBig := HBig^ChangeToCorrectFormBig2; + c := ChangeToCorrectFormBig2^(-1) * c * ChangeToCorrectFormBig2; + basechange := ChangeToCorrectFormBig2^(-1)*basechange; + w.bas := ChangeToCorrectFormBig2^(-1) * w.bas; + w.basi := w.basi * ChangeToCorrectFormBig2; + + ci := c^-1; + ciT := TransposedMat(ci); + + Info(InfoRecog,2,"End of form change"); + + # Now consider the transvections t_i: + # t_i : w.bas[j] -> w.bas[j] for j <> i and + # t_i : w.bas[i] -> w.bas[i] + ww + # We want to modify (t_i)^c such that it fixes w.bas{[1..w.n]}: + + trans := []; + transw := []; + vectorlist := []; + vectorlistscalar := []; + + # If we are finishing up, we have to make sure, that the pivot elements are really pivot elements for the horizontal transvections. + # Otherwise we have to choose different pivots + if aimdim = w.GoalDim then + cii := ExtractSubMatrix(ci,[n+1..aimdim],[2..n-1]); + ConvertToMatrixRep(cii,Size(F)); + cii := TransposedMat(cii); + zerovec := Zero(cii[1]); + MB := MutableBasis(F,[],zerovec); + i := 1; + pivots2 := EmptyPlist(newdim); + while i <= Length(cii) and NrBasisVectors(MB) < newdim do + if not(IsContainedInSpan(MB,cii[i])) then + Add(pivots2,i); + CloseMutableBasis(MB,cii[i]); + fi; + i := i + 1; + od; + if NrBasisVectors(MB) < newdim then + Error("this should not happen"); + fi; + fi; + + if not(IsEvenInt(aimdim)) then + trans := []; + vectorlist := []; + diagonalentrylist := []; + for i in pivots2 do + # This does t_i + for lambda in w.canb do + # This does t_i : v_j -> v_j + lambda * v_n + tf := IdentityMat(d,F); + tf{[2..n-1]}{[n]} := (lambda)^phi * ci{[2..n-1]}{[i+1]}; + tf{[1]}{[2..n-1]} := [Reversed(TransposedMat(-1*tf{[2..n-1]}{[n]}^phi)[1])]; + Add(vectorlistscalar,-1*lambda * c[n-i]{[n+1..aimdim]}); + if i+1 <= n/2 then + tfw := w.One*w.transh2[Size(w.transh2)-(i*w.ext)+Position(w.canb,lambda)]^(-1); + else + tfw := (w.One*w.transh1[Size(w.transh1)-((i-n/2+1)*w.ext)+Position(w.canb,lambda)])^(-1); + fi; + + # Now conjugate with c: + tfw := cwi*tfw*cw; + + # Now cleanup in column n above row n, the entries there + # are lambda times the stuff in column i of ci: + #for j in [1..w.n-1] do + # tf := DoRowOp_n(tf,j,w.n,-ci[j,i]*lambda,w); + #od; + # Now cleanup in column n above row n, the entries there + killerw := RECOG.WriteUpperKillerAsWordSU2(tf{[1..n]}{[1..n]}^(-1),n,d,w.One,w.transh1,w.transh2,w.sunstdf{[2*ext+1..(2*ext+ext/2)]},w.sunstdf[2*w.ext + (w.ext/2)+1],w.sunstdf[2*w.ext + (w.ext/2)+2],w.sunstdf[2*w.ext + (w.ext/2)+3],q,ext,alpha,p,phi); + Add(diagonalentrylist,-1*killerw[2]); + killerw := killerw[1]; + tfw := killerw*tfw; + Add(vectorlist, lambda^phi * ciT[i+1]{[n+1..aimdim]}); + Add(trans,tf); + Add(transw,tfw); + od; + od; + + # For now vector space variant. but change that! + VC := VectorSpace(GF(p),vectorlist); + VCBasis := Basis(VC,vectorlist); + ConvertToMatrixRep(vectorlist,F); + ConvertToMatrixRep(vectorlistscalar,F); + + # Now put together the clean ones by our knowledge of c^-1: + transd := []; + CanonicalVC := BasisVectors(CanonicalBasis(VC)); + for i in CanonicalVC do + LinearCombinationVector := Coefficients(VCBasis,i); + tf := IdentityMat(d,F); + tfw := w.One; + tfvalue := Zero(F); + currentvector := Zero(VC); + for lambda in [1..Size(LinearCombinationVector)] do + if LinearCombinationVector[lambda] <> Zero(F) then + #Display(tfvalue); + #Display(diagonalentrylist[lambda]); + #Display(RECOG.ComputeCornerEntryProductSU(vectorlist[lambda], vectorlistscalar[lambda], diagonalentrylist[lambda], F, Int(LinearCombinationVector[lambda]))); + #Display(LinearCombinationVector[lambda]*(currentvector*vectorlist[lambda])); + #Display(currentvector); + tfvalue := tfvalue + LinearCombinationVector[lambda]*(currentvector*vectorlist[lambda]) + RECOG.ComputeCornerEntryProductSU(vectorlist[lambda], vectorlistscalar[lambda], diagonalentrylist[lambda], F, Int(LinearCombinationVector[lambda])); + currentvector := currentvector + LinearCombinationVector[lambda]*vectorlistscalar[lambda]; + #Display(currentvector); + tfw := tfw*transw[lambda]^Int(LinearCombinationVector[lambda]); + fi; + od; + + if Position(CanonicalVC, i) = Size(CanonicalVC)/2 then + storeposition := Position(CanonicalVC, i); + fi; + + if not(Position(CanonicalVC, i) in [Size(CanonicalVC)/2..Size(CanonicalVC)/2 + w.ext - 1]) then + tf[1,n] := -1*tfvalue; + #Display(ResultOfStraightLineProgram(SLPOfElm(tfw),GeneratorsOfGroup(SU(20,7)))^(newbasechange^(-1))); + #Display(tf); + + #Error("more to do to compute diagonalentry"); + #Error("We find the new transvection matrices also where we cannot clear the top right entry"); + killerw := RECOG.WriteUpperKillerAsWordSU(tf{[1..n]}{[1..n]},n,d,w.One,w.transh1,w.transh2,w.sunstdf{[2*ext+1..(2*ext+ext/2)]},w.sunstdf[2*w.ext + (w.ext/2)+1],w.sunstdf[2*w.ext + (w.ext/2)+2],w.sunstdf[2*w.ext + (w.ext/2)+3],q,ext,alpha,p,phi); + tfw := killerw*tfw; + fi; + + Add(transd,tfw); + od; + Unbind(trans); + Unbind(transw); + + Info(InfoRecog,2,"Step 5 done"); + + # Now to the "horizontal" transvections, first create them as SLPs: + trans := []; + transw := []; + vectorlist := []; + vectorlistscalar := []; + diagonalentrylist := []; + + # If we are finishing up, we have to make sure, that the pivot elements are really pivot elements for the horizontal transvections. + # Otherwise we have to choose different pivots + if aimdim = w.GoalDim then + newpart := ExtractSubMatrix(c,[2..n-1],[n+1..aimdim]); + zerovec := Zero(newpart[1]); + MB := MutableBasis(F,[],zerovec); + i := 1; + pivots := EmptyPlist(newdim); + while i <= Length(newpart) and NrBasisVectors(MB) < newdim do + if not(IsContainedInSpan(MB,newpart[i])) then + Add(pivots,i); + CloseMutableBasis(MB,newpart[i]); + fi; + i := i + 1; + od; + fi; + + for i in pivots do + for lambda in w.canb do + # This does t_i : v_j -> v_j + lambda * v_n + tf := IdentityMat(d,F); + tf{[n]}{[2..n-1]} := lambda^phi * c{[i+1]}{[2..n-1]}; + tf{[2..n-1]}{[1]} := TransposedMat([Reversed((-1*tf{[n]}{[2..n-1]}^phi)[1])]); + Add(vectorlistscalar,-1*lambda * ciT[n-i]{[n+1..aimdim]}); + if i+1 <= n/2 then + tfw := w.One*w.transv2[Size(w.transv2)-(i*w.ext)+Position(w.canb,lambda)]^(-1); + else + tfw := (w.One*w.transv1[Size(w.transv1)-((i-n/2+1)*w.ext)+Position(w.canb,lambda)])^(-1); + fi; + + # Now conjugate with c: + tfw := cwi*tfw*cw; + + # Now cleanup in column n above row n, the entries there + # are lambda times the stuff in column i of ci: + #for j in [1..w.n-1] do + # tf := DoRowOp_n(tf,j,w.n,-ci[j,i]*lambda,w); + #od; + # Now cleanup in column n above row n, the entries there + killerw := RECOG.WriteLowerKillerAsWordSU2(tf{[1..n]}{[1..n]}^(-1),n,d,w.One,w.transv1,w.transv2,w.sunstdf{[2*ext+1..(2*ext+ext/2)]},w.sunstdf[2*w.ext + (w.ext/2)+1],w.sunstdf[2*w.ext + (w.ext/2)+2],w.sunstdf[2*w.ext + (w.ext/2)+3],q,ext,alpha,p,phi); + Add(diagonalentrylist,killerw[2]+(-1*lambda * ciT[n-i]{[n+1..aimdim]})*(lambda^phi * c[i+1]{[n+1..aimdim]})); + killerw := killerw[1]; + tfw := killerw*tfw; + Add(vectorlist, lambda^phi * c[i+1]{[n+1..aimdim]}); + Add(trans,tf); + Add(transw,tfw); + od; + od; + + # For now vector space variant. but change that! + VC := VectorSpace(GF(p),vectorlist); + VCBasis := Basis(VC,vectorlist); + ConvertToMatrixRep(vectorlist,F); + ConvertToMatrixRep(vectorlistscalar,F); + + # Now put together the clean ones by our knowledge of c^-1: + transr := []; + CanonicalVC := BasisVectors(CanonicalBasis(VectorSpace(F,IdentityMat(aimdim-n,F)))); + for i in CanonicalVC do + LinearCombinationVector := Coefficients(VCBasis,i); + tf := IdentityMat(d,F); + tfw := w.One; + tfvalue := Zero(F); + currentvector := Zero(VC); + for lambda in [1..Size(LinearCombinationVector)] do + if LinearCombinationVector[lambda] <> Zero(F) then + tfvalue := tfvalue + LinearCombinationVector[lambda]*(currentvector*vectorlistscalar[lambda]) + RECOG.ComputeCornerEntryProductSU(vectorlist[lambda], vectorlistscalar[lambda], diagonalentrylist[lambda], F, Int(LinearCombinationVector[lambda])); + currentvector := currentvector + LinearCombinationVector[lambda]*vectorlist[lambda]; + tfw := tfw*transw[lambda]^Int(LinearCombinationVector[lambda]); + fi; + od; + + if Position(CanonicalVC, i) <> (Size(CanonicalVC)+1)/2 then + tf[n,1] := -1*tfvalue; + killerw := RECOG.WriteLowerKillerAsWordSU(tf{[1..n]}{[1..n]},n,d,w.One,w.transv1,w.transv2,w.sunstdf{[2*ext+1..(2*ext+ext/2)]},w.sunstdf[2*w.ext + (w.ext/2)+1],w.sunstdf[2*w.ext + (w.ext/2)+2],w.sunstdf[2*w.ext + (w.ext/2)+3],q,ext,alpha,p,phi); + tfw := killerw*tfw; + fi; + + Add(transr,tfw); + od; + Unbind(trans); + Unbind(transw); + + Info(InfoRecog,2,"Step 6 done"); + + # Put together the n-cycle: + # 2n-1 -> 2n-2 -> ... -> n+1 -> n -> 2n-1 + + flag := false; + s := w.One; + PermMat3 := RECOG.ComputeCorrectingPermutationMatOdd(d,F,n,aimdim); + v := w.sunstdf[2*w.ext+(w.ext/2)+1]; + + for i in [aimdim-n,aimdim-n-1..(aimdim-n+1)/2+1] do + if flag then + # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + # TODO: Replace 2 by size of extension to get the correct matrices of transd (we want the ones with 1 and -1 at the transvection positions) + tf := transd[(i-1)*ext+1]*transr[i]^-1*transd[(i-1)*ext+1]; + else + # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + # TODO: Replace 2 by size of extension to get the correct matrices of transd (we want the ones with 1 and -1 at the transvection positions) + tf := transd[(i-1)*ext+1]^-1*transr[i]*transd[(i-1)*ext+1]^-1; + fi; + #Display(tf); + #Display((tf^(v^2))^(PermMat3^(-1))); + #Display(tf); + s := s * tf; + flag := not(flag); + od; + + if flag then + v := ((w.sunstdf[2*w.ext+(w.ext/2)+4]^((Sqrt(q)-1)/2))^((v*s*w.sunstdf[2*w.ext+(w.ext/2)+3])^(-1)))*(v*s); + else + v := (v*s); + fi; + w.sunstdf[2*w.ext+(w.ext/2)+1] := v; + w.myx := transd[storeposition]; + newbasechange := PermMat3^(-1)*basechange; + w.bas := PermMat3^(-1) * w.bas; + w.basi := w.basi * PermMat3; + Unbind(w.transv); + Unbind(w.transh); + w.n := aimdim; + Info(InfoRecog,2,"Step 7 done"); + return w; + else + trans := []; + vectorlist := []; + diagonalentrylist := []; + for i in pivots2 do + # This does t_i + for lambda in w.canb do + # This does t_i : v_j -> v_j + lambda * v_n + tf := IdentityMat(d,F); + tf{[2..n-1]}{[n]} := (lambda)^phi * ci{[2..n-1]}{[i+1]}; + tf{[1]}{[2..n-1]} := [Reversed(TransposedMat(-1*tf{[2..n-1]}{[n]}^phi)[1])]; + Add(vectorlistscalar,-1*lambda * c[n-i]{[n+1..aimdim]}); + if i+1 <= n/2 then + tfw := w.One*w.transh2[Size(w.transh2)-(i*w.ext)+Position(w.canb,lambda)]^(-1); + else + tfw := (w.One*w.transh1[Size(w.transh1)-((i-n/2+1)*w.ext)+Position(w.canb,lambda)])^(-1); + fi; + + # Now conjugate with c: + tfw := cwi*tfw*cw; + + # Now cleanup in column n above row n, the entries there + # are lambda times the stuff in column i of ci: + #for j in [1..w.n-1] do + # tf := DoRowOp_n(tf,j,w.n,-ci[j,i]*lambda,w); + #od; + # Now cleanup in column n above row n, the entries there + killerw := RECOG.WriteUpperKillerAsWordSU2(tf{[1..n]}{[1..n]}^(-1),n,d,w.One,w.transh1,w.transh2,w.sunstdf{[2*ext+1..(2*ext+ext/2)]},w.sunstdf[2*w.ext + (w.ext/2)+1],w.sunstdf[2*w.ext + (w.ext/2)+2],w.sunstdf[2*w.ext + (w.ext/2)+3],q,ext,alpha,p,phi); + Add(diagonalentrylist,-1*killerw[2]); + killerw := killerw[1]; + tfw := killerw*tfw; + Add(vectorlist, lambda^phi * ciT[i+1]{[n+1..aimdim]}); + Add(trans,tf); + Add(transw,tfw); + od; + od; + + # For now vector space variant. but change that! + VC := VectorSpace(GF(p),vectorlist); + VCBasis := Basis(VC,vectorlist); + ConvertToMatrixRep(vectorlist,F); + ConvertToMatrixRep(vectorlistscalar,F); + + # Now put together the clean ones by our knowledge of c^-1: + transd := []; + CanonicalVC := BasisVectors(CanonicalBasis(VC)); + for i in CanonicalVC do + LinearCombinationVector := Coefficients(VCBasis,i); + tf := IdentityMat(d,F); + tfw := w.One; + tfvalue := Zero(F); + currentvector := Zero(VC); + for lambda in [1..Size(LinearCombinationVector)] do + if LinearCombinationVector[lambda] <> Zero(F) then + #Display(tfvalue); + #Display(diagonalentrylist[lambda]); + #Display(RECOG.ComputeCornerEntryProductSU(vectorlist[lambda], vectorlistscalar[lambda], diagonalentrylist[lambda], F, Int(LinearCombinationVector[lambda]))); + #Display(LinearCombinationVector[lambda]*(currentvector*vectorlist[lambda])); + #Display(currentvector); + tfvalue := tfvalue + LinearCombinationVector[lambda]*(currentvector*vectorlist[lambda]) + RECOG.ComputeCornerEntryProductSU(vectorlist[lambda], vectorlistscalar[lambda], diagonalentrylist[lambda], F, Int(LinearCombinationVector[lambda])); + currentvector := currentvector + LinearCombinationVector[lambda]*vectorlistscalar[lambda]; + #Display(currentvector); + tfw := tfw*transw[lambda]^Int(LinearCombinationVector[lambda]); + fi; + od; + tf[1,n] := -1*tfvalue; + #Display(ResultOfStraightLineProgram(SLPOfElm(tfw),GeneratorsOfGroup(SU(20,7)))^(newbasechange^(-1))); + #Display(tf); + killerw := RECOG.WriteUpperKillerAsWordSU(tf{[1..n]}{[1..n]},n,d,w.One,w.transh1,w.transh2,w.sunstdf{[2*ext+1..(2*ext+ext/2)]},w.sunstdf[2*w.ext + (w.ext/2)+1],w.sunstdf[2*w.ext + (w.ext/2)+2],w.sunstdf[2*w.ext + (w.ext/2)+3],q,ext,alpha,p,phi); + tfw := killerw*tfw; + Add(transd,tfw); + od; + Unbind(trans); + Unbind(transw); + + Info(InfoRecog,2,"Step 5 done"); + + # Now to the "horizontal" transvections, first create them as SLPs: + trans := []; + transw := []; + vectorlist := []; + vectorlistscalar := []; + diagonalentrylist := []; + + # If we are finishing up, we have to make sure, that the pivot elements are really pivot elements for the horizontal transvections. + # Otherwise we have to choose different pivots + if aimdim = w.GoalDim then + newpart := ExtractSubMatrix(c,[2..n-1],[n+1..aimdim]); + zerovec := Zero(newpart[1]); + MB := MutableBasis(F,[],zerovec); + i := 1; + pivots := EmptyPlist(newdim); + while i <= Length(newpart) and NrBasisVectors(MB) < newdim do + if not(IsContainedInSpan(MB,newpart[i])) then + Add(pivots,i); + CloseMutableBasis(MB,newpart[i]); + fi; + i := i + 1; + od; + fi; + + for i in pivots do + for lambda in w.canb do + # This does t_i : v_j -> v_j + lambda * v_n + tf := IdentityMat(d,F); + tf{[n]}{[2..n-1]} := lambda^phi * c{[i+1]}{[2..n-1]}; + tf{[2..n-1]}{[1]} := TransposedMat([Reversed((-1*tf{[n]}{[2..n-1]}^phi)[1])]); + Add(vectorlistscalar,-1*lambda * ciT[n-i]{[n+1..aimdim]}); + if i+1 <= n/2 then + tfw := w.One*w.transv2[Size(w.transv2)-(i*w.ext)+Position(w.canb,lambda)]^(-1); + else + tfw := (w.One*w.transv1[Size(w.transv1)-((i-n/2+1)*w.ext)+Position(w.canb,lambda)])^(-1); + fi; + + # Now conjugate with c: + tfw := cwi*tfw*cw; + + # Now cleanup in column n above row n, the entries there + # are lambda times the stuff in column i of ci: + #for j in [1..w.n-1] do + # tf := DoRowOp_n(tf,j,w.n,-ci[j,i]*lambda,w); + #od; + # Now cleanup in column n above row n, the entries there + killerw := RECOG.WriteLowerKillerAsWordSU2(tf{[1..n]}{[1..n]}^(-1),n,d,w.One,w.transv1,w.transv2,w.sunstdf{[2*ext+1..(2*ext+ext/2)]},w.sunstdf[2*w.ext + (w.ext/2)+1],w.sunstdf[2*w.ext + (w.ext/2)+2],w.sunstdf[2*w.ext + (w.ext/2)+3],q,ext,alpha,p,phi); + Add(diagonalentrylist,killerw[2]+(-1*lambda * ciT[n-i]{[n+1..aimdim]})*(lambda^phi * c[i+1]{[n+1..aimdim]})); + killerw := killerw[1]; + tfw := killerw*tfw; + Add(vectorlist, lambda^phi * c[i+1]{[n+1..aimdim]}); + Add(trans,tf); + Add(transw,tfw); + od; + od; + + # For now vector space variant. but change that! + VC := VectorSpace(GF(p),vectorlist); + VCBasis := Basis(VC,vectorlist); + ConvertToMatrixRep(vectorlist,F); + ConvertToMatrixRep(vectorlistscalar,F); + + # Now put together the clean ones by our knowledge of c^-1: + transr := []; + CanonicalVC := BasisVectors(CanonicalBasis(VectorSpace(F,IdentityMat(aimdim-n,F)))); + for i in CanonicalVC do + LinearCombinationVector := Coefficients(VCBasis,i); + tf := IdentityMat(d,F); + tfw := w.One; + tfvalue := Zero(F); + currentvector := Zero(VC); + for lambda in [1..Size(LinearCombinationVector)] do + if LinearCombinationVector[lambda] <> Zero(F) then + tfvalue := tfvalue + LinearCombinationVector[lambda]*(currentvector*vectorlistscalar[lambda]) + RECOG.ComputeCornerEntryProductSU(vectorlist[lambda], vectorlistscalar[lambda], diagonalentrylist[lambda], F, Int(LinearCombinationVector[lambda])); + currentvector := currentvector + LinearCombinationVector[lambda]*vectorlist[lambda]; + tfw := tfw*transw[lambda]^Int(LinearCombinationVector[lambda]); + fi; + od; + tf[n,1] := -1*tfvalue; + killerw := RECOG.WriteLowerKillerAsWordSU(tf{[1..n]}{[1..n]},n,d,w.One,w.transv1,w.transv2,w.sunstdf{[2*ext+1..(2*ext+ext/2)]},w.sunstdf[2*w.ext + (w.ext/2)+1],w.sunstdf[2*w.ext + (w.ext/2)+2],w.sunstdf[2*w.ext + (w.ext/2)+3],q,ext,alpha,p,phi); + tfw := killerw*tfw; + Add(transr,tfw); + od; + Unbind(trans); + Unbind(transw); + + Info(InfoRecog,2,"Step 6 done"); + + # From here on we distinguish three cases: + # * w.n = 2 + # * we finish off the constructive recognition + # * we have to do another step as the next thing + if n = 4 then + #w.slnstdf[2*w.ext+2] := transd[1]*transr[1]^-1*transd[1]; + #w.slnstdf[2*w.ext+1] := w.transh[1]*w.transv[1]^-1*w.transh[1] + # *w.slnstdf[2*w.ext+2]; + #Unbind(w.transh); + #Unbind(w.transv); + #w.n := 3; + s := w.One; + PermMat3 := PermutationMat((3,5)(6,4),d,F); + v := w.sunstdf[2*w.ext+(w.ext/2)+1]; + #PermMat3 := PermutationMat((3,5)(6,4),20,GF(5)); + # w.ext = 2? + #for i in [n-1,n-3..1] do + flag := false; + for i in [2] do + if flag then + # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + tf := transd[(i-1)*ext+1]*transr[i]^-1*transd[(i-1)*ext+1]; + else + # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + #Display(transd[(i-1)*1+1]*transr[i]^-1*transd[(i-1)*1+1]); + tf := transd[(i-1)*ext+1]^-1*transr[i]*transd[(i-1)*ext+1]^-1; + fi; + #Display(tf); + #Display((tf^(v^2))^(PermMat3^(-1))); + s := s * tf; + flag := not(flag); + od; + + fixv := IdentityMat(d,F); + fixv[1,1] := -1*One(F); + fixv[4,4] := -1*One(F); + + v := v*s*w.sunstdf[2*w.ext+(w.ext/2)+4]^((Sqrt(q)-1)/2); + #v := v*s; + w.sunstdf[2*w.ext+(w.ext/2)+1] := v; + + newbasechange := PermMat3^(-1)*basechange; + w.bas := PermMat3^(-1) * w.bas; + w.basi := w.basi * PermMat3; + + # Now add the new transvections: + # for i in [Size(transd)/2+1..Size(transd)] do + # w.transh[w.ext*(w.n-1)+w.ext*(i-1)+1] := transr[i]; + # Add(w.transh1, transd[i]^(-1)); + # od; + # newtransv := transd{[1..Size(transd)/2]}; + # Append(newtransv,w.transh2); + # Error("here"); + # w.transh2 := newtransv; + w.n := aimdim; + Info(InfoRecog,2,"Step 7 done"); + return w; + fi; + # We can finish off: + + if aimdim = w.GoalDim then + # In this case we just finish off and do not bother with + # the transvections, we will only need the standard gens: + # Now put together the (newdim)-cycle: + # n+newdim -> n+newdim-1 -> ... -> n+1 -> n -> n+newdim + + flag := false; + s := w.One; + PermMat3 := RECOG.ComputeCorrectingPermutationMat(d,F,n,aimdim); + v := w.sunstdf[2*w.ext+(w.ext/2)+1]; + if newdim/2 = 1 then + for i in [2] do + if flag then + # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + tf := transd[(i-1)*ext+1]*transr[i]^-1*transd[(i-1)*ext+1]; + else + # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + tf := transd[(i-1)*ext+1]^-1*transr[i]*transd[(i-1)*ext+1]^-1; + fi; + s := s * tf; + flag := not(flag); + od; + + # Finally put together the new long cycle: + + v := ((w.sunstdf[2*w.ext+(w.ext/2)+4]^((Sqrt(q)-1)/2))^((v*s*w.sunstdf[2*w.ext+(w.ext/2)+3])^(-1)))*(v*s); + w.sunstdf[2*w.ext+(w.ext/2)+1] := v; + else + for i in Reversed([Size(transr)-(newdim/2)+1..Size(transr)]) do + if flag then + # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + tf := transd[(i-1)*ext+1]*transr[i]^-1*transd[(i-1)*ext+1]; + else + # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + tf := transd[(i-1)*ext+1]^-1*transr[i]*transd[(i-1)*ext+1]^-1; + fi; + s := s * tf; + flag := not(flag); + od; + + # Finally put together the new long cycle: + if flag then + v := ((w.sunstdf[2*w.ext+(w.ext/2)+4]^((Sqrt(q)-1)/2))^((v*s*w.sunstdf[2*w.ext+(w.ext/2)+3])^(-1)))*(v*s); + else + v := (v*s); + fi; + w.sunstdf[2*w.ext+(w.ext/2)+1] := v; + fi; + + newbasechange := PermMat3^(-1)*basechange; + w.bas := PermMat3^(-1) * w.bas; + w.basi := w.basi * PermMat3; + Unbind(w.transv); + Unbind(w.transh); + w.n := aimdim; + Info(InfoRecog,2,"Step 7 done"); + return w; + + fi; + + # Otherwise we do want to go on as the next thing, so we want to + # keep our transvections. This is easily done if we change the + # basis one more time. Note that we know that n is odd here! + + # Put together the n-cycle: + # 2n-1 -> 2n-2 -> ... -> n+1 -> n -> 2n-1 + flag := false; + PermMat3 := RECOG.ComputeCorrectingPermutationMat(d,F,n,aimdim); + s := w.One; + v := w.sunstdf[2*w.ext+(w.ext/2)+1]; + for i in [n-2,n-3..(n/2)] do + if flag then + # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + # TODO: Replace 2 by size of extension to get the correct matrices of transd (we want the ones with 1 and -1 at the transvection positions) + tf := transd[(i-1)*ext+1]*transr[i]^-1*transd[(i-1)*ext+1]; + else + # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + # TODO: Replace 2 by size of extension to get the correct matrices of transd (we want the ones with 1 and -1 at the transvection positions) + tf := transd[(i-1)*ext+1]^-1*transr[i]*transd[(i-1)*ext+1]^-1; + fi; + s := s * tf; + flag := not(flag); + od; + + # Finally put together the new long cycle: + v := (v*s); + w.sunstdf[2*w.ext+(w.ext/2)+1] := v; + + newbasechange := PermMat3^(-1)*basechange; + w.bas := PermMat3^(-1) * w.bas; + w.basi := w.basi * PermMat3; + + w.n := aimdim; + + Info(InfoRecog,2,"Step 7 done"); + return w; + fi; +end; diff --git a/gap/projective/constructive_recognition/SU/main.gi b/gap/projective/constructive_recognition/SU/main.gi new file mode 100644 index 000000000..d7891a57f --- /dev/null +++ b/gap/projective/constructive_recognition/SU/main.gi @@ -0,0 +1,390 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +############################################################################# + + + +############################################################################# +############################################################################# +######## Main function for unitary groups ################################### +############################################################################# +############################################################################# + + + +RECOG.FindStdGens_SU := function(sld) + + return RECOG.FindStdGens_SUTest(sld,DimensionOfMatrixGroup(sld)); + +end; + + + +RECOG.FindStdGens_SU2 := function(sld,IsoDim) + +# Group generated by input must be isomorphic SU(IsoDim,q) + +# gens of sld must be gens for Sp(d,q) in its natural rep with memory +# This function calls RECOG.SLn_constructsl2 and then extends +# the basis to a basis of the full row space and calls +# RECOG.SLn_UpStep often enough. Finally it returns an slp such +# that the Sp(d,q) standard generators with respect to this basis are +# expressed by the slp in terms of the original generators of sld. +local V,b,bas,basi,basit,d,data,ext,fakegens,id,nu,nu2,p,q,resl2,su2,su2small,su2gens,su2genssmall,su2completegens, + sl2gensf,sl2genss,sl2stdf,slp,slpsl2std,slptosl2,st,std,stdgens,i,ex,f,form; + + # Some setup: + f := FieldOfMatrixGroup(sld); + p := Characteristic(f); + q := Size(f); + ext := DegreeOverPrimeField(f); + d := DimensionOfMatrixGroup(sld); + form := PreservedForms(sld)[1]; + form := form!.matrix; + if not(IsObjWithMemory(GeneratorsOfGroup(sld)[1])) then + sld := GroupWithMemory(sld); + fi; + + # First find an SU2 with the space it acts on; + Info(InfoRecog,2,"Finding an SU2..."); + Info(InfoRecog,2,"-----"); + Info(InfoRecog,2,"Start of the GoingDown Algorithm."); + data := RECOG.SUn_constructsu2(sld,d,q,form); + Info(InfoRecog,2,"The GoingDown Algorithm was successful."); + Info(InfoRecog,2,"-----"); + + #bas := ShallowCopy(BasisVectors(Basis(data[2]))); + su2 := data[1]; + su2small := RECOG.ExtractSmallerGroup(GeneratorsOfGroup(su2),IdentityMat(20,GF(q)),2)[1]; + #slptosl2 := SLPOfElms(GeneratorsOfGroup(sl2)); + #sl2gens := StripMemory(GeneratorsOfGroup(sl2)); + #V := data[2]; + #b := Basis(V,bas); + #sl2genss := List(sl2gens,x->RECOG.LinearAction(b,f,x)); + + Info(InfoRecog,2,"-----"); + Info(InfoRecog,2,"Solving the base case"); + su2genssmall := RECOG.ConstructiveRecognitionSL2NaturalRepresentation(su2small,Sqrt(q),0.001); + su2gens := RECOG.LiftGroup(su2genssmall[1],2,q,d)[2]; + #su2completegens := RECOG.ConstructiveRecognitionSL2NaturalRepresentationCompleteBasis(su2gens[1],GF(Sqrt(q)),Sqrt(q),p,Size(Factors(q))/2); + return [su2gens,RECOG.LiftGroup([su2genssmall[2]],2,q,d)[2,1]*data[2]]; + #if q in [2,3,4,5,9] then + # Info(InfoRecog,2,"In fact found an SL4..."); + # stdgens := RECOG.MakeSL_StdGens(p,ext,4,4).all; + # slpsl2std := RECOG.FindStdGensUsingBSGS(Group(sl2genss),stdgens, + # false,false); + # nu := List(sl2gens,x->RECOG.FixspaceMat(x)); + # ex := SumIntersectionMat(nu[1],nu[2])[2]; + # for i in [3..Length(nu)] do + # ex := SumIntersectionMat(nu[3],ex); + # od; + # Append(bas,ex); + # ConvertToMatrixRep(bas,q); + # basi := bas^-1; + #else + # # Now compute the natural SL2 action and run constructive recognition: + # Info(InfoRecog,2, + # "Recognising this SL2 constructively in 2 dimensions..."); + # sl2genss := GeneratorsWithMemory(sl2genss); + # if IsEvenInt(q) then + # resl2 := RECOG.RecogniseSL2NaturalEvenChar(Group(sl2genss),f,false); + # else + # resl2 := RECOG.RecogniseSL2NaturalOddCharUsingBSGS(Group(sl2genss),f); + # fi; + # slpsl2std := SLPOfElms(resl2.all); + # bas := resl2.bas * bas; + # # We need the actual transvections: + # slp := SLPOfElms([resl2.s[1],resl2.t[1]]); + # st := ResultOfStraightLineProgram(slp, + # StripMemory(GeneratorsOfGroup(sl2))); + # + # # Extend basis by something invariant under SL2: + # id := IdentityMat(d,f); + # nu := NullspaceMat(StripMemory(st[1]-id)); + # nu2 := NullspaceMat(StripMemory(st[2]-id)); + # Append(bas,SumIntersectionMat(nu,nu2)[2]); + # ConvertToMatrixRep(bas,q); + # basi := bas^-1; + #fi; + #Display("Finished the base case."); + #Display("-----"); + + # Now set up fake generators for keeping track what we do: + #fakegens := ListWithIdenticalEntries(Length(GeneratorsOfGroup(sld)),()); + #fakegens := GeneratorsWithMemory(fakegens); + #sl2gensf := ResultOfStraightLineProgram(slptosl2,fakegens); + #sl2stdf := ResultOfStraightLineProgram(slpsl2std,sl2gensf); + #std := rec( f := f, d := d, GoalDim := IsoDim, n := 2, bas := bas, basi := basi, + # sld := sld, sldf := fakegens, slnstdf := sl2stdf, + # p := p, ext := ext ); + #Info(InfoRecog,2,"Going up to SL_d again..."); + #Display("-----"); + #Display("Start of the GoingUp Algorithm"); + #while std.n < std.GoalDim do + # RECOG.SLn_UpStep(std); + #od; + #Display("The GoingUp Algorithm was successful."); + #Display("-----"); + #return rec( slpstd := SLPOfElms(std.slnstdf), + # bas := std.bas, basi := std.basi ); + + return "Hallo"; +end; + + + + + + + + + + + + +# TODO: Next function is actually the correct function! + + +RECOG.FindStdGens_SUTest := function(sld,IsoDim) + +# Group generated by input must be isomorphic SU(IsoDim,q) + +# gens of sld must be gens for Sp(d,q) in its natural rep with memory +# This function calls RECOG.SLn_constructsl2 and then extends +# the basis to a basis of the full row space and calls +# RECOG.SLn_UpStep often enough. Finally it returns an slp such +# that the Sp(d,q) standard generators with respect to this basis are +# expressed by the slp in terms of the original generators of sld. +local V,b,bas,basi,basit,d,data,ext,fakegens,id,nu,nu2,p,q,resl2,su2,su2small,su2gens,su2genssmall,su2completegens,slpsu4std,myslp,su4stdf, + sl2gensf,sl2genss,sl2stdf,slp,slpsl2std,slptosl2,st,std,stdgens,i,ex,f,form,WrongForm,ChangeToCorrectFormBig,ChangeToCorrectFormBig2, + Galois,phi,alpha,primitive,finishedslp; + + # Some setup: + f := FieldOfMatrixGroup(sld); + p := Characteristic(f); + q := Size(f); + ext := DegreeOverPrimeField(f); + d := DimensionOfMatrixGroup(sld); + form := PreservedForms(sld)[1]; + form := form!.matrix; + if not(IsObjWithMemory(GeneratorsOfGroup(sld)[1])) then + sld := GroupWithMemory(sld); + fi; + + Galois := GaloisGroup(f); + Galois := Filtered(Galois, x -> Order(x) = 2); + phi := Galois[1]; + + # First find an SU2 with the space it acts on; + Info(InfoRecog,2,"Finding an SU2..."); + Info(InfoRecog,2,"-----"); + Info(InfoRecog,2,"Start of the GoingDown Algorithm."); + data := RECOG.SUn_constructsu4(sld,d,q,form); + if data = fail then + return TemporaryFailure; + fi; + Info(InfoRecog,2,"The GoingDown Algorithm was successful."); + Info(InfoRecog,2,"-----"); + + myslp := data[4]; + + su2 := data[1]; + su2small := RECOG.ExtractSmallerGroup(GeneratorsOfGroup(su2),IdentityMat(20,GF(q)),4)[1]; + + Info(InfoRecog,2,"-----"); + Info(InfoRecog,2,"Solving the base case"); + bas := data[2]; + + WrongForm := PreservedSesquilinearForms(su2small)[1]; + ChangeToCorrectFormBig := IdentityMat(d,f); + ChangeToCorrectFormBig{[1..4]}{[1..4]} := BaseChangeToCanonical(WrongForm)^(-1); + WrongForm := HermitianFormByMatrix(PermutationMat((1,4)(2,3),4,GF(q)),f); + ChangeToCorrectFormBig2 := IdentityMat(d,f); + ChangeToCorrectFormBig2{[1..4]}{[1..4]} := BaseChangeToCanonical(WrongForm); + su2 := su2^(ChangeToCorrectFormBig*ChangeToCorrectFormBig2); + su2small := RECOG.ExtractSmallerGroup(GeneratorsOfGroup(su2),IdentityMat(20,f),4)[1]; + bas := (ChangeToCorrectFormBig*ChangeToCorrectFormBig2)^(-1)*bas; + basi := bas^(-1); + + stdgens := RECOG.MakeSU_StdGens(4,Sqrt(q),p,ext,phi); + alpha := stdgens.alpha; + stdgens := stdgens.all; + + slpsu4std := RECOG.FindStdGensUsingBSGS(su2small,stdgens, + false,false); + + myslp := CompositionOfStraightLinePrograms(slpsu4std,myslp); + + #return [su2,bas,myslp]; + + Info(InfoRecog,2,"Constructive recognition of SU(4,q) was successful."); + Info(InfoRecog,2,"-----"); + + # Now set up fake generators for keeping track what we do: + fakegens := ListWithIdenticalEntries(Length(GeneratorsOfGroup(sld)),()); + fakegens := GeneratorsWithMemory(fakegens); + su4stdf := ResultOfStraightLineProgram(myslp,fakegens); + std := rec( f := f, d := d, GoalDim := IsoDim, n := 4, bas := bas, basi := basi, + sld := sld, sldf := fakegens, sunstdf := su4stdf, + p := p, ext := ext, phi := phi, alpha := alpha ); + Info(InfoRecog,2,"Going up to Sp_d again..."); + Info(InfoRecog,2,"-----"); + Info(InfoRecog,2,"Start of the GoingUp Algorithm"); + while std.n < std.GoalDim do + RECOG.SUn_UpStepWithSLP(std); + od; + Info(InfoRecog,2,"The GoingUp Algorithm was successful."); + Info(InfoRecog,2,"-----"); + if IsEvenInt(IsoDim) then + return rec( slpstd := SLPOfElms(std.sunstdf), + bas := std.bas, basi := std.basi ); + else + finishedslp := std.sunstdf; + Add(std.sunstdf,std.myx); + return rec( slpstd := SLPOfElms(finishedslp), + bas := std.bas, basi := std.basi ); + fi; +end; + + + +RECOG.MakeSU_StdGensTODO := function(p,ext,n,d) + local a,b,f,i,q,s,t,x,res; + f := GF(p,ext); + q := Size(f); + a := IdentityMat(d,f); + a := a{Concatenation([n],[1..n-1],[n+1..d])}; + ConvertToMatrixRep(a,q); + b := IdentityMat(d,f); + b := b{Concatenation([1,n],[2..n-1],[n+1..d])}; + ConvertToMatrixRep(b,q); + if IsEvenInt(n) then + a[1] := -a[1]; + else + b[2] := -b[2]; + fi; + s := []; + t := []; + for i in [0..ext-1] do + x := IdentityMat(d,f); + x[1,2] := Z(p,ext)^i; + Add(s,x); + x := IdentityMat(d,f); + x[2,1] := Z(p,ext)^i; + Add(t,x); + od; + + + + res := rec( s := s, t := t, a := a, b := b, f := f, q := q, p := p, + ext := ext, One := IdentityMat(d,f), one := One(f), + d := d ); + res.all := Concatenation( res.s, res.t, [res.a], [res.b] ); + return res; +end; + + + +RECOG.MakeSU_StdGens := function( d, q, p, ext, phi ) + + local w, alpha, s, t, delta, u, v, x, y, J, fld, res, upper, lower, backdiagonal, ele, i, f; + + f := GF(q); + w := PrimitiveElement(GF(q^2)); + alpha := w^((q+1)/2); + fld := GF(q^2); + + s := IdentityMat( d, fld ); + s[1][1] := Zero(fld); + s[d][d] := Zero(fld); + s[1][d] := alpha; + s[d][1] := alpha^(-q); + + t := IdentityMat( d, fld ); + t[1][d] := alpha; + + delta := IdentityMat( d, fld ); + delta[1][1] := w^(q+1); + delta[d][d] := w^((-(q+1))); + + v := 0 * IdentityMat( d, fld ); + if (IsEvenInt(d)) then + v[d/2][1] := One(fld); + v{[1..(d/2)-1]}{[2..d/2]} := IdentityMat((d/2)-1,fld); + v[d/2+1][d] := One(fld); + v{[(d/2)+2..d]}{[(d/2)+1..d-1]} := IdentityMat((d/2)-1,fld); + else + v[(d-1)/2][1] := One(fld); + v{[1..((d-1)/2)-1]}{[2..(d-1)/2]} := IdentityMat(((d-1)/2)-1,fld); + v[((d+1)/2)+1][d] := One(fld); + v[(d+1)/2][(d+1)/2] := One(fld); + v{[((d+1)/2)+2..d]}{[((d+1)/2)+1..d-1]} := IdentityMat(((d-1)/2)-1,fld); + fi; + + u := IdentityMat( d, fld );; + J := [[Zero(fld),One(fld)],[One(fld),Zero(fld)]]; + u{[1,2]}{[1,2]} := J; + u{[d-1,d]}{[d-1,d]} := J; + + x := IdentityMat( d, fld );; + if (IsEvenInt(d)) then + x[1][2] := One(fld); + x[d-1][d] := -One(fld); + else + x[(d+1)/2][1] := One(fld) * -1; + x[d][1] := One(fld)* -2^(-1); + x[d][(d+1)/2] := One(fld); + fi; + + y := IdentityMat( d, fld );; + if (IsEvenInt(d)) then + y[1][1] := w; + y[2][2] := w^(-1); + y[d-1][d-1] := w^q; + y[d][d] := w^(-q); + else + y[1][1] := w^(-q); + y[d][d] := w; + y[(d+1)/2][(d+1)/2] := w^(q-1); + fi; + + + upper := []; + lower := []; + backdiagonal := []; + for i in [0..ext-1] do + ele := IdentityMat(d,f); + ele[1,2] := Z(p,ext)^i; + ele[d-1,d] := -1*(Z(p,ext)^i)^phi; + Add(upper,ele); + ele := IdentityMat(d,f); + ele[2,1] := Z(p,ext)^i; + ele[d,d-1] := -1*(Z(p,ext)^i)^phi; + Add(lower,ele); + od; + + for i in [0..(ext/2)-1] do + ele := IdentityMat(d,f); + ele[1,d] := alpha^(-q)*(w^(q+1))^i; + Add(backdiagonal,ele); + od; + + + res := rec( s := s, t := t, delta := delta, u := u, x := x, y := y, v := v, + One := IdentityMat(d,f), one := One(f), alpha := alpha, + upper := upper, lower := lower, backdiagonal := backdiagonal); + res.all := Concatenation( res.upper, res.lower, res.backdiagonal, [res.v], [res.u], [res.s], [res.delta], [res.x], [res.y],[res.t] ); + return res; + +end; \ No newline at end of file diff --git a/gap/projective/constructive_recognition/Sp/BaseCase.gi b/gap/projective/constructive_recognition/Sp/BaseCase.gi new file mode 100644 index 000000000..9db88b3d9 --- /dev/null +++ b/gap/projective/constructive_recognition/Sp/BaseCase.gi @@ -0,0 +1,760 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +############################################################################# + + + +############################################################################# +############################################################################# +######## Constructive Recognition of Sp(4,q) ################################ +############################################################################# +############################################################################# + + +# The functions described here follow "Fast constructive recognition of black box symplectic groups" by Peter A. Brooksbank +# (Journal of Algebra, Volume 320 (2008), 885 - 909.) in the following [Brooksbank] +# and the dissertation "Constructive recognition of classical groups of small rank" by Kenneth J. Clarkson (student of Eamonn O'Brien) in the following [Clarkson]. +# The functions implemented here are from page 60 to 63 of [Clarkson] + +# In some situations the implementation differ from [Clarkson] since the computational results did not completly compare to the theoretical results. +# These situation are marked by [[DIFFERENCE]] + + +# Main function which basically implements the summary described at page 60 of [Clarkson] i.e. Section 5.2.1 +RECOG.FindStdGensSp4 := function(G, d, q) +local K, twofactors, stdgens1, stdgens2, factor1Gens, factor2Gens, p, f, stdgens1Complete, stdgens2Complete, basechange, basechangelift, slpgens1, slpgens2, myslp, +t1, h1, s1, t0, t2, h2, s2, T, gensT, currentbc, i, g, foundEle, zeroBlock, t, L, v, slp, slp1, slp2, newgens, t1l, t2l, slpL, slpG, listGeneratorsL, LL, hom, wh, basis, +Lbc, LGens, stdgensL, stdgensLComplete, tg, omega, h, space1, space2, hbig, u0, u, PermMat, LGensBig, space1Copy, check, basechangeSLs, form, formbc, GG, j, diagele, +vGood, x1, x2, x3, l1, x, mid, newgens1, newgens2, slpnewgens, allout, slpnewgensC, correct, uu, vv, connectG, transdown, transup, transdiag, transdiag2, coeff, val; + + # Initilize basis parameters + f := Factors(q); + p := f[1]; + f := Size(f); + omega := PrimitiveElement(GF(q)); + + # Set up the SLP + if not(IsObjWithMemory(GeneratorsOfGroup(G)[1])) then + G := GroupWithMemory(G); + fi; + + # Corresponds exactly to 5.2.2 of [Clarkson] + Info(InfoRecog,2,"Construct subgroup K which is isomorphic to SL(2,q) x SL(2,q)"); + if (q mod 2 = 0) then + K := RECOG.ConstructKEven(G, q); + else + K := RECOG.ConstructKOdd(G, q); + fi; + + #slp := K[2]; + K := K[1]; + + # Extracting the two factors is done by the methods descibed by Leedham-Green and O'Brien in "Constructive recognition of classical groups in odd characteristic" + # Section 11 + # Note that the method for even involutions is not implemented in GAP yet and so there is no method for extracting the two factors in even characteristic + Info(InfoRecog,2,"Extract the two SL(2,q) factors of K"); + twofactors := RECOG.ExtractTwoSL2Factors(K,q); + if twofactors = fail then + return TemporaryFailure; + fi; + basechange := twofactors[5]; + + slp1 := SLPOfElms([twofactors[1,1],twofactors[1,2]]); + slp2 := SLPOfElms([twofactors[2,1],twofactors[2,2]]); + + # [[DIFFERENCE]] Note mentioned in [Clarkson] but we apply an additional basechange to later have the natural Sp(4,q) of GAP + form := PreservedSesquilinearForms(G^(basechange^(-1)))[1]; + formbc := BaseChangeToCanonical(form); + #GG := G^(basechange^(-1)*formbc^(-1)); + + factor1Gens := [(twofactors[1,1]^(basechange^(-1)*formbc^(-1))){[3,4]}{[3,4]},(twofactors[1,2]^(basechange^(-1)*formbc^(-1))){[3,4]}{[3,4]}]; + factor2Gens := [(twofactors[2,1]^(basechange^(-1)*formbc^(-1))){[1,2]}{[1,2]},(twofactors[2,2]^(basechange^(-1)*formbc^(-1))){[1,2]}{[1,2]}]; + + # Call constructive recognition on the two SL(2,q) copies p. 61 middle of [Clarkson] + Info(InfoRecog,2,"Perform constructive recognition on both copies of SL(2,q)"); + stdgens1 := RECOG.ConstructiveRecognitionSL2NaturalRepresentation(GroupByGenerators(factor1Gens),q, 0.001); + stdgens1Complete := RECOG.ConstructiveRecognitionSL2NaturalRepresentationCompleteBasis(stdgens1[1],GF(q),q,p,f); + slpgens1 := CompositionOfStraightLinePrograms(stdgens1Complete[2],stdgens1[3]); + stdgens1Complete := stdgens1Complete[1]; + + stdgens2 := RECOG.ConstructiveRecognitionSL2NaturalRepresentation(GroupByGenerators(factor2Gens),q, 0.001); + stdgens2Complete := RECOG.ConstructiveRecognitionSL2NaturalRepresentationCompleteBasis(stdgens2[1],GF(q),q,p,f); + slpgens2 := CompositionOfStraightLinePrograms(stdgens2Complete[2],stdgens2[3]); + stdgens2Complete := stdgens2Complete[1]; + + slp := IntegratedStraightLineProgram([CompositionOfStraightLinePrograms(slpgens1,slp1),CompositionOfStraightLinePrograms(slpgens2,slp2)]); + slpnewgensC := IntegratedStraightLineProgram([CompositionOfStraightLinePrograms(slpgens1,slp1),CompositionOfStraightLinePrograms(slpgens2,slp2)]); + + basechangelift := RECOG.LiftGroup([formbc*basechange],4,q,d); + basechangeSLs := IdentityMat(d,GF(q)); + basechangeSLs{[3,4]}{[3,4]} := stdgens1[2]; + basechangeSLs{[1,2]}{[1,2]} := stdgens2[2]; + + currentbc := basechangeSLs * basechangelift[2,1]; + + # Continue now with 5.2.3 + # Set up new SLPs for writing specific elements as words + # Construct Elements in std copies. Also write MSLP for these elements + newgens1 := StripMemory(stdgens1Complete); + newgens1 := Concatenation([newgens1[1]],newgens1[2],newgens1[3]); + newgens2 := StripMemory(stdgens1Complete); + newgens2 := Concatenation([newgens2[1]],newgens2[2],newgens2[3]); + for i in [1..Size(newgens1)] do + g := IdentityMat(4,GF(q)); + g{[3,4]}{[3,4]} := newgens1[i]; + newgens1[i] := g; + g := IdentityMat(4,GF(q)); + g{[1,2]}{[1,2]} := newgens2[i]; + newgens2[i] := g; + od; + newgens := Concatenation(newgens1,newgens2,GeneratorsOfGroup(G^((currentbc{[1..4]}{[1..4]})^(-1)))); + GG := GeneratorsWithMemory(newgens); + mid := Size(newgens1); + + t1 := GG[mid+2]; + t2 := GG[2]; + h1 := GG[mid+1]; + h2 := GG[1]; + t0 := GG[2+f]; + t1l := GG[mid+2+f]; + t2l := GG[2+f]; + s1 := t1*(t1l)^(-1)*t1; + s2 := t2*(t2l)^(-1)*t2; + + # Construct the group T + Info(InfoRecog,2,"Construct subgroup T which intersects both SL copies"); + gensT := [t1]; + for i in [1..(f-1)] do + Add(gensT, t1^(h1^i)); + od; + T := GroupByGenerators(gensT); + zeroBlock := 0 * IdentityMat(2,GF(q)); + + # Find specific g in G (see 5.2.3 point 2. of [Clarkson]) + # TODO: Can we always iterate over the generators of G?!? ----> No, generators are not good enough (take random elements here) + foundEle := false; + for i in [(2*mid+1)..Size(newgens)] do + g := GG[i]; + L := GeneratorsOfGroup(T^g); + for tg in L do + if ((tg){[1,2]}{[3,4]} <> zeroBlock or (tg){[3,4]}{[1,2]} <> zeroBlock) and not ForAll(gensT,t -> tg*t= t*tg ) then + foundEle := true; + break; + fi; + od; + if foundEle then + break; + fi; + od; + + if not(foundEle) then + Display("TODO: maybe we have to look at this again."); + return fail; + fi; + + # Set up the group L and call constructive recognition on it (see 5.2.3 point 3. of [Clarkson]) + Info(InfoRecog,2,"Identity an element h of Q"); + # ClosureGroup(T,T^g)??? + L := GroupByGenerators(Concatenation(GeneratorsOfGroup(T),GeneratorsOfGroup(T^g))); + Lbc := RECOG.ComputeBlockBaseChangeMatrix(GeneratorsOfGroup(L),4,q); + LGensBig := GeneratorsOfGroup(L^(Lbc^(-1))); + LGens := [1..Size(LGensBig)]; + for i in [1..Size(LGensBig)] do + LGens[i] := (LGensBig[i]){[1,2]}{[1,2]}; + od; + stdgensL := RECOG.ConstructiveRecognitionSL2NaturalRepresentation(GroupByGenerators(LGens),q,0.001); + stdgensLComplete := RECOG.ConstructiveRecognitionSL2NaturalRepresentationCompleteBasis(stdgensL[1],GF(q),q,p,f); + slpL := CompositionOfStraightLinePrograms(stdgensLComplete[2],stdgensL[3]); + stdgensLComplete := stdgensLComplete[1]; + + slpL := CompositionOfStraightLinePrograms(slpL,SLPOfElms(GeneratorsOfGroup(L))); + slpG := []; + connectG := []; + for i in [1..Size(GeneratorsOfGroup(G))] do + Add(slpG,[i,1]); + Add(connectG,[i,1]); + od; + + Add(slpG,connectG); + slpG := StraightLineProgram(slpG,Size(GeneratorsOfGroup(G))); + slp := CompositionOfStraightLinePrograms(slpL,IntegratedStraightLineProgram([slp,slpG])); + + # Construct normalising element of T and T^g and of order q-1 (see 5.2.3 point 4. of [Clarkson]) + # TODO: choose first and f+1 ? + space1 := RECOG.FixspaceMat(LGens[1]^(stdgensL[2]^(-1))); + space1 := MutableCopyMat(space1); + for i in [2..Size(LGens)] do + space2 := RECOG.FixspaceMat(LGens[i]^(stdgensL[2]^(-1))); + Append(space1,space2); + if NullspaceMat(space1) = [] then + break; + else + Remove(space1,2); + fi; + od; + + h := IdentityMat(2,GF(q)); + h[1,1] := omega; + h[2,2] := omega^(-1); + h := space1^(-1)*h*space1; + + # Write h in terms of the standard generators + wh := RECOG.RewritingSL2(stdgensLComplete,GF(q),q,p,f,h); + hbig := IdentityMat(4,GF(q)); + hbig{[1..2]}{[1..2]} := h^(stdgensL[2]); + h := hbig^Lbc; + slp := CompositionOfStraightLinePrograms(wh,slp); + + # Now we can finally write the standard generators of Sp(4,q) + Info(InfoRecog,2,"Combine everything for the standard generators of Sp(4,q)"); + + # Initilise the needed elements with SLPs + newgens := Concatenation(newgens1,newgens2,[h],GeneratorsOfGroup(G^((currentbc{[1..4]}{[1..4]})^(-1)))); + GG := GeneratorsWithMemory(newgens); + + t1 := GG[mid+2]; + t2 := GG[2]; + h1 := GG[mid+1]; + h2 := GG[1]; + t0 := GG[2+f]; + t1l := GG[mid+2+f]; + t2l := GG[2+f]; + s1 := t1*(t1l)^(-1)*t1; + s2 := t2*(t2l)^(-1)*t2; + h := GG[2*mid+1]; + + # Construct u0 (see 5.2.3 point 5. of [Clarkson]) + u0 := Comm(h,h1); + + #From now one we follow 5.2.5 of [Clarkson] + + # [[DIFFERENCE]] u is definetly not the element as mentioned in [Clarkson]. Sometimes it is even the identity. + # We use some trick from Magma even though our approach still slightly differs. + # It should also be mentioned, that u actually looks like v and v looks like u with respect to the elements in [Clarkson] + u := Comm(Comm(u0,t0),h2); + + #u := Comm(Comm(u0,s2),h2); + + if u = One(G) then + u := Comm(u0,h2); + fi; + + # [[DIFFERENCE]] Our u somehow does not have trivial entries. We fix that here even though it is not mentioned in [Clarkson] + # TODO: How to avoid next discrete logarithm?!?! Possible? + # Note: Discrete logarithm is not really crucial, since the algorithm uses an SL2 oracle which so far (2023) requires also a discrete logarithm oracle + correct := LogFFE(u[1,3],h1[1,1]); + u := u^(h1^correct); + + # Set up a last base change to the natural representation of GAP + PermMat := PermutationMat((2,4),d,GF(q)); + PermMat[2,4] := -1*One(GF(q)); + + currentbc := PermMat*currentbc; + + # [[DIFFERENCE]] Now we are following 5.2.5 of [Clarkson] even though we swap u and v by setting uu := v and vv := u + v := u^s2; + if IsEvenInt(q) then + t := u*Comm(t0,v); + else + t := Comm(u,v); + fi; + uu := v; + vv := u; + l1 := s1; + x := uu^(s2^2); + x1 := x^l1; + x2 := x^s2; + x3 := (x1)^s2; + t1 := Comm(x1,x2); + + vGood := s2^2*(x1^3*t1)^3; + + transdown := [u^(s1^(-1))]; + transup := [transdown[1]^(vGood^s1)]; + transdiag := [t^((q+1)/2)]; + transdiag2 := [t^((q+1)/2)]; + + if f > 1 then + for i in [1..(f-1)] do + Add(transup,transup[1]^(h1^(-i))); + Add(transdown,transup[i+1]^(vGood^s1)); + Add(transdiag,transdiag[1]^(h1^(-i))); + od; + + basis := [1..f]; + for i in [0..f-1] do + basis[i+1] := omega^(2*i); + od; + basis := Basis(GF(q),basis); + for i in [1..(f-1)] do + coeff := Coefficients(basis,omega^i); + diagele := s1^0; + for j in [1..f] do + val := Int(coeff[j]); + diagele := diagele * transdiag[j]^(val); + od; + Add(transdiag2,diagele); + od; + fi; + + transup := Concatenation(transup,transdown); + transup := Concatenation(transup,transdiag2); + + slp := CompositionOfStraightLinePrograms(SLPOfElms(Concatenation(transup,[vGood^s1,vGood^s1,s1,h1])),IntegratedStraightLineProgram([slpnewgensC,slp,slpG])); + + return [StripMemory([s1^(PermMat^(-1)),t^(PermMat^(-1)),h1^(PermMat^(-1)),u^(PermMat^(-1)),vGood^(PermMat^(-1))]),currentbc,slp]; +end; + + + +# # Used by RECOG.ConstructKEven +# RECOG.IsSp4SmallPP2K := function(tau,q,list) +# local entry, ppd4k, ord, prime, ppds, i; + +# if q = 8 then +# #ord := RECOG.EstimateOrder(tau); +# if (Order(tau) mod 21 = 0) then +# return true; +# else +# return false; +# fi; +# elif q = 2 then +# if (Order(tau) mod 3 = 0) then +# return true; +# else +# return false; +# fi; +# else +# ord := Order(tau); +# for i in list do +# if (ord mod i = 0) then +# return true; +# fi; +# od; +# return false; +# fi; + +# end; + + + +# # Used by RECOG.ConstructKOdd +# RECOG.IsSp4SmallPP4K := function(tau,q,list) +# local entry, ppd4k, ord, prime; + +# ord := Order(tau); +# if (ord mod q = 0) then +# for entry in list do +# ppd4k := entry[2]; +# for prime in ppd4k do +# if (ord mod prime = 0) then +# return true; +# fi; +# od; +# od; +# else +# return false; +# fi; + +# return false; + +# end; + + + +# # Corresponds exactly to 5.2.2 of [Clarkson] +# RECOG.ConstructKEven := function(h, q) +# local a, tau, g, K0, Knext, S, counter, p, preparelist, i, containsPPD2K, containsPPD4K, ppd, new, k, ppds; + +# counter := 1; +# k := Size(Factors(q)); +# ppds := Factors(PrimitivePrimeDivisors(2*k,2).ppds); + +# Info(InfoRecog,2,"Function: ConstructKEven"); +# Info(InfoRecog,2,"Try to compute tau"); + +# while counter < 100 do +# tau := PseudoRandom(h); +# if RECOG.IsSp4SmallPP2K(tau,q,ppds) and ((tau^(q-1)) <> 1) then +# a := tau^(q-1); +# #a := tau^(2*(q^2-q+1)); +# Info(InfoRecog,2,"Found tau"); +# while counter < 100 do +# g := PseudoRandom(h); +# K0 := GroupByGenerators([a,a^g]); +# # Magma uses another hack here but just checking that K0 = SL2 x SL2 +# # We should probably also use it here +# Knext := RECOG.DerivedSubgroupMonteCarlo(K0,20); +# while not(IsTrivial(Knext)) do +# K0 := Knext; +# Knext := RECOG.DerivedSubgroupMonteCarlo(K0,20); +# od; +# S := [1..Int(8*(Log2Int(q)+1))]; +# for i in [1..Size(S)] do +# S[i] := PseudoRandom(K0); +# od; +# containsPPD2K := false; +# containsPPD4K := false; + +# for i in S do + +# if RECOG.IsSp4SmallPP2K(tau,q,ppds) then +# containsPPD2K := true; +# fi; + +# if RECOG.IsSp4SmallPP4K(tau,q,ppds) then +# containsPPD4K := true; +# fi; + +# od; + +# if containsPPD2K and not(containsPPD4K) then +# return [K0,SLPOfElms(GeneratorsOfGroup(K0))]; +# fi; + +# if counter = 5 then +# Error("here"); +# fi; + +# counter := counter + 1; +# od; +# fi; +# counter := counter + 1; +# od; + +# if counter >= 100 then +# return fail; +# fi; + +# end; + + +# # Corresponds exactly to 5.2.2 of [Clarkson] +# RECOG.ConstructKOdd := function(G, q) +# local count, tau, order, centre, n, taun, K0, K, CentralElement, g; + +# count := 0; + +# #TODO: Don't have do compute this right? Always the same two diagonal matrices + +# while count < 30 do +# tau := PseudoRandom(G); +# order := Order(tau); +# if (order mod 2 = 0) then +# n := order/2; +# taun := tau^n; +# CentralElement := true; +# for g in GeneratorsOfGroup(G) do +# if g*taun*g^(-1) <> taun then +# CentralElement := false; +# break; +# fi; +# od; +# if not(CentralElement) then +# K0 := GroupByGenerators(RECOG.CentraliserOfInvolution(G,taun,[],true,100,RECOG.CompletionCheck,PseudoRandom)[1]); +# K := RECOG.DerivedSubgroupMonteCarlo(K0,20); +# return [K,SLPOfElms(GeneratorsOfGroup(K))]; +# fi; +# fi;; +# count := count + 1; +# od; + +# return fail; +# end; + + + +RECOG.IsSp4SmallPP2K := function(tau,q,list) +local entry, ppd4k, ord, prime; + + ord := Order(tau); + if (ord mod q = 0) then + for entry in list do + ppd4k := entry[2]; + for prime in ppd4k do + if (ord mod prime = 0) then + return true; + fi; + od; + od; + else + return false; + fi; + + return false; + +end; + + + +RECOG.IsSp4SmallPP4K := function(tau,q,list) +local entry, ppd4k, ord, prime; + + ord := Order(tau); + if (ord mod q = 0) then + for entry in list do + ppd4k := entry[2]; + for prime in ppd4k do + if (ord mod prime = 0) then + return true; + fi; + od; + od; + else + return false; + fi; + + return false; + +end; + + + +RECOG.ConstructKEven := function(h, q) +local a, tau, g, K0, Knext, S, counter, p, preparelist, i, containsPPD2K, containsPPD4K, ppd, new, k; + + counter := 1; + + preparelist := []; + p := Factors(q)[1]; + # TODO: Adjust to ppd# elements. See Dissertation Jenneth Klarkson (Eamonns student) + for k in [1..10] do + new := [k]; + ppd := PrimitivePrimeDivisors( 2*k, p ); + Add(new,DuplicateFreeList(Factors(ppd.ppds))); + ppd := PrimitivePrimeDivisors( 4*k, p ); + Add(new,DuplicateFreeList(Factors(ppd.ppds))); + Add(preparelist,new); + od; + + Info(InfoRecog,2,"Precomputation finished"); + + while counter < 100 do + tau := PseudoRandom(h); + if RECOG.IsSp4SmallPP2K(tau,q,preparelist) and ((tau^(q-1)) <> 1) then + a := tau^(q-1); + #a := tau^(2*(q^2-q+1)); + Info(InfoRecog,2,"Found tau"); + while counter < 100 do + g := PseudoRandom(h); + K0 := GroupByGenerators([a,a^g]); + Knext := RECOG.DerivedSubgroupMonteCarlo(K0,20); + while not(IsTrivial(Knext)) do + K0 := Knext; + Knext := RECOG.DerivedSubgroupMonteCarlo(K0,20); + od; + S := [1..Int(8*(Log2Int(q)+1))]; + for i in [1..Size(S)] do + S[i] := PseudoRandom(K0); + od; + containsPPD2K := false; + containsPPD4K := false; + + for i in S do + + if RECOG.IsSp4SmallPP2K(tau,q,preparelist) then + containsPPD2K := true; + fi; + + if RECOG.IsSp4SmallPP4K(tau,q,preparelist) then + containsPPD4K := true; + fi; + + od; + + if containsPPD2K and not(containsPPD4K) then + return [K0,SLPOfElms(GeneratorsOfGroup(K0))]; + fi; + + counter := counter + 1; + od; + fi; + counter := counter + 1; + od; + + if counter >= 100 then + return fail; + fi; + +end; + + + +RECOG.ConstructKOdd := function(G, q) +local count, tau, order, centre, n, taun, K0, K, CentralElement, g; + + count := 0; + + #TODO: Don't have do compute this right? Always the same two diagonal matrices + + while count < 30 do + tau := PseudoRandom(G); + order := Order(tau); + if (order mod 2 = 0) then + n := order/2; + taun := tau^n; + CentralElement := true; + for g in GeneratorsOfGroup(G) do + if g*taun*g^(-1) <> taun then + CentralElement := false; + break; + fi; + od; + if not(CentralElement) then + K0 := GroupByGenerators(RECOG.CentraliserOfInvolution(G,taun,[],true,100,RECOG.CompletionCheck,PseudoRandom)[1]); + K := RECOG.DerivedSubgroupMonteCarlo(K0,20); + return [K,SLPOfElms(GeneratorsOfGroup(K))]; + fi; + fi;; + count := count + 1; + od; + + return fail; +end; + + + +# Extracting the two factors is done by the methods descibed by Leedham-Green and O'Brien in "Constructive recognition of classical groups in odd characteristic" +# Section 11 +# Note that the method for even involutions is not implemented in GAP yet and so there is no method for extracting the two factors in even characteristic +RECOG.ExtractTwoSL2Factors := function(h, q) +local counter, ele, x, x2, ord, invo, found, cent, product, eigenspace, Minuseigenspace, newbasis, dimeigen, dimMinuseigen, r1, r2, result, result2; + + if not(IsObjWithMemory(GeneratorsOfGroup(h)[1])) then + h := GroupWithMemory(h); + fi; + + # First we construct an involution i in h + + found := false; + for counter in [1..100] do + ele := PseudoRandom(h); + x := RECOG.EstimateOrder(ele); + x2 := x[2]; + ord := x[3]; + if x2 <> One(h) then + invo := x2^(ord/2); + else + invo := One(h); + fi; + + if invo <> One(h) and invo^2 = One(h) then + eigenspace := Eigenspaces(GF(q),invo); + if Size(eigenspace) <> 1 then + Minuseigenspace := eigenspace[2]; + eigenspace := eigenspace[1]; + dimeigen := Dimension(eigenspace); + dimMinuseigen := Dimension(Minuseigenspace); + if dimeigen = 2 then + found := true; + break; + fi; + fi; + fi; + od; + + if not(found) then + Error("could not find an involution"); + fi; + + newbasis := MutableCopyMat(BasisVectors(Basis(eigenspace))); + Append(newbasis,BasisVectors(Basis(Minuseigenspace))); + + if not(Determinant(newbasis) = One(GF(q))) then + newbasis[4] := Determinant(newbasis)^(-1)*newbasis[4]; + fi; + + # Second we compute the two factors by computing the centralizer of the involution i + + cent := RECOG.CentraliserOfInvolution(h,invo,[],true,100,RECOG.CompletionCheck,PseudoRandom); + product := GroupByGenerators(cent[1]); + + # Third we continue as in "Constructive recognition of classical groups in odd characteristic" part 11 to find generator + + r1 := [3,4]; + r2 := [1,2]; + for counter in [1..200] do + result := RECOG.ConstructSmallSub(r1, r2, product, newbasis, g -> RECOG.IsThisSL2Natural(GeneratorsOfGroup(g),GF(q))); + if result <> fail then + break; + fi; + od; + if result = fail then + return fail; + fi; + + r1 := [1,2]; + r2 := [3,4]; + for counter in [1..200] do + result2 := RECOG.ConstructSmallSub(r1, r2, product, newbasis, g -> RECOG.IsThisSL2Natural(GeneratorsOfGroup(g),GF(q))); + if result2 <> fail then + break; + fi; + od; + if result2 = fail then + return fail; + fi; + + return [result[1], result2[1], result[2], result2[2], newbasis]; + +end; + + + +################################################################################################### +################################################################################################### +######## Test version for Sp(n,2^f) ############################################################### +################################################################################################### +################################################################################################### + + + + +RECOG.MakeSp_StdGens := function(p,ext,n,d) + local a,b,c,f,i,q,s,t,u,x,res,l1,l2; + f := GF(p,ext); + q := Size(f); + l1 := [2..n/2]; + Add(l1,1); + l2 := [n/2+2..n]; + Add(l2,n/2+1); + a := PermutationMat(PermList(l1)*MappingPermListList(l2,[(n/2)+1..n]),d,f); + ConvertToMatrixRep(a,q); + b := PermutationMat((1,2)(n-1,n),d,GF(q)); + ConvertToMatrixRep(b,q); + c := PermutationMat((1,n),d,GF(q)); + c[n,1] := -1*One(f); + ConvertToMatrixRep(c,q); + s := []; + t := []; + u := []; + for i in [0..ext-1] do + x := IdentityMat(d,f); + x[1,2] := Z(p,ext)^i; + x[n-1,n] := -1*Z(p,ext)^i; + Add(s,x); + x := IdentityMat(d,f); + x[2,1] := Z(p,ext)^i; + x[n,n-1] := -1*Z(p,ext)^i; + Add(t,x); + x := IdentityMat(d,f); + x[1,n] := Z(p,ext)^i; + Add(u,x); + od; + res := rec( s := s, t := t, u := u, a := a, b := b, c:= c, f := f, q := q, p := p, + ext := ext, One := IdentityMat(d,f), one := One(f), + d := d ); + res.all := Concatenation( res.s, res.t, res.u, [res.a], [res.b], [res.c] ); + return res; +end; \ No newline at end of file diff --git a/gap/projective/constructive_recognition/Sp/GoingDown.gi b/gap/projective/constructive_recognition/Sp/GoingDown.gi new file mode 100644 index 000000000..202e18a99 --- /dev/null +++ b/gap/projective/constructive_recognition/Sp/GoingDown.gi @@ -0,0 +1,325 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +############################################################################# + + + +############################################################################# +############################################################################# +######## GoingDown method for symplectic groups ############################# +############################################################################# +############################################################################# + + + +RECOG.Sp_godownToDimension6 := function(h,q) +local counter, ele, x, x2, ord, invo, found, cent, product, eigenspace, Minuseigenspace, newbasis, dimeigen, dimMinuseigen, r1, r2, result; + + if not(IsObjWithMemory(GeneratorsOfGroup(h)[1])) then + h := GroupWithMemory(h); + fi; + + # First we construct an involution i in h + + found := false; + for counter in [1..100] do + ele := PseudoRandom(h); + x := RECOG.EstimateOrder(ele); + x2 := x[2]; + ord := x[3]; + if x2 <> One(h) then + invo := x2^(ord/2); + else + invo := One(h); + fi; + + if invo <> One(h) and invo^2 = One(h) then + eigenspace := Eigenspaces(GF(q),invo); + if Size(eigenspace) <> 1 then + Minuseigenspace := eigenspace[2]; + eigenspace := eigenspace[1]; + dimeigen := Dimension(eigenspace); + dimMinuseigen := Dimension(Minuseigenspace); + if dimeigen = 6 or dimMinuseigen = 6 then + found := true; + break; + fi; + fi; + fi; + od; + + if not(found) then + Error("could not find an involution"); + fi; + + newbasis := MutableCopyMat(BasisVectors(Basis(eigenspace))); + Append(newbasis,BasisVectors(Basis(Minuseigenspace))); + + # Second we compute the two factors by computing the centralizer of the involution i + + cent := RECOG.CentraliserOfInvolution(h,invo,[],true,100,RECOG.CompletionCheck,PseudoRandom); + product := GroupByGenerators(cent[1]); + + # Third we continue as in "Constructive recognition of classical groups in odd characteristic" part 11 to find generator + + if dimeigen = 6 then + r1 := [1..6]; + r2 := [7..8]; + else + r1 := [3..8]; + r2 := [1..2]; + fi; + for counter in [1..100] do + result := RECOG.ConstructSmallSub(r1, r2, product, newbasis, g -> RecogniseClassical(g).isSpContained); + if result <> fail then + break; + fi; + od; + + return result; + +end; + + +# This function is sometimes slow ---> some problem after computing tau. Is tau correct??? +# Construct a naturally embedded Sp4 of Sp6 +RECOG.Sp_godownToDimension4 := function(h,q) + + if not(IsObjWithMemory(GeneratorsOfGroup(h)[1])) then + h := GroupWithMemory(h); + fi; + + if q <= 5 then + return RECOG.ConstructSp4OddSmall(h,q); + else + return RECOG.ConstructSp4OddLarge(h,q); + fi; + +end; + + + +RECOG.IsSp4SmallTauElement := function(tau,q,list) +local entry, ppd4k, ord, prime; + + ord := Order(tau); + if (ord mod q = 0) then + for entry in list do + ppd4k := entry[2]; + for prime in ppd4k do + if (ord mod prime = 0) then + return true; + fi; + od; + od; + else + return false; + fi; + + return false; + +end; + + + +# called by Sp_godownToDimension4 to construct a naturally embedded Sp4 of Sp6 +# ConstructJOddSmall in Clarkson's thesis +RECOG.ConstructSp4OddSmall := function(h,q) +local tau, t, g1, g2, g3, g, counter, testgroup, smalltestgroup, preparelist, k, newentry, ppd, new, p, reco; + + counter := 1; + + preparelist := []; + p := Factors(q)[1]; + # TODO: Adjust to ppd# elements. See Dissertation Kenneth Clarkson (Eamonns student) + for k in [1..10] do + new := [k]; + ppd := PrimitivePrimeDivisors( 4*k, p ); + Add(new,PrimeDivisors(ppd.ppds)); + Add(preparelist,new); + od; + + Info(InfoRecog,2,"Precomputation finished"); + + while counter < 100 do + tau := PseudoRandom(h); + if RECOG.IsSp4SmallTauElement(tau,q,preparelist) and (Order(tau^(q^2+1)) <> 1) then + t := tau^(q^2+1); + #a := tau^(2*(q^2-q+1)); + Info(InfoRecog,2,"Found tau"); + while counter < 100 do + g1 := PseudoRandom(h); + g2 := PseudoRandom(h); + g3 := PseudoRandom(h); + testgroup := GroupByGenerators([t,t^g1,t^g2,t^g3]); + smalltestgroup := RECOG.LinearActionRepresentation(testgroup); + reco := RecogniseClassical(smalltestgroup); + if (reco.d = 4) and reco.isSpContained then + Info(InfoRecog,2,"Found Sp(4,q)"); + return [testgroup,smalltestgroup]; + fi; + counter := counter + 1; + od; + fi; + counter := counter + 1; + od; + + return fail; + +end; + + + +RECOG.IsSp4LargeTauElement := function(tau,q,list,extra) +local entry, foundFirst, foundSecond, ppdk, ppd4k, ord, prime; + + ord := Order(tau); + entry := extra; + if Size(DuplicateFreeList(Factors(ord))) <> 1 then + ppd4k := entry[2]; + for prime in ppd4k do + if (ord mod prime = 0) then + return true; + fi; + od; + fi; + for entry in list do + foundFirst := false; + foundSecond := false; + + ppdk := entry[2]; + for prime in ppdk do + if (ord mod prime = 0) then + foundFirst := true; + break; + fi; + od; + + if foundFirst then + ppd4k := entry[3]; + for prime in ppd4k do + if (ord mod prime = 0) then + return true; + fi; + od; + fi; + + od; + + return false; +end; + + + +# Next function correct??? +RECOG.ConstructSp4OddLarge := function(h,q) +local tau, a, g, counter, testgroup, smalltestgroup, preparelist, k, newentry, ppd, new, p, reco, extra; + + counter := 1; + + preparelist := []; + p := Factors(q)[1]; + # TODO: Adjust to ppd# elements. See Dissertation Kenneth Clarkson (Eamonns student) + if (q mod 2 = 0) then + # TODO + else + extra := [1,PrimeDivisors(PrimitivePrimeDivisors( 1, p ).ppds)]; + for k in [2..10] do + new := [k]; + ppd := PrimitivePrimeDivisors( k, p ); + Add(new,PrimeDivisors(ppd.ppds)); + ppd := PrimitivePrimeDivisors( 4*k, p ); + Add(new,PrimeDivisors(ppd.ppds)); + Add(preparelist,new); + od; + fi; + + Info(InfoRecog,2,"Precomputation finished"); + + while counter < 100 do + tau := PseudoRandom(h); + if RECOG.IsSp4LargeTauElement(tau,q,preparelist,extra) and (Order(tau^(q^2+1)) <> 1) then + a := tau^(q^2+1); + #a := tau^(2*(q^2-q+1)); + Info(InfoRecog,2,"Found tau"); + while counter < 100 do + g := PseudoRandom(h); + testgroup := GroupByGenerators([a,a^g]); + smalltestgroup := RECOG.LinearActionRepresentation(testgroup); + if smalltestgroup <> fail then + reco := RecogniseClassical(smalltestgroup); + if (reco.d = 4) and reco.isSpContained = true then + Info(InfoRecog,2,"Found Sp(4,q)"); + return [testgroup,smalltestgroup]; + fi; + fi; + counter := counter + 1; + od; + fi; + counter := counter + 1; + od; + + if counter >= 100 then + return fail; + fi; +end; + + + +RECOG.Spn_constructsp4:=function(g,d,q,form) +local r,h,basechange,basechange2,basechange3,liftbasechange2,liftbasechange3,liftr,i,rr,slp; + + if IsEvenInt(q) then + Error("not supported"); + fi; + + r := RECOG.constructppdTwoStingray(g,d,q,"Sp",form); + Info(InfoRecog,2,"Finished main GoingDown, i.e. we found a natural embedded Sp(8,q). \n"); + + # For now, compute a base change into the stingray matrices + basechange := RECOG.ComputeBlockBaseChangeMatrix(GeneratorsOfGroup(r),d,q); + slp := SLPOfElms(GeneratorsOfGroup(r)); + + r := RECOG.Sp_godownToDimension6(RECOG.ExtractSmallerGroup(GeneratorsOfGroup(r),basechange,8)[1],q); + basechange2 := RECOG.ComputeBlockBaseChangeMatrix(r[1],8,q); + slp := CompositionOfStraightLinePrograms(SLPOfElms(r[1]),slp); + # Remark D.R.: at this point we know that h is isomorphic to Sp(6,q) + Info(InfoRecog,2,"Succesful. "); + Info(InfoRecog,2,"Current Dimension: 6\n"); + Info(InfoRecog,2,"Next goal: Generate Sp(4,q). \n"); + + i := 1; + repeat + rr := RECOG.Sp_godownToDimension4(RECOG.ExtractSmallerGroup(r[1],basechange2,6)[1],q); + i := i + 1; + until i >= 10 or rr <> fail; + + r := rr; + if r = fail then + return fail; + fi; + slp := CompositionOfStraightLinePrograms(SLPOfElms(GeneratorsOfGroup(r[1])),slp); + basechange3 := RECOG.ComputeBlockBaseChangeMatrix(GeneratorsOfGroup(r[1]),6,q); + + liftbasechange2 := RECOG.LiftGroup([basechange2],8,q,d)[2,1]; + liftbasechange3 := RECOG.LiftGroup([basechange3],6,q,d)[2,1]; + + liftr := RECOG.LiftGroup(GeneratorsOfGroup(r[1]),6,q,d)[2]; + for i in [1..Size(liftr)] do + liftr[i] := liftr[i]^(liftbasechange3^(-1)); + od; + + return [GroupByGenerators(liftr),liftbasechange3*liftbasechange2*basechange,[basechange,liftbasechange2,liftbasechange3],slp]; +end; + diff --git a/gap/projective/constructive_recognition/Sp/GoingUp.gi b/gap/projective/constructive_recognition/Sp/GoingUp.gi new file mode 100644 index 000000000..da3bbc34d --- /dev/null +++ b/gap/projective/constructive_recognition/Sp/GoingUp.gi @@ -0,0 +1,1013 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +############################################################################# + + + +############################################################################# +############################################################################# +######## GoingUp method for symplectic groups ############################### +############################################################################# +############################################################################# + + + +RECOG.ComputeCorrectingPermutationMatSp:= function(d,F,n,aimdim) +local list, half; + + list := Concatenation([n+1..aimdim],[(n/2)+1..n]); + + return PermutationMat(MappingPermListList([(n/2)+1..aimdim],list)^(-1),d,F); + +end; + + + +RECOG.ComputeCorrectingPermutationMatSpTwo:= function(d,F,n,aimdim) +local list, list1, list2, mat, more; + + mat := IdentityMat(d,F); + more := aimdim - n; + list1 := [1..more]; + list2 := Reversed(Filtered(list1,x->IsEvenInt(x))); + list1 := Filtered(list1,x->IsOddInt(x)); + list := Concatenation(list1,list2); + + mat{[n+1..aimdim]}{[n+1..aimdim]} := PermutationMat(MappingPermListList([1..more],list)^(-1),more,F); + return mat; + +end; + + + +RECOG.SymplecticGroupStandardGenerators := function(d,n,q,f,F) +local s,u,v,diag,upper,lower, gens, list1, list2, ele, omega, i, one; + + gens := [3*f+4]; + upper := [1..f]; + lower := [1..f]; + diag := [1..f]; + + s := PermutationMat((1,n),d,F); + s[n,1] := -1*One(F); + ConvertToMatrixRepNC(s,F); + + u := PermutationMat((1,2)(n-1,n),d,F); + ConvertToMatrixRepNC(u,F); + + list1 := [1..n/2]; + list2 := Reversed([n/2+1..n]); + v := PermutationMat(CycleFromList(list1)*CycleFromList(list2),d,F); + ConvertToMatrixRepNC(v,F); + + omega := PrimitiveElement(F); + one := IdentityMat(d,F); + for i in [1..f] do + ele := MutableCopyMat(one); + ele[1,2] := omega^(i-1); + ele[n-1,n] := -1*omega^(i-1); + ConvertToMatrixRepNC(ele,F); + upper[i] := ele; + ele := MutableCopyMat(one); + ele[2,1] := omega^(i-1); + ele[n,n-1] := -1*omega^(i-1); + ConvertToMatrixRepNC(ele,F); + lower[i] := ele; + ele := MutableCopyMat(one); + ele[1,n] := omega^(i-1); + ConvertToMatrixRepNC(ele,F); + diag[i] := ele; + od; + + ele := MutableCopyMat(one); + ele[1,1] := omega; + ele[n,n] := omega^(-1); + + gens{[1..f]} := upper; + gens{[f+1..2*f]} := lower; + gens{[2*f+1..3*f]} := diag; + gens[3*f+1] := v; + gens[3*f+2] := u; + gens[3*f+3] := s; + gens[3*f+4] := ele; + + return gens; +end; + + + +RECOG.WriteLAsWord := function(L,n,d,onef,spnstdf,q,f,bool) +local tf, value, i, j, omega, basis, coeffs, coeff, trans, diag, s, v, u, shift, one, t, turn; + + #one := IdentityMat(n,GF(q)); + if bool then + trans := spnstdf{[1..f]}; + else + trans := spnstdf{[f+1..2*f]}; + fi; + + v := spnstdf[3*f+1]; + u := spnstdf[3*f+2]; + s := spnstdf[3*f+3]; + shift := v*u; + + diag := spnstdf{[2*f+1..3*f]}; + + omega := PrimitiveElement(GF(q)); + basis := [1..f]; + for i in [0..f-1] do + basis[i+1] := omega^i; + od; + basis := Basis(GF(q),basis); + + for i in [2..(n/2)] do + if bool then + value := L[1,i]; + else + value := L[i,1]; + fi; + coeffs := Coefficients(basis,value); + for j in [1..f] do + coeff := Int(coeffs[j]); + onef := onef * trans[j]^coeff; + od; + trans := List(trans,x->x^shift); + #t := IdentityMat(n,GF(q)); + #if bool then + # t[1,i] := value; + # t[n-i+1,n] := -1*value; + #else + # t[i,1] := value; + # t[n,n-i+1] := -1*value; + #fi; + #one := one*t; + od; + + if bool then + trans := spnstdf{[f+1..2*f]}; + else + trans := spnstdf{[1..f]}; + fi; + + trans := List(trans,x->x^(shift^((n/2)-2))); + trans := List(trans,x->x^s); + + for i in [(n/2)+1..n-1] do + if bool then + value := L[1,i]; + else + value := L[i,1]; + fi; + coeffs := Coefficients(basis,value); + for j in [1..f] do + coeff := Int(coeffs[j]); + onef := onef * trans[j]^coeff; + od; + trans := List(trans,x->x^(shift^(-1))); + #t := IdentityMat(n,GF(q)); + #if bool then + # t[1,i] := value; + # t[n-i+1,n] := value; + #else + # t[i,1] := value; + # t[n,n-i+1] := value; + #fi; + #one := one*t; + od; + + if bool then + value := RECOG.ComputeCornerEntry((L{[1]}{[2..n-1]})[1],n-2,GF(q)); + #value := one[1,n]; + coeffs := Coefficients(basis,-1*value); + for j in [1..f] do + coeff := Int(coeffs[j]); + onef := onef * diag[j]^coeff; + od; + else + #value := one[n,1]; + value := -1*RECOG.ComputeCornerEntry((L{[1]}{[2..n-1]})[1],n-2,GF(q)); + coeffs := Coefficients(basis,value); + turn := diag[1]^0; + for j in [1..f] do + coeff := Int(coeffs[j]); + turn := turn * diag[j]^coeff; + od; + turn := turn^s; + onef := onef*turn; + fi; + + return onef; + +end; + + + +RECOG.WriteUpperKillerAsWord := function(L,n,d,onef,trans1,trans2,diag,v,u,s,q,f) +local tf, value, i, j, omega, basis, coeffs, coeff, trans, shift, one, t, turn; + + #one := IdentityMat(n,GF(q)); + shift := v*u; + + omega := PrimitiveElement(GF(q)); + basis := [1..f]; + for i in [0..f-1] do + basis[i+1] := omega^i; + od; + basis := Basis(GF(q),basis); + + for i in [2..(n/2)] do + value := L[1,i]; + coeffs := Coefficients(basis,value); + for j in [1..f] do + coeff := Int(coeffs[j]); + onef := onef * trans1[(i-2)*f+j]^coeff; + od; + #t := IdentityMat(n,GF(q)); + #t[1,i] := value; + #t[n-i+1,n] := -1*value; + #one := one*t; + od; + + for i in [2..(n/2)] do + value := L[1,(n/2)+i-1]; + coeffs := Coefficients(basis,value); + for j in [1..f] do + coeff := Int(coeffs[j]); + onef := onef * trans2[(i-2)*f+j]^coeff; + od; + #t := IdentityMat(n,GF(q)); + #t[1,(n/2)+i-1] := value; + #t[n-((n/2)+i-1)+1,n] := value; + #one := one*t; + od; + + value := L[1,n]-RECOG.ComputeCornerEntry((L{[1]}{[2..n-1]})[1],n-2,GF(q)); + #value := L[1,n]-one[1,n]; + coeffs := Coefficients(basis,value); + for j in [1..f] do + coeff := Int(coeffs[j]); + onef := onef * diag[j]^coeff; + od; + + return onef; + +end; + + + +RECOG.WriteLowerKillerAsWord := function(L,n,d,onef,trans1,trans2,diag,v,u,s,q,f) +local tf, value, i, j, omega, basis, coeffs, coeff, trans, shift, one, t, turn; + + #one := IdentityMat(n,GF(q)); + shift := v*u; + + omega := PrimitiveElement(GF(q)); + basis := [1..f]; + for i in [0..f-1] do + basis[i+1] := omega^i; + od; + basis := Basis(GF(q),basis); + + for i in [2..(n/2)] do + value := L[i,1]; + coeffs := Coefficients(basis,value); + for j in [1..f] do + coeff := Int(coeffs[j]); + onef := onef * trans1[(i-2)*f+j]^coeff; + od; + #t := IdentityMat(n,GF(q)); + #t[i,1] := value; + #t[n,n-i+1] := -1*value; + #one := one*t; + od; + + for i in [2..(n/2)] do + value := L[(n/2)+i-1,1]; + coeffs := Coefficients(basis,value); + for j in [1..f] do + coeff := Int(coeffs[j]); + onef := onef * trans2[(i-2)*f+j]^coeff; + od; + #t := IdentityMat(n,GF(q)); + #t[(n/2)+i-1,1] := value; + #t[n,n-((n/2)+i-1)+1] := value; + #one := one*t; + od; + + value := -1*(L[n,1]-(-1*RECOG.ComputeCornerEntry((TransposedMat(L){[1]}{[2..n-1]})[1],n-2,GF(q)))); + #value := -1*(L[n,1]-one[n,1]); + coeffs := Coefficients(basis,value); + turn := diag[1]^0; + for j in [1..f] do + coeff := Int(coeffs[j]); + turn := turn * diag[j]^coeff; + od; + turn := turn^s; + onef := onef*turn; + + return onef; + +end; + + + +RECOG.ComputeCornerEntry := function(list, length, F) +local value, i; + + value := Zero(F); + for i in [1..length/2] do + value := value + list[i] * list[length-i+1]; + od; + + return value; + +end; + + + +# change input into H again +RECOG.Spn_UpStep := function(w) +# w has components: +# d : size of big Sp +# n : size of small Sp +# spnstdf : fakegens for Sp_n standard generators +# bas : current base change, first n vectors are where Sp_n acts +# rest of vecs are invariant under Sp_n +# basi : current inverse of bas +# sld : original group with memory generators, PseudoRandom +# delivers random elements +# sldf : fake generators to keep track of what we are doing +# f : field +# The following are filled in automatically if not already there: +# p : characteristic +# ext : q=p^ext +# One : One(slnstdf[1]) +# can : CanonicalBasis(f) +# canb : BasisVectors(can) +# transh : fakegens for the "horizontal" transvections n,i for 1<=i<=n/2 +# entries can be unbound in which case they are made from spnstdf +# transv : fakegens for the "vertical" transvections i,n for 1<=i<=n/2 +# entries can be unbound in which case they are made from spnstdf +# +# We keep the following invariants (going from n -> n':=2n-2) +# bas, basi is a base change to the target base +# spnstdf are SLPs to reach standard generators of Sp_n from the +# generators of sld +local d, id, q, F, t, GM, counter, aimdim, newdim, c1, c, ci, sum1, int1, i, v1, v2, L1, L2, newpart, zerovec, MB, newbas, newbasi, factors, ext, HBig, +int3, pivots, cii, pivots2, newbasechange, trans, tf, tw, lambda, killer, transr, vectorlist, VC, CanonicalVC, LinearCombinationVector, transd, vectorlist2, indexlist, +p, VCBuildBasis, vectorlistele, VCBasis, vectorlistindex, flag, v, s, PermMat3, PermMat, PermMat2, ChangeToCorrectForm, ChangeToCorrectFormBig2, ChangeToCorrectFormBig22, +ChangeToCorrectForm2, ChangeToCorrectFormBig, WrongForm, FormValue, HSmall, extract, HBigGens, WrongForm2, H, G, n, basechange, L1w, L2w, initele, pos, k, shift, pos2, tfw, tfvalue, vectorlistscalar, currentvector, +slp, c1w, cw, cwi, HFake, HBigF, FakeBigGens, SuperFake, killerw, transw, newtransv, begintransv, difftransv, ciT; + + Info(InfoRecog,3,"Going up: ",w.n," (",w.d,")..."); + + # Before we begin, we upgrade the data structure with a few internal + # things: + + if not(IsBound(w.can)) then w.can := CanonicalBasis(w.f); fi; + if not(IsBound(w.canb)) then w.canb := BasisVectors(w.can); fi; + if not(IsBound(w.One)) then w.One := One(w.spnstdf[1]); fi; + if not(IsBound(w.transh1)) then w.transh1 := []; fi; + if not(IsBound(w.transv1)) then w.transv1 := []; fi; + w.transv2 := []; + w.transh2 := []; + + for k in [1..w.ext] do + pos := k; + if not(IsBound(w.transh1[pos])) then + w.transh1[pos] := w.spnstdf[k]; + fi; + if not(IsBound(w.transv1[pos])) then + w.transv1[pos] := w.spnstdf[w.ext + k]; + fi; + od; + + shift := w.spnstdf[3*w.ext + 1] * w.spnstdf[3*w.ext + 2]; + for i in [3..(w.n)/2] do + for k in [1..w.ext] do + pos := (i-2)*w.ext + k; + if not(IsBound(w.transh1[pos])) then + # TODO: Remove initele + initele := One(w.spnstdf[1]); + initele := (initele * w.transh1[pos-w.ext])^shift; + w.transh1[pos] := initele; + fi; + if not(IsBound(w.transv1[pos])) then + # TODO: Remove initele + initele := One(w.spnstdf[1]); + initele := (initele * w.transv1[pos-w.ext])^shift; + w.transv1[pos] := initele; + fi; + od; + od; + + for k in [1..w.ext] do + pos := k; + pos2 := ((w.n)/2-2)*w.ext+k; + if not(IsBound(w.transv2[pos])) then + initele := One(w.spnstdf[1]); + initele := (initele * w.transh1[pos2])^w.spnstdf[3*w.ext + 3]; + w.transv2[pos] := initele; + fi; + if not(IsBound(w.transh2[pos])) then + initele := One(w.spnstdf[1]); + initele := (initele * w.transv1[pos2])^w.spnstdf[3*w.ext + 3]; + w.transh2[pos] := initele; + fi; + od; + + shift := shift^(-1); + for i in [3..(w.n)/2] do + for k in [1..w.ext] do + pos := (i-2)*w.ext + k; + if not(IsBound(w.transh2[pos])) then + initele := One(w.spnstdf[1]); + initele := (initele * w.transh2[pos-w.ext])^shift; + w.transh2[pos] := initele; + fi; + if not(IsBound(w.transv2[pos])) then + initele := One(w.spnstdf[1]); + initele := (initele * w.transv2[pos-w.ext])^shift; + w.transv2[pos] := initele; + fi; + od; + od; + + H := GroupByGenerators(w.spnstdf); + G := w.sld; + n := w.n; + basechange := w.bas; + + d := w.d; + p := w.p; + ext := w.ext; + q := p^ext; + F := GF(q); + + # Here everything starts, some more preparations: + + # We compute exclusively in our basis, so we occasionally need an + # identity matrix: + id := IdentityMat(d,F); + + Info(InfoRecog,2,"Current dimension: " ); + Info(InfoRecog,2,n); + Info(InfoRecog,2,"\n"); + Info(InfoRecog,2,"New dimension: "); + Info(InfoRecog,2,Minimum(2*n-2,d)); + Info(InfoRecog,2,"\n"); + + Info(InfoRecog,2,"Preparation done."); + + # Next step also correct for characteristic 2? + if p = 2 then + Error("todo"); + else + t := PermutationMat(CycleFromList([1..n/2])*CycleFromList(Reversed([(n/2)+1..n])),d,F); + tw := w.spnstdf[3*w.ext+1]; + fi; + + Info(InfoRecog,2,"Step 1 done."); + + # Find a good random element: + w.count := 0; + aimdim := Minimum(2*n-2,d); + newdim := aimdim - n; + counter := 0; + while true do # will be left by break + while true do # will be left by break + counter := counter + 1; + w.count := w.count + 1; + if InfoLevel(InfoRecog) >= 3 then Print(".\c"); fi; + c1 := PseudoRandom(G); + + # Do the base change into our basis: + c := t^(w.bas * c1 * w.basi); + + sum1 := SumIntersectionMat(c{[1..n]},id{[1..n]}); + + if Size(sum1[1]) = aimdim then + + int1 := SumIntersectionMat(RECOG.FixspaceMat(c),id{[1..n]})[2]; + + for i in [1..Size(int1)] do + v1 := int1[i]; + if not(IsZero(v1[1])) then break; fi; + od; + for i in [1..Size(int1)] do + v2 := int1[i]; + if (v1 <> v2) and not(IsZero(v2[n])) then break; fi; + od; + if (v1 = v2) or IsZero(v1[1]) or IsZero(v2[n]) then + Info(InfoRecog,2,"Ooops: Component n was zero!"); + continue; + fi; + + v1 := v1 / v1[1]; # normalize to 1 in position n + Assert(1,v1*c=v1); + + L1 := IdentityMat(d,F); + L2 := IdentityMat(d,F); + + for i in [2..n-1] do + L1[1,i] := v1[i]; + if i <= n/2 then + L1[n-i+1,n] := -1*v1[i]; + else + L1[n-i+1,n] := v1[i]; + fi; + od; + if v1[n] <> Zero(F) then + L1[1,n] := v1[n]; + fi; + + c := L1*c*L1^(-1); + int1 := SumIntersectionMat(RECOG.FixspaceMat(c),id{[1..n]})[2]; + for i in [1..Size(int1)] do + v2 := int1[i]; + if not(IsZero(v2[n])) then break; fi; + od; + + if IsZero(v2[n]) then + Info(InfoRecog,2,"Ooops: Component n was zero!"); + continue; + fi; + + v2 := v2 / v2[n]; # normalize to 1 in position n + Assert(1,v2*c=v2); + + for i in [2..n-1] do + L2[n,i] := v2[i]; + if i <= n/2 then + L2[n-i+1,1] := v2[i]; + else + L2[n-i+1,1] := -1*v2[i]; + fi; + od; + if v2[1] <> Zero(F) then + L2[n,1] := v2[1]; + fi; + + c := L2*c*L2^(-1); + ci := c^-1; + + break; + fi; + od; + + # We have to write L1 and L2 as words in spnstdf + L1w := RECOG.WriteLAsWord(L1,n,d,w.One,w.spnstdf,q,ext,true); + L2w := RECOG.WriteLAsWord(L2,n,d,w.One,w.spnstdf,q,ext,false); + + # Save the SLP for c + slp := SLPOfElm(c1); + c1w := ResultOfStraightLineProgram(slp,w.sldf); + cw := tw^c1w; + cw := L1w*cw*L1w^(-1); + cw := L2w*cw*L2w^(-1); + cwi := cw^-1; + + Info(InfoRecog,2,"Step 2 done."); + + # Now we found our aimdim-dimensional space W. Since Sp_n + # has a d-n-dimensional fixed space W_{d-n} and W contains a complement + # of that fixed space, the intersection of W and W_{d-n} has dimension + # newdim. + + # Change basis: + newpart := ExtractSubMatrix(c,[2..(n-1)],[1..(d)]); + # Clean out the first n entries to go to the fixed space of Sp_n: + zerovec := Zero(newpart[1]); + for i in [1..(n-2)] do + CopySubVector(zerovec,newpart[i],[1..n],[1..n]); + od; + MB := MutableBasis(F,[],zerovec); + i := 1; + pivots := EmptyPlist(newdim); + while i <= Length(newpart) and NrBasisVectors(MB) < newdim do + if not(IsContainedInSpan(MB,newpart[i])) then + Add(pivots,i); + CloseMutableBasis(MB,newpart[i]); + fi; + i := i + 1; + od; + newpart := newpart{pivots}; + newbas := Concatenation(id{[1..n]},newpart); + if 2*n-2 < d then + int3 := SumIntersectionMat(RECOG.FixspaceMat(c),id{[n+1..d]})[2]; + if Size(int3) <> d - aimdim then + Info(InfoRecog,2,"Ooops, FixSLn \cap Fixc wrong dimension"); + continue; + fi; + Append(newbas,int3); + fi; + ConvertToMatrixRep(newbas,Size(F)); + newbasi := newbas^-1; + if newbasi = fail then + Info(InfoRecog,2,"Ooops, Fixc intersected too much, we try again"); + continue; + fi; + + ci := newbas * ci * newbasi; + + cii := ExtractSubMatrix(ci,[n+1..aimdim],[2..n-1]); + ConvertToMatrixRep(cii,Size(F)); + cii := TransposedMat(cii); + # The rows of cii are now what used to be the columns, + # their length is newdim, we need to span the full newdim-dimensional + # row space and need to remember how: + zerovec := Zero(cii[1]); + MB := MutableBasis(F,[],zerovec); + i := 1; + pivots2 := EmptyPlist(newdim); + while i <= Length(cii) and NrBasisVectors(MB) < newdim do + if not(IsContainedInSpan(MB,cii[i])) then + Add(pivots2,i); + CloseMutableBasis(MB,cii[i]); + fi; + i := i + 1; + od; + if Length(pivots2) = newdim then + cii := cii{pivots2}^-1; + ConvertToMatrixRep(cii,F); + c := newbas * c * newbasi; + newbasechange := newbas*basechange; + w.bas := newbas * w.bas; + w.basi := w.basi * newbasi; + break; + fi; + Info(InfoRecog,2,"Ooops, no nice bottom..."); + # Otherwise simply try again + od; + + Info(InfoRecog,2,"Begin with form change"); + + # Transform the form into standard form + HFake := RECOG.LiftGroup(GeneratorsOfGroup(Sp(n,q)),n,q,d)[1]; + HBigGens := List(GeneratorsOfGroup(HFake),MutableCopyMat); + Append(HBigGens,GeneratorsOfGroup(HFake^c)); + HBig := GroupByGenerators(HBigGens); + basechange := newbasechange; + HSmall := GroupByGenerators(List(GeneratorsOfGroup(HBig),x->x{[1..aimdim]}{[1..aimdim]})); + WrongForm := PreservedSesquilinearForms(HSmall)[1]; + FormValue := (WrongForm!.matrix)[1,n]; + extract := BilinearFormByMatrix((FormValue^(-1)*WrongForm!.matrix){[n+1..aimdim]}{[n+1..aimdim]}, F ); + ChangeToCorrectForm := BaseChangeToCanonical(extract); + ChangeToCorrectFormBig := IdentityMat(aimdim,F); + ChangeToCorrectFormBig{[n+1..aimdim]}{[n+1..aimdim]} := ChangeToCorrectForm; + ChangeToCorrectFormBig2 := IdentityMat(d,F); + ChangeToCorrectFormBig2{[1..aimdim]}{[1..aimdim]} := ChangeToCorrectFormBig^(-1); + HBig := HBig^ChangeToCorrectFormBig2; + c := ChangeToCorrectFormBig2^(-1) * c * ChangeToCorrectFormBig2; + basechange := ChangeToCorrectFormBig2^(-1)*basechange; + w.bas := ChangeToCorrectFormBig2^(-1) * w.bas; + w.basi := w.basi * ChangeToCorrectFormBig2; + + if aimdim - n > 2 then + ChangeToCorrectFormBig22 := RECOG.ComputeCorrectingPermutationMatSpTwo(d,F,n,aimdim); + HBig := HBig^ChangeToCorrectFormBig22; + c := ChangeToCorrectFormBig22^(-1) * c * ChangeToCorrectFormBig22; + basechange := ChangeToCorrectFormBig22^(-1)*basechange; + w.bas := ChangeToCorrectFormBig22^(-1) * w.bas; + w.basi := w.basi * ChangeToCorrectFormBig22; + fi; + + ci := c^-1; + ciT := TransposedMat(ci); + + Info(InfoRecog,2,"End of form change"); + + # Now consider the transvections t_i: + # t_i : w.bas[j] -> w.bas[j] for j <> i and + # t_i : w.bas[i] -> w.bas[i] + ww + # We want to modify (t_i)^c such that it fixes w.bas{[1..w.n]}: + trans := []; + transw := []; + vectorlist := []; + vectorlistscalar := []; + + # If we are finishing up, we have to make sure, that the pivot elements are really pivot elements for the horizontal transvections. + # Otherwise we have to choose different pivots + if aimdim = w.GoalDim then + cii := ExtractSubMatrix(ci,[n+1..aimdim],[2..n-1]); + ConvertToMatrixRep(cii,Size(F)); + cii := TransposedMat(cii); + zerovec := Zero(cii[1]); + MB := MutableBasis(F,[],zerovec); + i := 1; + pivots2 := EmptyPlist(newdim); + while i <= Length(cii) and NrBasisVectors(MB) < newdim do + if not(IsContainedInSpan(MB,cii[i])) then + Add(pivots2,i); + CloseMutableBasis(MB,cii[i]); + fi; + i := i + 1; + od; + if NrBasisVectors(MB) < newdim then + Error("this should not happen"); + fi; + fi; + + for i in pivots2 do + for lambda in w.canb do + tf := IdentityMat(d,F); + tf{[2..n-1]}{[n]} := lambda * ci{[2..n-1]}{[i+1]}; + if i+1 <= n/2 then + tfw := w.One*w.transh2[Size(w.transh2)-(i*w.ext)+Position(w.canb,lambda)]; + tf{[1]}{[2..n-1]} := lambda * c{[n-i]}{[2..n-1]}; + Add(vectorlistscalar,lambda * c[n-i]{[n+1..aimdim]}); + else + tfw := (w.One*w.transh1[Size(w.transh1)-((i-n/2+1)*w.ext)+Position(w.canb,lambda)])^(-1); + tf{[1]}{[2..n-1]} := -1 * lambda * c{[n-i]}{[2..n-1]}; + Add(vectorlistscalar,-1*lambda * c[n-i]{[n+1..aimdim]}); + fi; + + # Now conjugate with c: + tfw := cwi*tfw*cw; + + # Now cleanup in column n above row n, the entries there + killerw := RECOG.WriteUpperKillerAsWord(tf{[1..n]}{[1..n]}^(-1),n,d,w.One,w.transh1,w.transh2,w.spnstdf{[2*ext+1..3*ext]},w.spnstdf[3*ext+1],w.spnstdf[3*ext+2],w.spnstdf[3*ext+3],q,ext); + tfw := killerw*tfw; + Add(vectorlist, lambda * ciT[i+1]{[n+1..aimdim]}); + Add(trans,tf); + Add(transw,tfw); + od; + od; + + # For now vector space variant. but change that! + VC := VectorSpace(GF(p),vectorlist); + VCBasis := Basis(VC,vectorlist); + ConvertToMatrixRep(vectorlist,F); + ConvertToMatrixRep(vectorlistscalar,F); + + # Now put together the clean ones by our knowledge of c^-1: + transd := []; + CanonicalVC := BasisVectors(CanonicalBasis(VC)); + for i in CanonicalVC do + LinearCombinationVector := Coefficients(VCBasis,i); + tf := IdentityMat(d,F); + tfw := w.One; + tfvalue := Zero(F); + currentvector := Zero(VC); + for lambda in [1..Size(LinearCombinationVector)] do + tfvalue := tfvalue + LinearCombinationVector[lambda]*(currentvector*vectorlist[lambda]); + currentvector := currentvector + LinearCombinationVector[lambda]*vectorlistscalar[lambda]; + tfw := tfw*transw[lambda]^Int(LinearCombinationVector[lambda]); + od; + tf[1,n] := tfvalue; + killerw := RECOG.WriteUpperKillerAsWord(tf{[1..n]}{[1..n]}^(-1),n,d,w.One,w.transh1,w.transh2,w.spnstdf{[2*ext+1..3*ext]},w.spnstdf[3*ext+1],w.spnstdf[3*ext+2],w.spnstdf[3*ext+3],q,ext); + tfw := killerw*tfw; + Add(transd,tfw); + od; + Unbind(trans); + Unbind(transw); + + Info(InfoRecog,2,"Step 5 done"); + + # Now to the "horizontal" transvections, first create them as SLPs: + trans := []; + transw := []; + vectorlist := []; + vectorlistscalar := []; + lambda := One(F); + + # If we are finishing up, we have to make sure, that the pivot elements are really pivot elements for the horizontal transvections. + # Otherwise we have to choose different pivots + if aimdim = w.GoalDim then + newpart := ExtractSubMatrix(c,[2..n-1],[n+1..aimdim]); + zerovec := Zero(newpart[1]); + MB := MutableBasis(F,[],zerovec); + i := 1; + pivots := EmptyPlist(newdim); + while i <= Length(newpart) and NrBasisVectors(MB) < newdim do + if not(IsContainedInSpan(MB,newpart[i])) then + Add(pivots,i); + CloseMutableBasis(MB,newpart[i]); + fi; + i := i + 1; + od; + fi; + + for i in pivots do + for lambda in w.canb do + tf := IdentityMat(d,F); + tf{[n]}{[2..n-1]} := lambda * c{[i+1]}{[2..n-1]}; + if i+1 <= n/2 then + tfw := w.One*w.transv2[Size(w.transv2)-(i*w.ext)+Position(w.canb,lambda)]; + tf{[2..n-1]}{[1]} := lambda * ci{[2..n-1]}{[n-i]}; + Add(vectorlistscalar,lambda * ciT[n-i]{[n+1..aimdim]}); + else + tfw := (w.One*w.transv1[Size(w.transv1)-((i-n/2+1)*w.ext)+Position(w.canb,lambda)])^(-1); + tf[n-i,1] := -1*lambda; + tf{[2..n-1]}{[1]} := -1*lambda * ci{[2..n-1]}{[n-i]}; + Add(vectorlistscalar, -1 * lambda * ciT[n-i]{[n+1..aimdim]}); + fi; + + # Now conjugate with c: + tfw := cwi*tfw*cw; + + killerw := RECOG.WriteLowerKillerAsWord(tf{[1..n]}{[1..n]}^(-1),n,d,w.One,w.transv1,w.transv2,w.spnstdf{[2*ext+1..3*ext]},w.spnstdf[3*ext+1],w.spnstdf[3*ext+2],w.spnstdf[3*ext+3],q,ext); + tfw := killerw*tfw; + Add(trans,tf); + Add(transw,tfw); + Add(vectorlist, lambda * c[i+1]{[n+1..aimdim]}); + od; + od; + + # For now vector space variant. but change that! + VC := VectorSpace(GF(p),vectorlist); + VCBasis := Basis(VC,vectorlist); + ConvertToMatrixRep(vectorlist,F); + ConvertToMatrixRep(vectorlistscalar,F); + + # Now put together the clean ones by our knowledge of c^-1: + transr := []; + CanonicalVC := BasisVectors(CanonicalBasis(VectorSpace(F,IdentityMat(aimdim-n,F)))); + for i in CanonicalVC do + LinearCombinationVector := Coefficients(VCBasis,i); + tf := IdentityMat(d,F); + tfvalue := Zero(F); + tfw := w.One; + tfvalue := Zero(F); + currentvector := Zero(VC); + for lambda in [1..Size(LinearCombinationVector)] do + tfvalue := tfvalue + LinearCombinationVector[lambda]*(currentvector*vectorlist[lambda]); + currentvector := currentvector + LinearCombinationVector[lambda]*vectorlistscalar[lambda]; + tfw := tfw*transw[lambda]^Int(LinearCombinationVector[lambda]); + od; + tf[n,1] := -1*tfvalue; + killerw := RECOG.WriteLowerKillerAsWord(tf{[1..n]}{[1..n]}^(-1),n,d,w.One,w.transv1,w.transv2,w.spnstdf{[2*ext+1..3*ext]},w.spnstdf[3*ext+1],w.spnstdf[3*ext+2],w.spnstdf[3*ext+3],q,ext); + tfw := killerw*tfw; + Add(transr,tfw); + od; + Unbind(trans); + Unbind(transw); + + Info(InfoRecog,2,"Step 6 done"); + + # From here on we distinguish three cases: + # * w.n = 4 + # * we finish off the constructive recognition + # * we have to do another step as the next thing + if w.n = 4 then + flag := false; + s := w.One; + PermMat3 := RECOG.ComputeCorrectingPermutationMatSp(d,F,n,aimdim); + v := w.spnstdf[3*ext+1]; + for i in [n-2,n-3..(n/2)] do + if flag then + # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + tf := transd[(i-1)*ext+1]*transr[i]^-1*transd[(i-1)*ext+1]; + else + # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + tf := transd[(i-1)*ext+1]^-1*transr[i]*transd[(i-1)*ext+1]^-1; + fi; + s := s * tf; + flag := not(flag); + od; + + # Finally put together the new long cycle: + v := ((w.spnstdf[3*ext+4]^((q-1)/2))^((v*s*w.spnstdf[3*ext+3])^(-1)))*(v*s); + w.spnstdf[3*ext+1] := v; + + newbasechange := PermMat3^(-1)*basechange; + w.bas := PermMat3^(-1) * w.bas; + w.basi := w.basi * PermMat3; + + # Now add the new transvections: + for i in [Size(transd)/2+1..Size(transd)] do + # w.transh[w.ext*(w.n-1)+w.ext*(i-1)+1] := transr[i]; + Add(w.transh1, transd[i]^(-1)); + od; + newtransv := transd{[1..Size(transd)/2]}; + Append(newtransv,w.transh2); + w.transh2 := newtransv; + w.n := aimdim; + Info(InfoRecog,2,"Step 7 done"); + return w; + fi; + + # We can finish off: + if aimdim = w.GoalDim then + # In this case we just finish off and do not bother with + # the transvections, we will only need the standard gens: + # Now put together the (newdim)-cycle: + # n+newdim -> n+newdim-1 -> ... -> n+1 -> n -> n+newdim + + flag := false; + s := w.One; + PermMat3 := RECOG.ComputeCorrectingPermutationMatSp(d,F,n,aimdim); + v := w.spnstdf[3*ext+1]; + if newdim/2 = 1 then + for i in [2] do + if flag then + # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + tf := transd[(i-1)*ext+1]*transr[i]^-1*transd[(i-1)*ext+1]; + else + # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + tf := transd[(i-1)*ext+1]^-1*transr[i]*transd[(i-1)*ext+1]^-1; + fi; + s := s * tf; + flag := not(flag); + od; + + # Finally put together the new long cycle: + + v := ((w.spnstdf[3*ext+4]^((q-1)/2))^((v*s*w.spnstdf[3*ext+3])^(-1)))*(v*s); + w.spnstdf[3*ext+1] := v; + else + for i in Reversed([Size(transr)-(newdim/2)+1..Size(transr)]) do + if flag then + # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + tf := transd[(i-1)*ext+1]*transr[i]^-1*transd[(i-1)*ext+1]; + else + # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + tf := transd[(i-1)*ext+1]^-1*transr[i]*transd[(i-1)*ext+1]^-1; + fi; + s := s * tf; + flag := not(flag); + od; + + # Finally put together the new long cycle: + if flag then + v := ((w.spnstdf[3*ext+4]^((q-1)/2))^((v*s*w.spnstdf[3*ext+3])^(-1)))*(v*s); + else + v := (v*s); + fi; + w.spnstdf[3*ext+1] := v; + fi; + + newbasechange := PermMat3^(-1)*basechange; + w.bas := PermMat3^(-1) * w.bas; + w.basi := w.basi * PermMat3; + Unbind(w.transv); + Unbind(w.transh); + w.n := aimdim; + Info(InfoRecog,2,"Step 7 done"); + return w; + fi; + + # Otherwise we do want to go on as the next thing, so we want to + # keep our transvections. This is easily done if we change the + # basis one more time. Note that we know that n is odd here! + + flag := false; + s := w.One; + PermMat3 := RECOG.ComputeCorrectingPermutationMatSp(d,F,n,aimdim); + v := w.spnstdf[3*ext+1]; + for i in [n-2,n-3..(n/2)] do + if flag then + # Make [[0,-1],[1,0]] in coordinates w.n and w.n+i: + tf := transd[(i-1)*ext+1]*transr[i]^-1*transd[(i-1)*ext+1]; + else + # Make [[0,1],[-1,0]] in coordinates w.n and w.n+i: + tf := transd[(i-1)*ext+1]^-1*transr[i]*transd[(i-1)*ext+1]^-1; + fi; + s := s * tf; + flag := not(flag); + od; + + # Finally put together the new long cycle: + v := (v*s); + w.spnstdf[3*ext+1] := v; + + newbasechange := PermMat3^(-1)*basechange; + w.bas := PermMat3^(-1) * w.bas; + w.basi := w.basi * PermMat3; + + # Now add the new transvections: + begintransv := Size(transd)/2+1; + difftransv := Size(transd) - Size(transd)/2; + for i in [1..difftransv/w.ext] do + for k in [1..w.ext] do + Add(w.transh1, transd[Size(transd)-i*w.ext+k]^(-1)); + od; + od; + + # TODO: Here is still something mixed to shift the transvections for the next run. If this is fixed, remove the command w.transh2 := [] at the beginning of this function + + #newtransv := []; + #for i in [1..difftransv/w.ext] do + # w.transh[w.ext*(w.n-1)+w.ext*(i-1)+1] := transr[i]; + # for k in [1..w.ext] do + # Add(newtransv, transd[Size(transr)-i*w.ext+k]); + # od; + #od; + #Append(newtransv,w.transh2); + #w.transh2 := newtransv; + w.n := aimdim; + + Info(InfoRecog,2,"Step 7 done"); + return w; +end; diff --git a/gap/projective/constructive_recognition/Sp/main.gi b/gap/projective/constructive_recognition/Sp/main.gi new file mode 100644 index 000000000..0a9b51366 --- /dev/null +++ b/gap/projective/constructive_recognition/Sp/main.gi @@ -0,0 +1,125 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +############################################################################# + + + +############################################################################# +############################################################################# +######## Main function for symplectic groups ################################ +############################################################################# +############################################################################# + + +RECOG.FindStdGens_Sp := function(sld) + + return RECOG.FindStdGens_Sp2(sld,DimensionOfMatrixGroup(sld)); + +end; + + +RECOG.FindStdGens_Sp2 := function(sld,IsoDim) + + # Group generated by input must be isomorphic Sp(IsoDim,q) + + # gens of sld must be gens for Sp(d,q) in its natural rep with memory + # This function calls RECOG.Spn_constructsp4 and then extends + # the basis to a basis of the full row space and calls + # RECOG.Spn_UpStep often enough. Finally it returns an slp such + # that the Sp(d,q) standard generators with respect to this basis are + # expressed by the slp in terms of the original generators of sld. + local V,b,bas,basi,basit,d,data,ext,fakegens,id,nu,nu2,p,q,resl2,sl2,sp4gens,bigcorrection, + sl2gensf,sl2genss,sp4stdf,slp,slpsl2std,slptosl2,st,std,stdgens,i,ex,f,form,smallsp4,basechange,myslp,sp8gens,sp8,WrongForm,correctForm1,correctForm2; + + # Some setup: + f := FieldOfMatrixGroup(sld); + p := Characteristic(f); + if IsEvenInt(p) then + Display("Since the characteristic is even, we have to call the algorithm for Omega(0,d+1,q) at this point. But this is not supported yet."); + return fail; + fi; + q := Size(f); + ext := DegreeOverPrimeField(f); + d := DimensionOfMatrixGroup(sld); + form := RECOG.SymplecticForm(sld); + if not(IsObjWithMemory(GeneratorsOfGroup(sld)[1])) then + sld := GroupWithMemory(sld); + fi; + + # First find an Sp4 with the space it acts on; + Info(InfoRecog,2,"Finding an Sp4..."); + Info(InfoRecog,2,"-----"); + Info(InfoRecog,2,"Start of the GoingDown Algorithm."); + data := RECOG.Spn_constructsp4(sld,d,q,form); + if data = fail then + return TemporaryFailure; + fi; + Info(InfoRecog,2,"The GoingDown Algorithm was successful."); + Info(InfoRecog,2,"-----"); + + myslp := data[4]; + + smallsp4 := RECOG.ExtractSmallerGroup(GeneratorsOfGroup(data[1]),IdentityMat(d,GF(q)),4); + Info(InfoRecog,2,"Start of constructive recognition of Sp(4,q)"); + i := 1; + sp4gens := fail; + while i < 10 and sp4gens = fail do + if not(IsEvenInt(q)) then + sp4gens := RECOG.FindStdGensSp4(smallsp4[1],d,q); + else + sp8 := RECOG.ExtractSmallerGroup(GeneratorsOfGroup(data[1]),data[2],8)[1]; + WrongForm := PreservedSesquilinearForms(sp8)[1]; + correctForm1 := BaseChangeToCanonical(WrongForm); + correctForm2 := BaseChangeToCanonical(PreservedSesquilinearForms(Sp(8,q))[1]); + sp8 := sp8^(correctForm1^(-1)*correctForm2); + bigcorrection := IdentityMat(d,GF(q)); + bigcorrection{[1..8]}{[1..8]} := (correctForm2)^(-1)*correctForm1; + basechange := bigcorrection*data[2]; + stdgens := RECOG.MakeSp_StdGens(p,ext,8,8).all; + sp8gens := RECOG.FindStdGensUsingBSGS(sp8,stdgens,false,false); + #if Size(sp8) <> 197406720 and 174182400 <> Size(sp8) then + Error("here"); + #fi; + return "TODO"; + fi; + i := i +1; + od; + if sp4gens = fail then + Info(InfoRecog,2,"-----"); + Info(InfoRecog,2,"Constructive recognition of Sp(4,q) failed. Restart."); + Info(InfoRecog,2,"-----"); + return TemporaryFailure; + fi; + basechange := sp4gens[2]*data[2]; + myslp := CompositionOfStraightLinePrograms(sp4gens[3],myslp); + Info(InfoRecog,2,"Constructive recognition of Sp(4,q) was successful."); + Info(InfoRecog,2,"-----"); + + fakegens := ListWithIdenticalEntries(Length(GeneratorsOfGroup(sld)), ()); + fakegens := GeneratorsWithMemory(fakegens); + sp4stdf := ResultOfStraightLineProgram(myslp,fakegens); + std := rec( f := f, d := d, GoalDim := IsoDim, n := 4, bas := basechange, basi := basechange^(-1), + sld := sld, sldf := fakegens, spnstdf := sp4stdf, + p := p, ext := ext ); + Info(InfoRecog,2,"Going up to Sp_d again..."); + Info(InfoRecog,2,"-----"); + Info(InfoRecog,2,"Start of the GoingUp Algorithm"); + while std.n < std.GoalDim do + RECOG.Spn_UpStep(std); + od; + Info(InfoRecog,2,"The GoingUp Algorithm was successful."); + Info(InfoRecog,2,"-----"); + return rec( slpstd := SLPOfElms(std.spnstdf), + bas := std.bas, basi := std.basi ); +end; diff --git a/gap/projective/constructive_recognition/main.gi b/gap/projective/constructive_recognition/main.gi new file mode 100644 index 000000000..d605ebf72 --- /dev/null +++ b/gap/projective/constructive_recognition/main.gi @@ -0,0 +1,31 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +############################################################################# + + + +############################################################################# +############################################################################# +######## Main function for all classical groups in natural reps ############# +############################################################################# +############################################################################# + + + +# TODO: main function +RECOG.ConstructiveRecognitionClassicalGroupsNaturalRepresentation := function(G) + + # TODO: Check which classical group is G and apply the correct subfuntion + +end; diff --git a/gap/projective/constructive_recognition/utils/PhDTests.gi b/gap/projective/constructive_recognition/utils/PhDTests.gi new file mode 100644 index 000000000..5739dc5a8 --- /dev/null +++ b/gap/projective/constructive_recognition/utils/PhDTests.gi @@ -0,0 +1,232 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +############################################################################# + + + +############################################################################# +############################################################################# +######## Contains test function for the PhD thesis of the author ############ +############################################################################# +############################################################################# + + + +RECOG.GenerateStatictsSL := function(d,q,n,tries) +local H, G, res, bugavoided, hit, counter,e1,e2,gens; + + G := SL(d,q); + gens := GeneratorsOfGroup(SL(n,q)); + e1 := IdentityMat(d,GF(q)); + e2 := IdentityMat(d,GF(q)); + e1{[1..n]}{[1..n]} := gens[1]; + e2{[1..n]}{[1..n]} := gens[2]; + + H := GroupByGenerators([e1,e2]); + + hit := 0; + counter := 0; + + while counter < tries do + if RECOG.FindTestEle(H,G,n,"SL") then + hit := hit + 1; + fi; + counter := counter + 1; + od; + + Display(hit/tries); + + return hit; +end; + + +RECOG.GenerateStatictsSU := function(d,q,tries) +local H, G, n, res, bugavoided, hit, counter; + + n := 2; + G := SU(d,q); + bugavoided := false; + while not(bugavoided) do + res := RECOG.FindStdGens_SU(G,d); + if res[1,1]^res[2] in G then + bugavoided := true; + fi; + od; + + H := GroupByGenerators(res[1]); + G := G^(res[2]^(-1)); + + hit := 0; + counter := 0; + + while counter < tries do + if RECOG.FindTestEle(H,G,n,"SU") then + hit := hit + 1; + fi; + counter := counter + 1; + od; + + Display(hit/tries); + + return hit; +end; + + +RECOG.GenerateStatictsSU := function(d,q,tries) +local H, G, n, res, bugavoided, hit, counter; + + n := 2; + G := Sp(d,q); + bugavoided := false; + while not(bugavoided) do + res := RECOG.FindStdGens_Sp(G,d); + if res[1,1]^res[2] in G then + bugavoided := true; + fi; + od; + + H := GroupByGenerators(res[1]); + G := G^(res[2]^(-1)); + + hit := 0; + counter := 0; + + while counter < tries do + if RECOG.FindTestEle(H,G,n,"SU") then + hit := hit + 1; + fi; + counter := counter + 1; + od; + + Display(hit/tries); + + return hit; +end; + + +RECOG.FindTestEle := function(H, G, n, type) +local c1, c, t; + + t := PseudoRandom(H); + c1 := PseudoRandom(G); + c := t^c1; + if type = "SL" then + return RECOG.TestGroupSL(H,c,2*n); + elif type = "SU" then + return RECOG.TestGroupSU(H,c,2*n); + elif type = "Sp" then + return RECOG.TestGroupSp(H,c,2*n); + elif type = "Omega" then + return RECOG.TestGroupOmega(H,c,2*n); + else + return fail; + fi; +end; + + +RECOG.TestGroupSU := function(G,c,d) +local H, gens, gens2, res; + + gens := List(GeneratorsOfGroup(G),MutableCopyMat); + gens2 := List(GeneratorsOfGroup(G),MutableCopyMat); + Apply(gens2,x->x^c); + Append(gens,gens2); + H := RECOG.LinearActionRepresentation(GroupByGenerators(gens)); + res := RecogniseClassical(H); + Display(res); + if res <> fail and IsBool(res.isSUContained) then + if res.d = d and res.isSUContained then + return true; + else + return false; + fi; + else + return false; + fi; +end; + + + +RECOG.TestGroupSL := function(G,c,d) +local H, gens, gens2, res; + + gens := List(GeneratorsOfGroup(G),MutableCopyMat); + gens2 := List(GeneratorsOfGroup(G),MutableCopyMat); + Apply(gens2,x->x^c); + Append(gens,gens2); + H := RECOG.LinearActionRepresentation(GroupByGenerators(gens)); + res := RecogniseClassical(H); + #Display(res); + #if res <> fail and IsBool(res.isSLContained) then + if res <> fail then + #if res.d = d and res.isSLContained then + if res.d = d then + return true; + else + #if res.d = d then + + #Error("here"); + #fi; + return false; + fi; + else + #Error("here"); + return false; + fi; +end; + + + +RECOG.TestGroupSp := function(G,c,d) +local H, gens, gens2, res; + + gens := List(GeneratorsOfGroup(G),MutableCopyMat); + gens2 := List(GeneratorsOfGroup(G),MutableCopyMat); + Apply(gens2,x->x^c); + Append(gens,gens2); + H := RECOG.LinearActionRepresentation(GroupByGenerators(gens)); + res := RecogniseClassical(H); + Display(res); + if res <> fail and IsBool(res.isSpContained) then + if res.d = d and res.isSpContained then + return true; + else + return false; + fi; + else + return false; + fi; +end; + + +RECOG.TestGroupOmega := function(G,c,d) +local H, gens, gens2, res; + + gens := List(GeneratorsOfGroup(G),MutableCopyMat); + gens2 := List(GeneratorsOfGroup(G),MutableCopyMat); + Apply(gens2,x->x^c); + Append(gens,gens2); + H := RECOG.LinearActionRepresentation(GroupByGenerators(gens)); + res := RecogniseClassical(H); + Display(res); + if res <> fail and IsBool(res.isSOContained) then + if res.d = d and res.isSOContained then + return true; + else + return false; + fi; + else + return false; + fi; +end; diff --git a/gap/projective/constructive_recognition/utils/achieve.gi b/gap/projective/constructive_recognition/utils/achieve.gi new file mode 100644 index 000000000..c00757248 --- /dev/null +++ b/gap/projective/constructive_recognition/utils/achieve.gi @@ -0,0 +1,925 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher, Max Neunhöffer, Ákos Seress. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +## +## Constructive recognition of classical groups in their natural +## representation. +## +############################################################################# + + +RECOG.ResetSLstd := function(r) + r.left := One(r.a); + r.right := One(r.a); + if not IsBound(r.cache) then + r.cache := [EmptyPlist(100),EmptyPlist(100), + List([1..r.ext],i->[]), # rowopcache + List([1..r.ext],i->[])]; # colopcache + fi; + return r; +end; + +# TODO: document the parameters +RECOG.InitSLstd := function(f,d,s,t,a,b) + local r; + r := rec( f := f, p := Characteristic(f), ext := DegreeOverPrimeField(f), + q := Size(f), d := d, all := Concatenation(s,t,[a],[b]), + one := One(f), One := One(s[1]), s := s, t := t, a := a, b := b ); + return RECOG.ResetSLstd(r); +end; + +RECOG.FindFFCoeffs := function(r,lambda) + return IntVecFFE(Coefficients(CanonicalBasis(r.f),lambda)); +end; + +# TODO: document this; what does "fake" mean???? +# Theory: the fake gens are only used for their memory. Since we are only +# interested in the memory (to produce slps), we use trivial permutations for +# the underlying group elements, so that the multiplication is cheap. +# Verify and then document this. +RECOG.InitSLfake := function(f,d) + local ext,l; + ext := DegreeOverPrimeField(f); + l := ListWithIdenticalEntries(2*ext+2,()); + l := GeneratorsWithMemory(l); + return RECOG.InitSLstd(f,d,l{[1..ext]},l{[ext+1..2*ext]}, + l[2*ext+1],l[2*ext+2]); +end; + +RECOG.DoRowOp_SL := function(m,i,j,lambda,std) + # add lambda times j-th row to i-th row, i<>j + # by left-multiplying with an expression in the standard generators: + # a : e_n -> e_{n-1} -> ... -> e_1 -> (-1)^(n+1) e_n + # b : e_n -> e_{n-1} -> ... -> e_2 -> (-1)^n e_n and e_1 -> e_1 + # s : e_1 -> e_1+ * e_2, e_i -> e_i for i > 1 + # t : e_2 -> e_1+ * e_2, e_i -> e_i for i <> 2 + # s and t are lists of length ext to span over GF(p) all the scalars + # in *. + # Note that V_i = . + # So is an SL_2 in the upper left corner, a is an n-cycle + # b is an n-1 cycle with garbage fixing the first vector + # This only modifies the record std collecting a straight line program. + local Getai,Getbj,coeffs,k,new,newnew; + + Getai := function(l) + local pos; + if l < 0 then pos := std.d - l; + else pos := l; + fi; + if not IsBound(std.cache[1][pos]) then + std.cache[1][pos] := std.a^l; + fi; + return std.cache[1][pos]; + end; + Getbj := function(l) + local pos; + if l < 0 then pos := std.d - l; + else pos := l; + fi; + if not IsBound(std.cache[2][pos]) then + std.cache[2][pos] := std.b^l; + fi; + return std.cache[2][pos]; + end; + + newnew := std.One; + coeffs := RECOG.FindFFCoeffs(std,lambda); + for k in [1..std.ext] do + if not IsZero(coeffs[k]) then + if IsBound(std.cache[3][k][i]) and + IsBound(std.cache[3][k][i][j]) then + new := std.cache[3][k][i][j]; + else; + new := std.One; + if i < j then + # We need to multiply from the left with the element + # a^(i-1) * b^(j-i-1) * s_k * b^-(j-i-1) * a^-(i-1) + # from the left. + if i > 1 then new := Getai(-(i-1)) * new; fi; + if j > i+1 then new := Getbj(-(j-i-1)) * new; fi; + new := std.s[k] * new; + if j > i+1 then new := Getbj(j-i-1) * new; fi; + if i > 1 then new := Getai(i-1) * new; fi; + elif i > j then + # We need to multiply from the left with the element + # a^(j-1) * b^(i-j-1) * t_k * b^-(i-j-1) * a^-(j-1) + # from the left. + if j > 1 then new := Getai(-(j-1)) * new; fi; + if i > j+1 then new := Getbj(-(i-j-1)) * new; fi; + new := std.t[k] * new; + if i > j+1 then new := Getbj(i-j-1) * new; fi; + if j > 1 then new := Getai(j-1) * new; fi; + fi; + if not IsBound(std.cache[3][k][i]) then + std.cache[3][k][i] := []; + fi; + std.cache[3][k][i][j] := new; + fi; + std.left := new^coeffs[k] * std.left; + newnew := new^coeffs[k] * newnew; + fi; + od; + if m <> false and not IsZero(lambda) then m[i] := m[i] + m[j] * lambda; fi; + return newnew; +end; + +RECOG.DoColOp_SL := function(m,i,j,lambda,std) + # add lambda times i-th column to j-th column, i<>j + # by left-multiplying with an expression in the standard generators: + # a : e_n -> e_{n-1} -> ... -> e_1 -> (-1)^(n+1) e_n + # b : e_n -> e_{n-1} -> ... -> e_2 -> (-1)^n e_n and e_1 -> e_1 + # s : e_1 -> e_1+ * e_2, e_i -> e_i for i > 1 + # t : e_2 -> e_1+ * e_2, e_i -> e_i for i <> 2 + # s and t are lists of length ext to span over GF(p) all the scalars + # in *. + # Note that V_i = . + # So is an SL_2 in the upper left corner, a is an n-cycle + # b is an n-1 cycle with garbage fixing the first vector + # This only modifies the record std collecting a straight line program. + local Getai,Getbj,coeffs,k,new,newnew; + + Getai := function(l) + local pos; + if l < 0 then pos := std.d - l; + else pos := l; + fi; + if not IsBound(std.cache[1][pos]) then + std.cache[1][pos] := std.a^l; + fi; + return std.cache[1][pos]; + end; + Getbj := function(l) + local pos; + if l < 0 then pos := std.d - l; + else pos := l; + fi; + if not IsBound(std.cache[2][pos]) then + std.cache[2][pos] := std.b^l; + fi; + return std.cache[2][pos]; + end; + + newnew := std.One; + coeffs := RECOG.FindFFCoeffs(std,lambda); + for k in [1..std.ext] do + if not IsZero(coeffs[k]) then + if IsBound(std.cache[4][k][i]) and + IsBound(std.cache[4][k][i][j]) then + new := std.cache[4][k][i][j]; + else; + new := std.One; + if i < j then + # We need to multiply from the right with the element + # a^(i-1) * b^(j-i-1) * s_k * b^-(j-i-1) * a^-(i-1) + # from the right. + if i > 1 then new := Getai(-(i-1)) * new; fi; + if j > i+1 then new := Getbj(-(j-i-1)) * new; fi; + new := std.s[k] * new; + if j > i+1 then new := Getbj(j-i-1) * new; fi; + if i > 1 then new := Getai(i-1) * new; fi; + elif i > j then + # We need to multiply from the right with the element + # a^(j-1) * b^(i-j-1) * t_k * b^-(i-j-1) * a^-(j-1) + # from the left. + if j > 1 then new := Getai(-(j-1)) * new; fi; + if i > j+1 then new := Getbj(-(i-j-1)) * new; fi; + new := std.t[k] * new; + if i > j+1 then new := Getbj(i-j-1) * new; fi; + if j > 1 then new := Getai(j-1) * new; fi; + fi; + if not IsBound(std.cache[4][k][i]) then + std.cache[4][k][i] := []; + fi; + std.cache[4][k][i][j] := new; + fi; + std.right := std.right * new^coeffs[k]; + newnew := newnew * new^coeffs[k]; + fi; + od; + if m <> false and not IsZero(lambda) then + for k in [1..Length(m)] do + m[k][j] := m[k][j] + m[k][i] * lambda; + od; + fi; + + return newnew; +end; + +RECOG.MakeSL_StdGens := function(p,ext,n,d) + local a,b,f,i,q,s,t,x,res; + f := GF(p,ext); + q := Size(f); + a := IdentityMat(d,f); + a := a{Concatenation([n],[1..n-1],[n+1..d])}; + ConvertToMatrixRep(a,q); + b := IdentityMat(d,f); + b := b{Concatenation([1,n],[2..n-1],[n+1..d])}; + ConvertToMatrixRep(b,q); + if IsEvenInt(n) then + a[1] := -a[1]; + else + b[2] := -b[2]; + fi; + s := []; + t := []; + for i in [0..ext-1] do + x := IdentityMat(d,f); + x[1,2] := Z(p,ext)^i; + Add(s,x); + x := IdentityMat(d,f); + x[2,1] := Z(p,ext)^i; + Add(t,x); + od; + res := rec( s := s, t := t, a := a, b := b, f := f, q := q, p := p, + ext := ext, One := IdentityMat(d,f), one := One(f), + d := d ); + res.all := Concatenation( res.s, res.t, [res.a], [res.b] ); + return res; +end; + +RECOG.ExpressInStd_SL2 := function(m,std) + local mi; + + if IsObjWithMemory(m) then + mi := InverseMutable(StripMemory(m)); + else + mi := InverseMutable(m); + fi; + std.left := std.One; + if not IsOne(mi[1,1]) then + if IsZero(mi[2,1]) then + RECOG.DoRowOp_SL(mi,2,1,std.one,std); + # Now mi[2,1] is non-zero + fi; + RECOG.DoRowOp_SL(mi,1,2,(std.one-mi[1,1])/mi[2,1],std); + fi; + # Now mi[1,1] is equal to one + if not IsZero(mi[2,1]) then + RECOG.DoRowOp_SL(mi,2,1,-mi[2,1],std); + fi; + # Now mi[2,1] is equal to zero and thus mi[2,2] equal to one + if not IsZero(mi[1,2]) then + RECOG.DoRowOp_SL(mi,1,2,-mi[1,2],std); + fi; + # Now mi is the identity matrix, the element collected in std + # is the one to multiply on the left hand side to transform mi to the + # identity. Thus it is equal to m. + return SLPOfElm(std.left); +end; + +RECOG.ExpressInStd_SL := function(m,std) + # m a matrix, std a fake standard generator record with trivial + # generators with memory + local d,i,j,mi,pos; + + if IsObjWithMemory(m) then + mi := InverseMutable(StripMemory(m)); + else + mi := InverseMutable(m); + fi; + std.left := std.One; + d := Length(m); + for i in [1..d] do + if not IsOne(mi[i,i]) then + pos := First([i+1..d],k->not IsZero(mi[k,i])); + if pos = fail then + pos := i+1; + RECOG.DoRowOp_SL(mi,pos,i,std.one,std); + fi; + RECOG.DoRowOp_SL(mi,i,pos,(std.one-mi[i,i])/mi[pos,i],std); + fi; + # Now mi[i,i] is equal to one + for j in Concatenation([1..i-1],[i+1..d]) do + if not IsZero(mi[j,i]) then + RECOG.DoRowOp_SL(mi,j,i,-mi[j,i],std); + fi; + od; + # Now mi[i,i] is the only non-zero entry in the column + od; + # Now mi is the identity matrix, the element collected in std + # is the one to multiply on the left hand side to transform mi to the + # identity. Thus it is equal to m. + return SLPOfElm(std.left); +end; + + + +RECOG.RecogniseSL2NaturalEvenChar := function(g,f,torig) + # f a finite field, g equal to SL(2,Size(f)), t either an involution + # or false. + # Returns a set of standard generators for SL_2 and the base change + # to expose it. Works with memory. Uses PseudoRandom. + local a,actpos,am,b,bas,bm,c,can,ch,cm,co,co2,el,ev,eva,evb,evbi,ext,gens, + i,j,k,kk,mas,masi,mat,mati,mb,o,one,os,pos,q,res,s,ss,ssm,t,tb,tm, + tt,ttm,u,v,x,xb,xm; + + q := Size(f); + gens := GeneratorsOfGroup(g); + if torig = false then + for a in gens do + if not IsOne(a) and IsOne(a^2) then + torig := a; + break; + fi; + od; + fi; + if torig = false then + # if no involution t has been given, compute one, using Proposition 4 from + # "Black box groups isomorphic to PGL(2,2^e)" by Kantor & Kassabov, + # Journal of Algebra, 421 (2015) 16–26. + repeat + am:=PseudoRandom(g); + until not IsOneProjective(am); + k := Order(am); + if IsEvenInt(k) then + tm := am^(k/2); + else + # find a conjugate of a which does not commute with a. + repeat + bm := am^PseudoRandom(g); + cm := am*bm; + tm := bm*am; + until cm<>tm; + tm := tm^-1 * cm; + if not IsOneProjective(StripMemory(tm)^2) then + tm := cm^((q^2-2)/2) * am; + fi; + fi; + else + tm := torig; + fi; + t := StripMemory(tm); + + Assert(1, IsOne(t^2)); + + ch := Factors(CharacteristicPolynomial(f,f,t,1)); + if Length(ch) <> 2 or ch[1] <> ch[2] then + ErrorNoReturn("matrix is not triagonalizable - this should never happen!"); + fi; + + one := OneMutable(t); + bas := MutableCopyMat(NullspaceMat(Value(ch[1],t))); + Add(bas,one[1]); + if RankMat(bas) < 2 then + bas[2] := one[2]; + fi; + tb := bas*t*bas^-1; + can := CanonicalBasis(f); + tt := [t]; + ttm := [tm]; + mat := [Coefficients(can,tb[2,1])]; + mb := MutableBasis(GF(2),mat); + o := [gens[1]]; + os := [gens[1]]; + actpos := 1; + j := 1; + ext := DegreeOverPrimeField(f); + while Length(tt) < ext do + repeat + repeat + while j > Length(o) do + for k in gens do + kk := o[actpos]*k; + pos := PositionSorted(os,kk); + if pos > Length(os) or os[pos] <> kk then + Add(o,kk); + Add(os,kk,pos); + fi; + od; + actpos := actpos + 1; + od; + xm := o[j]; + j := j + 1; + c := Comm(tm,xm); + until not IsOne(c^2); + xm := xm * c^(((q-1)*(q+1)-1)/2); + x := StripMemory(xm); + xb := bas*x*bas^-1; + co := Coefficients(can,xb[2,1]); + until not IsContainedInSpan(mb,co); + CloseMutableBasis(mb,co); + Add(tt,x); + Add(ttm,xm); + Add(mat,co); + od; + ConvertToMatrixRep(mat,2); + mati := mat^-1; + + # Now we can add an arbitrary multiple of the first row to the + # second and an arbitrary multiple of the second column to the first. + # Therefore we quickly find other complimentary transvections: + ss := []; + ssm := []; + mas := []; + mb := MutableBasis(GF(2),mas,ZeroMutable(mat[1])); + j := 1; + while Length(ss) < ext do + while true do # will be left by break + repeat + while j > Length(o) do + for k in gens do + kk := o[actpos]*k; + pos := PositionSorted(os,kk); + if pos > Length(os) or os[pos] <> kk then + Add(o,kk); + Add(os,kk,pos); + fi; + od; + actpos := actpos + 1; + od; + xm := o[j]; + j := j + 1; + x := MutableCopyMat(bas*StripMemory(xm)*bas^-1); + until not IsZero(x[1,2]); + + if not IsOne(x[2,2]) then + el := (One(f)-x[2,2])/x[1,2]; + co := Coefficients(can,el) * mati; + for i in [1..Length(co)] do + if not IsZero(co[i]) then + xm := ttm[i] * xm; + fi; + od; + x[2] := x[2] + x[1] * el; + if x <> bas*StripMemory(xm)*bas^-1 then + # FIXME: sometimes triggered by RecognizeGroup(GL(2,16)); + ErrorNoReturn("!!!"); + fi; + fi; + # now x[2,2] is equal to One(f) + # we postpone the actual computation of the final x until we + # know it is needed: + co := Coefficients(can,x[1,2]); + if IsContainedInSpan(mb,co) then continue; fi; + # OK, we need it, so let's make it: + el := x[2,1]; + co2 := Coefficients(can,el) * mati; + for i in [1..Length(co2)] do + if not IsZero(co2[i]) then + xm := xm * ttm[i]; + fi; + od; +# TODO: add sanity check here, too??? + x := StripMemory(xm); + # now x[2,1] is equal to Zero(f) and thus x[1,1] is One(f) as well + break; + od; + CloseMutableBasis(mb,co); + Add(ss,x); + Add(ssm,xm); + Add(mas,co); + od; + ConvertToMatrixRep(mas,2); + masi := mas^-1; + + # Now we replace all the s and the t by some products to get rid + # of the base changes: + s := EmptyPlist(ext); + t := EmptyPlist(ext); + for i in [1..ext] do + co := Positions(masi[i],Z(2)); + Add(s,Product(ssm{co})); + co := Positions(mati[i],Z(2)); + Add(t,Product(ttm{co})); + od; + + res := rec( g := g, t := t, s := s, bas := bas, basi := bas^-1, + one := One(f), a := s[1]*t[1]*s[1], b := One(s[1]), + One := One(s[1]), f := f, q := q, p := 2, ext := ext, + d := 2 ); + res.all := Concatenation(res.s,res.t,[res.a],[res.b]); + return res; +end; + +RECOG.GuessProjSL2ElmOrder := function(x,f) + local facts,i,j,o,p,q,r,s,y,z; + p := Characteristic(f); + q := Size(f); + if IsOneProjective(x) then return 1; + elif IsEvenInt(p) and IsOneProjective(x^2) then return 2; + fi; + if p > 2 then + y := x^p; + if IsOneProjective(y) then + return p; + fi; + fi; + if IsOneProjective(x^(q-1)) then + facts := Collected(FactInt(q-1:cheap)[1]); + s := Product(facts,x->x[1]^x[2]); + r := (q-1)/s; + else + facts := Collected(FactInt(q+1:cheap)[1]); + s := Product(facts,x->x[1]^x[2]); + r := (q+1)/s; + fi; + y := x^r; + o := r; + for i in [1..Length(facts)] do + p := facts[i]; + j := p[2]-1; + while j >= 0 do + z := y^(s/p[1]^(p[2]-j)); + if not IsOneProjective(z) then break; fi; + j := j - 1; + od; + o := o * p[1]^(j+1); + od; + return o; +end; + +RECOG.IsThisSL2Natural := function(gens,f) + # Checks quickly whether or not this is SL(2,f). + # The answer is not guaranteed to be correct, this is Las Vegas. + local CheckElm,a,b,clos,coms,i,isabelian,j,l,notA5,p,q,S,seenqm1,seenqp1,x; + + # The following method does not work for q <= 11, as then + # the projective orders are either q+1, or else less than 5. + # Hence seenqm1 never gets set. + CheckElm := function(x) + local o; + o := RECOG.GuessProjSL2ElmOrder(x,f); + if o in [1,2] then + return false; + fi; + if o > 5 then + if notA5 = false then Info(InfoRecog,4,"SL2: Group is not A5"); fi; + notA5 := true; + if seenqp1 and seenqm1 then + return true; + fi; + fi; + if o = p or o <= 5 then + return false; + fi; + if (q+1) mod o = 0 then + if not seenqp1 then + Info(InfoRecog,4,"SL2: Found element of order dividing q+1."); + seenqp1 := true; + if seenqm1 and notA5 then + return true; + fi; + fi; + else + if not seenqm1 then + Info(InfoRecog,4,"SL2: Found element of order dividing q-1."); + seenqm1 := true; + if seenqp1 and notA5 then + return true; + fi; + fi; + fi; + return false; + end; + + if Length(gens) <= 1 then + Info(InfoRecog,4,"SL2: Group cyclic"); + return false; + fi; + + q := Size(f); + p := Characteristic(f); + # For small q, compute the order of the group via a stabilizer chain. + # Note that at this point we are usually working projective, and thus + # scalars are factored out "implicitly". Thus the generators we are + # looking at may generate a group which only contains SL2 as a subgroup. + if q <= 11 then # this could be increased if needed + Info(InfoRecog,4,"SL2: Computing stabiliser chain."); + S := StabilizerChain(Group(gens)); + Info(InfoRecog,4,"SL2: size is ",Size(S)); + # return Size(S) mod (q*(q-1)*(q+1)) = 0; + return Size(S) = (q*(q-1)*(q+1)); + fi; + + seenqp1 := false; + seenqm1 := false; + notA5 := false; + + for i in [1..Length(gens)] do + if CheckElm(gens[i]) then + return true; + fi; + od; + CheckElm(gens[1]*gens[2]); + if Length(gens) >= 3 then + CheckElm(gens[1]*gens[3]); + CheckElm(gens[2]*gens[3]); + fi; + + # First we check the derived group: + coms := EmptyPlist(20); + l := Length(gens); + if l <= 4 then + Info(InfoRecog,4,"SL2: Computing commutators of gens..."); + for i in [1..l-1] do + for j in [i+1..l] do + x := Comm(gens[i],gens[j]); + if CheckElm(x) then + return true; + fi; + Add(coms,x); + od; + od; + else + Info(InfoRecog,4,"SL2: Computing 6 random commutators..."); + for i in [1..6] do + a := RECOG.RandomSubproduct(gens,rec()); + b := RECOG.RandomSubproduct(gens,rec()); + x := Comm(a,b); + if CheckElm(x) then + return true; + fi; + Add(coms,x); + od; + fi; + if ForAll(coms,c->RECOG.IsScalarMat(c) <> false) then + Info(InfoRecog,4,"SL2: Group is soluble, commutators are central"); + return false; + fi; + Info(InfoRecog,4,"SL2: Computing normal closure..."); + clos := FastNormalClosure(gens,coms,5); + for i in [Length(coms)+1..Length(clos)] do + if CheckElm(clos[i]) then + return true; + fi; + od; + if ForAll(clos{[Length(coms)+1..Length(clos)]}, + c->RECOG.IsScalarMat(c) <> false) then + Info(InfoRecog,4,"SL2: Group is soluble, derived subgroup central"); + return false; + fi; + Info(InfoRecog,4,"SL2: Computing 6 random commutators..."); + isabelian := true; + for i in [1..6] do + a := RECOG.RandomSubproduct(clos,rec()); + b := RECOG.RandomSubproduct(clos,rec()); + x := Comm(a,b); + if RECOG.IsScalarMat(x) = false then isabelian := false; break; fi; + od; + if isabelian then + Info(InfoRecog,4, + "SL2: Group is soluble, derived subgroup abelian mod scalars"); + return false; + fi; + + # Now we know that the group is not dihedral! + return false; +end; + + + +# Now the code for writing SLPs: + +SLPforElementFuncsProjective.PSL2 := function(ri,x) + local det,log,slp,y,z,pos,s; + ri!.fakegens.count := ri!.fakegens.count + 1; + if ri!.fakegens.count > 1000 then + ri!.fakegens := RECOG.InitSLfake(ri!.field,2); + ri!.fakegens.count := 0; + fi; + y := ri!.nicebas * x * ri!.nicebasi; + det := DeterminantMat(y); + if not IsOne(det) then + z := PrimitiveRoot(ri!.field); + log := LogFFE(det,z); + y := y * z^(-log*ri!.gcd.coeff1/ri!.gcd.gcd); + fi; + # At this point, y has determinant 1; but we consider it modulo scalars. + # To make sure that different coset reps behave the same, we scale it + # with a suitable primitive d-th root of unity. + if not IsBound(ri!.normlist) then + ri!.normlist := RECOG.SetupNormalisationListForPSLd(ri!.field, + ri!.gcd.gcd); + fi; + pos := PositionNonZero(y[1]); + s := RECOG.NormaliseScalarForPSLd(y[1,pos],ri!.normlist); + slp := RECOG.ExpressInStd_SL2(s * y,ri!.fakegens); + return slp; +end; + +# s: a non-zero scalar +# list: a list of certain primitive roots of unity, as +# computed by SetupNormalisationListForPSLd +# +# This function considers s and all its multiples by the elements in +# list, and picks the smallest of them. It returns the multiplicator +# used to obtain that element from s. +RECOG.NormaliseScalarForPSLd := function(s,list) + local min,minmul,t,u; + min := s; + minmul := s^0; + for t in list do + u := s*t; + if u < min then + min := u; + minmul := t; + fi; + od; + return minmul; +end; + +# f: a finite field +# d: a positive integer +# +# Returns a list of primitive d-th roots of unity. +RECOG.SetupNormalisationListForPSLd := function(f,d) + local e,i,list,z; + list := EmptyPlist(d); + z := PrimitiveRoot(f)^((Size(f)-1)/d); + e := z; + for i in [1..d-1] do + Add(list,e); + e := e * z; + od; + return list; +end; + +# el: a field element +# d: a positive integer (typically ri!.gcd.gcd) +# f: a galois field (typically ri!.field) +# +# Compute a primitive d-th root of el in the field f. +# TODO: This function copies the code from RootFFE, which will +# appear in GAP 4.9. Once GAP 4.9 is out, we can switch +# to using RootFFE directly. +RECOG.ComputeRootInFiniteField := function(el, d, f) + local z, e, m, p, a; + if IsZero(el) or IsOne(el) then + return el; + fi; + z := PrimitiveRoot(f); + m := Size(f) - 1; + e := LogFFE(el, z); + p := GcdInt(m, e); + d := d mod m; + a := GcdInt(m, d); + if p mod a <> 0 then + return fail; + fi; + a := e * (a / d mod (m / p)) / a mod m; + return z ^ a; +end; + +# Express an element of PSL_d as an slp in terms of standard generators. +SLPforElementFuncsProjective.PSLd := function(ri,x) + local det,pos,root,s,slp,y; + ri!.fakegens.count := ri!.fakegens.count + 1; + if ri!.fakegens.count > 1000 then + ri!.fakegens := RECOG.InitSLfake(ri!.field,ri!.dimension); + ri!.fakegens.count := 0; + fi; + y := ri!.nicebas * x * ri!.nicebasi; + det := DeterminantMat(y); + if not IsOne(det) then + # At this point, y is in the kernel of the determinant map *mod scalars*. + # That means that det may not be 1 -- it can be any d-th power. + # We thus can compute a d-th root of 1/det, and scale y with it, + # in order to obtain a matrix with determinant 1 in the same + # projective class. + root := RECOG.ComputeRootInFiniteField(1/det,Length(y),ri!.field); + if root = fail then + return fail; + fi; + y := y * root; + fi; + # At this point, y has determinant 1; but we consider it modulo scalars. + # To make sure that different coset reps behave the same, we scale it + # with a suitable primitive d-th root of unity. + if not IsBound(ri!.normlist) then + ri!.normlist := RECOG.SetupNormalisationListForPSLd(ri!.field, + ri!.gcd.gcd); + fi; + pos := PositionNonZero(y[1]); + s := RECOG.NormaliseScalarForPSLd(y[1,pos],ri!.normlist); + slp := RECOG.ExpressInStd_SL(s * y,ri!.fakegens); + return slp; +end; + +#! @BeginChunk ClassicalNatural +#! TODO +#! @EndChunk +BindRecogMethod(FindHomMethodsProjective, "ClassicalNatural", +"check whether it is a classical group in its natural representation", +function(ri, g) + local changed,classical,d,det,ext,f,gcd,gens,gm,i,p,pr,q,root,std,stdg,z; + d := ri!.dimension; + f := ri!.field; + q := Size(f); + p := Characteristic(f); + RECOG.SetPseudoRandomStamp(g,"ClassicalNatural"); + + # First check whether we are applicable: + if d = 2 then + if not RECOG.IsThisSL2Natural(GeneratorsOfGroup(g),f) then + Info(InfoRecog,2,"ClassicalNatural: Is not PSL_2."); + return fail; # FIXME: fail = TemporaryFailure here really correct? + fi; + else + classical := RecogniseClassical(g); + if classical.isSLContained <> true then + Info(InfoRecog,2,"ClassicalNatural: Is not PSL."); + return fail; # FIXME: fail = TemporaryFailure here really correct? + fi; + fi; + + # Now get rid of nasty determinants: + gens := ShallowCopy(GeneratorsOfGroup(g)); + changed := false; + z := Z(q); + gcd := Gcdex(d,q-1); + for i in [1..Length(gens)] do + det := DeterminantMat(gens[i]); + if not IsOne(det) then + root := RECOG.ComputeRootInFiniteField(det,gcd.gcd,f); + if root = fail then + ErrorNoReturn("Should not have happened, 15634, tell Max!"); + fi; + gens[i] := gens[i] * root; + changed := true; + fi; + od; + if changed then + gm := GroupWithMemory(gens); + pr := ProductReplacer(GeneratorsOfGroup(gm),rec(maxdepth := 500)); + gm!.pseudorandomfunc := [rec( func := Next, args := [pr] )]; + else + gm := Group(ri!.gensHmem); + gm!.pseudorandomfunc := [rec(func := function(ri,name,bool) + return RandomElm(ri,name,bool).el; + end, + args := [ri,"ClassicalNatural",true])]; + fi; + + if d = 2 then + # We only have to check for (P)SL_2 since otherwise the subfield + # method will detect it. Note that this is a projective method, + # but a projective group contains PSL_2 if and only if the matrix + # group generated by the same matrices (possibly scaled to make + # the determinant to be 1) contains SL_2. + + # This is (P)SL2, lets set up the recognition: + Info(InfoRecog,2,"ClassicalNatural: this is PSL_2!"); + if IsEvenInt(q) then + std := RECOG.RecogniseSL2NaturalEvenChar(gm,f,false); + ri!.comment := "PSL2Even"; + else + std := RECOG.RecogniseSL2NaturalOddCharUsingBSGS(gm,f); + ri!.comment := "PSL2Odd"; + fi; + Setslptonice(ri,SLPOfElms(std.all)); + ri!.nicebas := std.bas; + ri!.nicebasi := std.basi; + SetNiceGens(ri,List(StripMemory(std.all),x->std.basi*x*std.bas)); + ri!.fakegens := RECOG.InitSLfake(f,2); + ri!.fakegens.count := 0; + ri!.gcd := gcd; + SetFilterObj(ri,IsLeaf); + SetSize(ri,(q+1)*(q-1)*q/GcdInt(2,q-1)); + SetIsRecogInfoForSimpleGroup(ri, q>3); + Setslpforelement(ri,SLPforElementFuncsProjective.PSL2); + return Success; + else # bigger than 2: + if classical.isSLContained = true then + # Do not run the generic code in small cases: + if (q^d-1)/(q-1) <= 1000 or d = 3 then + # FIXME: Note d=3 currently has a problem in the SL2-finder. + Info(InfoRecog,2,"Classical natural: SL(",d,",",q,"): small ", + "case, handing over to Schreier-Sims."); + ri!.comment := Concatenation("SL(",String(d),",",String(q),")", + "_StabilizerChain"); + return FindHomMethodsProjective.StabilizerChainProj(ri,g); + fi; + Info(InfoRecog,2,"ClassicalNatural: this is PSL_n!"); + std := RECOG.FindStdGens_SL(gm); + Setslptonice(ri,std.slpstd); + ri!.nicebas := std.bas; + ri!.nicebasi := std.basi; + ext := DegreeOverPrimeField(f); + stdg := RECOG.MakeSL_StdGens(p,ext,d,d); + SetNiceGens(ri,List(StripMemory(stdg.all), + x->std.basi*x*std.bas)); + ri!.fakegens := RECOG.InitSLfake(f,d); + ri!.fakegens.count := 0; + ri!.comment := "PSLd"; + ri!.gcd := gcd; + SetFilterObj(ri,IsLeaf); + SetSize(ri,Product([0..d-1],i->(q^d-q^i))/((q-1)*gcd.gcd)); + SetIsRecogInfoForSimpleGroup(ri,true); + Setslpforelement(ri,SLPforElementFuncsProjective.PSLd); + return Success; + fi; + fi; + + return fail; # FIXME: fail = TemporaryFailure here really correct? + +end); diff --git a/gap/projective/constructive_recognition/utils/utils.gi b/gap/projective/constructive_recognition/utils/utils.gi new file mode 100644 index 000000000..08dd2fd44 --- /dev/null +++ b/gap/projective/constructive_recognition/utils/utils.gi @@ -0,0 +1,1986 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher, Max Neunhöffer, Ákos Seress. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +############################################################################# + + + +############################################################################# +############################################################################# +######## General utils ###################################################### +############################################################################# +############################################################################# + + + +InstallMethod( CharacteristicPolynomial, "for a memory element matrix", + [ IsMatrix and IsObjWithMemory ], + function(m) + return CharacteristicPolynomial(m!.el); + end ); + + + +InstallOtherMethod( \-, "for two memory elements", + [ IsMatrix and IsObjWithMemory, IsMatrix and IsObjWithMemory ], + function(m,n) + return m!.el - n!.el; + end ); + + + +InstallMethod( Eigenspaces, "for a field and a memory element matrix", + [ IsField, IsMatrix and IsObjWithMemory ], + function( f, m ) + return Eigenspaces(f,m!.el); + end ); + + +# compute the eigenspace of `mat` for the given eigenvalue lambda` +RECOG.EigenspaceMat := function(mat, lambda) + local i; + mat := MutableCopyMat( mat ); + # since mat is a copy, we can efficiently "subtract an identity matrix" + for i in [1..NrRows(mat)] do + mat[i,i] := mat[i,i] - lambda; + od; + # since mat is a copy we can use NullspaceMatDestructive instead of NullspaceMat + return NullspaceMatDestructive(mat); +end; + +# compute fixed space of mat, i.e. eigenspace for eigenvalue 1 +RECOG.FixspaceMat := function(mat) + return RECOG.EigenspaceMat(mat, 1); +end; + + + +############################################################################# +############################################################################# +######## CheckStingrayGroup ################################################# +############################################################################# +############################################################################# + + +RECOG.CheckNewStingrayGroup := function(g1,base1,g2,base2,q) +local baseSum, module; + + baseSum := Concatenation(base1,base2); + baseSum := TriangulizedMat(baseSum); + if IsZero(Last(baseSum)) then + return false; + fi; + + g1 := TransposedMat(StripMemory(g1)); + g2 := TransposedMat(StripMemory(g2)); + module := GModuleByMats( [g1,g2], GF(q) ); + module := MTX.InducedActionSubmoduleNB( module, baseSum ); + return MTX.IsIrreducible(module); +end; + + + +############################################################################# +############################################################################# +######## ConstructSmallSub ################################################## +############################################################################# +############################################################################# + + + +RECOG.ConstructSmallSub := function(r1, r2, product, newbasis, detectFun) + local gens, pseudoorderlist, Hsub, productEle, ele, ele2, H, cord1, cord2; + + gens := []; + pseudoorderlist := []; + Hsub := []; + repeat + productEle := PseudoRandom(product); + Add(Hsub, productEle); + ele := (productEle)^(newbasis^(-1)); + ele2 := ele{r2}{r2}; + ele := ele{r1}{r1}; + Add(pseudoorderlist, RECOG.EstimateOrder(ele2)[1]); + Add(gens,ele); + until Size(gens) = 2; + H := GroupByGenerators(gens); + if detectFun(H) = true then + cord1 := Order(gens[1]); + cord2 := Order(gens[2]); + if (Gcd(cord1,pseudoorderlist[1]) <> pseudoorderlist[1]) and (Gcd(cord2,pseudoorderlist[2]) <> pseudoorderlist[2]) then + gens[1] := gens[1]^pseudoorderlist[1]; + gens[2] := gens[2]^pseudoorderlist[2]; + H := GroupByGenerators(gens); + if detectFun(H) = true then + Hsub[1] := Hsub[1]^pseudoorderlist[1]; + Hsub[2] := Hsub[2]^pseudoorderlist[2]; + return [Hsub,H,newbasis]; + fi; + fi; + fi; + return fail; +end; + + + +############################################################################# +############################################################################# +######## constructppdTwoStingray ############################################ +############################################################################# +############################################################################# + + + +RECOG.constructppdTwoStingray := function(g,dim,q,type,form) + local out, list, out2, currentdim, aimdim, godown; + + if type = "SL" then + aimdim:=-1; + elif type = "O" then + aimdim:=8; + elif type = "Sp" then + aimdim:=8; + elif type = "SU" then + if IsEvenInt(q) then + aimdim := 10; + else + aimdim := 6; + fi; + else + Error("unsupported type ", type); + fi; + + Info(InfoRecog,2,"Current Dimension: ", dim, " for type ", type); + Info(InfoRecog,2,"\n"); + + list:=[g,dim,q,fail,form]; + currentdim := dim; + repeat + out:=RECOG.godownStingray(list,type); + if out=fail or IsOne(out[1]^2) then + Info(InfoRecog,2,"Restart. \n"); + Info(InfoRecog,2,"Current Dimension: "); + Info(InfoRecog,2,dim); + Info(InfoRecog,2,"\n"); + list:=[g,dim,q,fail,form]; + out:=fail; + else + if type = "SL" and out[2] = 2 then + return out[1]; + fi; + Assert(0, out[1] >= 2); + repeat + out2:=RECOG.godownStingray(list,type); + if out2=fail or out2[1]*out2[1]=One(out2[1]) then + if InfoLevel(InfoRecog) >= 3 then Print("B\c"); fi; + list:=[g,dim,q,fail,form]; + out2:=fail; + fi; + until out2<>fail and out2[2] >= 2; + if type = "SL" and out2[2] = 2 then + return out2[1]; + fi; + if RECOG.CheckNewStingrayGroup(out[1],out[3],out2[1],out2[3],q) then + list:=[Group(out[1],out2[1]),out[2]+out2[2],q,fail,form]; + currentdim := list[2]; + + Info(InfoRecog,2,"Debug Info:\n"); + Info(InfoRecog,2,"Dimension FirstElement: "); + Info(InfoRecog,2,out[2]); + Info(InfoRecog,2,"\n"); + Info(InfoRecog,2,"Dimension SecondElement: "); + Info(InfoRecog,2,out2[2]); + Info(InfoRecog,2,"\n"); + Info(InfoRecog,2,"End Debug Info. \n"); + + Info(InfoRecog,2,"New Dimension: "); + Info(InfoRecog,2,out[2]+out2[2]); + Info(InfoRecog,2,"\n"); + else + if InfoLevel(InfoRecog) >= 3 then Print("B\c"); fi; + Info(InfoRecog,2,"Restart. \n"); + Info(InfoRecog,2,"Current Dimension: "); + Info(InfoRecog,2,dim); + Info(InfoRecog,2,"\n"); + list:=[g,dim,q,fail,form]; + out:=fail; + fi; + fi; + until currentdim=aimdim; + + return list[1]; + +end; + + + +############################################################################# +############################################################################# +######## godownStingray ##################################################### +############################################################################# +############################################################################# + + + +# finds first element of a list that is relative prime to all others +# input: list=[Sp(d,q), d, q, Sp(n,q)] acting as a subgroup of some big Sp(n,q) +# output: list=[rr, dd] for a ppd(2*dd;q)-element rr +RECOG.godownStingray := function(list,type) +local d, firstSL, firstSU, q, p, g, i, r, pol, factors, degrees, newdim, power, rr, ss, max, +newgroup, colldegrees, exp, count, check, ocount, beta, NiList, Maxi, qFactors, +irrfact, invbase, form, CheckOtherFactors, CheckFactors, fld, restricted, b, j; + + CheckOtherFactors := function(i, deg, fact) + local j; + for j in [1..Length(deg)] do + if not(j = i) then + if RECOG.CheckPolynomialForSelfConjugate(fact[j]) then + if (deg[j] mod deg[i] = 0) then + return false; + fi; + else + if (deg[j] mod Int(deg[i]/2) = 0) then + return false; + fi; + fi; + fi; + od; + return true; + end; + + CheckFactors := function(deg, fact) + local i; + for i in [1..Length(deg)] do + if ((deg[i] mod 2) = 0) and RECOG.CheckPolynomialForSelfConjugate(fact[i]) and CheckOtherFactors(i,deg,fact) then + return i; + fi; + od; + return fail; + end; + + firstSU := function(list) + local i, j, goodElement; + for i in [1..Length(list)] do + if list[i]>1 and (list[i] mod 2 = 1) then + if Gcd(list[i],Product(list)/list[i]) < list[i] then + return i; + else + goodElement := true; + for j in [1..Length(list)] do + if not(j = i) and Gcd(list[i],list[j]) = list[i] then + goodElement := false; + break; + fi; + od; + if goodElement then + return i; + fi; + fi; + fi; + od; + return fail; + end; + + firstSL := function(list) + local i, j, goodElement; + for i in [1..Length(list)] do + if list[i]>1 then + if Gcd(list[i],Product(list)/list[i]) < list[i] then + return i; + else + goodElement := true; + for j in [1..Length(list)] do + if not(j = i) and Gcd(list[i],list[j]) = list[i] then + goodElement := false; + break; + fi; + od; + if goodElement then + return i; + fi; + fi; + fi; + od; + return fail; + end; + + g:=list[1]; + d:=list[2]; + q:=list[3]; + qFactors:=Factors(q); + p := qFactors[1]; + form := list[5]; + fld := GF(q); + + if type = "SL" then + max := Maximum([Log2Int(d),3]); + elif type = "Sp" then + max := Maximum([2*Log2Int(d),3]); + elif type = "SU" then + max := Maximum([2*Log2Int(d),3]); + elif type = "O" then + max := Maximum([2*Log2Int(d),3]); + else + Error("type not supported"); + fi; + + # Overall count. Replace by formula and unequality + ocount := 0; + while ocount < 100 do + + Info(InfoRecog,2,"Dimension: ",d); + #find an element with irreducible action of relative prime dimension to + #all other invariant subspaces + #count is just safety, if things go very bad + count:=0; + + repeat + count:=count+1; + r:=PseudoRandom(g); + pol:=CharacteristicPolynomial(r); + factors:=Factors(pol); + degrees:=List(factors,Degree); + if type = "SL" then + newdim:= firstSL(degrees); + elif type = "SU" then + newdim:= firstSU(degrees); + elif type = "O" or type = "Sp" then + newdim := CheckFactors(degrees, factors); + else + Error("type not supported"); + fi; + until (count>100) or (newdim <> fail and (degrees[newdim] < max)); + # Be careful if Log2Int(d) = 2! In this case we search for stingray elements with k < 2. Hence use newdim < Maximum([Log2Int(d),3]) + + if count>100 then + return fail; + fi; + + # Split result from first: + irrfact := factors[newdim]; + newdim := degrees[newdim]; + + if newdim = 2 and type = "SL" then + check := true; + else + # Check whether the stingray candidate is a ppd-stingray element + check := RECOG.IsPpdStingrayElement(p,Length(qFactors),newdim,irrfact); + fi; + + if check then + + # raise r to a power so that acting trivially outside one invariant irreducible subspace + NiList := Collected(degrees); + NiList := Filtered(NiList,x->not(x[1] = newdim)); + colldegrees := List(NiList,x->x[1]); + NiList := List(NiList,x->x[2]); + Maxi := Maximum(NiList); + beta := LogInt(Maxi,p); + if not(p^beta = Maxi) then + beta := beta + 1; + fi; + + # power further to cancel q-part of element order + power := Lcm(List(colldegrees, x->q^x-1))*p^beta; + rr:=r^power; + + invbase := NullspaceMat(TransposedMat(RECOG.FixspaceMat(StripMemory(rr)))); + + if newdim = 2 and type = "SL" then + if Size(invbase) = 2 then + return [rr,newdim,invbase]; + fi; + else + + #if (type = "SL") or (IsEvenInt(q) and type = "SU") then + # return [rr,newdim,invbase]; + #fi; + + #b := Basis(VectorSpace(fld,invbase),invbase); + #restricted := IdentityMat(newdim,fld); + #for i in [1..newdim] do + # for j in [1..newdim] do + # restricted[i,j] := b[i]*form*b[j]; + # od; + #od; + + #if IsEmpty(NullspaceMat(restricted)) then + return [rr,newdim,invbase]; + #else + # Error("here"); + #fi; + fi; + fi; + + ocount := ocount + 1; + od; + + return fail; + +end; + + + +############################################################################# +############################################################################# +######## PPD Check ########################################################## +############################################################################# +############################################################################# + + + +RECOG.CheckPPDdqe := function(m,d,q,e) +local factors, i, ele, good, ord; + + factors := Factors(q^e-1); + ord := Order(m); + for ele in factors do + good := true; + for i in [1..(e-1)] do + if ((q^i-1) mod ele) = 0 then + good := false; + break; + fi; + od; + if good then + if (ord mod ele) = 0 then + return true; + fi; + fi; + od; + + return false; +end; + + + +############################################################################# +############################################################################# +######## Coefficients Primitive Element ##################################### +############################################################################# +############################################################################# + + + +# The following function has been written by Thomas Breuer. +# It expresses an element alpha in a field fld as +# a linear combination of a Primitive Element. + +# Input: fld: A field, +# alpha : An element of fld + +# Output: Coefficients: A vector c sth for omega primitive element +# alpha = sum c[i] omega^(i-1) + +RECOG.CoefficientsPrimitiveElement := function ( fld, alpha ) + + if Size( fld ) <= MAXSIZE_GF_INTERNAL then + + return Coefficients( CanonicalBasis( fld ), alpha ); + else + + alpha := FFECONWAY.WriteOverLargerField( alpha, DegreeOverPrimeField( fld ) ); + + if IsCoeffsModConwayPolRep( alpha ) then + return alpha![1]; + elif IsModulusRep(alpha) then + return [alpha]; + else + Error( "this should not happen" ); + fi; + fi; + +end; + + + +############################################################################# +############################################################################# +######## Check PPD-Property and tests ####################################### +############################################################################# +############################################################################# + + + +## This function takes as input: +## +## field +## a characteristic polynomial +## degree of +##

a prime power +## an integer +## an irreducible factor of and of degree a + +RECOG.IsPpdStingrayElement := function( p, f, k, irrfact ) + local c, e, R, pm, g, islarge, F; + + F := GF(p^f); + c := irrfact; + R := PolynomialRing(F); + + e := k; + ## find the noppds and ppds parts + pm := PrimitivePrimeDivisors( f*e, p ); + ## pm contains two fields, noppds and ppds. + ## ppds is the product of all ppds of p^(ae)-1 + ## and noppds is p^(ae)-1/ppds. + + ## get rid of the non-ppd part + ## g will be x^noppds in F[x]/ + g := PowerMod( Indeterminate(F), pm.noppds, c ); + + ## now we know that is a ppd-element + + ## if g is one there is no ppd involved + if IsOne(g) then + return false; + else + return true; + fi; + + #if IsOne(g) then + # ## (e+1) is the only ppd dividing || and only once + # islarge := false; + # return [ e, islarge ]; + #else + # ## Either another ppd also divides || and this one is large or + # ## (e+1)^2 divides || and hence still large + # islarge := true; + # return [ e, islarge ]; + #fi; + + +end; + + + +RECOG.ComparePPDFunction := function(m,d,q,e,irrfact) + local f,p,factors; + + factors := Factors(q); + p := factors[1]; + f := Length(factors); + + if not(RECOG.CheckPPDdqe(m,d,q,e) = RECOG.IsPpdStingrayElement(p,f,e,irrfact[1])) then + Error("PPD error"); + fi; + +end; + + + +############################################################################# +############################################################################# +######## Linear action representation ####################################### +############################################################################# +############################################################################# + + + +RECOG.LinearAction := function(bas,field,el) + local mat,vecs; + if IsGroup(el) then + return Group(List(GeneratorsOfGroup(el), + x->RECOG.LinearAction(bas,field,x))); + fi; + if IsBasis(bas) then + vecs := BasisVectors(bas); + else + vecs := bas; + bas := Basis(VectorSpace(field,bas),bas); + fi; + mat := List(vecs,v->Coefficients(bas,v*el)); + ConvertToMatrixRep(mat,field); + return mat; +end; + + + +RECOG.LinearActionRepresentation := function(G) +local OldGens, newGens, i, base, fld, d, EleBase, fixbase, B, action, ele, V; + + OldGens := ShallowCopy(GeneratorsOfGroup(G)); + for i in [1..Length(OldGens)] do + if IsObjWithMemory(OldGens[i]) then + OldGens[i] := StripMemory(OldGens[i]); + fi; + od; + + fld := FieldOfMatrixList(OldGens); + d := Size(OldGens[1]); + base := []; + for i in [1..Length(OldGens)] do + ele := OldGens[i]; + fixbase := RECOG.FixspaceMat(TransposedMat(ele)); + if fixbase = [] then + return fail; + fi; + EleBase := NullspaceMat(TransposedMat(fixbase)); + Append(base,EleBase); + od; + + V := VectorSpace(fld,base); + B := Basis(V); + base := BasisVectors(B); + newGens := []; + for i in [1..Length(OldGens)] do + ele := OldGens[i]; + action := List(base,v->Coefficients(B,v*ele)); + Add(newGens,action); + od; + + return GroupByGenerators(newGens); +end; + + + +RECOG.LinearActionRepresentationSmallerMatrices := function(G) +local OldGens, newGens, i, base, fld, d, EleBase, fixbase, B, action, ele, V, baseCopy; + + OldGens := ShallowCopy(GeneratorsOfGroup(G)); + for i in [1..Length(OldGens)] do + if IsObjWithMemory(OldGens[i]) then + OldGens[i] := StripMemory(OldGens[i]); + fi; + od; + # Einfach StripMemory OldGens := StripMemory(GeneratorsOfGroup(G)) + + fld := FieldOfMatrixList(OldGens); + d := NumberRows(OldGens[1]); + base := []; + for i in [1..Length(OldGens)] do + ele := OldGens[i]; + fixbase := RECOG.FixspaceMat(TransposedMat(ele)); + EleBase := NullspaceMat(TransposedMat(fixbase)); + Append(base,EleBase); + od; + baseCopy := base; + + V := VectorSpace(fld,base); + B := Basis(V); + base := BasisVectors(B); + newGens := []; + for i in [1..Length(OldGens)] do + ele := OldGens[i]; + action := List(base,v->Coefficients(B,v*ele)); + + # DR: Change here so that we still operate from the same side + Add(newGens,action); + od; + + return [GroupByGenerators(newGens),Size(B),baseCopy]; +end; + + + +RECOG.LinearActionRepresentationSmallerMatricesVersion2 := function(G) +local OldGens, newGens, i, base, fld, d, EleBase, fixbase, B, action, ele, V; + + OldGens := ShallowCopy(GeneratorsOfGroup(G)); + for i in [1..Length(OldGens)] do + if IsObjWithMemory(OldGens[i]) then + OldGens[i] := StripMemory(OldGens[i]); + fi; + od; + # Einfach StripMemory OldGens := StripMemory(GeneratorsOfGroup(G)) + + fld := FieldOfMatrixList(OldGens); + d := NumberRows(OldGens[1]); + base := []; + for i in [1..Length(OldGens)] do + ele := OldGens[i]; + fixbase := RECOG.FixspaceMat(TransposedMat(ele)); + EleBase := NullspaceMat(TransposedMat(fixbase)); + Append(base,EleBase); + od; + + V := VectorSpace(fld,base); + B := Basis(V); + base := BasisVectors(B); + newGens := []; + for i in [1..Length(OldGens)] do + ele := OldGens[i]; + action := List(base,v->Coefficients(B,v*ele)); + + # DR: Change here so that we still operate from the same side + Add(newGens,action); + od; + + return [GroupByGenerators(newGens),Size(B),BasisVectors(B)]; +end; + + + +############################################################################# +############################################################################# +######## Self-conjugate polynomial check #################################### +############################################################################# +############################################################################# + + + +RECOG.CheckPolynomialForSelfConjugate := function (f) +local ind, coeff, aZero, i, fld, deg, pol; + + fld := FieldOfPolynomial(f); + ind := IndeterminateOfLaurentPolynomial(f); + coeff := CoefficientsOfLaurentPolynomial(f)[1]; + deg := Length(coeff); + aZero := coeff[1]; + + pol := ind^0 * Zero(fld); + for i in [1..deg] do + pol := pol + ind^(deg-i)*coeff[i]; + od; + + pol := aZero * pol; + + if pol = f then + return true; + else + return false; + fi; +end; + + + +############################################################################# +############################################################################# +######## Extract and rescale block matrices ################################# +############################################################################# +############################################################################# + + + +RECOG.ComputeBlockBaseChangeMatrix := function(list,d,q) +local fixbase, elebase, basis, matrix, fix, moved, currentmove, currentfix, k, newbase, OldGens, i; + + OldGens := ShallowCopy(list); + for i in [1..Length(OldGens)] do + if IsObjWithMemory(OldGens[i]) then + OldGens[i] := StripMemory(OldGens[i]); + fi; + od; + list := OldGens; + + fix := []; + moved := []; + + for matrix in list do; + fixbase := RECOG.FixspaceMat(TransposedMat(matrix)); + elebase := NullspaceMat(TransposedMat(fixbase)); + Add(moved, elebase); + + fixbase := RECOG.FixspaceMat(matrix); + Add(fix,fixbase); + od; + + if Size(moved) = 1 then + newbase := MutableCopyMat(moved[1]); + Append(newbase,fix[1]); + return newbase; + else + currentmove := MutableCopyMat(moved[1]); + currentfix := MutableCopyMat(fix[1]); + k := 1; + while k < Size(moved) do + currentmove := SumIntersectionMat(currentmove,moved[k+1])[1]; + currentfix := SumIntersectionMat(currentfix,fix[k+1])[2]; + k := k + 1; + od; + Append(currentmove,currentfix); + return currentmove; + fi; + +end; + + + +RECOG.ExtractSmallerGroup := function(list,basechange,size) +local gens, ele, block, OldGens, i; + + OldGens := ShallowCopy(list); + for i in [1..Length(OldGens)] do + if IsObjWithMemory(OldGens[i]) then + OldGens[i] := StripMemory(OldGens[i]); + fi; + od; + list := OldGens; + + gens := []; + for ele in list do + block := (ele^(basechange^(-1))); + block := block{[1..size]}{[1..size]}; + Add(gens,block); + od; + + return [GroupByGenerators(gens),gens]; +end; + + + +RECOG.LiftGroup := function(list,size,q,d) +local gens, ele, block, OldGens, i; + + OldGens := ShallowCopy(list); + for i in [1..Length(OldGens)] do + if IsObjWithMemory(OldGens[i]) then + OldGens[i] := StripMemory(OldGens[i]); + fi; + od; + list := OldGens; + + gens := []; + for ele in list do + block := IdentityMat(d,GF(q)); + block{[1..size]}{[1..size]} := ele; + Add(gens,block); + od; + + return [GroupByGenerators(gens),gens]; +end; + + + +############################################################################# +############################################################################# +######## Membership test in groups preserving a form ######################## +############################################################################# +############################################################################# + + +# given a matrix `mat`, test if it is contained in G, which must be Omega(e,n,fld) +# +# TODO: add unit tests +# +# e:=+1; d:=8; q:=8; +# G:=Omega(e,d,q); +# H:=SO(e,d,q,InvariantQuadraticForm(G).matrix); +# ForAll(GeneratorsOfGroup(G), g -> g in H); +# ForAll(GeneratorsOfGroup(G), g -> IsInOmega(G, g)); +# ForAll(GeneratorsOfGroup(H), g -> IsInOmega(G, g)); +# +RECOG.IsInOmega:=function(G,mat) + local d, Q, form, fld; + d := DimensionOfMatrixGroup(G); + fld := FieldOfMatrixGroup(G); + Assert(0, NrRows(mat) = d); + + # first verify the quadratic form is preserved + Q := InvariantQuadraticForm(G).matrix; + if not RespectsQuadraticForm(Q, mat) then + return false; + fi; + + if Characteristic(fld) <> 2 then + form := InvariantBilinearForm(G).matrix; + return IsOne(SpinorNorm(form, fld, mat)); + elif IsOddInt(d) then + # Omega(0,2n+1,2^k) = SO(0,2n+1,2^k) = GO(0,2n+1,2^k) + return true; + else + # the following is based on Lemma 3.5(2) in Holt, Roney-Dougal: + # "Constructing maximal subgroups of orthogonal groups" + return IsEvenInt(RankMat(mat + One(G))); + fi; +end; + + + +############################################################################# +############################################################################# +# Code from ClassicalMaximal to check BilinearForm ########################## +# https://github.com/gap-packages/ClassicalMaximals/blob/main/gap/Forms.gi ## +############################################################################# +############################################################################# + + + +RECOG.MatrixByEntries := function(field, nrRows, nrCols, entries) + local i, m, o; + o := One(field); + m := NullMat(nrRows, nrCols, field); + for i in entries do + m[i[1],i[2]] := i[3]*o; + od; + return ImmutableMatrix(field, m); +end; + + + +RECOG.AntidiagonalMat := function(entries, field) + local d, m, i; + if IsInt(entries) then + d := entries; + entries := ListWithIdenticalEntries(d, One(field)); + else + d := Length(entries); + fi; + m := NullMat(d, d, field); + for i in [1..d] do + m[i, d - i + 1] := entries[i]; + od; + return ImmutableMatrix(field, m); +end; + + + +# Solving the congruence a ^ 2 + b ^ 2 = c in F_q by trial and error. +# +# A solution always exists by a simple counting argument using the pigeonhole +# principle and the fact that there are (q + 1) / 2 > q / 2 squares in F_q (for +# q odd; the case q even is trivial). The trial and error approach taken here +# should in principle almost always terminate quickly: Assuming that - 1 - a ^ 2 +# is evenly distributed in GF(q), the chance to hit a quadratic residue is about +# 1 / 2 in each trial. +RECOG.SolveQuadraticCongruence := function(c, q) + local F, a, b; + F := GF(q); + for a in F do + b := RootFFE(F, (c - a ^ 2) * Z(q) ^ 0, 2); + if not b = fail then + break; + fi; + od; + return rec(a := a, b := b); +end; + + + +RECOG.ApplyFunctionToEntries := function(M, func) + local numberRows, numberColumns, i, j, result; + if not IsMatrix(M) or Length(M) = 0 then + ErrorNoReturn(" must be a matrix but = ", M); + fi; + + numberRows := NrRows(M); + numberColumns := NrCols(M); + result := NullMat(numberRows, numberColumns, DefaultFieldOfMatrix(M)); + for i in [1..numberRows] do + for j in [1..numberColumns] do + result[i, j] := func(M[i, j]); + od; + od; + + return result; +end; + + + +RECOG.HermitianConjugate := function(M, q) + return TransposedMat(RECOG.ApplyFunctionToEntries(M, x -> x ^ q)); +end; + + + +# If type = "S" then find a beta in GF(q ^ 2) with beta + beta ^ q = alpha. +# If type = "P" then find a beta in GF(q ^ 2) with gamma * gamma ^ q = alpha. +# In both cases, alpha is an element of GF(q). +# Construction as in Lemma 2.2 of [HR05] +RECOG.SolveFrobeniusEquation := function(type, alpha, q) + local F, R, S, x, delta, polynomial, result; + + F := GF(q); + if not alpha in F then + ErrorNoReturn(" must be an element of GF() but = ", + alpha, " and = ", q); + fi; + if not type in ["S", "P"] then + ErrorNoReturn(" must be one of 'S' or 'P' but = ", type); + fi; + # We have to make an exception for this case since the construction below + # does not work here: x ^ 2 + delta is never irreducible over GF(q) since + # all elements of GF(q) are squares for q even. + if type = "S" and alpha = 0 and IsEvenInt(q) then + return Z(q) ^ 0; + fi; + + R := PolynomialRing(F, ["x"]); + S := PolynomialRing(GF(q ^ 2), ["x"]); + x := Indeterminate(F, "x"); + + # A quick argument using the quadratic formula for q odd or some + # algebraic manipulations and the non-surjectivity of the Artin-Schreier + # map x -> x ^ 2 + x for q odd and alpha <> 0 shows that the construction + # below always works. + if type = "S" then + for delta in F do + polynomial := x ^ 2 - alpha * x + delta; + if IsIrreducibleRingElement(R, polynomial) then + result := -CoefficientsOfUnivariatePolynomial(Factors(S, polynomial)[1])[1]; + return result; + fi; + od; + # A similar argument to the one used for type "S" works here as well. Note, + # however, that the argument for q odd via the quadratic formula now + # additionally needs that the squares in GF(q) do not form an arithmetic + # progression (which is "closed", i.e. not only a_i+1 = a_i + d, but also + # a_n + d = a_1), which can be proved in the following way: If they did, + # then they would be given by -kd, ..., -d, 0, d, 2d, ..., ((q - 1) / 2 - k) * d + # for some 0 <= k <= (q - 1) / 2; since they form a multiplicative + # subgroup, we can divide by -d or d, respectively, and see that + # -+k, ..., -+1, 0, +-1, +-2, ..., +-((q - 1) / 2 - k) are also all the + # squares in GF(q). Most notably they all are in GF(p) and thus there are + # at most p squares in GF(q), which is < (q + 1) / 2 if q >= p ^ 2 - a + # contradiction. Now we can restrict ourselves to q = p and reach a + # contradiction for p >= 7 (we leave out the details); this leaves p = 3 + # and p = 5, which can easily be checked manually. + elif type = "P" then + for delta in F do + polynomial := x ^ 2 + delta * x + alpha; + if IsIrreducibleRingElement(R, polynomial) then + result := -CoefficientsOfUnivariatePolynomial(Factors(S, polynomial)[1])[1]; + return result; + fi; + od; + fi; +end; + + + +# An n x n - matrix of zeroes with a 1 in position (row, column) +RECOG.SquareSingleEntryMatrix := function(field, n, row, column) + return RECOG.MatrixByEntries(field, n, n, [[row, column, 1]]); +end; + + + +# Compute Ceil(m / n) for two integers m, n +RECOG.QuoCeil := function(m, n) + if m mod n = 0 then + return QuoInt(m, n); + else + return QuoInt(m, n) + 1; + fi; +end; + + + +# Compute the size of Sp(n, q) according to Theorem 1.6.22 in [BHR13] +RECOG.SizeSp := function(n, q) + local m, result, powerOfq, i; + if IsOddInt(n) then + ErrorNoReturn("Dimension must be even but ", n, " was given."); + fi; + m := QuoInt(n, 2); + result := q ^ (m * m); + powerOfq := 1; + for i in [1..m] do + powerOfq := powerOfq * q * q; + result := result * (powerOfq - 1); + od; + return result; +end; + + + +# Compute the size of PSp(n, q) according to Table 1.3 in [BHR13], +RECOG.SizePSp := function(n, q) + return QuoInt(RECOG.SizeSp(n, q), Gcd(2, q - 1)); +end; + + + +# Compute the size of SU(n, q) according to Theorem 1.6.22 in [BHR13] +# using the formula for GU(n, q) but starting with i = 2 +# because Table 1.3 gives [GU(n, q):SU(n, q)] = q + 1. +RECOG.SizeSU := function(n, q) + local result, powerOfq, sign, i; + result := q ^ QuoInt(n * (n - 1), 2); + powerOfq := q; + sign := 1; + for i in [2..n] do + powerOfq := powerOfq * q; + sign := -sign; + result := result * (powerOfq + sign); + od; + return result; +end; + + + +# Compute the size of PSU(n, q) according to Table 1.3 in [BHR13] +# Namely, we have | G / Z(G) : S / Z(S) | = | G : S | * |Z(S)| / |Z(G)| so due +# to | G : S | = q + 1, |Z(G)| = q + 1 and | G / Z(G) : S / Z(S) | = (q + 1, n), +# which are given in said table, this gives |Z(S)| = (q + 1, n). +RECOG.SizePSU := function(n, q) + return RECOG.SizeSU(n, q) / Gcd(n, q + 1); +end; + + + +# Compute the size of GU(n, q) according to Table 1.3 in [BHR13] +RECOG.SizeGU := function(n, q) + return (q + 1) * RECOG.SizeSU(n, q); +end; + + + +# Compute the size of GO(epsilon, n, q) according to Theorem 1.6.22 in [BHR13] +RECOG.SizeGO := function(epsilon, n, q) + local m, result, powerOfq, i; + if epsilon = 0 then + + if IsEvenInt(n) then + ErrorNoReturn("for = ", epsilon, " the dimension must be odd but ", n, " was given."); + fi; + + if IsEvenInt(q) then + return RECOG.SizeSp(n - 1, q); + fi; + + m := QuoInt(n - 1, 2); + result := 2 * q ^ (m * m); + + elif epsilon in [-1, 1] then + + if IsOddInt(n) then + ErrorNoReturn("for = ", epsilon, " the dimension must be even but ", n, " was given."); + fi; + + m := QuoInt(n, 2); + result := 2 * q ^ (m * (m - 1)) * (q ^ m - epsilon); + m := m - 1; + else + ErrorNoReturn(" must be in [-1, 0, 1] but ", epsilon, " was given."); + fi; + + powerOfq := 1; + for i in [1..m] do + powerOfq := powerOfq * q * q; + result := result * (powerOfq - 1); + od; + + return result; +end; + + + +# Compute the size of SO(epsilon, n, q) according to Table 1.3 in [BHR13] +RECOG.SizeSO := function(epsilon, n, q) + return QuoInt(RECOG.SizeGO(epsilon, n, q), Gcd(2, q - 1)); +end; + + + +RECOG.ReflectionMatrix := function(n, q, gramMatrix, v) + local F, reflectionMatrix, i, basisVector, reflectBasisVector, beta; + F := GF(q); + reflectionMatrix := NullMat(n, n, F); + beta := BilinearFormByMatrix(gramMatrix); + if IsZero(EvaluateForm(beta, v, v)) then + ErrorNoReturn("The vector must have non-zero norm with respect to", + " the bilinear form given by "); + fi; + for i in [1..n] do + basisVector := List([1..n], j -> Zero(F)); + basisVector[i] := Z(q) ^ 0; + reflectBasisVector := basisVector + - 2 * EvaluateForm(beta, v, basisVector) + / EvaluateForm(beta, v, v) * v; + reflectionMatrix[i]{[1..n]} := reflectBasisVector; + od; + return reflectionMatrix; +end; + + + +# Construct generators for the orthogonal groups with the properties listed in +# Lemma 2.4 of [HR05]. +# Construction as in: C. M. Roney-Dougal. "Conjugacy of Subgroups of the +# General Linear Group." Experimental Mathematics, vol. 13 no. 2, 2004, pp. +# 151-163. Lemma 2.4. +# We take the notation from [HR05]. +RECOG.GeneratorsOfOrthogonalGroup := function(epsilon, n, q) + local F, gramMatrix, generatorsOfSO, vectorOfSquareNorm, D, E, zeta, a, b, + solutionOfQuadraticCongruence; + if IsEvenInt(q) then + ErrorNoReturn("This function was only designed for odd but = ", + n, "and = ", q); + fi; + + F := GF(q); + zeta := PrimitiveElement(F); + if IsOddInt(n) then + gramMatrix := IdentityMat(n, F); + generatorsOfSO := GeneratorsOfGroup(RECOG.ConjugateToSesquilinearForm(SO(epsilon, n, q), + "O", + gramMatrix)); + D := - IdentityMat(n, F); + E := zeta * IdentityMat(n, F); + else + if epsilon = 1 then + gramMatrix := RECOG.AntidiagonalMat(n, F); + generatorsOfSO := GeneratorsOfGroup(RECOG.ConjugateToSesquilinearForm(SO(epsilon, n, q), + "O", + gramMatrix)); + # Our standard bilinear form is given by the Gram matrix + # Antidiag(1, ..., 1). The norm of [1, 0, ..., 0, 2] under this + # bilinear form is 4, i.e. a square. (Recall q odd, so this is not zero!) + vectorOfSquareNorm := zeta ^ 0 * Concatenation([1], + List([1..n - 2], i -> 0), + [2]); + D := RECOG.ReflectionMatrix(n, q, gramMatrix, vectorOfSquareNorm); + E := DiagonalMat(Concatenation(List([1..n / 2], i -> zeta), + List([1..n / 2], i -> zeta ^ 0))); + elif epsilon = -1 then + + # Get a, b in GF(q) with a ^ 2 + b ^ 2 = zeta + solutionOfQuadraticCongruence := RECOG.SolveQuadraticCongruence(zeta, q); + a := solutionOfQuadraticCongruence.a; + b := solutionOfQuadraticCongruence.b; + + if IsOddInt(n * (q - 1) / 4) then + gramMatrix := IdentityMat(n, F); + generatorsOfSO := GeneratorsOfGroup(RECOG.ConjugateToSesquilinearForm(SO(epsilon, n, q), + "O", + gramMatrix)); + # Our standard bilinear form is given by the Gram matrix + # Diag(1, ..., 1). The norm of [1, 0, ..., 0] under this bilinear + # form is 1, i.e. a square. + vectorOfSquareNorm := zeta ^ 0 * Concatenation([1], + List([1..n - 1], i -> 0)); + D := RECOG.ReflectionMatrix(n, q, gramMatrix, vectorOfSquareNorm); + # Block diagonal matrix consisting of n / 2 blocks of the form + # [[a, b], [b, -a]]. + E := RECOG.MatrixByEntries(F, n, n, + Concatenation(List([1..n], i -> [i, i, (-1) ^ (i + 1) * a]), + List([1..n], i -> [i, i + (-1) ^ (i + 1), b]))); + else + gramMatrix := Z(q) ^ 0 * DiagonalMat(Concatenation([zeta], + List([1..n - 1], i -> 1))); + generatorsOfSO := GeneratorsOfGroup(RECOG.ConjugateToSesquilinearForm(SO(epsilon, n, q), + "O", + gramMatrix)); + # Our standard bilinear form is given by the Gram matrix + # Diag(zeta, 1, ..., 1). The norm of [0, ..., 0, 1] under this + # bilinear form is 1, i.e. a square. + vectorOfSquareNorm := zeta ^ 0 * Concatenation(List([1..n - 1], i -> 0), + [1]); + D := RECOG.ReflectionMatrix(n, q, gramMatrix, vectorOfSquareNorm); + # Block diagonal matrix consisting of one block [[0, zeta], [1, 0]] + # and n / 2 - 1 blocks of the form [[a, b], [b, -a]]. + E := RECOG.MatrixByEntries(F, n, n, + Concatenation([[1, 2, zeta], [2, 1, zeta ^ 0]], + List([3..n], i -> [i, i, (-1) ^ (i + 1) * a]), + List([3..n], i -> [i, i + (-1) ^ (i + 1), b]))); + fi; + fi; + fi; + + return rec(generatorsOfSO := generatorsOfSO, D := D, E := E); +end; + + + +RECOG.MatrixGroup := function(F, gens) + if IsEmpty(gens) then + ErrorNoReturn(" cannot be empty"); + elif not IsField(F) then + ErrorNoReturn(" must be a field"); + fi; + return Group(List(gens, g -> ImmutableMatrix(F, g))); +end; + + + +RECOG.MatrixGroupWithSize := function(F, gens, size) + local result; + result := RECOG.MatrixGroup(F, gens); + SetSize(result, size); + return result; +end; + + + +# Assuming that the group G acts absolutely irreducibly, try to find a +# * symplectic form (if = S) or a +# * symmetric bilinear form (if = O) +# which is G-invariant or prove that no such form exists. +# +# We use this function instead of PreservedBilinearForms form the Forms package +# since PreservedBilinearForms seems to be buggy and unreliable (see also +# comment above UnitaryForm). +# +# In general, this function should only be used if one can be sure that +# preserves a bilinear form (but one does not know which one). +RECOG.BilinearForm := function(G, type) + local F, M, inverseTransposeM, counter, formMatrix, condition; + + if not type in ["S", "O"] then + ErrorNoReturn(" must be one of 'S', 'O'"); + fi; + # Set the condition the Gram matrix needs to satisfy for each of the + # possible types. + if type = "S" then + condition := x -> (x = - TransposedMat(x)); + elif type = "O" then + condition := x -> (x = TransposedMat(x)); + fi; + + F := DefaultFieldOfMatrixGroup(G); + + # Return stored bilinear form if it exists and is symplectic / symmetric + if HasInvariantBilinearForm(G) then + formMatrix := InvariantBilinearForm(G).matrix; + if condition(formMatrix) then + return ImmutableMatrix(F, formMatrix); + fi; + fi; + + M := GModuleByMats(GeneratorsOfGroup(G), F); + + if not MTX.IsIrreducible(M) then + ErrorNoReturn("BilinearForm failed - group is not irreducible"); + fi; + + # An element A of G acts as A ^ (-T) in MTX.DualModule(M) + inverseTransposeM := MTX.DualModule(M); + + counter := 0; + # As the MeatAxe is randomised, we might have to make some more trials to + # find a preserved symplectic / symmetric bilinear form if there is one; + # breaking after 1000 trials is just a "safety net" in case a group + # that does not preserve a symplectic / symmetric bilinear form is input. + while counter < 1000 do + counter := counter + 1; + + # If f: M -> inverseTransposeM is an isomorphism, it must respect + # multiplication by group elements, i.e. for A in G + # f(x * A) = f(x) * A ^ (-T) + # Let f be given by the matrix F, i.e. f: x -> x * F. Then we have + # (x * A) * F = x * F * A ^ (-T) + # Putting these results together for all vectors x gives + # A * F = F * A ^ (-T) + # <==> A * F * A ^ T = F, + # which is what we need. + formMatrix := MTX.IsomorphismModules(M, inverseTransposeM); + + if formMatrix <> fail then + # check if formMatrix is antisymmetric + if condition(formMatrix) then + return ImmutableMatrix(F, formMatrix); + fi; + if not MTX.IsAbsolutelyIrreducible(M) then + ErrorNoReturn("BilinearForm failed - group is not absolutely irreducible"); + fi; + fi; + od; + + return fail; +end; + + + +RECOG.SymplecticForm := function(G) + return RECOG.BilinearForm(G, "S"); +end; + + + +RECOG.SymmetricBilinearForm := function(G) + return RECOG.BilinearForm(G, "O"); +end; + + + +RECOG.QuadraticForm := function(G) + local d, F, formMatrix, polarFormMatrix, i, g, RightSideForLinSys, + MatrixForLinSys, x; + + d := DimensionOfMatrixGroup(G); + F := DefaultFieldOfMatrixGroup(G); + if not IsFinite(F) then + ErrorNoReturn("The base field of must be finite"); + fi; + + if HasInvariantQuadraticForm(G) then + formMatrix := InvariantQuadraticForm(G).matrix; + return ImmutableMatrix(F, formMatrix); + fi; + + # We first look for an invariant symmetric bilinear form of G, which will + # be the polar form of the desired quadratic form + polarFormMatrix := RECOG.SymmetricBilinearForm(G); + # The Gram matrix formMatrix of the quadratic form is upper triangular and + # polarFormMatrix = formMatrix + formMatrix ^ T, so the entries above the + # main diagonal of polarFormMatrix and formMatrix must be the same + formMatrix := List([1..d], i -> Concatenation(ListWithIdenticalEntries(i, Zero(F)), + polarFormMatrix[i]{[i + 1..d]})); + if Characteristic(F) <> 2 then + # In this case, the polar form determines the quadratic form completely + formMatrix := formMatrix + 1 / 2 * DiagonalMat(DiagonalOfMatrix(polarFormMatrix)); + else + # We are left to determine the diagonal entries of formMatrix. Let them + # be x1, ..., xd and X = diag(x1, ..., xd); furthermore, let U be the + # part of polarFormMatrix above the main diagonal (i.e. the current + # value of formMatrix). Then for the quadratic form X + U to be + # preserved, we need g * (X + U) * g ^ T to have the same diagonal + # entries as X + U, i.e. as X, for each generator g of G. + # + # Hence, we need xi = (g * U * g ^ T)_ii + (x1 * g[i, 1] ^ 2 + ... + xd * g[i, d] ^ 2) + # This leads to a linear system for the xi, which we solve. + + RightSideForLinSys := Concatenation(List(GeneratorsOfGroup(G), + g -> DiagonalOfMatrix(g * formMatrix * TransposedMat(g)))); + MatrixForLinSys := Concatenation(List(GeneratorsOfGroup(G), + g -> List([1..d], + i -> DiagonalOfMatrix(TransposedMat([g[i]{[1..d]}]) * [g[i]{[1..d]}])) + + IdentityMat(d, F))); + x := SolutionMat(TransposedMat(MatrixForLinSys), RightSideForLinSys); + + if x = fail then + return fail; + fi; + + formMatrix := formMatrix + DiagonalMat(x); + fi; + + return formMatrix; +end; + + + +# Compute the Gram matrix of the quadratic form corresponding to the bilinear +# form described by in odd characteristic. +RECOG.BilinearToQuadraticForm := function(gramMatrix) + local F, n, i, Q; + + F := DefaultFieldOfMatrix(gramMatrix); + + if Characteristic(F) = 2 then + ErrorNoReturn("Characteristic must be odd"); + fi; + + n := NrRows(gramMatrix); + Q := List(gramMatrix, ShallowCopy); + for i in [1..n] do + Q{[i + 1..n]}{[i]} := NullMat(n - i, 1, F); + Q[i, i] := gramMatrix[i, i] / 2; + od; + + return Q; +end; + +# One needs to ensure that the attribute DefaultFieldOfMatrixGroup is set +# correctly for ; this can be done, for example, by making the +# generators used during construction of the group immutable matrices over the +# appropriate field. +RECOG.ConjugateToSesquilinearForm := function(group, type, gramMatrix) + local gapForm, newForm, gapToCanonical, canonicalToNew, field, formMatrix, + result, d, q, broadType; + if not type in ["S", "O-B", "O-Q", "U"] then + ErrorNoReturn(" must be one of 'S', 'U', 'O-B', 'O-Q'"); + fi; + d := DimensionOfMatrixGroup(group); + field := DefaultFieldOfMatrixGroup(group); + if type = "S" or type = "O-B" then + if type = "S" then + broadType := type; + else + broadType := "O"; + fi; + formMatrix := RECOG.BilinearForm(group, broadType); + if formMatrix = fail then + if type = "S" then + ErrorNoReturn("No preserved symplectic form found for "); + else + ErrorNoReturn("No preserved symmetric bilinear form found for", + " "); + fi; + fi; + gapForm := BilinearFormByMatrix(formMatrix, field); + newForm := BilinearFormByMatrix(gramMatrix, field); + elif type = "U" then + if IsOddInt(DegreeOverPrimeField(field)) then + q := Size(field); + field := GF(q ^ 2); + fi; + formMatrix := RECOG.UnitaryForm(group); + if formMatrix = fail then + ErrorNoReturn("No preserved unitary form found for "); + fi; + gapForm := HermitianFormByMatrix(formMatrix, field); + newForm := HermitianFormByMatrix(gramMatrix, field); + else + # This is the case type = "O-Q" + formMatrix := RECOG.QuadraticForm(group); + if formMatrix = fail then + ErrorNoReturn("No preserved quadratic form found for "); + fi; + gapForm := QuadraticFormByMatrix(formMatrix, field); + newForm := QuadraticFormByMatrix(gramMatrix, field); + fi; + if gapForm = newForm then + # nothing to be done + result := group; + # The Forms package has a bug for d = 1 so we need to make this exception + elif d <> 1 then + # the following if condition can only ever be fulfilled if is an + # orthogonal group; there the case of even dimension is problematic since, + # in that case, there are two similarity classes of bilinear forms + if not WittIndex(gapForm) = WittIndex(newForm) then + ErrorNoReturn("The form preserved by must be similar to the form ", + "described by the Gram matrix ."); + fi; + gapToCanonical := BaseChangeHomomorphism(BaseChangeToCanonical(gapForm), + field); + canonicalToNew := BaseChangeHomomorphism(BaseChangeToCanonical(newForm) ^ (-1), + field); + result := RECOG.MatrixGroup(field, canonicalToNew(gapToCanonical(GeneratorsOfGroup(group)))); + + # Set useful attributes + UseIsomorphismRelation(group, result); + else + # replaces the Witt index check above + if IsZero(gramMatrix) <> IsZero(formMatrix) then + ErrorNoReturn("The form preserved by must be similar to the", + " form described by the Gram matrix ."); + fi; + result := group; + fi; + + if type = "S" then + SetInvariantBilinearForm(result, rec(matrix := gramMatrix)); + elif type = "O-B" then + SetInvariantQuadraticFormFromMatrix(result, RECOG.BilinearToQuadraticForm(gramMatrix)); + elif type = "U" then + SetInvariantSesquilinearForm(result, rec(matrix := gramMatrix)); + else + SetInvariantQuadraticFormFromMatrix(result, gramMatrix); + fi; + + return result; +end; + +# If preserves a sesquilinear form of type (one of "S", "U", "O" +# (in odd dimension), "O+" or "O-" (both in even dimension), return a group +# conjugate to preserving the standard form of that type. +# +# Also, one need to ensure that the attribute DefaultFieldOfMatrixGroup is set +# correctly for ; this can be done, for example, by making the +# generators used during construction of the group immutable matrices over the +# appropriate field. +RECOG.ConjugateToStandardForm := function(group, type) + local d, F, q, gapForm, broadType; + + # determining d (dimension of matrix group), F (base field) and q (order of + # F) plus some sanity checks + if not type in ["S", "O+", "O-", "O", "U"] then + ErrorNoReturn(" must be one of 'S', 'U', 'O+', 'O-', 'O'"); + fi; + F := DefaultFieldOfMatrixGroup(group); + d := DimensionOfMatrixGroup(group); + if type = "O" and IsEvenInt(d) then + ErrorNoReturn(" cannot be 'O' if the dimension of is even"); + elif type in ["O+", "O-"] and IsOddInt(d) then + ErrorNoReturn(" cannot be 'O+' or 'O-' if the dimension of", + " is odd"); + elif IsEvenInt(Size(F)) and IsOddInt(d) and type in ["O+", "O-", "O"] then + ErrorNoReturn("If is 'O+', 'O-' or 'O' and the size of is", + " even, must be even"); + fi; + if type in ["S", "O", "O+", "O-"] then + q := Size(F); + else + if IsSquareInt(Size(F)) then + q := RootInt(Size(F)); + else + # It might be that G is to be understood as a matrix group over + # GF(q ^ 2), but the matrices can actually be represented over a + # smaller field, which causes DefaultFieldOfMatrixGroup to return GF(q) + # instead of GF(q ^ 2) - we have to remedy this somehow ... + q := Size(F); + fi; + fi; + + # get standard GAP form + if type = "S" then + gapForm := InvariantBilinearForm(Sp(d, q)).matrix; + elif type = "U" then + gapForm := InvariantSesquilinearForm(GU(d, q)).matrix; + elif type = "O" then + gapForm := InvariantBilinearForm(Omega(d, q)).matrix; + elif type = "O+" then + if Characteristic(F) = 2 then + gapForm := InvariantQuadraticForm(Omega(1, d, q)).matrix; + else + gapForm := InvariantBilinearForm(Omega(1, d, q)).matrix; + fi; + elif type = "O-" then + if Characteristic(F) = 2 then + gapForm := InvariantQuadraticForm(Omega(-1, d, q)).matrix; + else + gapForm := InvariantBilinearForm(Omega(-1, d, q)).matrix; + fi; + fi; + + if type in ["O", "O+", "O-"] then + if Characteristic(F) = 2 then + broadType := "O-Q"; + else + broadType := "O-B"; + fi; + else + broadType := type; + fi; + + return RECOG.ConjugateToSesquilinearForm(group, broadType, gapForm); +end; + +# Let = [f1, f2, ..., ft] be a list of sesquilinear forms on the vector +# spaces F ^ d1, F ^ d2, ..., F ^ dt. Then we can lift these to a sesquilinear +# form f on the tensor product F ^ d1 x F ^ d2 x ... x F ^ dt by defining +# f(v1 x v2 x ... x vt, w1 x w2 x ... x wt) = f1(v1, w1)f2(v2, w2)...ft(vt, wt). +# +# Return the Gram matrix of f; the forms f1, f2, ..., ft must be given as their +# respective Gram matrices. +RECOG.LiftFormsToTensorProduct := function(forms, F) + local dims, d, t, newForm, i, j, iteri, iterj, indicesi, indicesj; + + dims := List(forms, NrRows); + d := Product(dims); + t := Length(dims); + newForm := NullMat(d, d, F); + dims := List(dims,d->[1..d]); + + iteri := IteratorOfCartesianProduct(dims); + for i in [1..d] do + indicesi := NextIterator(iteri); + iterj := IteratorOfCartesianProduct(dims); + for j in [1..d] do + indicesj := NextIterator(iterj); + newForm[i, j] := Product([1..t], k -> (forms[k])[indicesi[k], indicesj[k]]); + od; + od; + + return newForm; +end; + +# Return the standard orthogonal and corresponding bilinear form as used for +# constructions in [HR10], cf. section 3.1 loc. cit. +RECOG.StandardOrthogonalForm := function(epsilon, d, q) + local field, m, F, Q, gamma, xi; + + if not epsilon in [-1, 0, 1] then + ErrorNoReturn(" must be one of -1, 0, 1"); + fi; + if epsilon = 0 and IsEvenInt(d) then + ErrorNoReturn(" must be one of -1 or 1 if is even"); + fi; + if epsilon <> 0 and IsOddInt(d) then + ErrorNoReturn(" must be 0 if is odd"); + fi; + if IsEvenInt(q) and IsOddInt(d) then + ErrorNoReturn(" must be even if is even"); + fi; + + field := GF(q); + m := QuoInt(d, 2); + F := RECOG.AntidiagonalMat(d, field); + + if IsOddInt(d * q) then + Q := RECOG.AntidiagonalMat(One(field) * Concatenation(ListWithIdenticalEntries(m, 1), + [1 / 2], + ListWithIdenticalEntries(m, 0)), + field); + else + Q := RECOG.AntidiagonalMat(One(field) * Concatenation(ListWithIdenticalEntries(m, 1), + ListWithIdenticalEntries(m, 0)), + field); + if epsilon = -1 then + if IsEvenInt(q) then + gamma := RECOG.FindGamma(q); + else + xi := PrimitiveElement(GF(q ^ 2)); + gamma := xi ^ (q + 1) * (xi + xi ^ q) ^ (-2); + fi; + + F[m, m] := 2 * gamma ^ 0; + F[m + 1, m + 1] := 2 * gamma; + Q[m, m] := gamma ^ 0; + Q[m + 1, m + 1] := gamma; + fi; + fi; + + return rec(Q := Q, F := F); +end; + +RECOG.ConjugateModule := function(M, q) + return GModuleByMats(List(MTX.Generators(M), A -> RECOG.ApplyFunctionToEntries(A, x -> x ^ q)), + MTX.Field(M)); +end; + +# Assuming that the group G acts absolutely irreducibly, try to find a unitary +# form which is G-invariant or prove that no such form exists. +# +# We use this function instead of PreservedSesquilinearForms from the Forms +# package since PreservedSesquilinearForms seems to be buggy and unreliable. +# As an example, take the group generated by +# [ 1 0 0 ] [ z^39 z^9 z^24 ] +# [ z^33 z^14 z^26 ] and [ z^25 z^16 z^6 ] +# [ z^19 z^31 z^5 ] [ z^7 z^32 z^28 ] +# where z = Z(49), which does preserve a unitary form, but this is not +# recognised by PreservedSesquilinearForms, even after some 1000 calls of the +# function. +# +# In general, this function should only be used if one can be sure that +# preserves a unitary form (but one does not know which one). +RECOG.UnitaryForm := function(G) + local d, F, q, M, inverseHermitianConjugateM, formMatrix, row, col, x, + scalar, counter; + + d := DimensionOfMatrixGroup(G); + F := DefaultFieldOfMatrixGroup(G); + if not IsFinite(F) then + ErrorNoReturn("The base field of must be finite"); + fi; + if not IsEvenInt(DegreeOverPrimeField(F)) then + # It might be that G is to be understood as a matrix group over + # GF(q ^ 2), but the matrices can actually be represented over a + # smaller field, which causes DefaultFieldOfMatrixGroup to return GF(q) + # instead of GF(q ^ 2) - we have to remedy this somehow ... + q := Size(F); + else + q := RootInt(Size(F)); + fi; + + # Return stored sesquilinear form if it exists and is hermitian + if HasInvariantSesquilinearForm(G) then + formMatrix := InvariantSesquilinearForm(G).matrix; + if formMatrix = RECOG.HermitianConjugate(formMatrix, q) then + return ImmutableMatrix(F, formMatrix); + fi; + fi; + + M := GModuleByMats(GeneratorsOfGroup(G), F); + # An element A of G acts as A ^ (-T) in MTX.DualModule(M) and hence as + # HermitianConjugate(A, q) ^ (-1) in inverseHermitianConjugateM + inverseHermitianConjugateM := RECOG.ConjugateModule(MTX.DualModule(M), q); + + counter := 0; + scalar := fail; + # As the MeatAxe is randomised, we might have to make some more trials to + # find a preserved unitary form if there is one; breaking after 1000 trials + # is just a "safety net" in case a group that does not preserve a + # unitary form is input. + while scalar = fail and counter < 1000 do + counter := counter + 1; + + # If f: M -> inverseHermitianConjugateM is an isomorphism, it must respect + # multiplication by group elements, i.e. for A in G + # f(x * A) = f(x) * HermitianConjugate(A, q) ^ (-1). + # Let f be given by the matrix F, i.e. f: x -> x * F. Then we have + # (x * A) * F = x * F * HermitianConjugate(A, q) ^ (-1). + # Putting these results together for all vectors x gives + # A * F = F * HermitianConjugate(A, q) ^ (-1) + # <==> A * F * HermitianConjugate(A, q) = F, + # which is what we need. + formMatrix := MTX.IsomorphismModules(M, inverseHermitianConjugateM); + + # We now need to ensure that formMatrix is actually the matrix of a + # unitary form, which can be achieved by multiplying it by a scalar + if formMatrix <> fail then + if formMatrix <> RECOG.HermitianConjugate(formMatrix, q) then + # find a non-zero entry of formMatrix + row := First([1..d], x -> not IsZero(formMatrix[x])); + col := First([1..d], x -> not IsZero(formMatrix[row][x])); + if not IsZero(formMatrix[col, row]) then + # this must be 1 for formMatrix to be hermitian + x := formMatrix[row, col] * formMatrix[col, row] ^ (-q); + # multiplying formMatrix by scalar will ensure that x = 1, i.e. that + # formMatrix is hermitian + scalar := RootFFE(x, q - 1); + fi; + + if IsZero(formMatrix[col, row]) or scalar = fail then + if not MTX.IsAbsolutelyIrreducible(M) then + ErrorNoReturn("UnitaryForm failed - group is not absolutely irreducible"); + fi; + continue; + fi; + + # make formMatrix hermitian + formMatrix := scalar * formMatrix; + fi; + + if formMatrix <> RECOG.HermitianConjugate(formMatrix, q) and not MTX.IsAbsolutelyIrreducible(M) then + ErrorNoReturn("UnitaryForm failed - group is not absolutely irreducible"); + fi; + + return ImmutableMatrix(F, formMatrix); + fi; + od; + + return fail; +end; + +# Assuming that the group G acts absolutely irreducibly, try to find a +# * symplectic form (if = S) or a +# * symmetric bilinear form (if = O) +# which is G-invariant or prove that no such form exists. +# +# We use this function instead of PreservedBilinearForms form the Forms package +# since PreservedBilinearForms seems to be buggy and unreliable (see also +# comment above UnitaryForm). +# +# In general, this function should only be used if one can be sure that +# preserves a bilinear form (but one does not know which one). +RECOG.BilinearForm := function(G, type) + local F, M, inverseTransposeM, counter, formMatrix, condition; + + if not type in ["S", "O"] then + ErrorNoReturn(" must be one of 'S', 'O'"); + fi; + # Set the condition the Gram matrix needs to satisfy for each of the + # possible types. + if type = "S" then + condition := x -> (x = - TransposedMat(x)); + elif type = "O" then + condition := x -> (x = TransposedMat(x)); + fi; + + F := DefaultFieldOfMatrixGroup(G); + + # Return stored bilinear form if it exists and is symplectic / symmetric + if HasInvariantBilinearForm(G) then + formMatrix := InvariantBilinearForm(G).matrix; + if condition(formMatrix) then + return ImmutableMatrix(F, formMatrix); + fi; + fi; + + M := GModuleByMats(GeneratorsOfGroup(G), F); + + if not MTX.IsIrreducible(M) then + ErrorNoReturn("BilinearForm failed - group is not irreducible"); + fi; + + # An element A of G acts as A ^ (-T) in MTX.DualModule(M) + inverseTransposeM := MTX.DualModule(M); + + counter := 0; + # As the MeatAxe is randomised, we might have to make some more trials to + # find a preserved symplectic / symmetric bilinear form if there is one; + # breaking after 1000 trials is just a "safety net" in case a group + # that does not preserve a symplectic / symmetric bilinear form is input. + while counter < 1000 do + counter := counter + 1; + + # If f: M -> inverseTransposeM is an isomorphism, it must respect + # multiplication by group elements, i.e. for A in G + # f(x * A) = f(x) * A ^ (-T) + # Let f be given by the matrix F, i.e. f: x -> x * F. Then we have + # (x * A) * F = x * F * A ^ (-T) + # Putting these results together for all vectors x gives + # A * F = F * A ^ (-T) + # <==> A * F * A ^ T = F, + # which is what we need. + formMatrix := MTX.IsomorphismModules(M, inverseTransposeM); + + if formMatrix <> fail then + # check if formMatrix is antisymmetric + if condition(formMatrix) then + return ImmutableMatrix(F, formMatrix); + fi; + if not MTX.IsAbsolutelyIrreducible(M) then + ErrorNoReturn("BilinearForm failed - group is not absolutely irreducible"); + fi; + fi; + od; + + return fail; +end; + +RECOG.SymplecticForm := function(G) + return RECOG.BilinearForm(G, "S"); +end; + +RECOG.SymmetricBilinearForm := function(G) + return RECOG.BilinearForm(G, "O"); +end; + +RECOG.QuadraticForm := function(G) + local d, F, formMatrix, polarFormMatrix, i, g, RightSideForLinSys, + MatrixForLinSys, x; + + d := DimensionOfMatrixGroup(G); + F := DefaultFieldOfMatrixGroup(G); + if not IsFinite(F) then + ErrorNoReturn("The base field of must be finite"); + fi; + + if HasInvariantQuadraticForm(G) then + formMatrix := InvariantQuadraticForm(G).matrix; + return ImmutableMatrix(F, formMatrix); + fi; + + # We first look for an invariant symmetric bilinear form of G, which will + # be the polar form of the desired quadratic form + polarFormMatrix := RECOG.SymmetricBilinearForm(G); + # The Gram matrix formMatrix of the quadratic form is upper triangular and + # polarFormMatrix = formMatrix + formMatrix ^ T, so the entries above the + # main diagonal of polarFormMatrix and formMatrix must be the same + formMatrix := List([1..d], i -> Concatenation(ListWithIdenticalEntries(i, Zero(F)), + polarFormMatrix[i]{[i + 1..d]})); + if Characteristic(F) <> 2 then + # In this case, the polar form determines the quadratic form completely + formMatrix := formMatrix + 1 / 2 * DiagonalMat(DiagonalOfMatrix(polarFormMatrix)); + else + # We are left to determine the diagonal entries of formMatrix. Let them + # be x1, ..., xd and X = diag(x1, ..., xd); furthermore, let U be the + # part of polarFormMatrix above the main diagonal (i.e. the current + # value of formMatrix). Then for the quadratic form X + U to be + # preserved, we need g * (X + U) * g ^ T to have the same diagonal + # entries as X + U, i.e. as X, for each generator g of G. + # + # Hence, we need xi = (g * U * g ^ T)_ii + (x1 * g[i, 1] ^ 2 + ... + xd * g[i, d] ^ 2) + # This leads to a linear system for the xi, which we solve. + + RightSideForLinSys := Concatenation(List(GeneratorsOfGroup(G), + g -> DiagonalOfMatrix(g * formMatrix * TransposedMat(g)))); + MatrixForLinSys := Concatenation(List(GeneratorsOfGroup(G), + g -> List([1..d], + i -> DiagonalOfMatrix(TransposedMat([g[i]{[1..d]}]) * [g[i]{[1..d]}])) + + IdentityMat(d, F))); + x := SolutionMat(TransposedMat(MatrixForLinSys), RightSideForLinSys); + + if x = fail then + return fail; + fi; + + formMatrix := formMatrix + DiagonalMat(x); + fi; + + return formMatrix; +end; + + +############################################################################# +############################################################################# +################## Old function from RECOG package ########################## +############################################################################# +############################################################################# + + +RECOG.DerivedSubgroupMonteCarlo := function(g, NumberGenerators) + local gens,gens2,i,x,y; + gens := []; + for i in [1..Maximum([NumberGenerators, Size(GeneratorsOfGroup(g)) * 2 + 10])] do + x := PseudoRandom(g); + y := PseudoRandom(g); + Add(gens,Comm(x,y)); + od; + gens2 := FastNormalClosure(GeneratorsOfGroup(g),gens,10); + return GroupWithGenerators(gens2); +end; diff --git a/gap/projective/naming/ClassicalNamingAndUtils.gi b/gap/projective/naming/ClassicalNamingAndUtils.gi new file mode 100644 index 000000000..63efd4ad4 --- /dev/null +++ b/gap/projective/naming/ClassicalNamingAndUtils.gi @@ -0,0 +1,2126 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Daniel Rademacher. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +############################################################################# + +############################################################################## +# Naming Algorithms +############################################################################## + +# Test to check whether the group contains both a large ppd element +# and a basic ppd element +# TODO: Better comments... + +### +## Test whether n is a power of the prime p +## +IsPowerOfPrime := function( n, p ) + + local x; + + if n <= 0 then return false; fi; + + repeat + x := QuotientRemainder( n, p ); + if x[2] <> 0 then return false; fi; + n := x[1]; + until n = 1; + + return true; + +end; + + + +RECOG.IsGenericParameters := function( recognise, grp ) + + local fact, d, q, hint; + + hint := recognise.hint; + + d := recognise.d; + q := recognise.q; + + if hint = "unknown" then + return NeverApplicable; + + elif hint = "linear" and d <= 2 then + recognise.isGeneric := false; + return NeverApplicable; + + elif hint = "linear" and d = 3 then + #q = 2^s-1 + if IsPowerOfPrime( q+1, 2 ) then + recognise.isGeneric := false; + fi; + return NeverApplicable; + + elif hint = "symplectic" and + (d < 6 or (d mod 2 <> 0) or + [d,q] in [[6,2],[6,3],[8,2]]) then + recognise.isGeneric := false; + return NeverApplicable; + + elif hint = "unitary" and + (d < 5 or d = 6 or [d,q] = [5,4]) then + recognise.isGeneric := false; + return NeverApplicable; + + elif hint = "orthogonalplus" and + (d mod 2 <> 0 or d < 10 + or (d = 10 and q = 2)) then + recognise.isGeneric := false; + return NeverApplicable; + + elif hint = "orthogonalminus" and + (d mod 2 <> 0 or d < 6 + or [d,q] in [[6,2],[6,3],[8,2]]) then + recognise.isGeneric := false; + return NeverApplicable; + + elif hint = "orthogonalcircle" then + if d < 7 or [d,q] = [7,3] then + recognise.isGeneric := false; + return NeverApplicable; + fi; + if d mod 2 = 0 then + recognise.isGeneric := false; + return NeverApplicable; + fi; + if q mod 2 = 0 then + #TODO: INFORECOG1 ... not irreducible + #TODO: INFORECOG2 ... d odd --> q odd + recognise.isReducible := true; + recognise.isGeneric := false; + return NeverApplicable; + fi; + fi; + + return NeverApplicable; +end; + + +# Generate elements until we find the required ppd type +# elements...monte yes +# TODO: Better comments + +RECOG.IsGeneric := function (recognise, grp) + + if recognise.isGeneric = false then + return NeverApplicable; + fi; + +#sg + if recognise.d = 2 then + recognise.isGeneric := false; + return NeverApplicable; + fi; +#sg + + if Length(recognise.E) < 2 then return TemporaryFailure; fi; + if Length(recognise.LE) < 1 then return TemporaryFailure; fi; + if Length(recognise.BE) < 1 then return TemporaryFailure; fi; + + recognise.isGeneric := true; + + return NeverApplicable; +end; + +#enough info to rule out extension field groups...? +#TODO: comments... +RECOG.RuledOutExtField := function (recognise, grp) + + local differmodfour, d, q, E, b, bx, hint; + + hint := recognise.hint; + d := recognise.d; + q := recognise.q; + E := recognise.E; + +#sg + if recognise.d = 2 then return NeverApplicable; fi; +#sg + + differmodfour := function(E) + local e; + for e in E do + if E[1] mod 4 <> e mod 4 then + return Success; + fi; + od; + return NeverApplicable; + end; + + b := recognise.currentgcd; + + if hint in ["linear","unitary","orthogonalcircle"] then + bx := 1; + else + bx := 2; + fi; + + + if b < bx then + if hint <> "unknown" then + recognise.hintIsWrong := true; + # raeume auf + komme nie wieder + return Success; + fi; + recognise.isNotExt := true; + return NeverApplicable; + fi; + if b > bx then return TemporaryFailure; fi; + + if hint = "linear" then + if not IsPrime(d) + or E <> [d-1,d] + or d-1 in recognise.LE then + recognise.isNotExt := true; + return NeverApplicable; + fi; + + elif hint = "unitary" then + recognise.isNotExt := true; + return NeverApplicable; + + elif hint = "symplectic" then + if d mod 4 = 2 and q mod 2 = 1 then + recognise.isNotExt := + (PositionProperty(E, x -> (x mod 4 = 0)) <> fail); + elif d mod 4 = 0 and q mod 2 = 0 then + recognise.isNotExt := + (PositionProperty( E, x -> (x mod 4 = 2)) <> fail); + elif d mod 4 = 0 and q mod 2 = 1 then + recognise.isNotExt := differmodfour(E); + elif d mod 4 = 2 and q mod 2 = 0 then + recognise.isNotExt := (Length(E) > 0); + else + Info( InfoClassical, 2, "d cannot be odd in hint Sp"); + recognise.hintIsWrong := true; + # raeume auf + komme nie wieder + return Success; + fi; + + elif hint = "orthogonalplus" then + if d mod 4 = 2 then + recognise.isNotExt := + (PositionProperty (E, x -> (x mod 4 = 0 )) <> fail); + elif d mod 4 = 0 then + recognise.isNotExt := differmodfour(E); + else + Info( InfoClassical, 2, "d cannot be odd in hint O+"); + recognise.hintIsWrong := true; + # raeume auf + komme nie wieder + return Success; + fi; + + + elif hint = "orthogonalminus" then + if d mod 4 = 0 then + recognise.isNotExt := + (PositionProperty ( E, x -> (x mod 4 = 2)) <> fail); + elif d mod 4 = 2 then + recognise.isNotExt := differmodfour(E); + else + Info( InfoClassical, 2, "d cannot be odd in hint O-"); + recognise.hintIsWrong := true; + # raeume auf + komme nie wieder + return Success; + fi; + + elif hint = "orthogonalcircle" then + recognise.isNotExt := true; + return NeverApplicable; + fi; + + if recognise.isNotExt = true then return NeverApplicable; + else return TemporaryFailure; + fi; +end; + +RECOG.IsNotAlternating := function( recognise, grp ) + + local V, P, i, g ,q, o; + + q := recognise.q; + +#sg + if recognise.d = 2 then return NeverApplicable; fi; +#sg + +# if recognise.hint <> "unknown" and recognise.hint <> "linear" then +# Info( InfoClassical, 2, "G' not an AlternatingGroup;"); +# recognise.isNotAlternating := true; +# return NeverApplicable; +# fi; + + if Length(recognise.ClassicalForms) > 0 and not "linear" in + recognise.ClassicalForms then + recognise.isNotAlternating := true; + return NeverApplicable; + fi; + + if recognise.d <> 4 or q <> recognise.p or (3 <= q and q < 23) then + Info( InfoClassical, 2, "G is not an alternating group" ); + recognise.isNotAlternating := true; + return NeverApplicable; + fi; + + if q = 2 then + if Size(grp) <> 3*4*5*6*7 then + Info( InfoClassical, 2, "G is not an alternating group" ); + recognise.isNotAlternating := true; + return NeverApplicable; + else + Info( InfoClassical, 2, "G' might be A7;"); + AddSet(recognise.possibleNearlySimple,"A7"); + return Success; + fi; + fi; + + + if q >= 23 then + # TODO Check Magma Code + o := Order( recognise.g ); + if o mod 25 = 0 then + Info( InfoClassical, 2, "G' not alternating;"); + recognise.isNotAlternating := true; + return NeverApplicable; + fi; + o := Collected( Factors (o) ); + for i in o do + if i[1] >= 11 then + Info( InfoClassical, 2, "G' not alternating;"); + recognise.isNotAlternating := true; + return NeverApplicable; + fi; + od; + + if recognise.n > 15 then + AddSet (recognise.possibleNearlySimple, "2.A7"); + Info( InfoClassical, 2, "G' might be 2.A7;"); + return TemporaryFailure; + fi; + fi; + + return TemporaryFailure; + +end; + + +RECOG.IsNotMathieu := function( recognise, grp ) + + local i, fn, g, d, q, E, ord; + + d := recognise.d; + q := recognise.q; + E := recognise.E; + g := recognise.g; + +#sg + if d = 2 then return NeverApplicable; fi; +#sg + +# if recognise.hint <> "unknown" and recognise.hint <> "linear" then +# Info( InfoClassical, 2, "G' not a Mathieu Group;"); +# recognise.isNotMathieu := true; +# return NeverApplicable; +# fi; + + if Length(recognise.ClassicalForms) > 0 and not "linear" in + recognise.ClassicalForms then + recognise.isNotMathieu := true; + return NeverApplicable; + fi; + + if not [d, q] in [ [5, 3], [6,3], [11, 2] ] then + Info( InfoClassical, 2, "G' is not a Mathieu group;\n"); + recognise.isNotMathieu := true; + return NeverApplicable; + fi; + + if d in [5, 6] then + ord := Order(g); + if (ord mod 121=0 or (d=5 and ord=13) or (d=6 and ord=7)) then + Info( InfoClassical, 2, "G' is not a Mathieu group;\n"); + recognise.isNotMathieu := true; + return NeverApplicable; + fi; + else + if ForAny([6,7,8,9],m-> m in E) then + Info( InfoClassical, 2, "G' is not a Mathieu group;\n"); + recognise.isNotMathieu := true; + return NeverApplicable; + fi; + fi; + + +# TODO Check how big n should be + if d = 5 then + if recognise.n > 15 then + AddSet(recognise.possibleNearlySimple, "M_11" ); + Info( InfoClassical, 2, "G' might be M_11;"); + return TemporaryFailure; + fi; + elif d = 6 then + if recognise.n > 15 then + AddSet(recognise.possibleNearlySimple, "2M_12" ); + Info( InfoClassical, 2, "G' might be 2M_12;"); + return TemporaryFailure; + fi; + else + if recognise.n > 15 then + AddSet(recognise.possibleNearlySimple, "M_23" ); + AddSet(recognise.possibleNearlySimple, "M_24" ); + Info( InfoClassical, 2, "G' might be M_23 or M_24;"); + return TemporaryFailure; + fi; + fi; + + return TemporaryFailure; + +end; + + +RECOG.IsNotPSL := function (recognise, grp) + + local i, E, LE, d, p, a, q, str, fn, ord; + + E := recognise.E; + LE := recognise.LE; + d := recognise.d; + q := recognise.q; + a := recognise.a; + p := recognise.p; + +#sg + if d = 2 then return NeverApplicable; fi; +#sg + +# if recognise.hint <> "unknown" and recognise.hint <> "linear" then +# Info( InfoClassical, 2, "G' not PSL(2,r);"); +# recognise.isNotPSL := true; +# return NeverApplicable; +# fi; + if Length(recognise.ClassicalForms) > 0 and not "linear" in + recognise.ClassicalForms then + recognise.isNotPSL := true; + return NeverApplicable; + fi; + + if d = 3 and (q = 5 or q = 2) then + Info( InfoClassical, 2, "G' is not PSL(2,7)"); + recognise.isNotPSL := true; + return NeverApplicable; + fi; + + if d = 6 and q = 2 then + Info( InfoClassical, 2, "G' is not PSL(2,11)"); + recognise.isNotPSL := true; + return NeverApplicable; + fi; + + # test whether e_2 = e_1 + 1 and + # e_1 + 1 and 2* e_2 + 1 are primes + if Length(E) >= 2 then + if E[2]-1<>E[1] or + not IsPrimeInt(E[1]+1) or not IsPrimeInt(2*E[2]+1) then + Info(InfoClassical, 2, " G' is not PSL(2,r)"); + recognise.isNotPSL := true; + return NeverApplicable; + fi; + fi; + + if d = 3 then + # q = 3*2^s-1 and q^2-1 has no large ppd. + # TODO recheck this + if (q = 2 or ((q+1) mod 3 = 0 and IsPowerOfPrime((q+1)/3,2))) then + ord := Order(recognise.g); + if (ord mod 8 <> 0 or (p^(2*a)-1) mod ord = 0) then + Info( InfoClassical, 2, "G' not PSL(2,7);"); + recognise.isNotPSL := true; + return NeverApplicable; + fi; + else + if p = 3 or p = 7 or 2 in LE then + Info( InfoClassical, 2, "G' not PSL(2,7);"); + recognise.isNotPSL := true; + return NeverApplicable; + fi; + fi; + elif [d, q] = [5,3] then + ord := Order(recognise.g); + if (ord mod 11^2 = 0 or ord mod 20 = 0) then + Info( InfoClassical, 2, "G' not PSL(2,11);"); + recognise.isNotPSL := true; + return NeverApplicable; + fi; + elif d = 5 and p <> 5 and p <> 11 then + if (3 in LE or 4 in LE) then + Info( InfoClassical, 2, "G' not PSL(2,11);"); + recognise.isNotPSL := true; + return NeverApplicable; + fi; + elif [d, q] = [6, 3] then + ord := Order(recognise.g); + if (ord mod (11^2)=0 or 6 in E) then + Info( InfoClassical, 2, "G' not PSL(2,11);"); + recognise.isNotPSL := true; + return NeverApplicable; + fi; + elif d = 6 and p <> 5 and p <> 11 then + if (6 in E or 4 in LE) then + Info( InfoClassical, 2, "G' not PSL(2,11);"); + recognise.isNotPSL := true; + return NeverApplicable; + fi; + else + Info( InfoClassical, 2, "G' not PSL(2,r);"); + recognise.isNotPSL := true; + return NeverApplicable; + fi; + + + if recognise.n > 15 and Length(recognise.E) > 2 then + str := Concatenation("PSL(2,",Int(2*E[2]+1)); + str := Concatenation(str, ")"); + Info( InfoClassical, 2, "G' might be ", str); + AddSet( recognise.possibleNearlySimple, str ); + return TemporaryFailure; + fi; + return TemporaryFailure; +end; + + +# generate the next random element and its char polynomial +RECOG.TestRandomElement := function (recognise, grp) + + local g, ppd, bppd, d, q, cpol, f, deg, facs, r, s, h, gmod, str, + ord, bc, phi, kf, o1, o2; + +#sg + if recognise.d = 2 then + return NeverApplicable; + fi; +#sg + + recognise.g := PseudoRandom(grp); + recognise.cpol := CharacteristicPolynomial(recognise.g); + recognise.n := recognise.n + 1; + + d := recognise.d; + q := recognise.q; + f := recognise.field; + g := recognise.g; + cpol := recognise.cpol; + + if recognise.needOrders then + ord := Order(g); + recognise.ord := ord; + AddSet( recognise.orders, ord ); + fi; + if recognise.needPOrders then + ord := ProjectiveOrder(g); + AddSet( recognise.porders, ord ); + fi; + + ppd := IsPpdElement (f, cpol, d, recognise.q, 1); + # if the element is no ppd we get out + if ppd = false then + recognise.isppd := false; + else + AddSet(recognise.E,ppd[1]); + recognise.currentgcd := Gcd( recognise.currentgcd, ppd[1] ); + if ppd[2] = true then + AddSet(recognise.LE,ppd[1]); + fi; + recognise.ppd := [ ppd[1], ppd[2], "unknown" ]; + if Length(recognise.BE) < 1 or recognise.needLB then + #We only need one basic ppd-element + #Also, each basic ppd element is a ppd-element + bppd := IsPpdElement (f, cpol, d, recognise.p, recognise.a); + if bppd <> false then + AddSet(recognise.BE, bppd[1]); + if ppd[2] = true and ppd[1] = bppd[1] then + AddSet( recognise.LB, ppd[1] ); + recognise.ppd[3] := true; + fi; + fi; + fi; + fi; + if recognise.needE2 = true then + ppd := IsPpdElementD2(f, cpol, d, recognise.q, 1); + if ppd <> false then + AddSet( recognise.E2, ppd[1] ); + if ppd[2] = true then + + ## first we test whether the characteristic polynomial has + ## two factors of degree d/2. + facs := Factors( cpol ); + deg := List(facs, EuclideanDegree ); + if Length(deg) = 2 and deg[1] = deg[2] and deg[1] = d/2 then + + ## Now we compute the r-part h of g + r := ppd[3]; + s := Order(g); + while s mod r = 0 do s := Int (s/r); od; + str := " Found a large and special ppd("; + str := Concatenation(str, String(recognise.d)); + str := Concatenation(str, ", " ); + str := Concatenation(str, String(recognise.q)); + str := Concatenation(str, "; " ); + str := Concatenation(str, String(ppd[1])); + str := Concatenation(str, ")-element"); + if s = 1 and Length(facs) = 2 then + Info(InfoClassical,2, str ); + AddSet(recognise.LS, ppd[1] ); + else + h := g^s; + gmod := GModuleByMats([h], recognise.field); + if Length(MTX.CollectedFactors(gmod )) = 2 then + Info(InfoClassical,2, str ); + AddSet(recognise.LS, ppd[1] ); + fi; + fi; + fi; + fi; + fi; + fi; + + + if PositionProperty(recognise.E, x->(x mod 2 <> 0)) <> fail then + recognise.IsSpContained := false; + recognise.IsSOContained := false; + fi; + if PositionProperty(recognise.E, x ->(x mod 2 = 0)) <> fail then + recognise.IsSUContained := false; + fi; + + if recognise.needBaseChange = true and recognise.bc = "unknown" then + if Length(recognise.ClassicalForms) = 0 then + recognise.needForms := true; + return NeverApplicable; + fi; + if "orthogonalplus" in recognise.ClassicalForms then + phi := recognise.InvariantDualForm; + if IsOddInt (q) then + Info(InfoClassical, 2,"Performing base change"); + bc := FindBase (d, q, phi); + Info(InfoClassical, 2,"Computed base change matrix"); + bc := bc^-1; + recognise.bc := bc; + else + bc := FindBaseC2 (d, q, recognise.QuadraticForm); + Info(InfoClassical,2, + "Computed base change matrix for char 2\n"); + bc := bc^-1; + recognise.bc := bc; + fi; + else + Info(InfoClassical, 2, "need basechange only in O+"); + return TemporaryFailure; + fi; + fi; + + if recognise.needKF = true then + if recognise.bc = "unknown" then + recognise.needBaseChange := true; + else + kf := KroneckerFactors( g^recognise.bc ); + if kf = false then + kf := KroneckerFactors( (g^2)^recognise.bc ); + fi; + recognise.kf := kf; + fi; + fi; + + if recognise.needPlusMinus = true then + if recognise.kf = "unknown" then + recognise.needKF := true; + return TemporaryFailure; + fi; + if recognise.kf = false then + return TemporaryFailure; + fi; + kf := recognise.kf; + o1 := Order( kf[1] ); + o2 := Order( kf[2] ); + Info(InfoClassical,2,o1, " ", o2, "\n"); + if ( (q+1) mod o1 = 0 and (q+1) mod o2 = 0) then + Add( recognise.plusminus, [1,1] ); + fi; + if ( (q+1) mod o1 = 0 and (q-1) mod o2 = 0) then + Add( recognise.plusminus, [1,-1] ); + fi; + if ( (q-1) mod o1 = 0 and (q+1) mod o2 = 0) then + Add( recognise.plusminus, [1,-1] ); + fi; + if ( (q-1) mod o1 = 0 and (q-1) mod o2 = 0) then + Add( recognise.plusminus, [-1,-1] ); + fi; + fi; + + if recognise.needDecompose = true then + if recognise.kf = "unknown" then + recognise.needKF := true; + return TemporaryFailure; + fi; + if recognise.kf = false then + return TemporaryFailure; + fi; + kf := recognise.kf; + + if not kf[1] in Group(recognise.sq1) then + AddSet(recognise.sq1,kf[1]); + fi; + if not kf[2] in Group(recognise.sq2) then + AddSet(recognise.sq2,kf[2]); + fi; + fi; + + return TemporaryFailure; + +end; + + + +# Compute the degrees of the irreducible factors of +# the characteristic polynomial +RECOG.IsReducible := function( recognise, grp ) + + local deg, dims, g; + + # compute the degrees of the irreducible factors + deg := List(Factors(recognise.cpol), i-> Degree(i)); + + # compute all possible dimensions + dims := [0]; + for g in deg do + UniteSet(dims,dims+g); + od; + + # intersect it with recognise.dimsReducible + if IsEmpty(recognise.dimsReducible) then + recognise.dimsReducible := dims; + else + IntersectSet(recognise.dimsReducible,dims); + fi; + + # G acts irreducibly if only 0 and d are possible + if Length(recognise.dimsReducible)=2 then + recognise.isReducible := false; + return NeverApplicable; + fi; + + return TemporaryFailure; +end; + + + +RECOG.NoClassicalForms := function( recognise, grp ) + +#sg + if recognise.d = 2 then return NeverApplicable; fi; +#sg + + PossibleClassicalForms( grp, recognise.g, recognise ); + + if recognise.maybeDual = false and + recognise.maybeFrobenius = false then + recognise.ClassicalForms := ["linear"]; + return NeverApplicable; + fi; + + return TemporaryFailure; + +end; + + + +RECOG.ClassicalForms := function( recognise, grp) + local field, z, d, i, qq, A, c, I, t, i0, + a, l, g, module, forms, dmodule, fmodule, form; + +#sg + if recognise.d = 2 then return NeverApplicable; fi; +#sg + + if recognise.n > 15 then recognise.needForms := true; fi; + if recognise.needForms <> true then return NeverApplicable; fi; + + # the group has to be absolutely irreducible + if recognise.isReducible = "unknown" then + recognise.needMeataxe := true; + return TemporaryFailure; + fi; + + # set up the field and other information + field := recognise.field; + d := recognise.d; + z := Zero(field); + module := recognise.module; + + if recognise.maybeFrobenius = true then + qq := Characteristic(field) ^ (LogInt( Size(field), + Characteristic(field))/2 ); + fi; + + # try to find generators without scalars + if recognise.maybeDual = true then + dmodule := ClassicalForms_GeneratorsWithoutScalarsDual(grp); + if dmodule = false then + Add( recognise.ClassicalForms, "unknown" ); + recognise.maybeDual := false; + fi; + fi; + if recognise.maybeFrobenius = true then + fmodule := ClassicalForms_GeneratorsWithoutScalarsFrobenius(grp); + if fmodule = false then + Add( recognise.ClassicalForms, "unknown" ); + recognise.maybeFrobenius := false; + fi; + fi; + + # now try to find an invariant form + if recognise.maybeDual = true then + form := ClassicalForms_InvariantFormDual(module,dmodule); + if form <> false then + Add( recognise.ClassicalForms, form[1] ); + recognise.InvariantDualForm := form[2]; + if Length(form) = 4 then + recognise.QuadraticForm := form[4]; + fi; + else + Add( recognise.ClassicalForms, "dual" ); + fi; + fi; + + if recognise.maybeFrobenius = true then + form := ClassicalForms_InvariantFormFrobenius(module,fmodule); + if form <> false then + Add( recognise.ClassicalForms, form[1] ); + recognise.InvariantFrobeniusForm := form[2]; + else + Add( recognise.ClassicalForms, "frobenius" ); + fi; + fi; + return NeverApplicable; + +end; + + +RECOG.MeatAxe := function( recognise, grp ) + + if recognise.n > 15 then recognise.needMeataxe := true; fi; + if recognise.needMeataxe <> true then return NeverApplicable; fi; + + if MTX.IsIrreducible(recognise.module) then + recognise.isReducible := false; + return NeverApplicable; + else + Info( InfoClassical, 2, + "The group acts reducibly and thus doesn't contain a classical group"); + recognise.isReducible := true; + recognise.IsSLContained := false; + recognise.IsSpContained := false; + recognise.IsSUContained := false; + recognise.IsSOContained := false; + return Success; + fi; +end; + + +## Main function to test whether group contains SL +RECOG.IsSLContained := function( recognise, grp ) + +#sg + if recognise.d = 2 then return NeverApplicable; fi; +#sg + + if recognise.isGeneric <> true or + recognise.isNotExt <> true or + recognise.isNotPSL <> true or + recognise.isReducible = true or + recognise.isNotMathieu <> true or + recognise.isNotAlternating <> true then + return TemporaryFailure; + fi; + + if recognise.isReducible = "unknown" then + recognise.needMeataxe := true; + return NeverApplicable; + fi; + + # if we reach this point the natural module is irreducible + # since the MeatAxe Method aborts in the reducible case. + # Also we know that the module is absolutely irreducible, + # since we are in the generic case. + if Length(recognise.ClassicalForms)=0 then + recognise.needForms := true; + return NeverApplicable; + fi; + + if "linear" in recognise.ClassicalForms then + recognise.IsSLContained := true; + Info(InfoClassical,2,"The group contains SL(", recognise.d, ", ", + recognise.q, ");"); + return Success; + else + recognise.IsSLContained := false; + Info(InfoClassical,2,"The group does not contain SL(", + recognise.d, ", ", recognise.q, ");"); + return NeverApplicable; + fi; + +end; + +## Main function to test whether group contains Sp +RECOG.IsSpContained := function( recognise, grp ) + +#sg + if recognise.d = 2 then return NeverApplicable; fi; +#sg + + # if the dimension is not even, the group cannot be symplectic + if recognise.d mod 2 <> 0 then + recognise.IsSpContained := false; + return NeverApplicable; + fi; + + if recognise.IsSpContained = false then return NeverApplicable; fi; + + if recognise.isGeneric <> true or + recognise.isReducible = true or + recognise.currentgcd <> 2 or + recognise.isNotPSL <> true or + recognise.isNotMathieu <> true or + recognise.isNotAlternating <> true then + return TemporaryFailure; + fi; + + if recognise.isReducible = "unknown" then + recognise.needMeataxe := true; + return NeverApplicable; + fi; + + # if we reach this point the natural module is irreducible + # since the MeatAxe Method aborts in the reducible case. + # Also we know that the module is absolutely irreducible, + # since we are in the generic case. + if Length(recognise.ClassicalForms)=0 then + recognise.needForms := true; + return NeverApplicable; + fi; + + if "symplectic" in recognise.ClassicalForms then + recognise.IsSpContained := true; + recognise.isNotExt := true; + Info(InfoClassical,2,"The group contains Sp(", recognise.d, ", ", + recognise.q, ");"); + return Success; + else + recognise.IsSpContained := false; + Info(InfoClassical,2,"The group does not contain Sp(", + recognise.d, ", ", recognise.q, ");"); + return NeverApplicable; + fi; +end; + + +## Main function to test whether group contains SU +RECOG.IsSUContained := function( recognise, grp ) + + local f; + + f := recognise.field; + +#sg + if recognise.d = 2 then return NeverApplicable; fi; +#sg + + # if size of field not a square, the group cannot be unitary + if LogInt(Size(f),Characteristic(f)) mod 2 <> 0 then + recognise.IsSUContained := false; + return NeverApplicable; + fi; + + if recognise.IsSUContained = false then return NeverApplicable; fi; + + if recognise.isGeneric <> true or + recognise.isReducible = true or + recognise.isNotExt <> true or + recognise.isNotPSL <> true or + recognise.isNotMathieu <> true or + recognise.isNotAlternating <> true then + return TemporaryFailure; + fi; + + if recognise.isReducible = "unknown" then + recognise.needMeataxe := true; + return NeverApplicable; + fi; + + # if we reach this point the natural module is irreducible + # since the MeatAxe Method aborts in the reducible case. + # Also we know that the module is absolutely irreducible, + # since we are in the generic case. + if Length(recognise.ClassicalForms)=0 then + recognise.needForms := true; + return NeverApplicable; + fi; + + if "unitary" in recognise.ClassicalForms then + recognise.IsSUContained := true; + Info(InfoClassical,2,"The group contains SU(", recognise.d, ", ", + recognise.q, ");"); + return Success; + else + recognise.IsSUContained := false; + Info(InfoClassical,2,"The group does not contain SU(", + recognise.d, ", ", recognise.q, ");"); + return NeverApplicable; + fi; +end; + + + +## Main function to test whether group contains SO +RECOG.IsSOContained := function( recognise, grp ) + + local f; + +#sg + if recognise.d = 2 then return NeverApplicable; fi; +#sg + + if recognise.IsSOContained = false then return NeverApplicable; fi; + + if IsOddInt(recognise.d) and not IsOddInt(recognise.q) then + return NeverApplicable; + fi; + + if recognise.isGeneric <> true or + not recognise.currentgcd in [1,2] or + recognise.isNotPSL <> true or + recognise.isReducible = true or + recognise.isNotMathieu <> true or + recognise.isNotAlternating <> true then + return TemporaryFailure; + fi; + + if recognise.isReducible = "unknown" then + recognise.needMeataxe := true; + return NeverApplicable; + fi; + + # if we reach this point the natural module is irreducible + # since the MeatAxe Method aborts in the reducible case. + # Also we know that the module is absolutely irreducible, + # since we are in the generic case. + if Length(recognise.ClassicalForms)=0 then + recognise.needForms := true; + return NeverApplicable; + fi; + + if "orthogonalcircle" in recognise.ClassicalForms then + if recognise.d mod 2 = 0 then return NeverApplicable; fi; + if recognise.currentgcd <> 1 then return TemporaryFailure; fi; + recognise.isNotExt := true; + recognise.IsSOContained := true; + Info(InfoClassical,2,"The group contains SO^o(", recognise.d, ", ", + recognise.q, ");"); + return Success; + + elif "orthogonalplus" in recognise.ClassicalForms then + if recognise.d mod 2 <> 0 then return NeverApplicable; fi; + if recognise.currentgcd <> 2 then return TemporaryFailure; fi; + recognise.isNotExt := true; + recognise.IsSOContained := true; + Info(InfoClassical,2,"The group contains SO+(", recognise.d, ", ", + recognise.q, ");"); + return Success; + + elif "orthogonalminus" in recognise.ClassicalForms then + if recognise.d mod 2 <> 0 then return NeverApplicable; fi; + if recognise.currentgcd <> 2 then return TemporaryFailure; fi; + recognise.isNotExt := true; + recognise.IsSOContained := true; + Info(InfoClassical,2,"The group contains SO-(", recognise.d, ", ", + recognise.q, ");"); + return Success; + else + recognise.IsSOContained := false; + Info(InfoClassical,2,"The group does not contain SO(", + recognise.d, ", ", recognise.q, ");"); + return NeverApplicable; + fi; +end; + + +HasElementsMultipleOf := function(orders, ord ) + + local o; + + for o in ord do + if PositionProperty(orders, i->(i mod o = 0 )) = fail then + return NeverApplicable; + fi; + od; + + return Success; + +end; + +############################################################################/ +## +## The following functions deal with the Non-generic cases. See [3]. +## + +############################################################################/ +## +## NonGenericLinear (recognise, grp) . . . . . . . non-generic linear case +## +## Recognise non-generic linear matrix groups over finite fields: +## In order to prove that a group G <= GL( 3, 2^s-1) contains SL, we need to +## find an element of order a multiple of 4 and a large and basic ppd(3,q;3)- +## element +## +RECOG.NonGenericLinear := function( recognise, grp ) + + local CheckFlag; + + CheckFlag := function( ) + if recognise.isReducible = "unknown" then + recognise.needMeataxe := true; + return TemporaryFailure; + fi; + if Length(recognise.ClassicalForms) = 0 then + recognise.needForms := true; + return TemporaryFailure; + fi; + Info(InfoClassical,2,"The group is not generic"); + Info(InfoClassical,2,"and contains SL(", recognise.d, ", ", + recognise.q, ");"); + recognise.IsSLContained := true; + return Success; + end; + + if recognise.isReducible = true then return NeverApplicable; fi; + +#sg + if recognise.d = 2 then + recognise.needPOrders := true; + return NeverApplicable; + fi; +#sg + + if recognise.d > 3 then return NeverApplicable; fi; + + if Length( recognise.ClassicalForms ) > 0 and + not "linear" in recognise.ClassicalForms then + return NeverApplicable; + fi; + + if recognise.n <= 5 then + return TemporaryFailure; + elif recognise.n = 6 then + recognise.needOrders := true; + return TemporaryFailure; + fi; + + if 3 in recognise.LE and 3 in recognise.BE + and HasElementsMultipleOf(recognise.orders, [4]) then + return CheckFlag(); + fi; + + return TemporaryFailure; +end; + +############################################################################/ +## +## Recognise non-generic symplectic matrix groups over finite fields +## +RECOG.NonGenericSymplectic := function(recognise, grp) + + local d, q, CheckFlag; + + CheckFlag := function( ) + if recognise.isReducible = "unknown" then + recognise.needMeataxe := true; + return TemporaryFailure; + fi; + if Length(recognise.ClassicalForms) = 0 then + recognise.needForms := true; + return TemporaryFailure; + fi; + Info(InfoClassical,2,"The group is not generic"); + Info(InfoClassical,2,"and contains Sp(", recognise.d, ", ", + recognise.q, ");"); + recognise.IsSpContained := true; + return Success; + end; + + d := recognise.d; + q := recognise.q; + +#sg + if d = 2 then return NeverApplicable; fi; +#sg + + if not IsEvenInt(recognise.d) then return NeverApplicable; fi; + if recognise.isReducible = true then return NeverApplicable; fi; + + if Length( recognise.ClassicalForms ) > 0 and + not "symplectic" in recognise.ClassicalForms then + return NeverApplicable; + fi; + + if d > 8 then return NeverApplicable; fi; + + if recognise.n <= 5 then + return NeverApplicable; + elif recognise.n = 6 then + recognise.needOrders := true; + if d = 4 then + recognise.needLB := true; + recognise.needE2 := true; + fi; + return TemporaryFailure; + fi; + + + if d = 8 and q = 2 then + if not HasElementsMultipleOf(recognise.orders, [5,9,17]) then + return TemporaryFailure; + fi; + elif d = 6 and q = 2 then + if not HasElementsMultipleOf(recognise.orders, [5,7,9]) then + return TemporaryFailure; + fi; + elif d = 6 and q = 3 then + if not HasElementsMultipleOf(recognise.orders, [5,7]) then + return TemporaryFailure; + fi; + elif d = 4 and q = 3 then + if not HasElementsMultipleOf(recognise.orders, [5,9]) then + return TemporaryFailure; + fi; + elif d = 4 and q = 2 then + if Size(grp) mod (3*4*5*6) <> 0 then + Info(InfoClassical,2,"group does not contain Sp(", + recognise.d, ", ", recognise.q, ");"); + recognise.isSpContained := false; + return NeverApplicable; + fi; + elif d = 4 and q = 5 then + if not HasElementsMultipleOf(recognise.orders, [13,15]) then + return TemporaryFailure; + fi; + elif d = 4 and not IsPowerOfPrime(q+1,2) and not ((q+1) mod 3 = 0 and + IsPowerOfPrime((q+1)/3, 2)) and q<>2 then + if not 4 in recognise.LB then + return TemporaryFailure; + fi; + if not 2 in recognise.LS then return TemporaryFailure; fi; + elif d = 4 and q >= 7 and IsPowerOfPrime(q+1,2) then + if not 4 in recognise.LB then return TemporaryFailure; fi; + if not HasElementsMultipleOf(recognise.orders, [4]) then + return TemporaryFailure; + fi; + + elif d = 4 and q >= 11 and IsPowerOfPrime((q+1)/3, 2) then + if not HasElementsMultipleOf(recognise.orders, [3,4]) then + return TemporaryFailure; + fi; + if not 4 in recognise.LB then return TemporaryFailure; fi; + else + Info(InfoClassical,2, + "NonGenericSymplectic: d and q must have been be generic"); + return NeverApplicable; + fi; + + return CheckFlag(); + +end; + +############################################################################/ +## +## Recognise non-generic unitary matrix groups over finite fields +## +RECOG.NonGenericUnitary := function(recognise, grp) + + local d, q, q0, g, f1, f2, o, CheckFlag; + + CheckFlag := function( ) + if recognise.isReducible = "unknown" then + recognise.needMeataxe := true; + return TemporaryFailure; + fi; + if Length(recognise.ClassicalForms) = 0 then + recognise.needForms := true; + return TemporaryFailure; + fi; + Info(InfoClassical,2,"group contains SU(", + recognise.d, ", ", recognise.q, ");"); + recognise.isSpContained := true; + + recognise.IsSUContained := true; + return Success; + end; + + d := recognise.d; + q := recognise.q; + +#sg + if d = 2 then return NeverApplicable; fi; +#sg + if d > 6 then return NeverApplicable; fi; + if recognise.isReducible = true then return NeverApplicable; fi; + + if Length( recognise.ClassicalForms ) > 0 and + not "unitary" in recognise.ClassicalForms then + return NeverApplicable; + fi; + + if recognise.n <= 5 then + return NeverApplicable; + elif recognise.n = 6 then + recognise.needOrders := true; + if d = 6 or d = 4 then + recognise.needLB := true; + recognise.needE2 := true; + fi; + if d = 3 then + recognise.needPOrders := true; + if q >= 49 then + recognise.needLB := true; + fi; + fi; + return TemporaryFailure; + fi; + + if d = 6 and q = 4 then + if not HasElementsMultipleOf(recognise.orders, [7,10,11]) then + return TemporaryFailure; + fi; + elif d = 6 and q >= 9 then + if not 3 in recognise.E2 then return TemporaryFailure; fi; + if not 5 in recognise.LB then return TemporaryFailure; fi; + elif d = 5 and q = 4 then + if not HasElementsMultipleOf(recognise.orders, [11,12]) then + return TemporaryFailure; + fi; + elif d = 4 and q = 4 then + #TO DO : check this is same in Magma + if not HasElementsMultipleOf(recognise.orders, [5,9]) then + return TemporaryFailure; + fi; + elif d = 4 and q = 9 then + if not HasElementsMultipleOf(recognise.orders, [5,7,9]) then + return TemporaryFailure; + fi; + elif d = 4 and q > 9 then + if not 3 in recognise.LB then + return TemporaryFailure; + fi; + if not 2 in recognise.E2 then return TemporaryFailure; fi; + f1 := Collected(Factors( q^3-1 )); + f2 := Collected(Factors( q^2-1 )); + # check if we have a prime at least 11 + if PositionProperty( f1, i-> (i[1] >= 11)) <> fail then + return CheckFlag(); + fi; + if PositionProperty( f2, i-> (i[1] >= 11)) <> fail then + return CheckFlag(); + fi; + # Now we know that q^3-1 and q^2-1 only contain primes + # at most 7 + if not q^3 mod 7 = 1 or q^2 mod 7 = 1 or q mod 7 = 1 then + # 7 is not ppd of q^3-1 + return CheckFlag(); + fi; + # Now we know 7 is ppd of q^3 -1 + if not q^2 mod 5 = 1 or q mod 5 = 1 then + # 5 is not ppd of q^2-1 + return CheckFlag(); + fi; + if PositionProperty( recognise.orders, i -> + (i mod 7 = 0 and # order divisible by 7 + i <> 7 and # but not equal to 7 + q^3 mod i = 1 and # order divides q^3-1 + (7*(q-1)) mod i <> 0 # order does not divide 7*(q-1) + )) <> fail then + # 5 is not ppd of q^2-1 + return CheckFlag(); + fi; + elif d = 3 and q = 4 then + if Order(grp) mod 216 = 0 then + return CheckFlag(); + else + recognise.IsSUContained := false; + return NeverApplicable; + fi; + elif d = 3 and q = 9 then + if not HasElementsMultipleOf(recognise.orders, [7]) then + return TemporaryFailure; + fi; + if recognise.hasSpecialEle = false then + if not Order( recognise.g ) mod 6 = 0 then return TemporaryFailure; fi; + if PositionProperty( GeneratorsOfGroup(grp), + h-> (Comm(h,recognise.g^3) <> One(grp))) <> fail then + Info( InfoClassical,2, + "Cube of element of order div by 6 is not central" ); + recognise.hasSpecialEle := true; + return CheckFlag(); + fi; + else return CheckFlag(); + fi; + elif d = 3 and q = 16 then + if not HasElementsMultipleOf(recognise.orders, [5,13]) then + return TemporaryFailure; + fi; + if recognise.hasSpecialEle = false then + if not Order(recognise.g) mod 5 = 0 then return TemporaryFailure; fi; + if PositionProperty( GeneratorsOfGroup(grp), + h-> (Comm(h,recognise.g) <> One(grp))) <> fail then + Info( InfoClassical,2, + "The element of order 5 is not central" ); + recognise.hasSpecialEle := true; + return CheckFlag(); + fi; + else return CheckFlag(); + fi; + elif d = 3 and q = 25 then + if not HasElementsMultipleOf(recognise.orders, [5,7,8]) then + return TemporaryFailure; + fi; + if recognise.hasSpecialEle = false then + if Order(recognise.g) mod 8 <> 0 then return TemporaryFailure; fi; + g := recognise.g^(Order(recognise.g)/2); + if PositionProperty( GeneratorsOfGroup(grp), + h-> (Comm(h,g) <> One(grp))) <> fail then + Info( InfoClassical,2, + "involution in cyclic subgroup of order 8 is not central" ); + recognise.hasSpecialEle := true; + return CheckFlag(); + fi; + else return CheckFlag(); + fi; + elif d = 3 and q >= 49 then + if not 3 in recognise.LE or not 3 in recognise.BE then + return TemporaryFailure; + fi; + if not recognise.ppd[1] = 3 or not recognise.ppd[2]=true + or not recognise.ppd[3]=true then + return TemporaryFailure; + fi; + if recognise.hasSpecialEle = false then + g := recognise.g; + o := Order(g); + q0 := Characteristic(recognise.field)^ + (LogInt(q,Characteristic(recognise.field))/2); + if not ((q0^2 - q0 + 1)/Gcd(3,q0+1)) mod o = 0 then + return TemporaryFailure; + fi; + if not o > 7* Gcd(3,q0+1) then + return TemporaryFailure; + fi; + if PositionProperty(recognise.porders, + i->(i[1]>3 and q mod i[1]=1))=fail then + return TemporaryFailure; + fi; + recognise.hasSpeccialEle := true; + return CheckFlag(); + else + return CheckFlag(); + fi; + else + Info(InfoClassical,2, + "NonGenericUnitary: d and q must have been be generic"); + return NeverApplicable; + fi; + + return CheckFlag(); +end; + + +RECOG.NonGenericOrthogonalPlus := function(recognise,grp) + + local d, q, gp1, gp2, CheckFlag, pgrp, orbs; + + CheckFlag := function( ) + if recognise.isReducible = "unknown" then + recognise.needMeataxe := true; + return TemporaryFailure; + fi; + if Length(recognise.ClassicalForms) = 0 then + recognise.needForms := true; + return TemporaryFailure; + fi; + Info(InfoClassical,2,"group contains SO+(", + recognise.d, ", ", recognise.q, ");"); + + recognise.IsSOContained := true; + return Success; + end; + + d := recognise.d; + q := recognise.q; + + if not d in [4,6,8,10] then return NeverApplicable; fi; + + if d = 10 and q <> 2 then return NeverApplicable; fi; + if recognise.isReducible = true then return NeverApplicable; fi; + + if Length( recognise.ClassicalForms ) > 0 and + not "orthogonalplus" in recognise.ClassicalForms then + return NeverApplicable; + fi; + + if recognise.n <= 5 then + return NeverApplicable; + elif recognise.n = 6 then + recognise.needOrders := true; + if d = 8 then + recognise.needE2 := true; + fi; + return TemporaryFailure; + fi; + + if d = 10 and q = 2 then + if not HasElementsMultipleOf( recognise.orders, [17,31]) then + return TemporaryFailure; + fi; + elif d = 8 and q = 2 then + if not IsSubset(recognise.orders,[7, 9, 10, 15]) then + return TemporaryFailure; + fi; + pgrp := ProjectiveActionOnFullSpace( grp, recognise.field, d ); + orbs := Orbits( pgrp, MovedPointsPerms( GeneratorsOfGroup(pgrp))); + + if Set(List(orbs,Length)) <> [ 120, 135 ] then + recognise.isSOContained := false; + return NeverApplicable; + fi; + if Size(pgrp) mod 174182400 = 0 then + return CheckFlag(); + recognise.isSOContained := true; + else + recognise.isSOContained := false; + return NeverApplicable; + fi; + elif d = 8 and q = 3 then + if not HasElementsMultipleOf( recognise.orders, [7,13]) then + return TemporaryFailure; + fi; + pgrp := ProjectiveActionOnFullSpace( grp, recognise.field, d ); + orbs := Orbits( pgrp, MovedPointsPerms( GeneratorsOfGroup(pgrp))); + if Set(List(orbs, Length)) <> [ 1080, 1120] then + recognise.isSOContained := false; + return NeverApplicable; + fi; + if Size(pgrp) mod 4952179814400 = 0 then + return CheckFlag(); + else + recognise.isSOContained := false; + return NeverApplicable; + fi; + elif d = 8 and q = 5 then + if not HasElementsMultipleOf( recognise.orders, [7,13]) then + return TemporaryFailure; + fi; + elif d = 8 and (q = 4 or q > 5) then + if not 6 in recognise.LB then return TemporaryFailure; fi; + if not 4 in recognise.LS then return TemporaryFailure; fi; + elif d = 6 and q = 2 then + if not IsSubset( recognise.orders, [7,15] ) then return TemporaryFailure; fi; + elif d = 6 and q = 3 then + if not HasElementsMultipleOf( recognise.orders, [5]) then + return TemporaryFailure; + fi; + if not 13 in recognise.orders then return TemporaryFailure; fi; + elif d = 6 and q >= 4 then + if not 4 in recognise.LB then return TemporaryFailure; fi; + if not 3 in recognise.E2 then return TemporaryFailure; fi; + elif d = 4 and (q = 8 or q >= 11) then + if recognise.needPlusMinus = false then + recognise.needPlusMinus := true; + return NeverApplicable; + fi; + if not IsSubset(recognise.plusminus,[[1,1],[1,-1],[-1,-1]]) then + return TemporaryFailure; + fi; + elif d = 4 and q = 2 then + if Size(grp) mod 36 <> 0 then + recognise.isSOContained := false; + return NeverApplicable; + fi; + if recognise.needDecompose = false then + recognise.needDecompose := true; + return TemporaryFailure; + fi; + gp1 := Group(recognise.sq1); + gp2 := Group(recognise.sq2); + Info(InfoClassical,2,"Group projects to group of order ", + Size(gp1/recognise.scalars), "x", Size(gp2/recognise.scalars),"\n"); + if Size(gp1/recognise.scalars) mod 6 = 0 and + Size(gp2/recognise.scalars) mod 6 = 0 then + return CheckFlag(); + fi; + elif d = 4 and q = 3 then + if Size(grp) mod 288 <> 0 then + recognise.isSOContained := false; + return NeverApplicable; + fi; + if recognise.needDecompose = false then + recognise.needDecompose := true; + return TemporaryFailure; + fi; + gp1 := Group(recognise.sq1); + gp2 := Group(recognise.sq2); + Info(InfoClassical,2,"Group projects to group of order ", + Size(gp1/recognise.scalars), "x", Size(gp2/recognise.scalars),"\n"); + if Size(gp1/recognise.scalars) mod 12 = 0 and + Size(gp2/recognise.scalars) mod 12 = 0 then + return CheckFlag(); + fi; + elif d = 4 and q = 4 then + pgrp := ProjectiveActionOnFullSpace( grp, recognise.field, d ); + orbs := Orbits( pgrp, MovedPointsPerms( + GeneratorsOfGroup(pgrp))); + # TODO Check this in MAGMA + if Size(pgrp) mod 3600 <> 0 then + recognise.isSOContained := false; + return NeverApplicable; + fi; + if recognise.needDecompose = false then + recognise.needDecompose := true; + return TemporaryFailure; + fi; + gp1 := Group(recognise.sq1); + gp2 := Group(recognise.sq2); + Info(InfoClassical,2,"Group projects to group of order ", + Size(gp1/recognise.scalars), "x", Size(gp2/recognise.scalars),"\n"); + if Size(gp1/recognise.scalars) mod 3 = 0 and + Size(gp2/recognise.scalars) mod 3 = 0 then + return CheckFlag(); + fi; + elif d = 4 and q = 5 then + pgrp := ProjectiveActionOnFullSpace( grp, recognise.field, d ); + if Size(pgrp) mod 7200 <> 0 then + recognise.isSOContained := false; + return NeverApplicable; + else + return CheckFlag(); + fi; + elif d = 4 and q = 7 then + pgrp := ProjectiveActionOnFullSpace( grp, recognise.field, d ); + if Size(pgrp) mod 56448 <> 0 then + recognise.isSOContained := false; + return NeverApplicable; + fi; + if recognise.needDecompose = false then + recognise.needDecompose := true; + return TemporaryFailure; + fi; + gp1 := Group(recognise.sq1); + gp2 := Group(recognise.sq2); + Info(InfoClassical,2,"Group projects to group of order ", + Size(gp1/recognise.scalars), "x", Size(gp2/recognise.scalars),"\n"); + if Size(gp1/recognise.scalars) mod 168 = 0 and + Size(gp2/recognise.scalars) mod 168 = 0 then + return CheckFlag(); + fi; + elif d = 4 and q = 9 then + pgrp := ProjectiveActionOnFullSpace( grp, recognise.field, d ); + if Size(pgrp) mod 259200 <> 0 then + recognise.isSOContained := false; + return NeverApplicable; + else + return CheckFlag(); + fi; + else + Info(InfoClassical, 2, + "NonGenericO+: d and q must have been be generic"); + return NeverApplicable; + fi; + + return CheckFlag(); + +end; + +RECOG.NonGenericOrthogonalMinus := function(recognise, grp) + + local d, q, orbs, pgrp, h, g, ppd, CheckFlag; + + CheckFlag := function( ) + if recognise.isReducible = "unknown" then + recognise.needMeataxe := true; + return TemporaryFailure; + fi; + if Length(recognise.ClassicalForms) = 0 then + recognise.needForms := true; + return TemporaryFailure; + fi; + Info(InfoClassical,2,"group contains SO-(", + recognise.d, ", ", recognise.q, ");"); + recognise.IsSOContained := true; + return Success; + end; + + d := recognise.d; + q := recognise.q; + + if not d in [4,6,8] then return NeverApplicable; fi; + if d = 8 and q <> 2 then return NeverApplicable; fi; + if d = 6 and q > 3 then return NeverApplicable; fi; + + if recognise.isReducible = true then return NeverApplicable; fi; + + if Length( recognise.ClassicalForms ) > 0 and + not "orthogonalminus" in recognise.ClassicalForms then + return NeverApplicable; + fi; + + if recognise.n <= 5 then + return NeverApplicable; + elif recognise.n = 6 then + recognise.needOrders := true; + return TemporaryFailure; + fi; + + if d = 8 and q = 2 then + if not HasElementsMultipleOf( recognise.orders, [9,17]) then + return TemporaryFailure; + fi; + elif d = 6 and q = 3 then + if not HasElementsMultipleOf( recognise.orders, [5,7,9]) then + return TemporaryFailure; + fi; + elif d = 6 and q = 2 then + if not HasElementsMultipleOf( recognise.orders, [5,9]) then + return TemporaryFailure; + fi; + elif d = 4 and q = 2 then + if not HasElementsMultipleOf( recognise.orders, [3,5]) then + return TemporaryFailure; + fi; + elif d = 4 and q = 3 then + if not HasElementsMultipleOf( recognise.orders, [5]) then + return TemporaryFailure; + fi; + pgrp := ProjectiveActionOnFullSpace( grp, GF(3), 4 ); + orbs := Orbits( pgrp, MovedPointsPerms( GeneratorsOfGroup(pgrp))); + if Length(orbs) <> 3 then + recognise.isSOContained := false; + return NeverApplicable; + fi; + elif d = 4 and q >= 4 then + # TODO check this in Magma + ppd := IsPpdElement( recognise.field, recognise.cpol, d, q, 1 ); + if ppd = false or ppd[1] <> 4 then return TemporaryFailure; fi; + # found a ppd( 4, q; 4)-element + g := recognise.g; + for h in GeneratorsOfGroup(grp) do + if Comm(h,g) <> One(grp) or Comm(Comm(h,g),g) <> One(grp) then + return CheckFlag(); + fi; + od; + Info(InfoClassical, 2, "grp contained in O-(2,", q, "^2)\n" ); + recognise.isNotExt := false; + recognise.isSOContained := false; + return NeverApplicable; + else + Info(InfoClassical, 2, "NonGenericO-: d and q must be generic\n" ); + return NeverApplicable; + fi; + + return CheckFlag(); + +end; + + +RECOG.NonGenericOrthogonalCircle := function( recognise, grp ) + + local d, q, g, s, CheckFlag; + + if not IsOddInt(recognise.d) then return NeverApplicable; fi; + if not IsOddInt(recognise.q) then return NeverApplicable; fi; + + CheckFlag := function( ) + if recognise.isReducible = "unknown" then + recognise.needMeataxe := true; + return TemporaryFailure; + fi; + if Length(recognise.ClassicalForms) = 0 then + recognise.needForms := true; + return TemporaryFailure; + fi; + Info(InfoClassical,2,"group contains SOo(", + recognise.d, ", ", recognise.q, ");"); + recognise.IsSOContained := true; + return Success; + end; + + d := recognise.d; + q := recognise.q; + + if recognise.isReducible = true then return NeverApplicable; fi; + + if Length( recognise.ClassicalForms ) > 0 and + not "orthogonalcircle" in recognise.ClassicalForms then + return NeverApplicable; + fi; + + if recognise.n <= 5 then + return NeverApplicable; + elif recognise.n = 6 then + recognise.needOrders := true; + return TemporaryFailure; + fi; + + + if d = 7 and q = 3 then + if not HasElementsMultipleOf( recognise.orders, [5,7,13]) then + return TemporaryFailure; + fi; + elif d = 5 and q = 3 then + if not HasElementsMultipleOf( recognise.orders, [5,9]) then + return TemporaryFailure; + fi; + elif d = 5 and q >= 5 then + if not 4 in recognise.LE then return TemporaryFailure; fi; + elif d = 3 and q = 3 then + if not HasElementsMultipleOf( recognise.orders, [3]) then + return TemporaryFailure; + fi; + elif d = 3 and q = 5 then + if not HasElementsMultipleOf( recognise.orders, [3,5]) then + return TemporaryFailure; + fi; + elif d = 3 and q = 7 then + if not HasElementsMultipleOf( recognise.orders, [4,7]) then + return TemporaryFailure; + fi; + elif d = 3 and q = 9 then + if not HasElementsMultipleOf( recognise.orders, [3,5]) then + return TemporaryFailure; + fi; + if recognise.hasSpecialEle = false then + if not Order(recognise.g) in [4,8] then return TemporaryFailure; fi; + g := recognise.g^2; + if PositionProperty(GeneratorsOfGroup(grp), + h->(Comm(h,g)<>One(grp))) <> fail then + recognise.hasSpecialEle := true; + return CheckFlag(); + fi; + else + return CheckFlag(); + fi; + recognise.IsSOContained := false; + return NeverApplicable; + elif d = 3 and q = 11 then + if not HasElementsMultipleOf( recognise.orders, [3,11]) then + return TemporaryFailure; + fi; + elif d = 3 and q = 19 then + if not HasElementsMultipleOf( recognise.orders, [5,9,19]) then + return TemporaryFailure; + fi; + elif d = 3 and q >=31 and IsPowerOfPrime(q+1,2) then + s := LogInt(q+1,2); + if PositionProperty(recognise.orders, + i->(i > 2 and (q-1) mod i = 0))=fail then + return TemporaryFailure; + fi; + if PositionProperty(recognise.orders, + i-> i mod 2^(s-1) = 0 ) = fail then + return TemporaryFailure; + fi; + elif d = 3 and q>11 and ((q+1) mod 3=0 and + IsPowerOfPrime((q+1)/3,2)) then + # TO DO Check this in Magma + s := LogInt( (q+1)/3, 2); + if PositionProperty(recognise.orders, + i-> i mod (3*2^(s-1)) = 0 ) = fail then + return TemporaryFailure; + fi; + if PositionProperty(recognise.orders, + i->(i > 2 and (q-1) mod i = 0))=fail then + return TemporaryFailure; + fi; + elif d = 3 and ((q+1) mod 3 <> 0 or not IsPowerOfPrime((q+1)/3,2)) and + not IsPowerOfPrime(q+1,2) then + if not 2 in recognise.LB then return TemporaryFailure; fi; + if PositionProperty(recognise.orders, + i->(i > 2 and (q-1) mod i = 0))=fail then + return TemporaryFailure; + fi; + else + Info(InfoClassical, 2, "NonGenericOo: d and q must be generic\n" ); + return NeverApplicable; + fi; + + return CheckFlag(); +end; + + + + + +############################## +## ## +## sg (functions for d = 2) ## +## ## +############################## + +# generates the next random element and its char polynomial +RECOG.TestRandomElementCase2 := function ( recognise, grp ) + + local g, porder; + + if recognise.d <> 2 then return NeverApplicable; fi; + + recognise.g := PseudoRandom(grp); + recognise.cpol := CharacteristicPolynomial(recognise.g); + recognise.n := recognise.n + 1; + + g := recognise.g; + + if recognise.needPOrders then + porder := ProjectiveOrder(g); + AddSet( recognise.porders, porder ); + + # for further calculations find h in G s.t. h^2 is not in Z(G) + if porder[1] > 2 then + recognise.h := g; + recognise.hasExp2 := false; + recognise.needPOrders := false; + fi; + fi; + + return TemporaryFailure; +end; + + +# tests whether group is abelian +RECOG.IsAbelian := function ( recognise, grp ) + + if recognise.d <> 2 then return NeverApplicable; fi; + + if IsAbelian( grp ) then + recognise.isAbelian := true; + # an abelian group does not contain SL(2,q) + Info( InfoClassical, 2, + "The group is abelian and thus doesn't contain a classical group"); + recognise.IsSLContained := false; + return Success; + fi; + + recognise.isAbelian := false; + return NeverApplicable; +end; + + +# tests whether group modulo scalars has exp = 2 +RECOG.HasExp2 := function ( recognise, grp ) + + local generators, gen, porder; + + if recognise.d <> 2 then return NeverApplicable; fi; + if recognise.hasExp2 <> "unknown" then return NeverApplicable; fi; + + generators := recognise.generators; + + # if testing random elements did not rule out + # the case exp(G/Z) = 2 then test generators + if recognise.n > 15 then + # find projective order of generators and - if possible - + # set h such that h^2 is not in Z(G) + for gen in generators do + porder := ProjectiveOrder( gen ); + if porder[1] > 2 then + recognise.h := gen; + recognise.hasExp2 := false; + return NeverApplicable; + fi; + od; + # if all generators have projective order <= 2 then + # g^2 in Z for all g in G and thus (gZ)^2 = Z + # hence ord(gZ) = 2 for all gZ in G/Z, i.e. exp(G/Z) = 2 + recognise.hasExp2 := true; + # a group with exp(G/Z) = 2 does not contain SL(2,q) + Info( InfoClassical, 2, + "The group modulo scalars has exponent 2 and thus doesn't contain a classical group"); + recognise.IsSLContained := false; + return Success; + fi; + + return TemporaryFailure; +end; + + +# tests whether G is a subgroup of GammaL(1,q^2) +RECOG.IsSubgroupOfGammaL := function ( recognise, grp ) + + local h, q, gen, generators, x, x2, charPol; + + if recognise.d <> 2 then return NeverApplicable; fi; + + # in case we haven't found h yet try again later + if recognise.h = fail then return TemporaryFailure; fi; + + h := recognise.h; + q := recognise.q; + charPol := CharacteristicPolynomial(h^2); + x := h^4; + generators := recognise.generators; + + # if h^2 is reducible then G is not conjugate to a subgroup of GammaL + if not IsIrreducible(charPol) then + recognise.isSubgroupOfGammaL := false; + return NeverApplicable; + fi; + + # if h^2 is not 'primitive', i.e a ppd(2,q;2)-element, then find a new h + if ( Order( h^2 ) in Factors( q^2-1 ) ) = false or + Order( h^2 ) in Factors( q-1 ) then + recognise.needPOrders := true; + return TemporaryFailure; + fi; + + for gen in generators do + x2 := x^gen; + if (x2 * x <> x * x2) then + recognise.isSubgroupOfGammaL := false; + return NeverApplicable; + fi; + od; + + recognise.isSubgroupOfGammaL := true; + # a subgroup of GammaL does not contain SL(2,q) + Info( InfoClassical, 2, + "The group is conjugate to a subgroup of GammaL(1,", q, ") and thus doesn't contain a classical group"); + recognise.IsSLContained := false; + return Success; +end; + + +# tests whether G is imprimitive +RECOG.IsImprimitive := function ( recognise, grp ) + + local h, f, gen, genNew, generators, eigenvectors; + + if recognise.d <> 2 then return NeverApplicable; fi; + + # in case we haven't found h yet try again later + if recognise.h = fail then return TemporaryFailure; fi; + + h := recognise.h; + f := recognise.field; + generators := recognise.generators; + eigenvectors := Eigenvectors( f, h^2 ); + + # if there are not two distict eigenspaces then G is primitive + if Length(eigenvectors) <> 2 then + recognise.isImprimitive := false; + return NeverApplicable; + fi; + + # consider the list of eigenvectors as a matrix + for gen in generators do + genNew := gen^eigenvectors; + # if genNew is not monomial, then G is primitive + if not IsMonomialMatrix( genNew ) then + recognise.isImprimitive := false; + return NeverApplicable; + fi; + + od; + recognise.isImprimitive := true; + # an imprimitive group does not contain SL(2,q) + Info( InfoClassical, 2, + "The group is imprimitive and thus doesn't contain a classical group"); + recognise.IsSLContained := false; + return Success; +end; + + +# tests if group is isomorphic to Alt(5), Alt(4), Sym(4) +RECOG.IsAlt5Alt4Sym4 := function ( recognise, grp ) + + local pgrp, q; + + if recognise.d <> 2 then return NeverApplicable; fi; + + pgrp := ProjectiveActionOnFullSpace( grp, recognise.field, 2 ); + recognise.pgrp := pgrp; + q := recognise.q; + + if NrMovedPoints( pgrp ) <= 5 then + # check if G/Z is isomorphic to Alt4, Alt5 or Sym4 + # and is not one of the exceptions ( GL(2,3), SL(2,3), + # GL(2,4), SL(2,4), SL(2,5), ) + # if so, then G does not contain SL(2,q) + if (Size( pgrp ) = 12 and q <> 3) or + (Size( pgrp ) = 24 and q <> 3) or + (Size( pgrp ) = 60 and q <> 4 and q <> 5) then + if IsAlternatingGroup(pgrp) or IsSymmetricGroup(pgrp) then + recognise.isAlt5Alt4Sym4 := true; + Info( InfoClassical, 2, + "The group modulo scalars is isomorphic to Alt5, ALt4 or Sym4 and is not one of the exceptions thus doesn't contain a classical group"); + recognise.IsSLContained := false; + return Success; + fi; + fi; + fi; + + recognise.isAlt5Alt4Sym4 := false; + return NeverApplicable; +end; + + +# tests whether a subgroup of GL(2,q) contains SL(2,q) +RECOG.IsSL2Contained := function( recognise, grp ) + + if recognise.d <> 2 then return NeverApplicable; fi; + if recognise.isReducible = true then return NeverApplicable; fi; + + # if G has passed all the tests so far then it is either representable + # over a proper subfield modulo scalars or it contains SL(2,q) + if (recognise.isReducible = false and + recognise.isAbelian = false and + recognise.hasExp2 = false and + recognise.isSubgroupOfGammaL = false and + recognise.isImprimitive = false and + recognise.isAlt5Alt4Sym4 = false) then + + # if G is transitive on the q+1 1-dim subspaces of the underlying + # vector space then it is not realizable over a proper subfield + if IsTransitive( recognise.pgrp ) then + recognise.isRepresentableOverSubfield := false; + Info(InfoClassical,2,"The group is not generic"); + Info(InfoClassical,2,"and contains SL(", 2, ", ", recognise.q, ");"); + recognise.IsSLContained := true; + return Success; + fi; + + recognise.isRepresentableOverSubfield := true; + Info( InfoClassical, 2, + "The group is representable over a proper subfield and thus doesn't contain a classical group"); + recognise.IsSLContained := false; + return Success; + fi; + + return TemporaryFailure; +end; diff --git a/gap/projective/tensor.gi b/gap/projective/tensor.gi deleted file mode 100644 index 82de4990d..000000000 --- a/gap/projective/tensor.gi +++ /dev/null @@ -1,443 +0,0 @@ -############################################################################# -## -## This file is part of recog, a package for the GAP computer algebra system -## which provides a collection of methods for the constructive recognition -## of groups. -## -## This files's authors include Max Neunhöffer, Ákos Seress. -## -## Copyright of recog belongs to its developers whose names are too numerous -## to list here. Please refer to the COPYRIGHT file for details. -## -## SPDX-License-Identifier: GPL-3.0-or-later -## -## -## A collection of find homomorphism methods for tensor product -## decompositions of matrix groups. -## -############################################################################# - -RECOG.FindTensorKernel := function(G,onlyone) - # Assume G respects a tensor product decomposition of its natural - # module V. Try to find the kernel of the canonical map: - local N,allps,c,fac,facs,i,j,kgens,newc,notused,o,pfacs,x,z; - kgens := []; - for i in [1..5] do - x := PseudoRandom(G); - o := ProjectiveOrder(x)[1]; - fac := Collected(Factors(Integers,o)); - pfacs := List(fac,x->x[1]); - allps := Product(pfacs); - z := x^(o/allps); - #Print(pfacs,"\n"); - for j in pfacs do - #Print(j," \c"); - Add(kgens,z^(allps/j)); - # make a prime element, hope it is in the kernel - od; - #Print("\n"); - od; - - # Now we hope that at least one of the elements in kgens is in the kernel, - # we do something to ensure that in that case we have a kernel element: - facs := []; - while Length(kgens) > 0 do - #Print(Length(kgens)," \c"); - c := kgens[1]; - notused := []; - for i in [2..Length(kgens)] do - newc := Comm(c,kgens[i]); - if IsOneProjective(newc) then - x := PseudoRandom(G); - newc := Comm(c,kgens[i]^x); - if IsOneProjective(newc) then - Add(notused,kgens[i]); - else - c := newc; - fi; - else - c := newc; - fi; - od; - #Print(Length(notused)," \c"); - N := GroupWithGenerators(FastNormalClosure(G,[c],10)); - if onlyone and - (ForAny(GeneratorsOfGroup(N),m->IsZero(m[1,1]) or - not IsOne(m*(m[1,1])^-1))) then - # we found a non-scalar normal subgroup: - #Print("\n"); - return N; - fi; - Add(facs,N); - kgens := notused; - od; - #Print("\n"); - return facs; -end; - -RECOG.FindTensorDecomposition := function(G,N) - # N a non-scalar normal subgroup of G - local b,basis,basisi,c,d,f,g,gens,gensn,h,homs,homsimg,i,l,lset,m,n,subdim,w; - - d := DimensionOfMatrixGroup(G); - - # First find an irreducible N-submodule of the natural module: - f := FieldOfMatrixGroup(G); - gensn := GeneratorsOfGroup(N); - # FIXME: necessary:? - #if IsObjWithMemory(gensn[1]) then - # gensn := StripMemory(gensn); - #fi; - m := [GModuleByMats(gensn,f)]; - n := [MTX.ProperSubmoduleBasis(m[1])]; - if n[1] = fail then - # This means the restriction is irreducible, we cannot do anything here - return fail; - fi; - i := 1; - while n[i] <> fail do - Add(m,MTX.InducedActionSubmodule(m[i],n[i])); - Add(n,MTX.ProperSubmoduleBasis(m[i+1])); - i := i + 1; - od; - i := i - 1; - b := n[i]; - i := i - 1; - while i >= 1 do - b := b * n[i]; - i := i - 1; - od; - - # Compute the homogeneous component: - w := m[Length(m)]; # An irreducible FN-module - homs := MTX.Homomorphisms(w,m[1]); - homsimg := Concatenation(homs); - ConvertToMatrixRep(homsimg,f); - if Length(homsimg) = d then # we see one homogeneous component - basis := homsimg; - basisi := homsimg^-1; - # In this case we will have a tensor decomposition: - subdim := MTX.Dimension(w); - if MTX.IsAbsolutelyIrreducible(w) then - # This is a genuine tensor decomposition: - return rec(t := basis, ti := basisi, blocksize := subdim); - fi; - # Otherwise we have a tensor decomposition over a bigger field: - # This will not be reached, since we have made sure that - # semilinear already caught this. (Lemma: If one tensor factor is - # semilinear, then the product is.) - ErrorNoReturn("This should never have happened (1), talk to Max."); - fi; - # homsimg is a basis of an N-homogeneous component. - # We move that one around with G to find a basis of the natural module: - # By Clifford's theorem this is a block system: - if d mod Length(homsimg) <> 0 then - # Not a homogeneous component, obviously we did not find - # a normal subgroup for some reason! - return fail; - fi; - - h := [ShallowCopy(homsimg)]; - b := MutableCopyMat(homsimg); - TriangulizeMat(b); - l := [b]; - lset := [b]; - gens := GeneratorsOfGroup(G); - i := 1; - while Length(h) < d/Length(homsimg) and i <= Length(l) do - for g in gens do - c := OnSubspacesByCanonicalBasis(l[i],g); - if not c in lset then - Add(h,h[i]*g); - Add(l,c); - AddSet(lset,c); - fi; - od; - i := i + 1; - od; - h := Concatenation(h); - ConvertToMatrixRep(h,f); - - if i > Length(l) then # by Clifford this should never happen, but still... - if Length(l) = 1 then - return fail; - else - # We have a (relatively short) non-trivial orbit! - return rec(orbit := lset); - fi; - else - ConvertToMatrixRep(basis,f); - basisi := basis^-1; - return rec(t := basis, ti := basisi, spaces := lset, field := f, - blocksize := Length(lset[1])); - fi; -end; - -RECOG.IsKroneckerProduct := function(m,r) - local blocksize,a,ac,ar,b,blockpos,d,entrypos,i,j,mul,pos; - blocksize := r.blocksize; - if Length(m) mod blocksize <> 0 then - return [false]; - fi; - d := Length(m); - pos := PositionNonZero(m[1]); - blockpos := QuoInt(pos-1,blocksize)+1; - entrypos := ((pos-1) mod blocksize)+1; - a := ExtractSubMatrix(m,[1..blocksize], - [(blockpos-1)*blocksize+1..blockpos*blocksize]); - a := a/a[1,entrypos]; - ac := []; - for i in [1..d/blocksize] do - ar := []; - for j in [1..d/blocksize] do - b := ExtractSubMatrix(m,[(i-1)*blocksize+1..i*blocksize], - [(j-1)*blocksize+1..j*blocksize]); - mul := b[1,entrypos]; - if a * mul <> b then - return [false]; - fi; - Add(ar,mul); - od; - Add(ac,ar); - od; - ConvertToMatrixRep(a,r.field); - ConvertToMatrixRep(ac,r.field); - return [true,a,ac]; -end; - -# RECOG.VerifyTensorDecomposition := function(gens,r) -# local g,newgens,newgensdec,res,yes; -# newgens := List(gens,x->r.t * x * r.ti); -# newgensdec := []; -# yes := true; -# for g in newgens do -# res := RECOG.IsKroneckerProduct(g,r); -# if res[1] = false then -# Add(newgensdec,fail); -# yes := false; -# else -# Add(newgensdec,[res[2],res[3]]); -# fi; -# od; -# return [yes,newgens,newgensdec]; -# end; -# -# RECOG.FindInvolution := function(g) -# # g a matrix group -# local i,o,x; -# for i in [1..100] do -# x := PseudoRandom(g); -# o := Order(x); -# if o mod 2 = 0 then -# return x^(o/2); -# fi; -# od; -# return fail; -# end; -# -# RECOG.FindCentralisingElementOfInvolution := function(G,x) -# # x an involution in G -# local o,r,y,z; -# r := PseudoRandom(G); -# y := x^r; -# # Now x and y generate a dihedral group -# if x=y then return r; fi; -# z := x*y; -# o := Order(z); -# if IsEvenInt(o) then -# return z^(o/2); -# else -# return z^((o+1)/2)*r^(-1); -# fi; -# end; -# -# RECOG.FindInvolutionCentraliser := function(G,x) -# # x an involution in G -# local i,l,y; -# l := []; -# for i in [1..20] do # find 20 generators of the centraliser -# y := RECOG.FindCentralisingElementOfInvolution(G,x); -# AddSet(l,y); -# od; -# return GroupWithGenerators(l); -# end; -# -# -# RECOG.FindTensorOtherFactor := function(G,N,blocksize) -# # N a non-scalar normal subgroup of G -# # Basechange already done such that N is a block scalar matrix meaning -# # "block-diagonal" and all blocks along the diagonal are equal. -# local c,i,invs,o,out,timeout,x,z; -# -# # Find a non-scalar involution in N: -# timeout := 100; -# while true do -# timeout := timeout - 1; -# if timeout = 0 then return fail; fi; -# x := RECOG.FindInvolution(N); -# if x <> fail and RECOG.IsScalarMat(x) = false then -# break; -# fi; -# od; -# -# invs := [x]; -# for i in [1..5] do -# Add(invs,x^PseudoRandom(N)); -# od; -# -# timeout := 100; -# while true do -# timeout := timeout - 1; -# if timeout = 0 then return fail; fi; -# c := RECOG.FindCentralisingElementOfInvolution(G,invs[1]); -# o := Order(c); -# if IsOddInt(o) then continue; fi; -# c := c^(o/2); -# i := 2; -# out := false; -# while i <= 5 do -# x := invs[i] * c; -# o := Order(x); -# if IsOddInt(o) then break; fi; -# z := x^(o/2); # this now commutes with invs[1]..invs[i], because -# # it is a power of a product of inv -# od; -# od; -# end; - - -#! @BeginChunk TensorDecomposable -#! TODO/FIXME: it is unclear if the following description actually belongs -#! to this method, so be cautious! -#! -#! -#! This method currently tries to find one tensor factor by powering up -#! commutators of random elements to elements of prime order. This seems -#! to work quite well provided that the two tensor factors are not -#! linked too much such that there exist enough elements that act -#! with different orders on both tensor factors. -#! -#! This method and its description needs some improvement. -#! @EndChunk -BindRecogMethod(FindHomMethodsProjective, "TensorDecomposable", -"find a tensor decomposition", -function(ri,G) - local H,N,conjgensG,d,f,hom,kro,r; - - RECOG.SetPseudoRandomStamp(G,"TensorDecomposable"); - - # Here we probably want to do an order test and even a polynomial - # factorization test... Later! - # Do we want? - - d := ri!.dimension; - if IsPrime(d) then - return NeverApplicable; - fi; - f := ri!.field; - - # Now assume a tensor factorization exists: - #Gm := GroupWithMemory(G);??? - N := RECOG.FindTensorKernel(G,true); - Info(InfoRecog,3, - "TensorDecomposable: I seem to have found a normal subgroup..."); - r := RECOG.FindTensorDecomposition(G,N); - if r = fail then - return TemporaryFailure; - fi; - if IsBound(r.orbit) then - Info(InfoRecog,2,"Did not find tensor decomposition but orbit."); - # We did not find a tensor decomposition, but a relatively short orbit: - hom := ActionHomomorphism(G,r.orbit,OnSubspacesByCanonicalBasis, - "surjective"); - SetHomom(ri,hom); - Setmethodsforimage(ri,FindHomDbPerm); - return Success; - fi; - - Info(InfoRecog,2, - "TensorDecomposable: I seem to have found a tensor decomposition."); - - # Now we believe to have a tensor decomposition: - conjgensG := List(GeneratorsOfGroup(G),x->r.t * x * r.ti); - kro := List(conjgensG,g->RECOG.IsKroneckerProduct(g,r)); - if not ForAll(kro, k -> k[1]) then - Info(InfoRecog,1,"VERY, VERY, STRANGE!"); - Info(InfoRecog,1,"False alarm, was not a tensor decomposition.", - " Found at least a perm action."); - hom := ActionHomomorphism(G,r.spaces,OnSubspacesByCanonicalBasis, - "surjective"); - SetHomom(ri,hom); - Setmethodsforimage(ri,FindHomDbPerm); - return Success; - fi; - - H := GroupWithGenerators(conjgensG); - hom := GroupHomByFuncWithData(G,H,RECOG.HomDoBaseChange,r); - SetHomom(ri,hom); - - # Hand down information: - InitialDataForImageRecogNode(ri).blocksize := r.blocksize; - InitialDataForImageRecogNode(ri).generatorskronecker := kro; - AddMethod(InitialDataForImageRecogNode(ri).hints, FindHomMethodsProjective.KroneckerProduct, 2000); - # This is an isomorphism: - findgensNmeth(ri).method := FindKernelDoNothing; - return Success; -end); - -RECOG.HomTensorFactor := function(data,m) - local k; - k := RECOG.IsKroneckerProduct(m,data); - if k[1] <> true then - return fail; - fi; - return k[3]; -end; - -#! @BeginChunk KroneckerProduct -#! TODO -#! @EndChunk -BindRecogMethod(FindHomMethodsProjective, "KroneckerProduct", -"TODO", -function(ri, G) - # We got the hint that this is a Kronecker product, let's take it apart. - # We first recognise projectively in one tensor factor and then in the - # other, life is easy because of projectiveness! - local H,data,hom,newgens; - newgens := List(ri!.generatorskronecker,x->x[3]); - H := GroupWithGenerators(newgens); - data := rec(blocksize := ri!.blocksize, field := ri!.field); - hom := GroupHomByFuncWithData(G,H,RECOG.HomTensorFactor,data); - SetHomom(ri,hom); - - AddMethod(InitialDataForKernelRecogNode(ri).hints, FindHomMethodsProjective.KroneckerKernel, 2000); - InitialDataForKernelRecogNode(ri).blocksize := ri!.blocksize; - return Success; -end); - -RECOG.HomTensorKernel := function(data,m) - local mm; - mm := ExtractSubMatrix(m,[1..data.blocksize],[1..data.blocksize]); - MakeImmutable(mm); - return mm; -end; - -#! @BeginChunk KroneckerKernel -#! TODO -#! @EndChunk -BindRecogMethod(FindHomMethodsProjective, "KroneckerKernel", -"TODO", -function(ri, G) - # One up in the tree we got the hint about a Kronecker product, this - # method is called when we have gone to one factor and now are in the - # kernel. So we know that we are a block diagonal matrix with identical - # diagonal blocks. All we do is to project down to one of the blocks. - local H,data,hom,newgens; - data := rec(blocksize := ri!.blocksize, field := ri!.field); - newgens := List(GeneratorsOfGroup(G),x->RECOG.HomTensorKernel(data,x)); - H := GroupWithGenerators(newgens); - hom := GroupHomByFuncWithData(G,H,RECOG.HomTensorKernel,data); - SetHomom(ri,hom); - findgensNmeth(ri).method := FindKernelDoNothing; - return Success; -end); diff --git a/gap/projective/tensor/tensor.gi b/gap/projective/tensor/tensor.gi new file mode 100644 index 000000000..c33ff3ead --- /dev/null +++ b/gap/projective/tensor/tensor.gi @@ -0,0 +1,2591 @@ +############################################################################# +## +## This file is part of recog, a package for the GAP computer algebra system +## which provides a collection of methods for the constructive recognition +## of groups. +## +## This files's authors include Max Neunhöffer, Ákos Seress, Daniel Rademacher. +## +## Copyright of recog belongs to its developers whose names are too numerous +## to list here. Please refer to the COPYRIGHT file for details. +## +## SPDX-License-Identifier: GPL-3.0-or-later +## +## +## A collection of find homomorphism methods for tensor product +## decompositions of matrix groups. +## +############################################################################# + +RECOG.FindTensorKernel := function(G,onlyone) + # Assume G respects a tensor product decomposition of its natural + # module V. Try to find the kernel of the canonical map: + local N,allps,c,fac,facs,i,j,kgens,newc,notused,o,pfacs,x,z; + kgens := []; + for i in [1..5] do + x := PseudoRandom(G); + o := ProjectiveOrder(x)[1]; + fac := Collected(Factors(Integers,o)); + pfacs := List(fac,x->x[1]); + allps := Product(pfacs); + z := x^(o/allps); + #Print(pfacs,"\n"); + for j in pfacs do + #Print(j," \c"); + Add(kgens,z^(allps/j)); + # make a prime element, hope it is in the kernel + od; + #Print("\n"); + od; + + # Now we hope that at least one of the elements in kgens is in the kernel, + # we do something to ensure that in that case we have a kernel element: + facs := []; + while Length(kgens) > 0 do + #Print(Length(kgens)," \c"); + c := kgens[1]; + notused := []; + for i in [2..Length(kgens)] do + newc := Comm(c,kgens[i]); + if IsOneProjective(newc) then + x := PseudoRandom(G); + newc := Comm(c,kgens[i]^x); + if IsOneProjective(newc) then + Add(notused,kgens[i]); + else + c := newc; + fi; + else + c := newc; + fi; + od; + #Print(Length(notused)," \c"); + N := GroupWithGenerators(FastNormalClosure(G,[c],10)); + if onlyone and + (ForAny(GeneratorsOfGroup(N),m->IsZero(m[1,1]) or + not IsOne(m*(m[1,1])^-1))) then + # we found a non-scalar normal subgroup: + #Print("\n"); + return N; + fi; + Add(facs,N); + kgens := notused; + od; + #Print("\n"); + return facs; +end; + +RECOG.FindTensorDecomposition := function(G,N) + # N a non-scalar normal subgroup of G + local b,basis,basisi,c,d,f,g,gens,gensn,h,homs,homsimg,i,l,lset,m,n,subdim,w; + + d := DimensionOfMatrixGroup(G); + + # First find an irreducible N-submodule of the natural module: + f := FieldOfMatrixGroup(G); + gensn := GeneratorsOfGroup(N); + # FIXME: necessary:? + #if IsObjWithMemory(gensn[1]) then + # gensn := StripMemory(gensn); + #fi; + m := [GModuleByMats(gensn,f)]; + n := [MTX.ProperSubmoduleBasis(m[1])]; + if n[1] = fail then + # This means the restriction is irreducible, we cannot do anything here + return fail; + fi; + i := 1; + while n[i] <> fail do + Add(m,MTX.InducedActionSubmodule(m[i],n[i])); + Add(n,MTX.ProperSubmoduleBasis(m[i+1])); + i := i + 1; + od; + i := i - 1; + b := n[i]; + i := i - 1; + while i >= 1 do + b := b * n[i]; + i := i - 1; + od; + + # Compute the homogeneous component: + w := m[Length(m)]; # An irreducible FN-module + homs := MTX.Homomorphisms(w,m[1]); + homsimg := Concatenation(homs); + # FIXME: + ConvertToMatrixRep(homsimg); + if Length(homsimg) = d then # we see one homogeneous component + basis := homsimg; + basisi := homsimg^-1; + # In this case we will have a tensor decomposition: + subdim := MTX.Dimension(w); + if MTX.IsAbsolutelyIrreducible(w) then + # This is a genuine tensor decomposition: + return rec(t := basis, ti := basisi, blocksize := subdim); + fi; + # Otherwise we have a tensor decomposition over a bigger field: + # This will not be reached, since we have made sure that + # semilinear already caught this. (Lemma: If one tensor factor is + # semilinear, then the product is.) + ErrorNoReturn("This should never have happened (1), talk to Max."); + fi; + # homsimg is a basis of an N-homogeneous component. + # We move that one around with G to find a basis of the natural module: + # By Clifford's theorem this is a block system: + if d mod Length(homsimg) <> 0 then + # Not a homogeneous component, obviously we did not find + # a normal subgroup for some reason! + return fail; + fi; + + h := [ShallowCopy(homsimg)]; + b := MutableCopyMat(homsimg); + TriangulizeMat(b); + l := [b]; + lset := [b]; + gens := GeneratorsOfGroup(G); + i := 1; + while Length(h) < d/Length(homsimg) and i <= Length(l) do + for g in gens do + c := OnSubspacesByCanonicalBasis(l[i],g); + if not c in lset then + Add(h,h[i]*g); + Add(l,c); + AddSet(lset,c); + fi; + od; + i := i + 1; + od; + h := Concatenation(h); + ConvertToMatrixRep(h); + + if i > Length(l) then # by Clifford this should never happen, but still... + if Length(l) = 1 then + return fail; + else + # We have a (relatively short) non-trivial orbit! + return rec(orbit := lset); + fi; + else + ConvertToMatrixRep(basis); + basisi := basis^-1; + return rec(t := basis, ti := basisi, spaces := lset, + blocksize := Length(lset[1])); + fi; +end; + +RECOG.IsKroneckerProduct := function(m,blocksize) + local a,ac,ar,b,blockpos,d,entrypos,i,j,mul,pos; + if Length(m) mod blocksize <> 0 then + return [false]; + fi; + d := Length(m); + pos := PositionNonZero(m[1]); + blockpos := QuoInt(pos-1,blocksize)+1; + entrypos := ((pos-1) mod blocksize)+1; + a := ExtractSubMatrix(m,[1..blocksize], + [(blockpos-1)*blocksize+1..blockpos*blocksize]); + a := a/a[1,entrypos]; + ac := []; + for i in [1..d/blocksize] do + ar := []; + for j in [1..d/blocksize] do + b := ExtractSubMatrix(m,[(i-1)*blocksize+1..i*blocksize], + [(j-1)*blocksize+1..j*blocksize]); + mul := b[1,entrypos]; + if a * mul <> b then + return [false]; + fi; + Add(ar,mul); + od; + Add(ac,ar); + od; + # FIXME: + ConvertToMatrixRep(a); + ConvertToMatrixRep(ac); + return [true,a,ac]; +end; + +# RECOG.VerifyTensorDecomposition := function(gens,r) +# local g,newgens,newgensdec,res,yes; +# newgens := List(gens,x->r.t * x * r.ti); +# newgensdec := []; +# yes := true; +# for g in newgens do +# res := RECOG.IsKroneckerProduct(g,r.blocksize); +# if res[1] = false then +# Add(newgensdec,fail); +# yes := false; +# else +# Add(newgensdec,[res[2],res[3]]); +# fi; +# od; +# return [yes,newgens,newgensdec]; +# end; +# +# RECOG.FindInvolution := function(g) +# # g a matrix group +# local i,o,x; +# for i in [1..100] do +# x := PseudoRandom(g); +# o := Order(x); +# if o mod 2 = 0 then +# return x^(o/2); +# fi; +# od; +# return fail; +# end; +# +# RECOG.FindCentralisingElementOfInvolution := function(G,x) +# # x an involution in G +# local o,r,y,z; +# r := PseudoRandom(G); +# y := x^r; +# # Now x and y generate a dihedral group +# if x=y then return r; fi; +# z := x*y; +# o := Order(z); +# if IsEvenInt(o) then +# return z^(o/2); +# else +# return z^((o+1)/2)*r^(-1); +# fi; +# end; +# +# RECOG.FindInvolutionCentraliser := function(G,x) +# # x an involution in G +# local i,l,y; +# l := []; +# for i in [1..20] do # find 20 generators of the centraliser +# y := RECOG.FindCentralisingElementOfInvolution(G,x); +# AddSet(l,y); +# od; +# return GroupWithGenerators(l); +# end; +# +# +# RECOG.FindTensorOtherFactor := function(G,N,blocksize) +# # N a non-scalar normal subgroup of G +# # Basechange already done such that N is a block scalar matrix meaning +# # "block-diagonal" and all blocks along the diagonal are equal. +# local c,i,invs,o,out,timeout,x,z; +# +# # Find a non-scalar involution in N: +# timeout := 100; +# while true do +# timeout := timeout - 1; +# if timeout = 0 then return fail; fi; +# x := RECOG.FindInvolution(N); +# if x <> fail and RECOG.IsScalarMat(x) = false then +# break; +# fi; +# od; +# +# invs := [x]; +# for i in [1..5] do +# Add(invs,x^PseudoRandom(N)); +# od; +# +# timeout := 100; +# while true do +# timeout := timeout - 1; +# if timeout = 0 then return fail; fi; +# c := RECOG.FindCentralisingElementOfInvolution(G,invs[1]); +# o := Order(c); +# if IsOddInt(o) then continue; fi; +# c := c^(o/2); +# i := 2; +# out := false; +# while i <= 5 do +# x := invs[i] * c; +# o := Order(x); +# if IsOddInt(o) then break; fi; +# z := x^(o/2); # this now commutes with invs[1]..invs[i], because +# # it is a power of a product of inv +# od; +# od; +# end; + + +#! @BeginChunk TensorDecomposable +#! TODO/FIXME: it is unclear if the following description actually belongs +#! to this method, so be cautious! +#! +#! +#! This method currently tries to find one tensor factor by powering up +#! commutators of random elements to elements of prime order. This seems +#! to work quite well provided that the two tensor factors are not +#! linked too much such that there exist enough elements that act +#! with different orders on both tensor factors. +#! +#! This method and its description needs some improvement. +#! @EndChunk +BindRecogMethod(FindHomMethodsProjective, "TensorDecomposable", +"find a tensor decomposition", +function(ri,G) + local H,N,conjgensG,d,f,hom,kro,r; + + RECOG.SetPseudoRandomStamp(G,"TensorDecomposable"); + + # Here we probably want to do an order test and even a polynomial + # factorization test... Later! + # Do we want? + + d := ri!.dimension; + if IsPrime(d) then + return NeverApplicable; + fi; + f := ri!.field; + + # Now assume a tensor factorization exists: + #Gm := GroupWithMemory(G);??? + N := RECOG.FindTensorKernel(G,true); + Info(InfoRecog,3, + "TensorDecomposable: I seem to have found a normal subgroup..."); + r := RECOG.FindTensorDecomposition(G,N); + if r = fail then + return TemporaryFailure; + fi; + if IsBound(r.orbit) then + Info(InfoRecog,2,"Did not find tensor decomposition but orbit."); + # We did not find a tensor decomposition, but a relatively short orbit: + hom := ActionHomomorphism(G,r.orbit,OnSubspacesByCanonicalBasis, + "surjective"); + SetHomom(ri,hom); + Setmethodsforimage(ri,FindHomDbPerm); + return Success; + fi; + + Info(InfoRecog,2, + "TensorDecomposable: I seem to have found a tensor decomposition."); + + # Now we believe to have a tensor decomposition: + conjgensG := List(GeneratorsOfGroup(G),x->r.t * x * r.ti); + kro := List(conjgensG,g->RECOG.IsKroneckerProduct(g,r.blocksize)); + if not ForAll(kro, k -> k[1]) then + Info(InfoRecog,1,"VERY, VERY, STRANGE!"); + Info(InfoRecog,1,"False alarm, was not a tensor decomposition.", + " Found at least a perm action."); + hom := ActionHomomorphism(G,r.spaces,OnSubspacesByCanonicalBasis, + "surjective"); + SetHomom(ri,hom); + Setmethodsforimage(ri,FindHomDbPerm); + return Success; + fi; + + H := GroupWithGenerators(conjgensG); + hom := GroupHomByFuncWithData(G,H,RECOG.HomDoBaseChange,r); + SetHomom(ri,hom); + + # Hand down information: + InitialDataForImageRecogNode(ri).blocksize := r.blocksize; + InitialDataForImageRecogNode(ri).generatorskronecker := kro; + AddMethod(InitialDataForImageRecogNode(ri).hints, FindHomMethodsProjective.KroneckerProduct, 2000); + # This is an isomorphism: + findgensNmeth(ri).method := FindKernelDoNothing; + return Success; +end); + +RECOG.HomTensorFactor := function(data,m) + local k; + k := RECOG.IsKroneckerProduct(m,data.blocksize); + if k[1] <> true then + return fail; + fi; + return k[3]; +end; + +#! @BeginChunk KroneckerProduct +#! TODO +#! @EndChunk +BindRecogMethod(FindHomMethodsProjective, "KroneckerProduct", +"TODO", +function(ri, G) + # We got the hint that this is a Kronecker product, let's take it apart. + # We first recognise projectively in one tensor factor and then in the + # other, life is easy because of projectiveness! + local H,data,hom,newgens; + newgens := List(ri!.generatorskronecker,x->x[3]); + H := GroupWithGenerators(newgens); + data := rec(blocksize := ri!.blocksize); + hom := GroupHomByFuncWithData(G,H,RECOG.HomTensorFactor,data); + SetHomom(ri,hom); + + AddMethod(InitialDataForKernelRecogNode(ri).hints, FindHomMethodsProjective.KroneckerKernel, 2000); + InitialDataForKernelRecogNode(ri).blocksize := ri!.blocksize; + return Success; +end); + +RECOG.HomTensorKernel := function(data,m) + local mm; + mm := ExtractSubMatrix(m,[1..data.blocksize],[1..data.blocksize]); + MakeImmutable(mm); + return mm; +end; + +#! @BeginChunk KroneckerKernel +#! TODO +#! @EndChunk +BindRecogMethod(FindHomMethodsProjective, "KroneckerKernel", +"TODO", +function(ri, G) + # One up in the tree we got the hint about a Kronecker product, this + # method is called when we have gone to one factor and now are in the + # kernel. So we know that we are a block diagonal matrix with identical + # diagonal blocks. All we do is to project down to one of the blocks. + local H,data,hom,newgens; + data := rec(blocksize := ri!.blocksize); + newgens := List(GeneratorsOfGroup(G),x->RECOG.HomTensorKernel(data,x)); + H := GroupWithGenerators(newgens); + hom := GroupHomByFuncWithData(G,H,RECOG.HomTensorKernel,data); + SetHomom(ri,hom); + findgensNmeth(ri).method := FindKernelDoNothing; + return Success; +end); + + +################################################################################################### +################################################################################################### +######## Tensor Products infrastructure ########################################################### +################################################################################################### +################################################################################################### + + +# Implemented by DR to keep track of the tensor stuff below. +RECOG.PrepareTensor := function(G) +local gens; + + gens := GeneratorsOfGroup(G); + + return rec( group := G, d := NumberRows(gens[1]), gens := gens, fld := FieldOfMatrixList(gens), IsTensorProduct := "unknown", TensorDimensions := "unknown", + TensorBasis := "unknown", TensorProductFlag := "unknown", TensorFactors := "unknown"); + +end; + + + +# {Return true if we know G is a tensor product, +# false if we know that G is not, otherwise "unknown"} +# G::GrpMat : Factors := [], Fast := false, RandomElements := 20 +RECOG.IsTensor := function (G, Factors, Fast, RandomElements) +local a, flag, TM; + + if RecogniseClassical(G) <> "fail" then + # TODO: We want + # ClassicalType (G) eq "orthogonalplus" + # But is there a naming algorithm for gray box groups in GAP so far? + # And if yes, can the algorithm decide between the types? + if (Degree (G) = 4) and (RecogniseClassical(G).IsSOContained = true) then + RandomElements := Maximum (RandomElements, 200); + else + return false; + fi; + fi; + + TM := RECOG.IsTensorMain(RECOG.PrepareTensor(G), false, Factors, Fast, RandomElements); + if TM <> fail then + return TM; + else + return "unknown"; + fi; +end; + + + +RECOG.TensorDimension := function (G) +local fac, u, w; + + fac := G.TensorFactors; + # Compute represent of factor 1 and factor 2 + u := NumberRows(GeneratorsOfGroup(fac[1])); + w := NumberRows(GeneratorsOfGroup(fac[2])); + G.TensorDimensions := [u, w]; + return [u, w]; + +end; + + +#{Return the change of basis matrix which exhibits the +# tensor decomposition of G}; +RECOG.TensorBasis := function (G) + + if G.TensorBasis <> fail then + return G.TensorBasis; + fi; + + return "unknown"; + +end; + + +RECOG.SetTensorBasis := function (G, B) + + G.TensorBasis := B; + +end; + + +RECOG.TensorProductFlag := function (G) + + if G.TensorProductFlag <> fail then + return G.TensorProductFlag; + fi; + + return "unknown"; + +end; + + +RECOG.SetTensorProductFlag := function (G, value) + + G.IsTensorProduct := value; + +end; + + +RECOG.TensorFactors := function (G) + + if G.TensorFactors <> fail then + return G.TensorFactors; + fi; + + return "unknown"; + +end; + + +RECOG.SetTensorFactors := function (G, factors) + + G.TensorFactors := factors; + +end; + + +RECOG.Normalise := function(M, F, zero, d) +local scaler, mat, row, col, notfound, scalerInv; + + scaler := zero; + mat := IdentityMat(d,F); + notfound := true; + for row in [1..d] do + if M[row,1] <> zero then + if notfound then + scaler := M[row,1]; + scalerInv := scaler^(-1); + notfound := false; + else + mat[row,1] := M[row,1]*scalerInv; + fi; + else + mat[row,1] := zero; + fi; + od; + + for row in [1..d] do + for col in [2..d] do + if M[row,col] <> zero then + mat[row,col] := M[row,col]*scalerInv; + else + mat[row,col] := zero; + fi; + od; + od; + + return [mat,scaler]; +end; + + +#{ Decide whether or not the collection of matrices X is composed +# of blocks size blockSize which differ only by scalars; +# if so, return true and the decomposition of each matrix, else false. +#} +RECOG.DecomposeKronecker := function(X, blockSize) +local F, d, flag, nBlocks, components, decompositions, scalars, row, col, top, left, scalar, g, block, normalised; + + if Size(X) = 0 then + Print("Argument 1 must be non-empty\n"); + return [false,false]; + fi; + + F := FieldOfMatrixList(X); + d := NrRows(X[1]); + flag := IsInt(d/blockSize); + if flag then + nBlocks := Int(d/blockSize); + else + return [false,false]; + fi; + + decompositions := []; + + for g in X do + components := []; + scalars := []; + + for row in [1 .. nBlocks] do + for col in [1 .. nBlocks] do + top := (row - 1) * blockSize + 1; + left := (col - 1) * blockSize + 1; + + block := g{[top..(top+blockSize-1)]}{[left..(left+blockSize-1)]}; + # Write function IsZero, i.e. at least one entry not zero; + if IsZero(block) then + Add(scalars, Zero(F)); + else + normalised := RECOG.Normalise(block, F, Zero(F), blockSize); + scalar := normalised[2]; + normalised := normalised[1]; + + if Size(components) = 0 then + Add(components, normalised); + else + if normalised <> components[1] then + return [false, false]; + fi; + fi; + + Add(scalars, scalar); + fi; + od; + od; + + # All blocks zero? + if Size(components) = 0 then + return [false, false]; + fi; + + scalars := Matrix(IsPlistMatrixRep,F,scalars,blockSize); + scalars := Unpack(scalars); + + Add(components, scalars); + if KroneckerProduct(components[2], components[1]) <> g then + Error("KroneckerDecomposition: What the hell did you do?"); + fi; + + Append(decompositions, Reversed(components)); + od; + + return [true, decompositions]; +end; + + + +#{Decide whether or not the collection of matrices X is composed of +# k x k blocks which differ only by scalars; if so, return true and +# the decomposition of each matrix, else false} +RECOG.AreProportional := function(X, k) + return RECOG.DecomposeKronecker(X, k); +end; + + + +# CB is a tuple containing change of basis matrix and the dimension +# of the geometry found; return the two tensor factors of the group +# G as matrix groups U and W */ + +RECOG.ConstructTensorFactors := function (G, CBTup) +local U, W, CB, DimU, F, gens, newgens, flag, Matrices, u, w, matU, matW; + + CB := CBTup[1]; + DimU := CBTup[2]; + + F := G.fld; + gens := G.gens; + newgens := List(gens, x -> x^CB); + if Size(gens) = 0 then + newgens := [One(G.group)]; + fi; + + flag := RECOG.AreProportional(gens, DimU); + Matrices := flag[2]; + flag := flag[1]; + + u := NumberRows(Matrices[1][1]); + w := NumberRows(Matrices[1][2]); + + matU := [1..Size(Matrices)]; + matW := [1..Size(Matrices)]; + matU := List(matU, x-> Matrices[x][1]); + matW := List(matW, x-> Matrices[x][2]); + U := GroupByGenerators(matU); + W := GroupByGenerators(matW); + + return [U, W]; + +end; + + + +RECOG.SetTypes := function(G) +local T, basis, invbasis, dim1, dim2, d, F, gens, U, W, matrices, Result; + + if not(G.IsTensorProduct) then + return; + fi; + + T := RECOG.TensorFactors(G); + if not(IsMatrixGroup(G.group)) then + return; + fi; + basis := G.TensorBasis; + dim1 := Dimension(T[1]); + dim2 := Dimension(T[2]); + d := G.d; + F := G.fld; + matrices := G.gens; + invbasis := basis^-1; + gens := G.gens; + if RECOG.AreProportional(List(matrices,m->m^invbasis), dim1) then + Result := [invbasis, dim1]; + elif RECOG.AreProportional(List(matrices,m->m^invbasis), dim2) then + Result := [invbasis, dim2]; + else + Error("Error in Tensor"); + fi; + RECOG.SetTensorBasis(G, invbasis); + U := RECOG.ConstructTensorFactors (G, Result); + W := U[2]; + U := U[1]; + RECOG.SetTensorFactors(G, [U, W]); + +end; + + + +# G, NonNegativeSolution: Factors := [], Fast := false, RandomElements := 25 +RECOG.IsTensorMain := function (G, NonNegativeSolution, Factors, Fast, RandomElements) +local factors, fast, NmrTries, flag, gens, d, F, list, Status, Result, U, W, CB; + + factors := Factors; + fast := Fast; + NmrTries := RandomElements; + + flag := RECOG.TensorProductFlag(G); + + if flag <> "unknown" then + return flag; + fi; + + if IsMatrixGroup(G) then + #SetGenerators (G, GroupGenerators (G)); + gens := GeneratorsOfGroup(G); + #elif Type (G) eq ModGrp then + # SetGenerators (G, GroupGenerators (Group (G))); + else + Error("IsTensor expects a group or a G-module"); + fi; + + d := Degree(gens[1]); + F := FieldOfMatrixList([gens]); + Print("Tensor: \nDimension = ", F ," \n Field = ", d, "\n"); + + list := RECOG.TensorTest(G, NmrTries, NonNegativeSolution, factors, fast); + Status := list[1]; + Result := list[2]; + + # we may have only checked some of the possible factorisations */ + if (Size(factors) = 0) and (Status = false) then + RECOG.SetTensorProductFlag (G, false); + fi; + + if Status then + CB := Result[1]; + RECOG.SetTensorProductFlag (G, true); + RECOG.SetTensorBasis (G, CB); + U := RECOG.ConstructTensorFactors (G, Result); + W := U[2]; + U := U[1]; + RECOG.SetTensorFactors (G, [U, W]); + fi; + + return Status; + +end; + +# Continue from here + +# return partitions of set S into subsets + +#RECOG.SetPartitions := function (SS) +#local S, Q, P, X; + +# S := SS; + +# if Size(S) = 1 then +# return {{S}}; +# else +# x := Random (S); +# Exclude (~S, x); +# P := $$(S); +# Q := {}; +# for X in P do +# for T in X do +# Q := Q join {X diff {T} join {T join {x}}}; +# od; +# Q := Q join {X join {{x}}}; +# od; +# return Q; +# fi; + +#end; + + +# compute the order of m mod n + +RECOG.OrderMod := function (m, n) +local i, mm; + + if n = 1 then + return 0; + fi; + if Gcd(m, n) = 1 then + return 0; + fi; + i := 1; + mm := m; + while true do + if mm mod n = 0 then + return i; + fi; + mm := mm * m; + i := i + 1; + od; + +end; + + +# return the sum of the lcms of the elements of X + +RECOG.Score := function (X) +local a; + + #return &+[Lcm (SetToSequence (T)) : T in X]; + a := List(X,T->Lcm(List(T))); + return Sum(a); + +end; + + +RECOG.FactorisationToInteger := function (l) +local ele, tuple; + + ele := 1; + for tuple in l do + ele := ele * tuple[1]^tuple[2]; + od; + return ele; + +end; + + +# returns the least d such that GL(d, q) has an element +# of order n and the corresponding factorisation of n; +# Gcd (n, q) = 1 */ + +RECOG.LeastLinearSemiSimple := function (n, q) +local p, f, orders, S, least, nparts, x, y, scores, i; + + p := Factors(q)[1]; + + f := Collected(Factors(n)); + + # for each prime-power factor of n, store the least d + # such that GL(d, q) has an element of this order + + orders := Set( List(f, x -> RECOG.OrderMod(q, x[1]^(x[2]))) ); + + # also need to remove divisors + for x in orders do + for y in orders do + if (x < y) and (y mod x = 0) then + Remove(orders,Position(orders,x)); + fi; + od; + od; + + if Size(orders) = 0 then + return [1, 1]; + fi; + + S := PartitionsSet(orders); + S := List(S); + + scores := List(S, x-> RECOG.Score(x)); + + # minimise partition score subject to maximising number of parts + + least := scores[1]; + nparts := Size(S[1]); + for i in [2..Size(scores)] do + if (scores[i] <= least) and (Size(S[i]) > nparts) then + least := scores[i]; + nparts := Size(S[i]); + fi; + od; + + return [least, nparts]; + +end; + + +RECOG.LeastProjectiveSemiSimple := function (n, q) +local u, m; + + if Gcd(n, q) <> 1 then + return false; + fi; + + if n = 1 then + return 1; + fi; + + u := RECOG.LeastLinearSemiSimple (n, q); + m := u[2]; + u := u[1]; + + if m > 1 then + return u; + fi; + + if (((q^u - 1)/(q - 1)) mod n) = 0 then + return u; + fi; + + return u + 1; + +end; + + +# find smallest d such that PGL(d, q) can contain an element +# of projective order n + +RECOG.LeastProjective := function (n, q) +local p, f, primes, index, alpha, factor, m; + + # write n = p^alpha * m + + p := Factors(q)[1]; + + # find p'-part of projective order n + + f := Collected(Factors(n)); + primes := List(f, x -> x[1]); + + index := Position(primes, p); + if index > 0 then + alpha := f[index][2]; + factor := 1 + p^(alpha - 1); + Remove(f, Position(f,[p,alpha])); + else + alpha := 0; + factor := 1; + fi; + + # p'-part of projective order + m := RECOG.FactorizationToInteger(f); + + if alpha = 0 then + return RECOG.LeastProjectiveSemiSimple(m, q); + elif m = 1 then + return factor; + else + return factor + RECOG.LeastLinearSemiSimple(m, q); + fi; + +end; + +# return prime factorisation p^a * q^b * .. as sequence [p, a, q, b, ..] + +RECOG.PrimePowers := function (n) + return Flat(Collected(Factors(n))); +end; + + +# take prime powers of n; compute scores for elements having +# these prime power orders; choose prime with largest score +# as best prime + +RECOG.FindBestPrime := function (n, q) +local D, Score, max, index, p, s, i; + + D := RECOG.PrimePowers(n); + + Score := [1..(Size(D)/2)]; + for i in [1..(Size(D)/2)] do + Score[i] := RECOG.LeastProjective (D[2*i-1] * D[2*i], q); + od; + max := Maximum (Score); + index := Position(Score, max); + + p := D[2 * (index - 1) + 1]; + s := D[2 * index]; + + return [p, s]; + +end; + + +# return factorisations of n into ordered pairs + +RECOG.FactorList := function (n) +local D, s, list; + + D := DivisorsInt(n); + s := Sqrt(n); + list := Filtered(D,x -> x <= s); + return List(list, x -> [x, n/x]); +end; + + +# find co-prime factorisations of n + +RECOG.CoPrimeFactorisations := function (n) +local L; + + # find co-prime factorisations of n + L := RECOG.FactorList(n); + return Filtered(L, x-> Gcd(x[1],x[2]) = 1); +end; + + +# is there a co-prime factorisation of n as k * l such +# that Score (k * m) <= DimU and Score (l * m) <= DimW ? + +# Original input: (n, m, d, q, DimU, DimW: Limit := 10^3) +RECOG.ExistsFactorisation := function (n, m, d, q, DimU, DimW, Limit) +local P, u, y, x; + + # find co-prime factorisations of n + P := RECOG.CoPrimeFactorisations(n); + + Print("Tensor: Number of coprime factorisations is ", Size(P), "\n"); + + if Size(P) > Limit then + return "unknown"; + fi; + + # is there is a valid co-prime factorisation of n? + # -- that is, one whose components fit into each side + + for x in P do + Print("Tensor: Processing order factorisation ", x, "\n"); + u := List([1..2], i -> RECOG.LeastProjective(x[i] * m, q)); + + y := List([1..2], i -> x[i] * m); + Print("Tensor: Score for ", y, " = ", u, "\n"); + + # is DimU >= u[1] and DimW >= u[2] or vice versa? + # EOB -- fix to include both options Nov 2012 + if ((u[1] <= DimU) and (u[2] <= DimW)) or ((u[1] <= DimW) and (u[2] <= DimU)) then + return true; + fi; + od; + + return false; +end; + +# can an element g of order n rule out possible tensor +# factorisation DimU x DimW of a subgroup of GL (d, q)? +# TestedPrimes records the prime order elements obtained +# as powers of g which are not projectivities + +RECOG.PossibleFactorisation := function (G, g, nn, d, q, DimU, DimW, list, TestedPrimes) +local n, m, Primes, p, s, h, Result, CB, D, flag; + + n := nn; + m := 1; + Primes := TestedPrimes; + + flag := RECOG.ExistsFactorisation (n, m, d, q, DimU, DimW, 10^3); + if flag = "unknown" then + return ["unknown", "unknown"]; + fi; + + while flag do + p := RECOG.FindBestPrime (n, q); + s := p[2]; + p := p[1]; + + h := g^((m * n)/p); + Print("Tensor: Projective order of possible scalar element is ", ProjectiveOrder(h), "\n"); + + # Next line was not commented by me + # Result, T := SmashElement (G, h); + + if not(h in Primes) then + # D:= Set (&cat List); + D := Set (list); + # TODO: Implement next line + #Result := IsMatrixProjectivity(G, h, D, Result, CB); + CB := Result[2]; + Result := Result[1]; + if Result then + return [CB, Primes]; + fi; + if Result = "unknown" then + return ["unknown", Primes]; + fi; + Add(Primes, h); + fi; + + # we can now conclude that if there is such a tensor decomposition, + # then an element of order m acts as a non-scalar on both factors + n := n/(p^s); + m := m * p^s; + Print("Tensor: n is now ", n, " m is now ",m, "\n"); + + flag := RECOG.ExistsFactorisation (n, m, d, q, DimU, DimW, 10^3); + od; + + return [flag, Primes]; + +end; + + + +# generate random elements and try to decide whether an element +# of projective order n rules out any possible tensor factorisation +# of a subgroup of GL (d, q) */ + +# Original input: (G, N, ~List, ~Record, ~Result) +RECOG.OrderTest := function(G, N, list, Record, Result) +local F, d, q, NmrElts, Tested, TestedPrimes, P, MinScore, n, g, u, w, i, f; + + F := G.fld; + d := G.d; + q := Size(F); + + Result := false; + NmrElts := 0; + Record := []; + Tested := []; + + TestedPrimes := Set([]); + + # generate N random elements and compute their scores + # P := Internal_RandomProcess(G); + P := [1..N]; + i := 1; + while i <= N do + P[i] := PseudoRandom(G); + i := i + 1; + od; + repeat + g := Random(P); + NmrElts := NmrElts + 1; + n := ProjectiveOrder(g); + + if Position (Tested, n) <> 0 then + continue; + fi; + + Print("Tensor: \nProcessing Element ", NmrElts, " of projective order ", n, "\n"); + + # what is smallest dimension which can contain + # element of projective order n? + MinScore := RECOG.LeastProjective(n, q); + Append(Record, [g, n]); + Append(Tested, n); + + # now consider each possible factorisation of d as u x w + # and decide whether such a factorisation of d is compatible + # with an element of projective order n */ + + for f in list do + u := f[1]; + w := f[2]; + Print("Tensor: \nConsider dimension factorisation u = ",u, " w = ", w, "\n"); + + # does the element fit into each factor? + if (MinScore <= u) and (MinScore <= w) then + Print("Tensor: Element of projective order ", n, " fits into both factors\n"); + # then the element fits into all other factors as well + break; + else + # the element doesn't fit into both factors; + # however, there may exist a coprime factorisation; + # we may also be able to conclude that the element can't + # act in desired manner by calls to IsProjectivity + + Result := RECOG.PossibleFactorisation(G, g, n, d, q, u, w, list, TestedPrimes); + TestedPrimes := Result[2]; + Result := Result[1]; + + # may have found a tensor decomposition + if Size(Result) = 2 then + return; + # or ruled out a possible decomposition + elif Result = false then + Print("Tensor: No valid score exists for dimension factorisation ", f); + Remove(list, Position(list,f)); + elif Result = "unknown" then + TestedPrimes := Set([]); + break; + fi; + fi; + od; + until (Size(List) = 0) or (NmrElts >= N) or (Result); + + return [list, Record, Result]; +end; + + +# TODO: Continue here + +# find tensor product of polynomials f and g + +RECOG.PolynomialTensorProduct := function(f, g) + + return CharacteristicPolynomial(TensorProduct(CompanionMatrix(f), CompanionMatrix(g))); + +end; + +# take some power of g, an element of (projective) order n +# to obtain an element of (projective) order at most Limit + +RECOG.PowerOfSmallOrder := function (g, n, Limit) +local powers, newg, f, power; + + if (n = 1) or IsPrime(n) then + return g; + fi; + + f := Collected(Factors(n)); + powers := List(f, x -> (x[1]^x[2])); + powers := Filtered(powers, x -> x <= Limit); + + if Size(powers) > 0 then + power := Random(powers); + newg := g^(n/power); + else + newg := g^(n/f[1][1]); + fi; + + return newg; + +end; + +# use the inherent symmetry of a left-hand factor to write +# down permutations to reduce the number of possible solutions + +RECOG.ApplySymmetry := function (F, n, PolyBasis) +local q, factor, omega, lambda, image, p, Perms, PR, f; + + q := Size(F); + factor := Gcd(q - 1, n); + + if factor = 1 then + return []; + fi; + + omega := PrimitiveElement(F); + lambda := omega^((q - 1)/factor); + + PR := GroupByGenerators(PolyBasis); + f := GeneratorsOfGroup(PR)[1] - lambda; + + image := List([1..Size(PolyBasis)], i -> Position(PolyBasis, TensorProduct(PolyBasis[i], f))); + # TODO: next line? + #image cat := [Size(PolyBasis) + 1]; + + p := Subgroup(SymmetricGroup (Size(PolyBasis) + 1), image); + Perms := List(Reversed([1..(Order(p) - 1)]), i -> (p^i) ); + + return Perms; + +end; + +# P is the list of permutations, u is one possible left-hand side; +# if some image of u under an element of P occurs later in an +# ordering, we don't need to process u + +RECOG.ProcessVector := function (P, u, lenu) +local i, v, Im; + + i := 1; + repeat + v := P[i]; + Im := List([1..lenu], j -> [u[v[j]]]); + if Im > u then + return false; + fi; + i := i + 1; + until i > Size(P); + + return true; + +end; + +# given sequence of polynomials, some product of which is f, +# find which exponents occur in f + +RECOG.ExponentsOfFactors := function (R, f) +local fac, exponents, i, factor, j; + + fac := Collected(Factors(f)); + + exponents := List([1..Size(R)], i -> 0); + + for i in [1..Size(fac)] do + factor := fac[i]; + j := Position(R, factor[1]); + exponents[j] := factor[2]; + od; + + return exponents; + +end; + +# setup the basis matrices and write them over the integers + +RECOG.SetupMatrices := function (Table) +local n, m, R, M, i, x, y; + + n := Size(Table[1]); + m := Size(Table[1][1]); + + #R := RMatrixSpace(Integers (), n, m); + + M := []; + for i in [1..Size(Table)] do + x := Table[i]; + #y := &cat[x[j] : j in [1..#x]]; + M[i] := y; + od; + + return M; + +end; + + +# TODO: Implement next function +RECOG.IsConsistent := function(A, t) + +end; + +# TODO: Implement next function +RECOG.FindNonNegativeSolution := function(A, t) + +end; + + +# Perms is list of possible permutations which can be +# used to reduce number of possible left-hand sides; +# M is the set of matrices; t is the right-hand side; +# Degrees is list of degrees of the factors; +# DimU is the degree of the u factor; +# build up left-hand side and solve system + +RECOG.FindFactorisation := function (Perms, M, t, Degrees, DimU, NonNegativeSolution) +local tot, n, lenm, m, x, Outstanding, LIMIT, index, flag, s, K, A, NonNegative, Resolved, zm, zs, exists, i; + + tot := 0; + + n := Size(M); + lenm := n + 1; + m := List([1..(n + 1)], i -> 0); + x := 0; + + Outstanding := false; # can we settle the question for this element? + + LIMIT := 10^5; # max number of solns to consider + repeat + index := 1; + m[index] := m[index] + 1; + x := x + Degree[index]; + + while (index <= n) and (x > DimU) do + x := x - m[index] * Degree[index]; + m[index] := 0; + index := index + 1; + m[index] := m[index] + 1; + if index <= n then + x := x + Degree[index]; + fi; + od; + + if x = DimU then + if (Size(Perms) = 0) or RECOG.ProcessVector(Perms, m, lenm) then + A := Sum(List([1..n], i -> m[i] * M[i])); + tot := tot + 1; + flag := RECOG.IsConsistent(A, t); + s := flag[2]; + K := flag[3]; + flag := flag[1]; + + if flag then + Print("Tensor: A solution over Z was found after testing ", tot, " vectors of correct weight\n"); + Print("Tensor: Kernel has dimension ", Dimension(K), "\n"); + Resolved := true; + exists := false; + for i in [1..Degree(s)] do + if s[i] < 0 then + exists := true; + break; + fi; + od; + if exists then + if Dimension (K) > 0 then + if NonNegativeSolution then + # we should test if some translate of this solution + # is non-negative; this may be very expensive + Print("Tensor: Now try for a solution over N"); + NonNegative := RECOG.FindNonNegativeSolution(A, t); + s := NonNegative[2]; + NonNegative := NonNegative[1]; + else + Resolved := false; + # record one possible solution over Z + NonNegative := false; + zm := m; + zs := s; + fi; # if NonNegativeSolution + else + Print("Tensor: Solution is unique"); + NonNegative := false; + fi; # Dimension (K) gt 0 + else + Print("Tensor: Our existing solution is over N "); + NonNegative := true; + fi; # if exists + + if not(Resolved) then + Outstanding := true; + fi; + + if NonNegative then + Print("Tensor: A solution over N found after testing", tot, "vectors of correct weight"); + Print("Tensor: m = ", m, "s = ", s); + return [true, m, s, true]; + fi; + + fi; # if flag + + fi; # if ProcessVector + + fi; # if x eq DimU + + until (index > n) or (tot > LIMIT); + # until (index gt n); + + if tot > LIMIT then + Outstanding := true; + fi; + + if Outstanding then + Print("Tensor: *** Existence of non-negative solution for some u unresolved ***"); + return [true, zm, zs, false]; + fi; + + Print("Tensor: Number of vectors of correct weight tested is ", tot); + + return [false, false, false, true]; + +end; + + +# compute factors of x^n - theta + +RECOG.ListFactors := function (F, n, theta) +local x, P, R, PolyBasis, Degrees; + + x := Indeterminate(F); + + P := x^n - theta; + + R := Collected(Factors(P)); + R := Reversed(R); + + PolyBasis := List([1..Size(R)], i -> R[i][1] ); + Degrees := List([1..Size(R)], i -> Degree(R[i][1])); + + return [PolyBasis, Degrees]; + +end; + +# compute tensor product of each element of PolyBasis1 with 2 +# and record what combination of elements of PolyBasis +# is equal to this product + +RECOG.ComputeTensorTable := function (PolyBasis, PolyBasis1, PolyBasis2) +local T, i, tp, j; + + T := []; + for i in [1..Size(PolyBasis1)] do + T[i] := []; + for j in [1..Size(PolyBasis2)] do + tp := TensorProduct(PolyBasis1[i], PolyBasis2[j]); + T[i][j] := RECOG.ExponentsOfFactors(PolyBasis, tp); + od; + od; + + return T; + +end; + +# f is the characteristic polynomial of an element of order n; +# does it have a tensor factorisation with a factor of degree dimU? + +RECOG.DecideFactorisation := function (F, f, n, phi, n0, PolyBasis, dimU, t, NonNegativeSolution) +local x, E, Outstanding, theta, PolyBasis1, Degrees1, PolyBasis2, Degrees2, Table, M, Perms, found, u, v, Resolved; + + # run over theta where theta is an element of F^* / (F^*)^n + # and F^* is the multiplicative group of the field + + x := PrimitiveElement (F); + E := List([0..(n0 - 1)], i -> x^i); + + Outstanding := false; + + for theta in E do + + PolyBasis1 := RECOG.ListFactors(F, n, theta); + Degrees1 := PolyBasis1[2]; + PolyBasis1 := PolyBasis[1]; + PolyBasis2 := RECOG.ListFactors(F, n, phi * theta^-1); + Degrees2 := PolyBasis2[2]; + PolyBasis2 := PolyBasis2[1]; + Table := RECOG.ComputeTensorTable(PolyBasis, PolyBasis1, PolyBasis2); + M := RECOG.SetupMatrices(Table); + + Perms := RECOG.ApplySymmetry(F, n, PolyBasis1); + found := RECOG.FindFactorisation(Perms, M, t, Degrees1, dimU, NonNegativeSolution); + u := found[2]; + v := found[3]; + Resolved := found[4]; + found := found[1]; + Print("Tensor: u = ", u, " v = ", v, "\n"); + if found and Resolved then + return [found, u, v, Resolved]; + fi; + + if not(Resolved) then + Outstanding := true; + fi; + + od; + + return [false, false, false, not Outstanding]; + +end; + +# try to tensor factorise the characteristic polynomials +# of N random elements of G; Outstanding records if the +# possible factorisation over the natural nuumbers +# is not conclusively decided */ + +# Old input: G, N, ~List, ~Outstanding, NonNegativeSolution +RECOG.FactorisePolynomials := function(G, N, list, Outstanding, NonNegativeSolution) +local MaxOrder, MaxNmrFactors, F, q, Tested, NmrElts, P, i, phi, n, f, n0, found, u, v, Resolved, g, t, PolyBasis, Degrees, pair; + + MaxOrder := 40; + MaxNmrFactors := 24; + + F := G.fld; + q := Size(F); + + # examine tensor factorisation of characteristic polynomial + # TODO: Whats this? Tested := {@ @}; + Tested := Set([]); + NmrElts := 0; + + Outstanding := false; + + P := [1..N]; + i := 1; + while i <= N do + P[i] := PseudoRandom(G.grp); + i := i + 1; + od; + + repeat + NmrElts := NmrElts + 1; + g := Random(P); + #n, phi := ProjectiveOrder(g); + n := ProjectiveOrder(g); + phi := n[2]; + n := n[1]; + + # if the order of g is too large, replace g by some power + if n > MaxOrder then + g := RECOG.PowerOfSmallOrder(g, n, MaxOrder); + n := ProjectiveOrder(g); + phi := n[2]; + n := n[1]; + fi; + + if n > MaxOrder then + continue; + fi; + + f := CharacteristicPolynomial(g); + + if not(f in Tested) then + Add(Tested, f); + n0 := Gcd(n, q - 1); + + # get factors of x^n - phi and express f as a product + # of its irreducible factors + + PolyBasis := RECOG.ListFactors (F, n, phi); + Degrees := PolyBasis[2]; + PolyBasis := PolyBasis[1]; + + if Size(Degrees) > MaxNmrFactors then + Print("Tensor: *** Too Many Factors ***"); + continue; + fi; + + Print("Tensor: \nProjective order of element is ", n, "\n"); + + t := RECOG.ExponentsOfFactors(PolyBasis, f); + t := RECOG.RSpace(Integers (), Size(t)); + + for pair in list do + Print("Tensor: Processing dimension factorisation ", pair, "\n"); + # do we find tensor product factorisation? + found := RECOG.DecideFactorisation(F, f, n, phi, n0, PolyBasis, pair[1], t, NonNegativeSolution); + u := found[2]; + v := found[3]; + Resolved := found[4]; + found := found[1]; + + Print("Tensor: Resolved is ", Resolved, "\n"); + + if (not found) and Resolved then + Remove(list, Position(list,pair)); + fi; + + if not(Resolved) then + Outstanding := true; + fi; + od; + fi; + until (Size(List) = 0) or (NmrElts >= N); +end; + + +# TODO: Continue here + + +# do the projectivities generate a field? this is not a conclusive test; +# we simply check that they commute and that we can find a generating +# element + +RECOG.ProjectivitiesGenerateField := function(S, order) +local G, flag, g, y, i, exists; + + for y in S do + exists := false; + for i in S do + if y*i <> i*y then + exists := true; + break; + fi; + od; + if exists then + Print("Tensor: Projectivities do not commute"); + return [false, false]; + fi; + od; + + G := GroupByGenerators(S); + flag := RECOG.RandomElementOfOrder(G, order); + g := flag[2]; + flag := flag[1]; + + if not(flag) then + Print("Tensor: Didn't find element of appropriate order"); + return [false, false]; + fi; + + return [true, g]; + +end; + +# X is a matrix, return the non-zero blocks of size k in X + +RECOG.BlocksOfMatrix := function (X, k) +local F, d, Nmr, blocks, i, j, A; + + F := FieldOfMatrixList([X]); + d := NumberRows(X); + + Nmr := d/k; + blocks := []; + + for i in [1..Nmr] do + for j in [1..Nmr] do + A := ExtractSubMatrix(X, (i - 1) * k + 1, (j - 1) * k + 1, k, k); + if not(IsScalar(A)) then + Add(blocks, A); + fi; + od; + od; + + return blocks; + +end; + +# rewrite basis for P wrt N + +RECOG.ConstructNewFlat := function (N, P) +local Coeffs, B, v, F; + + F := FieldOfMatrixList(N); + Coeffs := Basis(N); + B := Basis(P); + v := Sum( List([1..Size(Coeffs)], i -> List([1..Size(B)], j -> B[j] * Coeffs[i][j]))); + return VectorSpace(F,[v]); + +end; + +# can we use the potential projectivity C to give us +# a singular element? + +RECOG.FoundSingularElement := function (C, DimU, P) +local f, flag, factors, h, N, m; + + # compute its characteristic polynomial + f := CharacteristicPolynomial(C); + + # is f the DimU power of some polynomial? + flag := RECOG.IsPowerOfPolynomial(f, DimU); + factors := flag[2]; + flag := flag[1]; + if flag = false then + return [true, true]; + fi; + + # is f a power of an irreducible polynomial? + if Size(factors) > 1 then + # compute generalised eigenspace of C + h := factors[1][1]; + N := NullspaceMat(RECOG.EvaluateImage(h, C)); + return [true, RECOG.ConstructNewFlat (N, P)]; + else + m := MinimalPolynomial(C); + factors := Collected(Factors(m)); + if factors[1][2] > 1 then + # compute generalised eigenspace of C + h := factors[1][1]; + N := NullspaceMat(RECOG.EvaluateImage (h, C)); + return [true, RECOG.ConstructNewFlat (N, P)]; + else + return [false, false]; + fi; + fi; +end; + +# Y collection of matrices written wrt geometric basis; +# P is a potential flat; we are searching for a point +# of dimension DimU + +RECOG.SetupBlocks := function (Y, P, DimU) +local Proj, blocks, Dim, B, i, a, b, C, Ainv, DimP, Result, N, j, exists; + + Proj := Set([]); + blocks := []; + DimP := Dimension(P); + + # look through DimP x DimP in matrix for each element of Y + # for one with determinant 0 + + for i in [1..Size(Y)] do + if IsScalar(Y[i]) then + continue; + fi; + B := RECOG.BlocksOfMatrix(Y[i], DimP); + exists := false; + for b in B do + if Determinant (b) = 0 then + exists := true; + Result := b; + break; + fi; + od; + if exists then + Print("Tensor: Block A has nullspace"); + N := NullspaceMat(Result); + return [true, RECOG.ConstructNewFlat(N, P)]; + fi; + Append(blocks, B); + od; + + # construct potential projectivities + for i in [1..Size(blocks)] do + if Size(blocks)[i] = 0 then + Print("Tensor: #Blocks from A is 0"); + continue; + fi; + Ainv := (blocks[i][1])^-1; + for j in [2..Size(blocks[i])] do + C := blocks[i][j] * Ainv; + if not IsScalar (C) then + a := RECOG.FoundSingularElement(C, DimU, P); + b := a[2]; + a := a[1]; + if a then + return [true, b]; + fi; + Add(Proj, C); + fi; + od; + od; + + return [false, Proj]; + +end; + +# search for singular element in algebra generated by collection +# of projectivies CC + +RECOG.SearchForSingularElement := function (C, P, DimU, NmrTries) +local x, y, module, A, i, z, a, b; + + A := GroupByGenerators(C); # to get random elements + + i := 0; + repeat + x := Random (A); + y := Random (A); + z := x + y; + if not IsScalar (z) then + a := RECOG.FoundSingularElement(z, DimU, P); + b := a[2]; + a := a[1]; + if a then + return [true, b]; + fi; + Add(C, z); + fi; + i := i + 1; + until i = NmrTries; + + return [false, C]; + +end; + +# try to find singular element in algebra of projectivities + +RECOG.InvestigateMatrices := function (Y, P, DimU, NmrTries) +local DimP, flag, C; + + DimP := Dimension(P); + + flag := RECOG.SetupBlocks(Y, P, DimU); + C := flag[2]; + flag := flag[1]; + + if flag then + return [flag, C]; + fi; + + if Size(C) = 0 then + return [false, false]; + fi; + + flag := RECOG.SearchForSingularElement(C, P, DimU, NmrTries); + C := flag[2]; + flag := flag[1]; + + return [flag, C]; + +end; + +# set up matrix whose rows are the vectors of the +# bases for each subspace in Sum + +RECOG.SetupMatrix := function(sum) +local S, A, basis, transform, number, a, b; + + A := []; + + for S in sum do + basis := BasisVectors(Basis(S)); + Add(A,Matrix(basis)); + od; + + transform := []; + number := Size(A[1]); + for a in A do + for b in [1..number] do + Add(transform,a[b]); + od; + od; + + return transform; + +end; + +# find minimal set of components of Sum whose direct sum contains P; +# U is the inclusion of P into V wrt the given basis for P and +# for the basis of V obtained by concatentating the given +# bases for the direct summands + +RECOG.IdentifySubset := function (A, P, sum) +local Ainv, basis, U, DegU, k, Indices, i, j, Dim; + + Ainv := A^-1; + + basis := BasisVectors(Basis(P)); + U := List(basis, v -> v * Ainv); + DegU := Size(U[1]); + k := Size(sum); + + Dim := Dimension (sum[1]); + Indices := Set([]); + for i in [1..Size(U)] do + for j in [1..DegU] do + if U[i][j] <> 0 then + Add(Indices, (j - 1)/Dim + 1); + if Size(Indices) = k then + return [Indices, U]; + fi; + fi; + od; + od; + + return [Indices, U]; + +end; + + +RECOG.ComponentsOfSum:= function (P, sum, index, M) +local B; + + B := Basis(sum[index]); + return List([1..NumberRows(M)], i -> Sum(List([1..Size(B)], j -> M[i][j] * B[j]))); + +end; + +# extract the (index)th matrix of dimension DimP x DimP from U + +RECOG.BasisMatrix := function (P, U, index) +local DimP, m; + + DimP := Dimension(P); + + m := List([1..Size(U)], i -> List([(index-1) * DimP + 1 .. index * DimP], j -> U[i][j])); + + return m; + +end; + +# construct the change of basis matrix and return it +# together with the generators of G wrt the new basis + +RECOG.ConstructMatrices := function(G, P, Equated, A) +local k, DimP, F, K, x, i, y, j, C; + + k := Size(Equated); + DimP := Dimension(P); + + F := FieldOfMatrixGroup(G); + K := GL(NumberRows(G), F); + + x := []; + for i in [1..Size(Equated)] do + y := [1..Degree(Equated[i])]; + for j in [1..Degree(Equated[i])] do + y[j] := Sum(List([1..Degree(Equated[i][j])], k -> [Equated[i][j][k] * A[(i - 1) * DimP + k]])); + od; + Add(x,y); + od; + + C := Matrix(x)^-1; + + # write down the generators of G wrt to new basis + return [List(GeneratorsOfGroup(G), x -> x^C), C]; + +end; + +# # are the matrices composed of k x k blocks which differ +# # only by scalars? if so, return the decomposition + +# #{Decide whether or not the matrix X is composed of k x k blocks which differ +# # only by scalars; if so, return true and the decomposition, else false} +# RECOG.IsProportional := function(X, k) +# local i, d + +# i := RECOG.AreProportional(X, k); +# d := i[2]; +# i := i[1]; +# if i then +# return [true, d[1]]; +# else +# return [false, false]; +# fi; +# end; + +# construct the isomorphisms from one of the equated spaces +# to each of the rest + +# Input: G, ~P, I, U, Sum, ~E, ~Equated +RECOG.FindIsom := function(G, P, I, U, sum, E, Equated) +local F, PG, V, StartDim, Common, fixed, Mfixed, Component, NewP, MfixedInv, M, Isom, i; + + F := G.fld; + PG := GL(Dimension(P), F); + + V := VectorSpace(F, IdentityMat(Size(BasisVectors(Basis(P))[1]),F)); + + StartDim := Dimension(P); + + # I meet E = intersection? + Common := Intersection(I,E); + + if Size(Common) <> 0 and Size(I) <> Size(Common) then + + fixed := Representative(Common); + Mfixed := RECOG.BasisMatrix(P, U, fixed); + + # is Mfixed a basis for Sum[fixed]? + Component := RECOG.ComponentsOfSum (P, sum, fixed, Mfixed); + NewP := Subspace(V,Component); + + if Dimension(NewP) < StartDim then + P := NewP; + return [P,E,Equated]; + fi; + + MfixedInv := (Mfixed)^-1; + + # Elements in I but not in E + # I diff E + + for i in Difference(I,E) do + + M := RECOG.BasisMatrix(P, U, i); + Component := RECOG.ComponentsOfSum(P, Sum, i, M); + NewP := Subspace(V,Component); + + if Dimension (NewP) < StartDim then + P := NewP; + return [P,E,Equated]; + fi; + + # compute the isomorphism matrix from space Mfixed to M + Isom := MfixedInv * M; + Equated[i] := Equated[fixed] * Isom; + Add(E, i); + + od; + fi; + + return [P,E,Equated]; + +end; + + +# given irreducible matrix group G and collection of subspaces of +# associated vector space V, write V as direct sum of subspaces of V */ + +# Input: Spaces, flag +RECOG.DirectSumSpaces := function(G, Spaces, flag) +local S, d, k, NmrTries, n, SumSpaces, bound, g, I, sum, D, i, count; + + S := Spaces[1]; + d := Dimension(S); + k := Int(Size(BasisVectors(Basis(S))[1])/d); + NmrTries := 100; + flag := true; + + while Size(Spaces) < k do + + n := Size(Spaces); + # Add all spaces + # SumSpaces := &+[Spaces[i] : i in [1..n]]; + SumSpaces := []; + for sum in Spaces do + Append(SumSpaces, BasisVectors(Basis(sum))); + od; + SumSpaces := VectorSpace(G.fld,SumSpaces); + + bound := n * d; + + count := 0; + repeat + count := count + 1; + # g := RandomElement (G); + g := PseudoRandom(G.group); + I := S^g; + sum := SumSpaces + I; + D := Dimension(sum); + until (D > bound) or (count > NmrTries); + + # do we have a submodule for G? */ + if D <= bound then + for i in G.gens do + I := S^i; + sum := SumSpaces + I; + D := Dimension(sum); + if D > bound then + break; + fi; + od; + fi; + + # yes, so this subspace is not a flat + if D <= bound then + flag := false; + return [Spaces, flag]; + fi; + + if (D <> (n + 1) * d) then + Spaces := [Intersection(SumSpaces, I)]; + Spaces := RECOG.DirectSumSpaces(G, Spaces, flag); + flag := Spaces[2]; + Spaces := Spaces[1]; + return [Spaces, flag]; + fi; + + Add(Spaces, I); + + od; + + return [Spaces, flag]; + +end; + + +# flag is set false if we fail to express the underlying vector +# space as a direct sum of images of the contents of Spaces; +# this may happen if G acts reducibly or G is imprimitive */ + +# Input: G, ~Spaces, ~flag +RECOG.ObtainDirectSumSpaces := function(G, Spaces, flag) +local F, d, b; + + Spaces := RECOG.DirectSumSpaces(G, Spaces, flag); + flag := Spaces[2]; + Spaces := Spaces[1]; + + # have we found a submodule? + if not(flag) then + return [Spaces, flag]; + fi; + + F := G.fld; + d := G.d; + + # have we found a block? + b := Subspace(VectorSpace (F, IdentityMat(d,F)), Spaces[1]); + # TODO: Do we need this? + #x := MinBlocks(G, Basis (b)); + #if IsBlockSystem(x) then + # flag := false; + #fi; + + return [Spaces, flag]; +end; + + +# S = Sum[1]; +# S is a potential flat in a projective geometry of dimension DimU; +# find a point in the geometry or decide that S is not a flat + +# Input: G, ~sum, DimU, ~Status, ~CB: Exact := true +RECOG.FindPoint := function(G, sum, DimU, Status, CB, Exact) +local exact, k, S, StartDim, A, F, d, Idnn, Equated, E, DimP, flag, Y, P, U, I, Result, NewP, NmrTries, g; + + exact := Exact; + Status := false; + CB := "undefined"; + + if Dimension(sum[1]) mod DimU <> 0 then + return [sum, Status, CB]; + fi; + + # need to equate k spaces + k := Size(sum); + + S := sum[1]; + StartDim := Dimension(S); + + A := RECOG.SetupMatrix(sum); + + F := G.fld; + d := G.d; + + Idnn := One(GL(StartDim, F)); + Equated := List([1..k], i -> Idnn); + + E := Set([1]); + + repeat + + # g := RandomElement (G); + g := PseudoRandom(G.group); + + P := S^g; + I := RECOG.IdentifySubset(A, P, sum); + U := I[2]; + I := I[1]; + P := RECOG.FindIsom(G, P, I, U, sum, E, Equated); + E := P[2]; + Equated := P[3]; + P := P[1]; + + DimP := Dimension(P); + + if (DimP mod DimU) <> 0 then + return [sum, Status, CB]; + fi; + + if DimP < StartDim then + sum := [P]; + sum := RECOG.ObtainDirectSumSpaces(G, sum, flag); + flag := sum[2]; + sum := sum[1]; + # if flag eq false then Status := false; return; end if; + if not(flag) then + Status := "unknown"; + return [sum, Status, CB]; + fi; + sum := RECOG.FindPoint(G, sum, DimU, Status, CB, Exact); + Status := sum[2]; + CB := sum[3]; + sum := sum[1]; + return [sum, Status, CB]; + fi; + + until Size(E) = k; + + Print("Tensor: After setting up points in general position Dim = ", Dimension (P)); + + Y := RECOG.ConstructMatrices(G, S, Equated, A); + CB := Y[2]; + Y := Y[1]; + + # are the generators of G proportional? + if not(exact) then + Status := RECOG.AreProportional(Y, DimP); + Print("Tensor: Are matrices proportional for dim %o", DimP, "? ", Status, "\n"); + else + # are the generators of G proportional? + Status := RECOG.AreProportional(Y, DimU); + Print("Tensor: Are matrices proportional for dim %o", DimU, "? ", Status, "\n"); + if not(Status) then + # are the generators of G proportional? + Status := RECOG.AreProportional(Y, d/DimU); + Print("Tensor: Are matrices proportional for dim ", d/DimU, "? ", Status); + fi; + fi; + + if not(Status) then + CB := "undefined"; + fi; + + if Status then + if (DimP = DimU or DimP * DimU = d) then + #CB := ; + Append(CB, DimP); + return [sum, Status, CB]; + else + Status := "unknown"; + fi; + elif (Dimension (P) = DimU) then + return [sum, Status, CB]; + fi; + + NmrTries := 100; + + Result := RECOG.InvestigateMatrices(Y, S, DimU, NmrTries); + NewP := Result[2]; + Result := Result[1]; + if not(NewP) then + Status := "unknown"; + return [sum, Status, CB]; + fi; + + # did we construct a possible new flat? + # if (NewP) eq ModTupFld then + if Result then + Print("Tensor: Found a possible new flat of dimension ", Dimension (NewP), "\n"); + if (Dimension (NewP) mod DimU) <> 0 then + Status := false; + return [sum, Status, CB]; + fi; + S := NewP; + sum := [S]; + sum := RECOG.ObtainDirectSumSpaces(G, sum, flag); + flag := sum[2]; + sum := sum[1]; + # if flag eq false then Status := false; return; end if; + if not(flag) then + Status := "unknown"; + return [sum, Status, CB]; + fi; + sum := RECOG.FindPoint(G, sum, DimU, Status, CB, Exact); + Status := sum[2]; + CB := sum[3]; + sum := sum[1]; + return [sum, Status, CB]; + elif not(Result) then + Print("** Unresolved case -- Probably found tensor / decomposition over extension field \n"); + Status := "unknown"; + return [sum, Status, CB]; + #if ProjectivitiesGenerateField (NewP, Size(F)^(DimP/DimU) - 1) then + # Print("** Unresolved case -- Probably found tensor / decomposition over extension field \n"); + # Status := "unknown"; + # return [sum, Status, CB]; + #else + # Error("** Projectivities do not generate field **"); + #fi; + fi; + + return [sum, Status, CB]; +end; + +# S is a potential flat in a projective geometry of dimension DimU; +# find a point in the geometry or decide that S is not a flat */ + +# intrinsic GeneralFindPoint +# (G::GrpMat, ~S::., DimU::RngIntElt, ~Status::BoolElt, ~CB::. : +# Exact := true) +# { This is a new intrinsic } + +# Input: (G, ~S, DimU, ~Status, ~CB Exact := true) +RECOG.GeneralFindPoint := function(G, S, DimU, Status, CB, Exact) +local sum, exact, flag; + + sum := [S]; + exact := Exact; + + flag := true; + + sum := RECOG.ObtainDirectSumSpaces(G, sum, flag); + flag := sum[2]; + sum := sum[1]; + if not(flag) then + Status := false; + return [sum, Status, CB]; + fi; + + return RECOG.FindPoint(G, sum, DimU, Status, CB, exact); + +end; + +# Decide if S is a point; Status is set to true if +# we verify S is a point + +# Input: G, ~S, DimU, ~Status, ~CB +IsPoint := function(G, S, DimU, Status, CB) +local sum, k, StartDim, Idnn, R, F, P, I, U, flag, A, Equated, g, DimP, Y; + + Status := false; + + sum := [S]; + sum := RECOG.ObtainDirectSumSpaces(G, sum, flag); + flag := sum[2]; + sum := sum[1]; + if not(flag) then + Status := false; + return [S, Status, CB]; + fi; + + if Dimension(sum[1]) mod DimU <> 0 then + return [S, Status, CB]; + fi; + + # need to equate k spaces + k := Size(sum); + + S := sum[1]; + StartDim := Dimension(S); + + A := RECOG.SetupMatrix(Sum); + + F := G.fld; + + Idnn := One(GL(StartDim, F)); + Equated := List([1..k], i -> Idnn); + + E := Set([1]); + + #R := Internal_RandomProcess(G); + R := PseudoRandom(G.grp); + #R := [1..N]; + #i := 1; + #while i <= N do + # R[i] := PseudoRandom(G.grp); + # i := i + 1; + #od; + repeat + + # g := RandomElement (G); + g := PseudoRandom(R); + + P := S^g; + I := RECOG.IdentifySubset(A, P, sum); + U := I[2]; + I := I[1]; + + P := RECOG.FindIsom(G, P, I, U, sum, E, Equated); + E := P[2]; + Equated := P[3]; + P := P[1]; + DimP := Dimension(P); + if DimP < DimU then + return [S, Status, CB]; + fi; + + until Size(E) = k; + + Y := RECOG.ConstructMatrices(G, S, Equated, A); + CB := Y[2]; + Y := Y[1]; + + # are the generators of G of the correct shape? + Status := RECOG.AreProportional(Y, DimU); + Print("Tensor: Are matrices proportional? ", Status); + + return [S, Status, CB]; + +end; + + +# tests for tensor product factorisation; if tensor decomposition +# found, then Status is true and Result is the change of basis matrix */ + + RECOG.TensorTest := function(G, N, NonNegativeSolution, Factors, Fast) + local factors, fast, Nmr, NmrTries, NmrSmash, NmrProjective, d, F, gens, q, p, Status, Result, u, x, y, list, Record, OutStanding; + + factors := Factors; + fast := Fast; + + Nmr := 20; + NmrTries := 25; + NmrSmash := 4; + NmrProjective := 4; + + gens := G.gens; + d := G.d; + F := G.fld; + q := Size(F); + p := Characteristic(F); + + # possible dimensions of tensor factors + if factors = [] then + list := Factors(d); + else + list := factors; + list := list(List, x-> (d mod x = 0)); + fi; + list := Remove(list, Position(list,1)); + list := Remove(list, Position(list,d)); + + Print("Tensor: List of dimensions of possible tensor factorisations is \n", list); + + if Size(list) = 0 then + Status := false; + Result := list; + return [Status, Result]; + fi; + + # check if the supplied matrices are already Kronecker products + for u in DivisorsInt(d) do + gens := G.gens; + if Size(gens) = 0 then + gens := [Identity (G)]; + fi; + x := RECOG.AreProportional(gens, u); + y := x[2]; + x := x[1]; + if x then + Status := true; + Result := GroupByGenerators([u]); + return [Status,Result]; + fi; + od; + + list := RECOG.OrderTest (G, N, list, Record, Result); + Record := list[2]; + Result := list[3]; + list := list[1]; + if not(IsBool(Result)) and not(Result = "unknown") then + Status := true; + return [Status,Result]; + fi; + + Print("Tensor: \n Final list after order test is ", list, "\n"); + + if Size(list) = 0 then + Status := false; + Result := list; + return [Status,Result]; + fi; + + # if we have not called Smash already, then + # Smash some elements of prime order + + #Elts := []; L := Set (&cat (list)); + #for i in [1..Minimum (Size(Record), NmrSmash)] do + # g := Record[i][1]; o := Record[i][2]; + # TODO: Next big function + # Status, Result, Elts := ProjectivityTest (G, g, o, Elts, NmrProjective, L : Exact := factors ne []); + # if Status then + # return [Status,Result]; + # fi; + # if Size(Elts) >= NmrSmash then + # break; + # fi; + #od; + + Print("Tensor: Outstanding is ", list, "\n"); + + # examine tensor factorisation of characteristic polynomial + # FactorisePolynomials (G, N, ~list, ~OutStanding, NonNegativeSolution); + list := RECOG.FactorisePolynomials(G, N, list, OutStanding, NonNegativeSolution); + OutStanding := list[2]; + list := list[1]; + + Print("Tensor: \nFinal list after polynomial factorisation is ", list); + Print("Tensor: Outstanding is ", OutStanding); + + if Size(list) = 0 then + Status := false; + Result := list; + return [Status, Result]; + fi; + + # we may be interested only in a fast test and do not wish + # to invoke local test * + if fast then + Status := "unknown"; + Result := list; + return [Status, Result]; + fi; + + # outstanding dimensions + #List := Set (&cat(List)); + Print("Tensor: \nAt entry to Local, list is ", list); + + # now carry out local subgroup test + # TODO: next big function + #LocalTest (G, ~List, ~Result, Nmr, NmrTries: Exact := factors ne []); + + if Size(list) = 0 then + Status := false; + Result := []; + return [Status, Result]; + fi; + + if IsString(Result) then + Status := "unknown"; + Result := list; + return [Status, Result]; + fi; + + if not(IsBool(Result)) then + Status := true; + return; + fi; + + Status := Result; + Result := list; + + return [Status, Result]; + +end; diff --git a/init.g b/init.g index aab3621a8..f06e41b77 100644 --- a/init.g +++ b/init.g @@ -27,4 +27,4 @@ ReadPackage("recog","gap/matrix/ppd.gd"); ReadPackage("recog","gap/matrix/classical.gd"); ReadPackage("recog","gap/projective/almostsimple.gd"); ReadPackage("recog","gap/projective/findnormal.gd"); -ReadPackage("recog","gap/projective/AnSnOnFDPM.gd"); +ReadPackage("recog","gap/projective/AnSn/AnSnOnFDPM.gd"); diff --git a/misc/spdownexperiment.log b/misc/spdownexperiment.log deleted file mode 100644 index a7f4ce928..000000000 --- a/misc/spdownexperiment.log +++ /dev/null @@ -1,151 +0,0 @@ -LoadPackage("recog"); -Read("downsp.g"); -d := 100; -q := 8; -g := Sp(d,q); -x := constructppd2(g,d,q); -h := Group(x,x^PseudoRandom(g)); -mov := RECOG.MovedSpace(h); -hh := RECOG.LinearAction(mov,GF(q),h); -ri := RecogniseGroup(hh); -SetInfoLevel(InfoRecog,3); -h := Group(x,x^PseudoRandom(g)); -mov := RECOG.MovedSpace(h); -hh := RECOG.LinearAction(mov,GF(q),h); -ri := RecogniseGroup(hh); -h := Group(x,x^PseudoRandom(g)); -mov := RECOG.MovedSpace(h); -hh := RECOG.LinearAction(mov,GF(q),h); -ri := RecogniseGroup(hh); -# we found an L2(8)xL2(x), before we only saw L2(64) -gens := GeneratorsOfGroup(hh); -o := Orb(hh,gens[1],OnPoints,rec(report := 1000,lookingfor := [gens[2]], schreier := true)); -Enumerate(o); -word := TraceSchreierTreeForward(o,o!.found); -gensbig := GeneratorsOfGroup(h); -NamesOfComponents(g); -g!.PseudoRandomSeed; -y := First(g!.PseudoRandomSeed,u->biggens[1]^u=biggens[2]); -y := First(g!.PseudoRandomSeed,u->gensbig[1]^u=gensbig[2]); -u; -y := First(g!.PseudoRandomSeed[1],u->gensbig[1]^u=gensbig[2]); -y := PseudoRandom(g); -h := Group(x,y); -mov := RECOG.MovedSpace(h); -hh := RECOG.LinearAction(mov,GF(q),h); -ri := RecogniseGroup(hh); -y := PseudoRandom(g); -h := Group(x,y); -mov := RECOG.MovedSpace(h); -x; -Order(x); -h := Group(x,x^y); -mov := RECOG.MovedSpace(h); -hh := RECOG.LinearAction(mov,GF(q),h); -ri := RecogniseGroup(hh); -y := PseudoRandom(g); -h := Group(x,x^y); -mov := RECOG.MovedSpace(h); -hh := RECOG.LinearAction(mov,GF(q),h); -ri := RecogniseGroup(hh); -y := PseudoRandom(g); -h := Group(x,x^y); -mov := RECOG.MovedSpace(h); -hh := RECOG.LinearAction(mov,GF(q),h); -ri := RecogniseGroup(hh); -# finally got L2(8)xL2(8) again, this time remembering y -gens := GeneratorsOfGroup(hh); -o := Orb(hh,gens[1],OnPoints,rec(report := 1000,lookingfor := [gens[2]], schreier := true)); -Enumerate(o); -word := TraceSchreierTreeForward(o,o!.found); -gensbig := GeneratorsOfGroup(h); -z := Product(gensbig{word}); -x^z=x^y; -x^(y*z^-1)=x; -cent1 := y*z^-1; -Display(cent1); -y1 := y; -y := PseudoRandom(g); -h := Group(x,x^y); -mov := RECOG.MovedSpace(h); -hh := RECOG.LinearAction(mov,GF(q),h); -ri := RecogniseGroup(hh); -Size(ri); -h := Group(x,x^y); -y := PseudoRandom(g); -h := Group(x,x^y); -mov := RECOG.MovedSpace(h); -hh := RECOG.LinearAction(mov,GF(q),h); -ri := RecogniseGroup(hh); -y := PseudoRandom(g); -h := Group(x,x^y); -mov := RECOG.MovedSpace(h); -hh := RECOG.LinearAction(mov,GF(q),h); -ri := RecogniseGroup(hh); -gens := GeneratorsOfGroup(hh); -o := Orb(hh,gens[1],OnPoints,rec(report := 1000,lookingfor := [gens[2]], schreier := true)); -Enumerate(o); -word := TraceSchreierTreeForward(o,o!.found); -gensbig := GeneratorsOfGroup(h); -z := Product(gensbig{word}); -x^z=x^y; -x^(y*z^-1)=x; -cent2 := y*z^-1; -a := PseudoRandom(g); -b := PseudoRandom(g); -h := Group(x,x^a,x^b); -mov := RECOG.MovedSpace(h); -hh := RECOG.LinearAction(mov,GF(q),h); -ri := RecogniseGroup(hh); -DisplayCompositionSeries(SL(4,8)); -# we got an O+(6,8) -mov2 := RECOG.MovedSpace(Group(x)); -s := StabMC(h,mov2[1],OnRight); -# s is an Sp(4,8) abstractly, however acting in 5 dimensions -mov2[1]*cent1=mov2[1]; -mov2[1]*cent2=mov2[1]; -s := StabMC(h,mov2[2],OnRight); -V := VectorSpace(GF(8),mov2); -e := Enumerator(V); -v := NextIterator(e); -Length(e); -e[1]; -IsZero(e[1]); -i := 2; -repeat -s := StabMC(h,e[i],OnRight); -i := i + 1; -Print(".\c"); until s.size <> 1056706560; -hh; -ri := RecogniseGroup(hh); -V := GF(8)^6; -v := Random(V); -s := StabMC(hh,v,OnRight); -v := Random(V); -s := StabMC(hh,v,OnRight); -v := Random(V); -s := StabMC(hh,v,OnRight); -Factors(1040449536); -ri2 := RecogniseGroup(s.stab); -Size(ri2); -ri2; -v; -w := v*mov; -ss := StabMC(h,w,OnRight); -r := RecogniseClassical(hh); -qu := r.QuadraticForm; -NamesOfComponents(qu); -qu!.matrix; -Display(qu!.matrix); -HELP("QuadraticForm"); -EvaluateForm(qu,v); -mov; -bas := Basis(VectorSpace(GF(8),mov),mov); -vv := Coefficients(bas,mov2[1]); -ww := Coefficients(bas,mov2[2]); -EvaluateForm(qu,vv); -EvaluateForm(qu,ww); -V := VectorSpace(GF(8),[vv,ww]); -e := Enumerator(V); -List(e,v->EvaluateForm(qu,v)); -Positions(last,0*Z(2)); diff --git a/misc/spdownexperiment2.log b/misc/spdownexperiment2.log deleted file mode 100644 index 1a07b95c8..000000000 --- a/misc/spdownexperiment2.log +++ /dev/null @@ -1,249 +0,0 @@ -LoadPackage("recog"); -Read("downsp.g"); -d := 100; -q := 8; -g := Sp(d,q); -x := constructppd2(g,d,q); -y := PseudoRandom(g); -z := PseudoRandom(g); -h := Group(x,x^y,x^z); -mov := RECOG.MovedSpace(h); -hh := RECOG.LinearAction(mov,GF(q),h); -ri := RecogniseGroup(hh); -SetInfoLevel(InfoRecog,3); -DisplayCompositionSeries(SL(4,8)); -# got an O+(6,8) -h; -mov; -s := StabMC(h,mov[1],OnRight); -s := StabMC(s.stab,mov[2],OnRight); -s := s.stab; -repeat a := PseudoRandom(s); -o := Order(a); -until o mod 7 = 0; -o; -aa := a^9; -Order(aa); -RECOG.FixedSpace(Group(aa)); -RECOG.MovedSpace(Group(aa)); -b := PseudoRandom(g); -k := Group(a,a^b); -mov2 := RECOG.MovedSpace(k); -a := aa; -k := Group(a,a^b); -mov2 := RECOG.MovedSpace(k); -kk := RECOG.LinearAction(mov2,GF(8),k); -ri2 := RecogniseGroup(kk); -Size(ri); -ri; -ri; -RECOG.FixedSpace(Group(a)); -RECOG.MovedSpace(Group(a)); -k := Group(a,a^b); -mov2 := RECOG.MovedSpace(k); -kk := RECOG.LinearAction(mov2,GF(8),k); -ri2 := RecogniseGroup(kk); -Size(ri2); -ri2; -504*64; -k := Group(a,a^b); -mov2 := RECOG.MovedSpace(k); -kk := RECOG.LinearAction(mov2,GF(8),k); -ri2 := RecogniseGroup(kk); -Size(ri2); -ri2; -b := PseudoRandom(g); -k := Group(a,a^b); -mov2 := RECOG.MovedSpace(k); -kk := RECOG.LinearAction(mov2,GF(8),k); -ri2 := RecogniseGroup(kk); -Size(ri2); -ri2; -b := PseudoRandom(g); -504^2; -k := Group(a,a^b); -mov2 := RECOG.MovedSpace(k); -kk := RECOG.LinearAction(mov2,GF(8),k); -ri2 := RecogniseGroup(kk); -Size(ri2); -ri2; -b := PseudoRandom(g); -l := []; -for i in [1..100] do -b := PseudoRandom(g); -k := Group(a,a^b); -mov2 := RECOG.MovedSpace(k); -kk := RECOG.LinearAction(mov2,GF(8),k); -ri2 := RecogniseGroup(kk); -Add(l,Size(ri2)); -Print(Size(ri2)," \c"); -od; -SetInfoLevel(InfoRecog,0); -return; -l; -Collected(l); -504^2; -repeat -b := PseudoRandom(g); -k := Group(a,a^b); -mov2 := RECOG.MovedSpace(k); -kk := RECOG.LinearAction(mov2,GF(8),k); -ri2 := RecogniseGroup(kk); -until Size(ri2)=254016; -ri2; -IsConjugate(GeneratorsOfGroup(kk)[1],GeneratorsOfGroup(kk)[2]); -IsConjugate(kk,GeneratorsOfGroup(kk)[1],GeneratorsOfGroup(kk)[2]); -gens := GeneratorsOfGroup(kk); -o := Orb(kk,kk[2],OnPoints,rec(report := 1000, lookingfor := [gens[1]], schreier := true)); -o := Orb(kk,gens[2],OnPoints,rec(report := 1000, lookingfor := [gens[1]], schreier := true)); -Enumerate(o); -word := TraceSchreierTreeForward(o,o!.found); -Product(GeneratorsOfGroup(k){word}); -c := last; -a^(b*c); -last = a; -cent1 := b*c; -repeat -b := PseudoRandom(g); -k := Group(a,a^b); -mov2 := RECOG.MovedSpace(k); -kk := RECOG.LinearAction(mov2,GF(8),k); -ri2 := RecogniseGroup(kk); -until Size(ri2)=254016; -ri2; -IsConjugate(kk,GeneratorsOfGroup(kk)[1],GeneratorsOfGroup(kk)[2]); -gens := GeneratorsOfGroup(kk); -o := Orb(kk,gens[2],OnPoints,rec(report := 1000, lookingfor := [gens[1]], schreier := true)); -Enumerate(o); -word := TraceSchreierTreeForward(o,o!.found); -Product(GeneratorsOfGroup(k){word}); -c := last; -a^(b*c); -last = a; -cent2 := b*c; -c := Group(cent1,cent2); -mov3 := RECOG.MovedSpace(c); -IsOne(Comm(a,cent2)); -IsOne(Comm(a,cent1)); -m := GModuleByMats([cent1,cent2],GF(8)); -MTX.CompositionFactors(m); -MTX.BasisSocle(m); -Length(last); -MTX.CompositionFactors(m); -cc := Group(last[3].generators); -r := RecogniseClassical(cc); -h; -hh; -r := RecogniseClassical(hh); -qu := r.QuadraticForm; -mov, -mov; -mov2; -mov3; -mov3 := RECOG.MovedSpace(Group(a)); -bas := Basis(VectorSpace(GF(8),mov),mov); -v := Coefficients(bas,mov3[1]); -w := Coefficients(bas,mov3[2]); -V := VectorSpace(GF(8),[v,w]); -e := Enumerator(V); -i := 2; -while not(IsZero(EvaluateForm(qu,e[i]))) do i := i + 1; Print(".\c"); od; -i; -EvaluateForm(qu,e[9]); -u := e[9] * mov; -h; -StabMC(h,u,OnRight); -ss := last; -8^4*504^2; -ss := ss.stab; -SetSize(ss,1040449536); -NiceMonomorphism(ss); -ri3 := RecogniseGroup(ss); -SetInfoLevel(InfoRecog,3); -return; -Length(origgens); -S := StabilizerChain(ss); -ssp := Group(ActionOnOrbig(S!.orbit,GeneratorsOfGroup(ss))); -ssp := Group(ActionOnOrbit(S!.orbit,GeneratorsOfGroup(ss))); -ssp := Group(ActionOnOrbit(S!.orb,GeneratorsOfGroup(ss))); -StabilizerChain(ssp); -PCore(ssp); -PCore(ssp,2); -Size(last); -sspm := GroupWithMemory(ssp); -SSm := StabilizerChain(sspm); -slpstrong := SLPOfElms(StrongGenerators(SSm)); -ForgetMemory(SSm); -strong := ResultOfStraightLineProgram(slpstrong,GeneratorsOfGroup(ss)); -pc := PCore(ssp,2); -gens := GeneratorsOfGroup(pc); -Length(gens); -slps := List(gens,x->SiftGroupElementSLP(SSm,x).slp); -pcore := Group(List(slps,slp->ResultOfStraightLineProgram(slp,strong))); -StabilizerChain(pcore); -pcore := GeneratorsOfGroup(pcore); -cc; -c; -GeneratorsOfGroup(c)=[cent1,cent2]; -comm := Comm(cent1,cent2); -derived := FastNormalClosure; -derived := FastNormalClosure([cent1,cent2],[comm],6); -guck := derived; -guck := Group(derived); -movguck := RECOG.MovedSpace(guck);, -; -guckguck := RECOG.LinearAction(movguck,GF(8),guck); -RecogniseClassical(guckguck); -pcore; -gens := Concatenation(derived,GeneratorsOfGroup(ss)); -guck := FastNormalClosure(gens,pcore,3); -List(guck,Order); -guck := FastNormalClosure(gens,pcore,10); -Length(guck); -guck := FastNormalClosure(gens,pcore,30); -Length(guck); -IsOne(Comm(Random(guck),Random(guck))); -IsOne(Comm(Random(guck),Random(guck))); -IsOne(Comm(Random(guck),Random(guck))); -IsOne(Comm(Random(guck),Random(guck))); -IsOne(Comm(Random(guck),Random(guck))); -IsOne(Comm(Random(guck),Random(guck))); -IsOne(Comm(Random(guck),Random(guck))); -IsOne(Comm(Random(guck),Random(guck))); -IsOne(Comm(Random(guck),Random(guck))); -IsOne(Comm(Random(guck),Random(guck))); -IsOne(Comm(Random(guck),Random(guck))); -ForAll(guck,x->ForAll(guck,y->IsOne(Comm(x,y)))); -List(guck,x->RECOG.MovedSpace(Group(x))); -Concatenation(last); -RankMat(last); -u*guck[1]=u; -ForAll(guck,x->u*x=u); -bas := [u]; -ConvertToMatrixRep(bas,8); -RECOG.ExtendToBasisEchelon(bas); -RECOG.ExtendToBasisEchelon; -RECOG.ExtendToBasisEchelon(bas,100,GF(8)); -bas; -bas := last2; -ConvertToMatrixRep(bas,8); -basi := bas^-1; -guck2 := List(guck,x->bas*x*basi); -Display(guck2[1]); -guck3 := List(guck2,x->ExtractSubMatrix(x,[2..100],[2..100])); -List(guck3,x->RECOG.MovedSpace(Group(x))); -Concatenation(last); -RankMat(last); -guck3 := List(guck3,TransposedMat); -List(guck3,x->RECOG.MovedSpace(Group(x))); -Concatenation(last); -RankMat(last); -uu := last2; -SemiEchelonMat(uu); -uu := last.vectors[1]; -u=uu; -Display(u); -Display(uu); -guck4 := List(guck2,x->ExtractSubMatrix(x,[2..100],[2..100])); -guck4 := List(guck4,x->x-One(x)); -List(guck4,RankMat); diff --git a/read.g b/read.g index 8482ca9e0..fcefa4367 100644 --- a/read.g +++ b/read.g @@ -45,15 +45,35 @@ ReadPackage("recog","gap/matrix/classical.gi"); # Projective groups ReadPackage("recog","gap/projective/findnormal.gi"); ReadPackage("recog","gap/projective/c6.gi"); -ReadPackage("recog","gap/projective/tensor.gi"); +ReadPackage("recog","gap/projective/tensor/tensor.gi"); ReadPackage("recog","gap/projective/c3c5.gi"); ReadPackage("recog","gap/projective/d247.gi"); ReadPackage("recog","gap/projective/almostsimple/threeelorders.gi"); ReadPackage("recog","gap/projective/almostsimple.gi"); ReadPackage("recog","gap/projective/almostsimple/lietype.gi"); +ReadPackage("recog","gap/projective/naming/ClassicalNamingAndUtils.gi"); ReadPackage("recog","gap/projective/almostsimple/hints.gi"); -ReadPackage("recog","gap/projective/classicalnatural.gi"); -ReadPackage("recog","gap/projective/AnSnOnFDPM.gi"); +ReadPackage("recog","gap/projective/constructive_recognition/utils/achieve.gi"); +ReadPackage("recog","gap/projective/constructive_recognition/utils/utils.gi"); +ReadPackage("recog","gap/projective/constructive_recognition/SL/BaseCase.gi"); +ReadPackage("recog","gap/projective/constructive_recognition/SL/GoingDown.gi"); +ReadPackage("recog","gap/projective/constructive_recognition/SL/GoingUp.gi"); +ReadPackage("recog","gap/projective/constructive_recognition/SL/main.gi"); +ReadPackage("recog","gap/projective/constructive_recognition/SL/sl2_BlackBox.gi"); +ReadPackage("recog","gap/projective/constructive_recognition/Sp/BaseCase.gi"); +ReadPackage("recog","gap/projective/constructive_recognition/Sp/GoingDown.gi"); +ReadPackage("recog","gap/projective/constructive_recognition/Sp/GoingUp.gi"); +ReadPackage("recog","gap/projective/constructive_recognition/Sp/main.gi"); +ReadPackage("recog","gap/projective/constructive_recognition/SU/BaseCase.gi"); +ReadPackage("recog","gap/projective/constructive_recognition/SU/GoingDown.gi"); +ReadPackage("recog","gap/projective/constructive_recognition/SU/GoingUp.gi"); +ReadPackage("recog","gap/projective/constructive_recognition/SU/main.gi"); +ReadPackage("recog","gap/projective/constructive_recognition/O/BaseCase.gi"); +ReadPackage("recog","gap/projective/constructive_recognition/O/GoingDown.gi"); +ReadPackage("recog","gap/projective/constructive_recognition/O/GoingUp.gi"); +ReadPackage("recog","gap/projective/constructive_recognition/O/main.gi"); +ReadPackage("recog","gap/projective/blackbox/blackboxClassical.gi"); +ReadPackage("recog","gap/projective/AnSn/AnSnOnFDPM.gi"); # All the method installations are now here: ReadPackage("recog","gap/perm.gi"); diff --git a/tst/working/slow/ConstructiveRecognition.tst b/tst/working/slow/ConstructiveRecognition.tst new file mode 100644 index 000000000..8945a1481 --- /dev/null +++ b/tst/working/slow/ConstructiveRecognition.tst @@ -0,0 +1,83 @@ +gap> START_TEST("bugfix.tst"); +gap> oldInfoLevel := InfoLevel(InfoRecog);; +gap> SetInfoLevel(InfoRecog, 0); + +# Tests for special linear groups +gap> for d in [10,23,60] do +> for p in [2,3,5,7,11] do +> for k in [1,2,3] do +> if p^k < 256 then +> G := SL(d,p^k); +> g := PseudoRandom(GL(d,p^k)); +> G := G^g; +> res := RECOG.FindStdGens_SL(G); +> slp := res.slpstd;; bc := res.basi;; +> res2 := ResultOfStraightLineProgram(slp,GeneratorsOfGroup(G)); +> StdGens := RECOG.MakeSL_StdGens(p,k,d,d).all; +> for e in [1..Size(res2)] do +> Assert(0, res2[e]^bc = StdGens[e]); +> od; +> fi; +> od; +> od; +> od; + +# Tests for symplectic groups +gap> for d in [10,20,60] do +> for p in [5,7,11] do +> for k in [1,2,3] do +> if p^k < 256 then +> G := Sp(d,p^k); +> g := PseudoRandom(Sp(d,p^k)); +> G := G^g; +> i := 1; +> res := fail; +> while i < 20 and res = fail do +> res := RECOG.FindStdGens_Sp(G); +> od; +> if not(res = fail) then +> slp := res.slpstd;; bc := res.basi;; +> res2 := ResultOfStraightLineProgram(slp,GeneratorsOfGroup(G)); +> StdGens := RECOG.MakeSp_StdGens(p,k,d,d).all; +> for e in [1..Size(res2)-1] do +> Assert(0, res2[e]^bc = StdGens[e]); +> od; +> else +> Error("something is wrong"); +> fi; +> fi; +> od; +> od; +> od; + +# Tests for unitary groups +gap> for d in [10,20,60,11,21,61] do +> for p in [5,7,11] do +> if p^2 < 256 then +> G := SU(d,p); +> g := PseudoRandom(SU(d,p)); +> G := G^g; +> i := 1; +> res := fail; +> while i < 20 and res = fail do +> res := RECOG.FindStdGens_SU(G); +> od; +> if not(res = fail) then +> slp := res.slpstd;; bc := res.basi;; +> res2 := ResultOfStraightLineProgram(slp,GeneratorsOfGroup(G)); +> StdGens := RECOG.MakeSU_StdGens(p,k,d,d).all; +> for e in [1..Size(res2)-1] do +> Assert(0, res2[e]^bc = StdGens[e]); +> od; +> else +> Error("something is wrong"); +> fi; +> fi; +> od; +> od; + +# Tests for orthogonal groups + +# +gap> SetInfoLevel(InfoRecog, oldInfoLevel); +gap> STOP_TEST("bugfix.tst");