| Current Path : /usr/share/gap/lib/ |
Linux ift1.ift-informatik.de 5.4.0-216-generic #236-Ubuntu SMP Fri Apr 11 19:53:21 UTC 2025 x86_64 |
| Current File : //usr/share/gap/lib/sgpres.gi |
#############################################################################
##
#W sgpres.gi GAP library Volkmar Felsch
##
##
#Y Copyright (C) 1997, Lehrstuhl D für Mathematik, RWTH Aachen, Germany
#Y (C) 1998 School Math and Comp. Sci., University of St Andrews, Scotland
#Y Copyright (C) 2002 The GAP Group
##
## This file contains the methods for subgroup presentations in finitely
## presented groups (fp groups).
##
#############################################################################
##
#M AbelianInvariantsNormalClosureFpGroupRrs( <G>, <H> ) . . . . . . . . . .
#M . . . . . abelian invariants of the normal closure of the subgroup H of G
##
## uses the Reduced Reidemeister-Schreier method to compute the abelian
## invariants of the normal closure of a subgroup <H> of a finitely
## presented group <G>.
##
InstallGlobalFunction( AbelianInvariantsNormalClosureFpGroupRrs,
function ( G, H )
local M;
M:=RelatorMatrixAbelianizedNormalClosureRrs( G, H );
if Length(M)=0 then
return [];
else
DiagonalizeMat( Integers, M );
return AbelianInvariantsOfList(DiagonalOfMat(M));
fi;
end );
#############################################################################
##
#M AbelianInvariantsSubgroupFpGroupMtc( <G>, <H> ) . . . . . . . . . . . . .
#M . . . . . abelian invariants of the normal closure of the subgroup H of G
##
## uses the Modified Todd-Coxeter method to compute the abelian
## invariants of a subgroup <H> of a finitely presented group <G>.
##
InstallGlobalFunction( AbelianInvariantsSubgroupFpGroupMtc,
function ( G, H )
local M;
M:=RelatorMatrixAbelianizedSubgroupMtc( G, H );
if Length(M)=0 then
return [];
else
DiagonalizeMat( Integers, M );
return AbelianInvariantsOfList(DiagonalOfMat(M));
fi;
end );
#############################################################################
##
#M AbelianInvariantsSubgroupFpGroupRrs( <G>, <H> ) . . . . . . . . . . . . .
#M AbelianInvariantsSubgroupFpGroupRrs( <G>, <costab> ) . . . . . . . . . .
#M . . . . . abelian invariants of the normal closure of the subgroup H of G
##
## uses the Reduced Reidemeister-Schreier method to compute the abelian
## invariants of a subgroup <H> of a finitely presented group <G>.
##
## Alternatively to the subgroup <H>, its coset table <table> in <G> may be
## given as second argument.
##
InstallGlobalFunction( AbelianInvariantsSubgroupFpGroupRrs,
function ( G, H )
local M;
M:=RelatorMatrixAbelianizedSubgroupRrs( G, H );
if Length(M)=0 then
return [];
else
DiagonalizeMat( Integers, M );
return AbelianInvariantsOfList(DiagonalOfMat(M));
fi;
end );
#############################################################################
##
#M AugmentedCosetTableInWholeGroup
##
InstallGlobalFunction(AugmentedCosetTableInWholeGroup,
function(arg)
local aug,H,wor,w;
H:=arg[1];
if Length(arg)=1 then
return AugmentedCosetTableRrsInWholeGroup(H);
fi;
wor:=List(arg[2],UnderlyingElement); # words for given elements
# is there an MTc table we can use?
if HasAugmentedCosetTableMtcInWholeGroup(H) then
aug := AugmentedCosetTableMtcInWholeGroup( H );
if IsSubset(aug.primaryGeneratorWords,wor) or
IsSubset(SecondaryGeneratorWordsAugmentedCosetTable(aug),wor) then
return aug;
fi;
fi;
# try the Rrs table
aug := AugmentedCosetTableRrsInWholeGroup( H );
if IsSubset(aug.primaryGeneratorWords,wor) or
IsSubset(SecondaryGeneratorWordsAugmentedCosetTable(aug),wor) then
return aug;
fi;
# still not: need completely new table
w:=FamilyObj(H)!.wholeGroup;
aug:=AugmentedCosetTableMtc(w,SubgroupNC(w,arg[2]),2,"y" );
return aug;
end);
#############################################################################
##
#M AugmentedCosetTableMtcInWholeGroup
##
InstallMethod( AugmentedCosetTableMtcInWholeGroup,
"subgroup of fp group", true, [IsSubgroupFpGroup], 0,
function( H )
local G, aug;
G := FamilyObj( H )!.wholeGroup;
aug := AugmentedCosetTableMtc( G, H, 2, "y" );
return aug;
end);
#############################################################################
##
#M AugmentedCosetTableRrsInWholeGroup
##
InstallMethod( AugmentedCosetTableRrsInWholeGroup,
"subgroup of fp group", true, [IsSubgroupFpGroup], 0,
function( H )
local G, costab, fam, aug, gens;
G := FamilyObj( H )!.wholeGroup;
costab := CosetTableInWholeGroup( H );
aug := AugmentedCosetTableRrs( G, costab, 2, "y" );
# if H has not yet any generators, we store them (and then also can store
# the coset table as Mtc table)
if not (HasGeneratorsOfGroup(H)
or HasAugmentedCosetTableMtcInWholeGroup(H)) then
SetAugmentedCosetTableMtcInWholeGroup(H,aug);
gens := aug.primaryGeneratorWords;
# do we need to wrap?
if not IsFreeGroup( G ) then
fam := ElementsFamily( FamilyObj( H ) );
gens := List( gens, i -> ElementOfFpGroup( fam, i ) );
fi;
SetGeneratorsOfGroup( H, gens );
fi;
return aug;
end);
#############################################################################
##
#M AugmentedCosetTableNormalClosureInWholeGroup( <H> ) . . . augmented coset
#M table of the normal closure of an fp subgroup in its whole group
##
## is equivalent to `AugmentedCosetTableNormalClosure( <G>, <H> )' where <G>
## is the (unique) finitely presented group such that <H> is a subgroup of
## <G>.
##
InstallMethod( AugmentedCosetTableNormalClosureInWholeGroup,
"subgroup of fp group", true, [IsSubgroupFpGroup], 0,
function( H )
local G, costab, aug;
# get the whole group G of H
G := FamilyObj( H )!.wholeGroup;
# compute a coset table of the normal closure N of H in G
costab := CosetTableNormalClosureInWholeGroup( H );
# apply the Reduced Reidemeister-Schreier method to construct an
# augmented coset table of N in G
aug := AugmentedCosetTableRrs( G, costab, 2, "%" );
return aug;
end );
#############################################################################
##
#M AugmentedCosetTableMtc( <G>, <H>, <type>, <string> ) . . . . . . . . . .
#M . . . . . . . . . . . . . do an MTC and return the augmented coset table
##
## is an internal function used by the subgroup presentation functions
## described in "Subgroup Presentations". It applies a Modified Todd-Coxeter
## coset representative enumeration to construct an augmented coset table
## (see "Subgroup presentations") for the given subgroup <H> of <G>. The
## subgroup generators will be named <string>1, <string>2, ... .
##
## Valid types are 1 (for the one generator case), 0 (for the abelianized
## case), and 2 (for the general case). A type value of -1 is handled in
## the same way as the case type = 1, but the function will just return the
## the exponent <aug>.exponent of the given cyclic subgroup <H> and its
## index <aug>.index in <G> as the only components of the resulting record
## <aug>.
##
InstallGlobalFunction( AugmentedCosetTableMtc,
function ( G, H, ttype, string )
# check the arguments
if not ( IsSubgroupFpGroup( G ) and IsGroupOfFamily( G ) ) then
Error( "<G> must be a finitely presented group" );
fi;
if FamilyObj( H ) <> FamilyObj( G ) then
Error( "<H> must be a subgroup of <G>" );
fi;
return NEWTC_CosetEnumerator(FreeGeneratorsOfFpGroup(G),
RelatorsOfFpGroup(G),GeneratorsOfGroup(H),true);
end );
#############################################################################
##
#M AugmentedCosetTableRrs( <G>, <coset table>, <type>, <string> ) . . . . .
#M do a RRS and return the augmented coset table
##
## 'AugmentedCosetTableRrs' applies the Reduced Reidemeister-Schreier method
## to construct an augmented coset table for the subgroup of G which is
## defined by the given coset table. The new subgroup generators will be
## named <string>1, <string>2, ... .
##
InstallGlobalFunction( AugmentedCosetTableRrs,
function ( G, table, type, string )
local fgens, # generators of asscociated free group
grels, # relators of G
involutions, # indices of involutory gens of G
index, # index of the group in the parent group
cosTable, # coset table
negTable, # coset table to be built up
coFacTable, # coset factor table
numcols, # number of columns in the tables
numgens, # number of generators
F, # a new free group
span, # spanning tree
ggens, # parent group gens prallel to columns
gens, # new generators
ngens, # number of new generators
defs, # definitions of primary subgroup gens
tree, # tree of generators
tree1, tree2, # components of tree of generators
treelength, # number of gens (primary + secondary)
rels, # representatives for the relators
relsGen, # relators beginning with a gen
deductions, # deduction queue
ded, # index of current deduction in above
nrdeds, # current number of deductions in above
i, ii, gen, inv, # loop variables for generator
triple, # loop variable for relators as triples
word, factors, # words defining subgroup generators
app, # application stack for 'ApplyRel'
app2, # application stack for 'ApplyRel2'
j, k, # loop variables
fac, # tree entry
count, # number of negative table entries
next, #
numoccs, # number of gens which occur in the table
occur, #
treeNums, #
convert, # conversion list for subgroup generators
aug, # augmented coset table
field, # loop variable for record field names
EnterDeduction, # subroutine
LoopOverAllCosets; # subroutine
EnterDeduction := function ( )
# a deduction has been found, check the current coset table entry.
# if triple[2][app[1]][app[2]] <> -app[4] or
# triple[2][app[3]][app[4]] <> -app[2] then
# Error( "unexpected coset table entry" );
# fi;
# compute the corresponding factors in "factors".
app2[1] := triple[3];
app2[2] := deductions[ded][2];
app2[3] := -1;
app2[4] := app2[2];
ApplyRel2( app2, triple[2], triple[1] );
factors := app2[7];
#if Length(factors)>0 then Print(Length(factors)," ",Maximum(factors)," ",Minimum(factors),"\n");fi;
# ensure that the scan provided a deduction.
# if app2[1] - 1 <> app2[3]
# or triple[2][app2[1]][app2[2]] <> - app2[4]
# or triple[2][app2[3]][app2[4]] <> - app2[2]
# then
# Error( "the given scan does not provide a deduction" );
# fi;
# extend the tree to define a proper factor, if necessary.
fac := TreeEntry( tree, factors );
# now enter the deduction to the tables.
triple[2][app2[1]][app2[2]] := app2[4];
coFacTable[triple[1][app2[1]]][app2[2]] := fac;
triple[2][app2[3]][app2[4]] := app2[2];
coFacTable[triple[1][app2[3]]][app2[4]] := - fac;
nrdeds := nrdeds + 1;
deductions[nrdeds] := [ triple[1][app2[1]], app2[2] ];
treelength := tree[3];
count := count - 2;
end;
LoopOverAllCosets:=function()
# loop over all the cosets
for j in [ 1 .. index ] do
CompletionBar(InfoFpGroup,2,"Coset Loop: ",j/index);
# run through all the rows and look for negative entries
for i in [ 1 .. numcols ] do
gen := negTable[i];
if gen[j] < 0 then
# add the current Schreier generator to the set of new
# subgroup generators, and add the definition as deduction.
k := - gen[j];
word := ggens[i];
while k > 1 do
word := word * ggens[span[2][k]]^-1; k := span[1][k];
od;
k := j;
while k > 1 do
word := ggens[span[2][k]] * word; k := span[1][k];
od;
numgens := numgens + 1;
defs[numgens] := word;
treelength := treelength + 1;
tree[3] := treelength;
tree[4] := numgens;
if type = 0 then
tree1[treelength] :=
ListWithIdenticalEntries( numgens, 0 );
tree1[treelength][numgens] := 1;
tree2[numgens] := 0;
else
tree1[treelength] := 0;
tree2[treelength] := 0;
fi;
# add the definition as deduction.
inv := negTable[i + 2*(i mod 2) - 1];
k := - gen[j];
gen[j] := k;
coFacTable[i][j] := treelength;
if inv[k] < 0 then
inv[k] := j;
ii := i + 2*(i mod 2) - 1;
coFacTable[ii][k] := - treelength;
fi;
count := count - 2;
# set up the deduction queue and run over it until it's empty
deductions:=[];
deductions[1] := [i,j];
nrdeds := 1;
ded := 1;
while ded <= nrdeds do
# apply all relators that start with this generator
for triple in relsGen[deductions[ded][1]] do
app[1] := triple[3];
app[2] := deductions[ded][2];
app[3] := -1;
app[4] := app[2];
if ApplyRel( app, triple[2] ) and
triple[2][app[1]][app[2]] < 0 and
triple[2][app[3]][app[4]] < 0 then
# a deduction has been found: compute the
# corresponding factor and enter the deduction to
# the tables and to the deductions lists.
EnterDeduction( );
if count <= 0 then
return;
fi;
fi;
od;
ded := ded + 1;
od;
fi;
od;
od;
end;
# check G to be a finitely presented group.
if not ( IsSubgroupFpGroup( G ) and IsGroupOfFamily( G ) ) then
Error( "<G> must be a finitely presented group" );
fi;
# check the type for being 0 or 2.
if type <> 0 and type <> 2 then
Error( "invalid type; it should be 0 or 2" );
fi;
# get some local variables
fgens := FreeGeneratorsOfFpGroup( G );
grels := RelatorsOfFpGroup( G );
# check the number of columns of the given coset table to be twice the
# number of generators of the parent group G.
numcols := Length( table );
if numcols <> 2 * Length( fgens ) then
Error( "parent group and coset table are inconsistent" );
fi;
index := IndexCosetTab( table );
# get a negative copy of the coset table, and initialize the coset factor
# table (parallel to it) by zeros.
involutions := IndicesInvolutaryGenerators( G );
if Length( involutions ) = 0 then
cosTable := table;
else
cosTable := [ ];
for i in [ 1 .. Length( fgens ) ] do
cosTable[2*i-1] := table[2*i-1];
if i in involutions then
cosTable[2*i] := table[2*i-1];
else
cosTable[2*i] := table[2*i];
fi;
od;
fi;
negTable := [ ];
coFacTable := [ ];
for i in [ 1 .. Length( fgens ) ] do
negTable[2*i-1] := List( cosTable[2*i-1], x -> -x );
coFacTable[2*i-1] := ListWithIdenticalEntries( index, 0 );
if i in involutions then
negTable[2*i] := negTable[2*i-1];
coFacTable[2*i] := coFacTable[2*i-1];
else
negTable[2*i] := List( cosTable[2*i], x -> -x );
coFacTable[2*i] := ListWithIdenticalEntries( index, 0 );
fi;
od;
count := index * ( numcols - 2 ) + 2;
# construct the list relsGen which for each generator or inverse
# generator contains a list of all cyclically reduced relators,
# starting with that element, which can be obtained by conjugating or
# inverting given relators. The relators in relsGen are represented as
# lists of the coset table columns corresponding to the generators and,
# in addition, as lists of the respective column numbers.
rels := RelatorRepresentatives( grels );
relsGen := RelsSortedByStartGen( fgens, rels, negTable, true );
SortRelsSortedByStartGen( relsGen );
# check the number of columns to be twice the number of generators of
# the parent group G.
if numcols <> 2 * Length( fgens ) then
Error( "parent group and coset table are inconsistent" );
fi;
# initialize the tree of secondary generators.
tree1 := ListWithIdenticalEntries( 100, 0 );
if type = 0 then
tree2 := [ ];
else
tree2 := ListWithIdenticalEntries( 100, 0 );
fi;
treelength := 0;
tree := [ tree1, tree2, treelength, 0, type ];
# initialize an empty deduction list
deductions := [ ]; deductions[index] := 0;
nrdeds := 0;
# get a spanning tree for the cosets
span := SpanningTree( cosTable );
# enter the coset definitions into the coset table.
for k in [ 2 .. index ] do
j := span[1][k];
i := span[2][k];
ii := i + 2*(i mod 2) - 1;
# check the current table entry.
if negTable[i][j] <> - k or negTable[ii][k] <> -j then
Error( "coset table and spanning tree are inconsistent" );
fi;
# enter the deduction.
negTable[i][j] := k;
if negTable[ii][k] < 0 then negTable[ii][k] := j; fi;
nrdeds := nrdeds + 1;
deductions[nrdeds] := [i,j];
od;
# make the local structures that are passed to 'ApplyRel' or, via
# EnterDeduction, to 'ApplyRel2".
app := ListWithIdenticalEntries( 4, 0 );
app2 := ListWithIdenticalEntries( 9, 0 );
if type = 0 then
factors := tree2;
else
factors := [ ];
fi;
# set those arguments of ApplyRel2 which are global with respect to the
# following loops.
app2[5] := type;
app2[6] := coFacTable;
app2[7] := factors;
if type = 0 then
app2[8] := tree;
fi;
# set up the deduction queue and run over it until it's empty
ded := 1;
while ded <= nrdeds do
if ded mod 50=0 then
CompletionBar(InfoFpGroup,2,"Queue: ",ded/nrdeds);
fi;
# apply all relators that start with this generator
for triple in relsGen[deductions[ded][1]] do
app[1] := triple[3];
app[2] := deductions[ded][2];
app[3] := -1;
app[4] := app[2];
if ApplyRel( app, triple[2] ) and triple[2][app[1]][app[2]] < 0
and triple[2][app[3]][app[4]] < 0 then
# a deduction has been found: compute the corresponding
# factor and enter the deduction to the tables and to the
# deductions lists.
EnterDeduction( );
fi;
od;
ded := ded + 1;
od;
CompletionBar(InfoFpGroup,2,"Queue: ",false);
# get a list of the parent group generators parallel to the table
# columns.
ggens := [ ];
for i in [ 1 .. numcols/2 ] do
ggens[2*i-1] := fgens[i];
ggens[2*i] := fgens[i]^-1;
od;
# initialize the list of new subgroup generators
numgens := 0;
defs := [ ];
# loop over cosets
LoopOverAllCosets();
CompletionBar(InfoFpGroup,2,"Coset Loop: ",false);
# save the number of primary subgroup generators and the number of all
# subgroup generators in the tree.
tree[3] := treelength;
# get an immutable coset table with no two columns identical.
if IsMutable( table ) then
cosTable := Immutable( table );
else
cosTable := table;
fi;
# separate pairs of identical columns in the coset factor table.
for i in [ 1 .. Length( fgens ) ] do
if i in involutions then
coFacTable[2*i] := StructuralCopy( coFacTable[2*i-1] );
fi;
od;
# create the augmented coset table record.
aug := rec( );
aug.isAugmentedCosetTable := true;
aug.type := type;
aug.tableType := TABLE_TYPE_RRS;
aug.groupGenerators := fgens;
aug.groupRelators := grels;
aug.cosetTable := cosTable;
aug.cosetFactorTable := coFacTable;
aug.primaryGeneratorWords := defs;
aug.tree := tree;
# renumber the generators such that the primary ones precede the
# secondary ones, and sort the tree and the factor table accordingly.
if type = 2 then
RenumberTree( aug );
# determine which generators occur in the augmented table.
occur := ListWithIdenticalEntries( treelength, 0 );
for i in [ 1 .. numgens ] do
occur[i] := 1;
od;
numcols := Length( coFacTable );
numoccs := numgens;
i := 1;
while i < numcols do
for next in coFacTable[i] do
if next <> 0 then
j := AbsInt( next );
if occur[j] = 0 then
occur[j] := 1; numoccs := numoccs + 1;
fi;
fi;
od;
i := i + 2;
od;
# build up a list of pointers from the occurring generators to the
# tree, and define names for the occurring secondary generators.
ngens := numgens;
treeNums := [ 1 .. numoccs ];
for j in [ numgens+1 .. treelength ] do
if occur[j] <> 0 then
ngens := ngens + 1;
treeNums[ngens] := j;
fi;
od;
aug.treeNumbers := treeNums;
# get ngens new generators
F := FreeGroup( ngens, string );
gens := GeneratorsOfGroup( F );
# prepare a conversion list for the subgroup generator numbers if
# they do not all occur in the subgroup relators.
numgens := Length( gens );
if numgens < treelength then
convert := ListWithIdenticalEntries( treelength, 0 );
for i in [ 1 .. numgens ] do
convert[treeNums[i]] := i;
od;
aug.conversionList := convert;
fi;
aug.numberOfSubgroupGenerators := ngens;
aug.nameOfSubgroupGenerators := Immutable( string );
aug.subgroupGenerators := gens;
fi;
# ensure that all components of the augmented coset table are immutable.
for field in RecNames( aug ) do
MakeImmutable( aug.(field) );
od;
# display a message
numgens := Length( defs );
Info( InfoFpGroup, 1, "RRS defined ", numgens, " primary and ",
treelength - numgens, " secondary subgroup generators" );
# return the augmented coset table.
return aug;
end );
#############################################################################
##
#M AugmentedCosetTableNormalClosure( <G>, <H> ) . . . augmented coset table
#M of the normal closure of a subgroup in a finitely presented group
##
InstallMethod( AugmentedCosetTableNormalClosure,
"for finitely presented groups",
true,
[ IsSubgroupFpGroup and IsGroupOfFamily, IsSubgroupFpGroup ],
0,
function( G, H );
if G <> FamilyObj( H )!.wholeGroup then
Error( "<H> must be a subgroup of <G>" );
fi;
return AugmentedCosetTableNormalClosureInWholeGroup( H );
end );
#############################################################################
##
#M CosetTableBySubgroup(<G>,<H>)
##
## returns a coset table for the action of <G> on the cosets of <H>. The
## columns of the table correspond to the `GeneratorsOfGroup(<G>)'.
##
InstallMethod(CosetTableBySubgroup,"coset action",IsIdenticalObj,
[IsGroup,IsGroup],0,
function ( G, H )
local column, gens, i, range, table, transversal;
# construct a permutations representation of G on the cosets of H.
gens := GeneratorsOfGroup(G);
if not (IsPermGroup(G) and IsPermGroup(H) and
IsEqualSet(Orbit(G,1),[1..NrMovedPoints(G)]) and H=Stabilizer(G,1)) then
transversal := RightTransversal( G, H );
gens := List( gens, gen -> Permutation( gen, transversal,OnRight ) );
range := [ 1 .. Length( transversal ) ];
else
range := [ 1 .. NrMovedPoints(G) ];
fi;
# initialize the coset table.
table := [];
# construct the columns of the table from the permutations.
for i in gens do
column := OnTuples( range, i );
Add( table, column );
column:=OnTuples(range,i^-1);
Add( table, column );
od;
# standardize the table and return it.
StandardizeTable( table );
return table;
end);
InstallMethod(CosetTableBySubgroup,"use `CosetTableInWholeGroup",
IsIdenticalObj, [IsSubgroupFpGroup,IsSubgroupFpGroup],0,
function(G,H)
if IndexInWholeGroup(G)>1 or not IsIdenticalObj(G,Parent(G))
or List(GeneratorsOfGroup(G),UnderlyingElement)
<>FreeGeneratorsOfFpGroup(Parent(G)) then
TryNextMethod();
fi;
return CosetTableInWholeGroup(H);
end);
#############################################################################
##
#M CanonicalRelator( <relator> ) . . . . . . . . . . . . canonical relator
##
## 'CanonicalRelator' returns the canonical representative of the given
## relator.
##
InstallGlobalFunction( CanonicalRelator, function ( Rel )
local i, i1, ii, j, j1, jj, k, k1, kk, length, max, min, rel;
rel := Rel;
length := Length( rel );
max := Maximum( rel );
min := Minimum( rel );
if max < - min then
i := 0;
else
i := Position( rel, max, 0 );
k := i;
while k <> false do
k := Position( rel, max, k );
if k <> false then
ii := i; kk := k; k1 := k - 1;
while kk <> k1 do
if ii = length then ii := 1; else ii := ii + 1; fi;
if kk = length then kk := 1; else kk := kk + 1; fi;
if rel[kk] > rel[ii] then i := k; kk := k1;
elif rel[kk] < rel[ii] then kk := k1;
elif kk = k1 then k := false; fi;
od;
fi;
od;
fi;
if - min < max then
j := 0;
else
j := Position( rel, min, 0 );
k := j;
while k <> false do
k := Position( rel, min, k );
if k <> false then
jj := j; kk := k; j1 := j + 1;
while jj <> j1 do
if jj = 1 then jj := length; else jj := jj - 1; fi;
if kk = 1 then kk := length; else kk := kk - 1; fi;
if rel[kk] < rel[jj] then j := k; jj := j1;
elif rel[kk] > rel[jj] then jj := j1;
elif jj = j1 then k := false; fi;
od;
fi;
od;
fi;
if - min = max then
if i = 1 then i1 := length; else i1 := i - 1; fi;
ii := i; jj := j;
while ii <> i1 do
if ii = length then ii := 1; else ii := ii + 1; fi;
if jj = 1 then jj := length; else jj := jj - 1; fi;
if - rel[jj] < rel[ii] then j := 0; ii := i1;
elif - rel[jj] > rel[ii] then i := 0; ii := i1; fi;
od;
fi;
if i = 0 then rel := - Reversed( rel ); i := length + 1 - j; fi;
if i > 1 then rel := Concatenation(
rel{ [i..length] }, rel{ [1..i-1] } );
fi;
return( rel );
end );
#############################################################################
##
#M CheckCosetTableFpGroup( <G>, <table> ) . . . . . . . checks a coset table
##
## 'CheckCosetTableFpGroup' checks whether table is a legal coset table of
## the finitely presented group G.
##
InstallGlobalFunction( CheckCosetTableFpGroup, function ( G, table )
local fgens, grels, i, id, index, ngens, perms;
# check G to be a finitely presented group.
if not ( IsSubgroupFpGroup( G ) and IsGroupOfFamily( G ) ) then
Error( "<G> must be a finitely presented group" );
fi;
# check table to be a list of lists.
if not ( IsList( table ) and ForAll( table, IsList ) ) then
Error( "<table> must be a coset table" );
fi;
# get some local variables
fgens := FreeGeneratorsOfFpGroup( G );
grels := RelatorsOfFpGroup( G );
# check the number of columns against the number of group generators.
ngens := Length( fgens );
if Length( table ) <> 2 * ngens then
Error( "inconsistent number of group generators and table columns" );
fi;
# check the columns to be permutations of equal degree.
index := IndexCosetTab( table );
perms := [ ]; perms[ngens] := 0;
for i in [ 1 .. ngens ] do
if Length( table[2*i-1] ) <> index then
Error( "table has columns of different length" );
fi;
perms[i] := PermList( table[2*i-1] );
if PermList( table[2*i] ) <> perms[i]^-1 then
Error( "table has inconsistent inverse columns" );
fi;
od;
# check the permutations to act transitively.
id := perms[1]^0;
if not IsTransitive( GroupByGenerators( perms, id ), [ 1 .. index ] ) then
Error( "table does not act transitively" );
fi;
# check the permutations to satisfy the group relators.
if not ForAll( grels, rel -> MappedWord( rel, fgens, perms )
= id ) then
Error( "table columns do not satisfy the group relators" );
fi;
end );
#############################################################################
##
#M IsStandardized( <costab> ) . . . . . test if coset table is standardized
##
InstallGlobalFunction( IsStandardized, function ( table )
local i, index, j, next;
index := IndexCosetTab( table );
j := 1;
next := 2;
while next < index do
for i in [ 1, 3 .. Length( table ) - 1 ] do
if table[i][j] >= next then
if table[i][j] > next then return false; fi;
next := next + 1;
fi;
od;
j := j + 1;
od;
return true;
end );
#############################################################################
##
#R IsPresentationDefaultRep( <pres> )
##
## is the default representation of presentations.
## `IsPresentationDefaultRep' is a subrepresentation of
## `IsComponentObjectRep'.
##
DeclareRepresentation( "IsPresentationDefaultRep",
IsComponentObjectRep and IsAttributeStoringRep, [] );
#T eventually the admissible component names should be listed here
#############################################################################
##
#M \.( <pres>, <nam> ) . . . . . . . . . . . . . . . . . for a presentation
##
InstallMethod( \.,
"for a presentation in default representation",
true,
[ IsPresentation and IsPresentationDefaultRep, IsPosInt ], 0,
function( pres, nam )
Error("still record access");
return pres!.( NameRNam( nam ) );
end );
#############################################################################
##
#M IsBound\.( <pres>, <nam> ) . . . . . . . . . . . . . . for a presentation
##
InstallMethod( IsBound\.,
"for a presentation in default representation",
true,
[ IsPresentation and IsPresentationDefaultRep, IsPosInt ], 0,
function( pres, nam )
Error("still record access");
return IsBound( pres!.( NameRNam( nam ) ) );
end );
#############################################################################
##
#M \.\:\=( <pres>, <nam>, <val> ) . . . . . . . . . . . . for a presentation
##
InstallMethod( \.\:\=,
"for a mutable presentation in default representation",
true,
[ IsPresentation and IsPresentationDefaultRep and IsMutable,
IsPosInt, IsObject ], 0,
function( pres, nam, val )
Error("still record access");
pres!.( NameRNam( nam ) ):= val;
end );
#############################################################################
##
#M Unbind\.( <pres>, <nam> ) . . . . . . . . . . . . . . for a presentation
##
InstallMethod( Unbind\.,
"for a mutable presentation in default representation",
true,
[ IsPresentation and IsPresentationDefaultRep and IsMutable,
IsPosInt ], 0,
function( pres, nam )
Error("still record access");
Unbind( pres!.( NameRNam( nam ) ) );
end );
#############################################################################
##
#M PresentationAugmentedCosetTable( <aug>, <string> [,<print level>] ) . . .
#M create a Tietze record
##
## 'PresentationAugmentedCosetTable' creates a presentation, i.e. a Tietze
## record, from the given augmented coset table. It assumes that <aug> is an
## augmented coset table of type 2. The generators will be named <string>1,
## <string>2, ... .
##
InstallGlobalFunction( PresentationAugmentedCosetTable,
function ( arg )
local aug, coFacTable, comps, F, fgens, gens, i, invs, lengths, numgens,
numrels, pointers, printlevel, rels, string, T, tietze, total,
tree, treelength, treeNums;
# check the first argument to be an augmented coset table.
aug := arg[1];
if not ( IsRecord( aug ) and IsBound( aug.isAugmentedCosetTable ) and
aug.isAugmentedCosetTable ) then
Error( "first argument must be an augmented coset table" );
fi;
# get the generators name.
string := arg[2];
if not IsString( string ) then
Error( "second argument must be a string" );
fi;
# check the third argument to be an integer.
printlevel := 1;
if Length( arg ) >= 3 then printlevel := arg[3]; fi;
if not IsInt( printlevel ) then
Error ("third argument must be an integer" );
fi;
# initialize some local variables.
coFacTable := aug.cosetFactorTable;
tree := ShallowCopy( aug.tree );
treeNums := ShallowCopy( aug.treeNumbers );
treelength := Length( tree[1] );
F := FreeGroup(IsLetterWordsFamily, infinity, string );
fgens := GeneratorsOfGroup( F );
gens := ShallowCopy(aug.subgroupGenerators);
rels := List(aug.subgroupRelators,ShallowCopy);
numrels := Length( rels );
numgens := Length( gens );
# create the Tietze object.
T := Objectify( NewType( PresentationsFamily,
IsPresentationDefaultRep
and IsPresentation
and IsMutable ),
rec() );
# construct the relator lengths list.
lengths := List( [ 1 .. numrels ], i -> Length( rels[i] ) );
total := Sum( lengths );
# initialize the Tietze stack.
tietze := ListWithIdenticalEntries( TZ_LENGTHTIETZE, 0 );
tietze[TZ_NUMRELS] := numrels;
tietze[TZ_RELATORS] := rels;
tietze[TZ_LENGTHS] := lengths;
tietze[TZ_FLAGS] := ListWithIdenticalEntries( numrels, 1 );
tietze[TZ_TOTAL] := total;
# construct the generators and the inverses list, and save the generators
# as components of the Tietze record.
invs := [ ]; invs[2*numgens+1] := 0;
pointers := [ 1 .. treelength ];
for i in [ 1 .. numgens ] do
invs[numgens+1-i] := i;
invs[numgens+1+i] := - i;
T!.(String( i )) := fgens[i];
pointers[treeNums[i]] := treelength + i;
od;
invs[numgens+1] := 0;
comps := [ 1 .. numgens ];
# define the remaining Tietze stack entries.
tietze[TZ_FREEGENS] := fgens;
tietze[TZ_NUMGENS] := numgens;
tietze[TZ_GENERATORS] := List( [ 1 .. numgens ], i -> fgens[i] );
tietze[TZ_INVERSES] := invs;
tietze[TZ_NUMREDUNDS] := 0;
tietze[TZ_STATUS] := [ 0, 0, -1 ];
tietze[TZ_MODIFIED] := false;
# define some Tietze record components.
T!.generators := tietze[TZ_GENERATORS];
T!.tietze := tietze;
T!.components := comps;
T!.nextFree := numgens + 1;
T!.identity := One( fgens[1] );
SetOne(T,One( fgens[1] ));
# save the tree as component of the Tietze record.
tree[TR_TREENUMS] := treeNums;
tree[TR_TREEPOINTERS] := pointers;
tree[TR_TREELAST] := treelength;
T!.tree := tree;
# save the definitions of the primary generators as words in the original
# group generators.
SetPrimaryGeneratorWords(T,aug.primaryGeneratorWords);
# handle relators of length 1 or 2, but do not eliminate any primary
# generators.
TzOptions(T).protected := tree[TR_PRIMARY];
TzOptions(T).printLevel := printlevel;
if Length(arg)>3 and arg[4]=true then
# the stupid Length1or2 convention might mess up the connection to the
# coset table.
TzInitGeneratorImages(T);
fi;
if numgens>0 then
TzHandleLength1Or2Relators( T );
fi;
T!.hasRun1Or2:=true;
TzOptions(T).protected := 0;
# sort the relators.
TzSort( T );
TzOptions(T).printLevel := printlevel;
# return the Tietze record.
return T;
end );
#############################################################################
##
#M PresentationNormalClosureRrs( <G>, <H> [,<string>] ) . . . Tietze record
#M for the normal closure of a subgroup
##
## 'PresentationNormalClosureRrs' uses the Reduced Reidemeister-Schreier
## method to compute a presentation (i.e. a presentation record) for the
## normal closure N, say, of a subgroup H of a finitely presented group G.
## The generators in the resulting presentation will be named <string>1,
## <string>2, ... , the default string is `\"_x\"'.
##
InstallGlobalFunction( PresentationNormalClosureRrs,
function ( arg )
local G, # given group
H, # given subgroup
string, # given string
F, # associated free group
fgens, # generators of <F>
hgens, # generators of <H>
fhgens, # their preimages in <F>
grels, # relators of <G>
krels, # relators of normal closure <N>
K, # factor group of F isomorphic to G/N
cosTable, # coset table of <G> by <N>
i, # loop variable
aug, # auxiliary coset table of <G> by <N>
T; # resulting Tietze record
# check the first two arguments to be a finitely presented group and a
# subgroup of that group.
G := arg[1];
if not ( IsSubgroupFpGroup( G ) and IsGroupOfFamily( G ) ) then
Error( "<G> must be a finitely presented group" );
fi;
H := arg[2];
if not IsSubgroupFpGroup( H ) or FamilyObj( H ) <> FamilyObj( G ) then
Error( "<H> must be a subgroup of <G>" );
fi;
# get the generators name.
if Length( arg ) = 2 then
string := "_x";
else
string := arg[3];
if not IsString( string ) then
Error( "third argument must be a string" );
fi;
fi;
# get some local variables
F := FreeGroupOfFpGroup( G );
fgens := GeneratorsOfGroup( F );
grels := RelatorsOfFpGroup( G );
hgens := GeneratorsOfGroup( H );
fhgens := List( hgens, gen -> UnderlyingElement( gen ) );
# construct a factor group K of F isomorphic to the factor group of G by
# the normal closure N of H.
krels := Concatenation( grels, fhgens );
K := F / krels;
# get the coset table of N in G by constructing the coset table of the
# trivial subgroup in K.
cosTable := CosetTable( K, TrivialSubgroup( K ) );
Info( InfoFpGroup, 1, "index is ", Length( cosTable[1] ) );
# # obsolete: No columns should be equal!
# for i in [ 1 .. Length( fgens ) ] do
# if IsIdenticalObj( cosTable[2*i-1], cosTable[2*i] ) then
# Error( "there is a bug in PresentationNormalClosureRrs" ); fi; od;
# apply the Reduced Reidemeister-Schreier method to construct a coset
# table presentation of N.
aug := AugmentedCosetTableRrs( G, cosTable, 2, string );
# determine a set of subgroup relators.
aug.subgroupRelators := RewriteSubgroupRelators( aug, aug.groupRelators);
# create a Tietze record for the resulting presentation.
T := PresentationAugmentedCosetTable( aug, string );
# handle relators of length 1 or 2, but do not eliminate any primary
# generators.
TzOptions(T).protected := T!.tree[TR_PRIMARY];
TzHandleLength1Or2Relators( T );
T!.hasRun1Or2:=true;
TzOptions(T).protected := 0;
# sort the relators.
TzSort( T );
return T;
end );
#############################################################################
##
#M PresentationSubgroupRrs( <G>, <H> [,<string>] ) . . . . . . Tietze record
#M PresentationSubgroupRrs( <G>, <costab> [,<string>] ) . . for a subgroup
##
## 'PresentationSubgroupRrs' uses the Reduced Reidemeister-Schreier method
## to compute a presentation (i.e. a presentation record) for a subgroup H
## of a finitely presented group G. The generators in the resulting
## presentation will be named <string>1, <string>2, ... , the default
## string is "_x".
##
## Alternatively to a finitely presented group, the subgroup H may be given
## by its coset table.
##
InstallGlobalFunction( PresentationSubgroupRrs, function ( arg )
local aug, G, gens, H, ngens, string, T, table;
# check G to be a finitely presented group.
G := arg[1];
if not ( IsSubgroupFpGroup( G ) and IsGroupOfFamily( G ) ) then
Error( "<group> must be a finitely presented group" );
fi;
# get the generators name.
if Length( arg ) = 2 then
string := "_x";
else
string := arg[3];
if not IsString( string ) then
Error( "third argument must be a string" );
fi;
fi;
# check the second argument to be a subgroup or a coset table of G, and
# get the coset table in either case.
H := arg[2];
if not IsSubgroupFpGroup( H ) or FamilyObj( H ) <> FamilyObj( G ) then
# check the given table to be a legal coset table.
table := H;
CheckCosetTableFpGroup( G, table );
# ensure that it is standardized.
if not IsStandardized( table) then Print(
"#I Warning: the given coset table is not standardized,\n",
"#I a standardized copy will be used instead.\n" );
StandardizeTable( StructuralCopy( table ) );
fi;
# apply the Reduced Reidemeister-Schreier method to construct an
# augmented RRS coset table of H.
aug := AugmentedCosetTableRrs( G, table, 2, string );
else
# get a copy of an augmented RRS coset table of H in G.
aug := CopiedAugmentedCosetTable(
AugmentedCosetTableRrsInWholeGroup( H ) );
# insert the required subgroup generator names if necessary.
if aug.nameOfSubgroupGenerators <> string then
aug.nameOfSubgroupGenerators := string;
ngens := aug.numberOfSubgroupGenerators;
gens := GeneratorsOfGroup( FreeGroup( ngens, string ) );
aug.subgroupGenerators := gens;
fi;
fi;
# determine a set of subgroup relators.
aug.subgroupRelators := RewriteSubgroupRelators( aug, aug.groupRelators);
# create a Tietze record for the resulting presentation.
T := PresentationAugmentedCosetTable( aug, string );
return T;
end );
#############################################################################
##
#M ReducedRrsWord( <word> ) . . . . . . . . . . . . . . freely reduce a word
##
## 'ReducedRrsWord' freely reduces the given RRS word and returns the result.
##
InstallGlobalFunction( ReducedRrsWord, function ( word )
local i, j, reduced;
# initialize the result.
reduced := [];
# run through the factors of the given word and cancel or add them.
j := 0;
for i in [ 1 .. Length( word ) ] do
if word[i] <> 0 then
if j > 0 and word[i] = - reduced[j] then j := j-1;
else j := j+1; reduced[j] := word[i]; fi;
fi;
od;
if j < Length( reduced ) then
reduced := reduced{ [1..j] };
fi;
return( reduced );
end );
#############################################################################
##
#M RelatorMatrixAbelianizedNormalClosureRrs( <G>, <H> ) . . relator matrix
#M . . . . . . . . . . . . for the abelianized normal closure of a subgroup
##
## 'RelatorMatrixAbelianizedNormalClosureRrs' uses the Reduced Reidemeister-
## Schreier method to compute a matrix of abelianized defining relators for
## the normal closure of a subgroup H of a finitely presented group G.
##
InstallGlobalFunction( RelatorMatrixAbelianizedNormalClosureRrs,
function ( G, H )
local F, # associated free group
fgens, # generators of <F>
hgens, # generators of <H>
fhgens, # their preimages in <F>
grels, # relators of <G>
krels, # relators of normal closure <N>
K, # factor group of F isomorphic to G/N
cosTable, # coset table of <G> by <N>
i, # loop variable
aug; # auxiliary coset table of <G> by <N>
# check the arguments to be a finitely presented group and a subgroup of
# that group.
if not ( IsSubgroupFpGroup( G ) and IsGroupOfFamily( G ) ) then
Error( "<G> must be a finitely presented group" );
fi;
if not IsSubgroupFpGroup( H ) or FamilyObj( H ) <> FamilyObj( G ) then
Error( "<H> must be a subgroup of <G>" );
fi;
# get some local variables
F := FreeGroupOfFpGroup( G );
fgens := GeneratorsOfGroup( F );
grels := RelatorsOfFpGroup( G );
hgens := GeneratorsOfGroup( H );
fhgens := List( hgens, gen -> UnderlyingElement( gen ) );
# construct a factor group K of F isomorphic to the factor group of G by
# the normal closure N of H.
krels := Concatenation( grels, fhgens );
K := F / krels;
# get the coset table of N in G by constructing the coset table of the
# trivial subgroup in K.
cosTable := CosetTable( K, TrivialSubgroup( K ) );
Info( InfoFpGroup, 1, "index is ", Length( cosTable[1] ) );
# # obsolete: No columns should be equal!
# for i in [ 1 .. Length( fgens ) ] do
# if IsIdenticalObj( cosTable[2*i-1], cosTable[2*i] ) then
# Error( "there is a bug in RelatorMatrixAbelianizedNormalClosureRrs" );
# fi; od;
# apply the Reduced Reidemeister-Schreier method to construct a coset
# table presentation of N.
aug := AugmentedCosetTableRrs( G, cosTable, 0, "_x" );
# determine a set of abelianized subgroup relators.
aug.subgroupRelators := RewriteAbelianizedSubgroupRelators( aug,
aug.groupRelators);
return aug.subgroupRelators;
end );
RelatorMatrixAbelianizedNormalClosure :=
RelatorMatrixAbelianizedNormalClosureRrs;
#############################################################################
##
#M RelatorMatrixAbelianizedSubgroupRrs( <G>, <H> ) . . . relator matrix for
#M RelatorMatrixAbelianizedSubgroupRrs( <G>, <costab> ) . . an abelianized
#M . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . subgroup
##
## 'RelatorMatrixAbelianizedSubgroupRrs' uses the Reduced Reidemeister-
## Schreier method to compute a matrix of abelianized defining relators for
## a subgroup H of a finitely presented group G.
##
## Alternatively to a finitely presented group, the subgroup H may be given
## by its coset table.
##
InstallGlobalFunction( RelatorMatrixAbelianizedSubgroupRrs, function ( G, H )
local aug, table;
# check G to be a finitely presented group.
if not ( IsSubgroupFpGroup( G ) and IsGroupOfFamily( G ) ) then
Error( "<group> must be a finitely presented group" );
fi;
# check the second argument to be a subgroup or a coset table of G, and
# get the coset table in either case.
if not IsSubgroupFpGroup( H ) or FamilyObj( H ) <> FamilyObj( G ) then
# check the given table to be a legal coset table.
table := H;
CheckCosetTableFpGroup( G, table );
# ensure that it is standardized.
if not IsStandardized( table) then Print(
"#I Warning: the given coset table is not standardized,\n",
"#I a standardized copy will be used instead.\n" );
StandardizeTable( StructuralCopy( table ) );
fi;
else
# construct the coset table of H in G if it is not yet available.
if not HasCosetTableInWholeGroup( H ) then
Info( InfoFpGroup, 1, "index is ", IndexInWholeGroup( H ) );
fi;
table := CosetTableInWholeGroup( H );
fi;
# apply the Reduced Reidemeister-Schreier method to construct an
# augmented coset table of H.
aug := AugmentedCosetTableRrs( G, table, 0, "_x" );
# determine a set of abelianized subgroup relators.
aug.subgroupRelators := RewriteAbelianizedSubgroupRelators( aug,
aug.groupRelators);
return aug.subgroupRelators;
end );
#############################################################################
##
#M RenumberTree( <augmented coset table> ) . . . . . renumber generators in
#M augmented coset table
##
## 'RenumberTree' is a subroutine of the Reduced Reidemeister-Schreier
## routines. It renumbers the generators such that the primary generators
## precede the secondary ones.
##
InstallGlobalFunction( RenumberTree, function ( aug )
local coFacTable, column, convert, defs, i, index, j, k, null, numcols,
numgens, tree, tree1, tree2, treelength, treesize;
# get factor table, generators, and tree.
coFacTable := aug.cosetFactorTable;
defs := aug.primaryGeneratorWords;
tree := aug.tree;
# truncate the tree, if necessary.
treelength := tree[3];
treesize := Length( tree[1] );
if treelength < treesize then
tree[1] := tree[1]{ [ 1 .. treelength ] };
tree[2] := tree[2]{ [ 1 .. treelength ] };
fi;
# initialize some local variables.
numcols := Length( coFacTable );
index := Length( coFacTable[1] );
numgens := Length( defs );
# establish a local renumbering list.
convert := ListWithIdenticalEntries( 2 * treelength + 1, 0 );
null := treelength + 1;
j := treelength + 1; k := numgens + 1;
i := treelength;
while i >= 1 do
if tree[1][i] = 0 then
k := k - 1; convert[null+i] := k; convert[null-i] := - k;
else
j := j - 1; convert[null+i] := j; convert[null-i] := - j;
tree[1][j] := tree[1][i]; tree[2][j] := tree[2][i];
fi;
i := i - 1;
od;
if convert[null+numgens] <> numgens then
# change the tree entries accordingly.
for i in [1..numgens] do
tree[1][i] := 0; tree[2][i] := 0;
od;
tree1 := tree[1]; tree2 := tree[2];
for j in [numgens+1..treelength] do
tree1[j] := convert[null+tree1[j]];
tree2[j] := convert[null+tree2[j]];
od;
# change the factor table entries accordingly.
for i in [1..numcols] do
# --------------
# obsolete condition: columns should never be equal.
# if i mod 2 = 1 or
# not IsIdenticalObj( coFacTable[i], coFacTable[i-1] ) then
if i > 1 and IsIdenticalObj( coFacTable[i], coFacTable[i-1] ) then
Error( "there is a bug in RenumberTree" ); fi;
# --------------
column := coFacTable[i];
for j in [1..index] do
column[j] := convert[null+column[j]];
od;
od;
fi;
end );
#############################################################################
##
#M RewriteAbelianizedSubgroupRelators( <aug>,<prels> ) . rewrite abelianized
#M . . . . . . . . . . . . . subgroup relators from an augmented coset table
##
## 'RewriteAbelianizedSubgroupRelators' is a subroutine of the Reduced
## Reidemeister-Schreier and the Modified Todd-Coxeter routines. It computes
## a set of subgroup relators from the coset factor table of an augmented
## coset table of type 0 and the relators <prels> of the parent group.
##
InstallGlobalFunction( RewriteAbelianizedSubgroupRelators,
function ( aug,prels )
local app2, coFacTable, cols, cosTable, factor, ggensi, grel,greli, i,
index, j, length, nums, numgens, numrels, p, rels, total, tree,
treelength, type,si,ei,nneg,word;
# check the type for being zero.
type := aug.type;
if type <> 0 then
Error( "type of augmented coset table is not zero" );
fi;
# initialize some local variables.
ggensi := List(aug.groupGenerators,i->AbsInt(LetterRepAssocWord(i)[1]));
cosTable := aug.cosetTable;
coFacTable := aug.cosetFactorTable;
index := Length( cosTable[1] );
tree := aug.tree;
treelength := tree[3];
numgens := tree[4];
total := numgens;
rels := List( [ 1 .. total ],
i -> ListWithIdenticalEntries( numgens, 0 ) );
numrels := 0;
# display some information.
Info( InfoFpGroup, 2, "index is ", index );
Info( InfoFpGroup, 2, "number of generators is ", numgens );
Info( InfoFpGroup, 2, "tree length is ", treelength );
# initialize the structure that is passed to 'ApplyRel2'
app2 := ListWithIdenticalEntries( 9, 0 );
app2[5] := type;
app2[6] := coFacTable;
app2[8] := tree;
# loop over all group relators
for greli in [1..Length(prels)] do
CompletionBar(InfoFpGroup,2,"Relator Loop:",greli/Length(prels));
grel:=prels[greli];
# get two copies of the group relator, one as a list of words in the
# factor table columns and one as a list of words in the coset table
# column numbers.
length := Length( grel );
if length>0 then
nums := [ ]; nums[2*length] := 0;
cols := [ ]; cols[2*length] := 0;
i:=0;
# for si in [ 1 .. NrSyllables(grel) ] do
# p:=2*Position(ggensi,GeneratorSyllable(grel,si));
# nneg:=ExponentSyllable(grel,si)>0;
# for ei in [1..AbsInt(ExponentSyllable(grel,si))] do
# i:=i+1;
# if nneg then
# nums[2*i] := p-1;
# nums[2*i-1] := p;
# cols[2*i] := cosTable[p-1];
# cols[2*i-1] := cosTable[p];
# else
# nums[2*i] := p;
# nums[2*i-1] := p-1;
# cols[2*i] := cosTable[p];
# cols[2*i-1] := cosTable[p-1];
# fi;
# od;
# od;
word:=LetterRepAssocWord(grel);
for si in [1..Length(word)] do
p:=2*Position(ggensi,AbsInt(word[si]));
i:=i+1;
if word[si]>0 then
nums[2*i]:=p-1;
nums[2*i-1]:=p;
cols[2*i]:=cosTable[p-1];
cols[2*i-1]:=cosTable[p];
else
nums[2*i]:=p;
nums[2*i-1]:=p-1;
cols[2*i]:=cosTable[p];
cols[2*i-1]:=cosTable[p-1];
fi;
od;
# loop over all cosets and determine the subgroup relators which are
# induced by the current group relator.
for i in [ 1 .. index ] do
# scan the ith coset through the current group relator and
# collect the factors of its invers (!) in rel.
numrels := numrels + 1;
if numrels > total then
total := total + 1;
rels[total] := ListWithIdenticalEntries( numgens, 0 );
fi;
app2[7] := rels[numrels];
app2[1] := 2;
app2[2] := i;
app2[3] := 2 * length - 1;
app2[4] := i;
ApplyRel2( app2, cols, nums );
# add the resulting subgroup relator to rels.
numrels := AddAbelianRelator( rels, numrels );
od;
fi;
od;
CompletionBar(InfoFpGroup,2,"Relator Loop:",false);
# loop over all primary subgroup generators.
for j in [ 1 .. numgens ] do
CompletionBar(InfoFpGroup,2,"Generator Loop:",j/numgens);
# get two copies of the subgroup generator, one as a list of words in
# the factor table columns and one as a list of words in the coset
# table column numbers.
grel := aug.primaryGeneratorWords[j];
length := Length( grel );
if length>0 then
nums := [ ]; nums[2*length] := 0;
cols := [ ]; cols[2*length] := 0;
i:=0;
# for si in [ 1 .. NrSyllables(grel) ] do
# p:=2*Position(ggensi,GeneratorSyllable(grel,si));
# nneg:=ExponentSyllable(grel,si)>0;
# for ei in [1..AbsInt(ExponentSyllable(grel,si))] do
# i:=i+1;
# if nneg then
# nums[2*i] := p-1;
# nums[2*i-1] := p;
# cols[2*i] := cosTable[p-1];
# cols[2*i-1] := cosTable[p];
# else
# nums[2*i] := p;
# nums[2*i-1] := p-1;
# cols[2*i] := cosTable[p];
# cols[2*i-1] := cosTable[p-1];
# fi;
# od;
# od;
word:=LetterRepAssocWord(grel);
for si in [1..Length(word)] do
p:=2*Position(ggensi,AbsInt(word[si]));
i:=i+1;
if word[si]>0 then
nums[2*i]:=p-1;
nums[2*i-1]:=p;
cols[2*i]:=cosTable[p-1];
cols[2*i-1]:=cosTable[p];
else
nums[2*i]:=p;
nums[2*i-1]:=p-1;
cols[2*i]:=cosTable[p];
cols[2*i-1]:=cosTable[p-1];
fi;
od;
# scan coset 1 through the current subgroup generator and collect the
# factors of its invers (!) in rel.
numrels := numrels + 1;
if numrels > total then
total := total + 1;
rels[total] := ListWithIdenticalEntries( numgens, 0 );
fi;
app2[7] := rels[numrels];
app2[1] := 2;
app2[2] := 1;
app2[3] := 2 * length - 1;
app2[4] := 1;
ApplyRel2( app2, cols, nums );
else
# trivial generator
numrels := numrels + 1;
if numrels > total then
total := total + 1;
rels[total] := ListWithIdenticalEntries( numgens, 0 );
fi;
fi;
# add as last factor the generator number j.
rels[numrels][j] := rels[numrels][j] + 1;
# add the resulting subgroup relator to rels.
numrels := AddAbelianRelator( rels, numrels );
od;
# reduce the relator list to its proper size.
if numrels < numgens then
for i in [ numrels + 1 .. numgens ] do
rels[i] := ListWithIdenticalEntries( numgens, 0 );
od;
numrels := numgens;
fi;
for i in [ numrels + 1 .. total ] do
Unbind( rels[i] );
od;
CompletionBar(InfoFpGroup,2,"Generator Loop:",false);
return rels;
end );
#############################################################################
##
#M RewriteSubgroupRelators( <aug>, <prels> [,<indices>] )
##
## 'RewriteSubgroupRelators' is a subroutine of the Reduced Reidemeister-
## Schreier and the Modified Todd-Coxeter routines. It computes a set of
## subgroup relators from the coset factor table of an augmented coset table
## and the relators <prels> of the parent group. It assumes that <aug>
## is an augmented coset table of type 2.
## If <indices> are given only those cosets are used
##
InstallGlobalFunction( RewriteSubgroupRelators,
function (arg)
local app2, coFacTable, cols, convert, cosTable, factor, ggensi,
greli,grel, i, index, j, last, length, nums, numgens, p, rel, rels,
treelength, type,si,nneg,ei,word,aug,prels,indices;
aug:=arg[1];
prels:=arg[2];
# check the type.
type := aug.type;
if type <> 2 then Error( "invalid type; it should be 2" ); fi;
# initialize some local variables.
ggensi := List(aug.groupGenerators,i->AbsInt(LetterRepAssocWord(i)[1]));
cosTable := aug.cosetTable;
coFacTable := aug.cosetFactorTable;
index := Length( cosTable[1] );
if Length(arg)=2 then
indices:=[1..index];
else
indices:=arg[3];
fi;
rels := [ ];
# initialize the structure that is passed to 'ApplyRel2'
app2 := ListWithIdenticalEntries( 9, 0 );
app2[5] := type;
app2[6] := coFacTable;
app2[7] := [ ]; app2[7][100] := 0;
# loop over all group relators
for greli in [1..Length(prels)] do
CompletionBar(InfoFpGroup,2,"Relator Loop:",greli/Length(prels));
grel:=prels[greli];
length := Length( grel );
if length > 0 then
# get two copies of the group relator, one as a list of words in the
# factor table columns and one as a list of words in the coset table
# column numbers.
nums := [ ]; nums[2*length] := 0;
cols := [ ]; cols[2*length] := 0;
i:=0;
# for si in [ 1 .. NrSyllables(grel) ] do
# p:=2*Position(ggensi,GeneratorSyllable(grel,si));
# nneg:=ExponentSyllable(grel,si)>0;
# for ei in [1..AbsInt(ExponentSyllable(grel,si))] do
# i:=i+1;
# if nneg then
# nums[2*i] := p-1;
# nums[2*i-1] := p;
# cols[2*i] := cosTable[p-1];
# cols[2*i-1] := cosTable[p];
# else
# nums[2*i] := p;
# nums[2*i-1] := p-1;
# cols[2*i] := cosTable[p];
# cols[2*i-1] := cosTable[p-1];
# fi;
# od;
# od;
word:=LetterRepAssocWord(grel);
for si in [1..Length(word)] do
p:=2*Position(ggensi,AbsInt(word[si]));
i:=i+1;
if word[si]>0 then
nums[2*i]:=p-1;
nums[2*i-1]:=p;
cols[2*i]:=cosTable[p-1];
cols[2*i-1]:=cosTable[p];
else
nums[2*i]:=p;
nums[2*i-1]:=p-1;
cols[2*i]:=cosTable[p];
cols[2*i-1]:=cosTable[p-1];
fi;
od;
# loop over all cosets and determine the subgroup relators which are
# induced by the current group relator.
for i in indices do
# scan the ith coset through the current group relator and
# collect the factors of its inverse (!) in rel.
app2[1] := 2;
app2[2] := i;
app2[3] := 2 * length - 1;
app2[4] := i;
ApplyRel2( app2, cols, nums );
# add the resulting subgroup relator to rels.
rel := app2[7];
last := Length( rel );
if last > 0 then
MakeCanonical( rel );
if Length( rel ) > 0 and not rel in rels then
AddSet( rels, Immutable(CopyRel( rel ) ));
fi;
fi;
od;
fi;
od;
CompletionBar(InfoFpGroup,2,"Relator Loop:",false);
# loop over all primary subgroup generators.
numgens := Length( aug.primaryGeneratorWords );
for j in [ 1 .. numgens ] do
CompletionBar(InfoFpGroup,2,"Generator Loop:",j/numgens);
# get two copies of the subgroup generator, one as a list of words in
# the factor table columns and one as a list of words in the coset
# table column numbers.
grel := aug.primaryGeneratorWords[j];
length := Length( grel );
if length>0 then
nums := [ ]; nums[2*length] := 0;
cols := [ ]; cols[2*length] := 0;
i:=0;
# for si in [ 1 .. NrSyllables(grel) ] do
# p:=2*Position(ggensi,GeneratorSyllable(grel,si));
# nneg:=ExponentSyllable(grel,si)>0;
# for ei in [1..AbsInt(ExponentSyllable(grel,si))] do
# i:=i+1;
# if nneg then
# nums[2*i] := p-1;
# nums[2*i-1] := p;
# cols[2*i] := cosTable[p-1];
# cols[2*i-1] := cosTable[p];
# else
# nums[2*i] := p;
# nums[2*i-1] := p-1;
# cols[2*i] := cosTable[p];
# cols[2*i-1] := cosTable[p-1];
# fi;
# od;
# od;
word:=LetterRepAssocWord(grel);
for si in [1..Length(word)] do
p:=2*Position(ggensi,AbsInt(word[si]));
i:=i+1;
if word[si]>0 then
nums[2*i]:=p-1;
nums[2*i-1]:=p;
cols[2*i]:=cosTable[p-1];
cols[2*i-1]:=cosTable[p];
else
nums[2*i]:=p;
nums[2*i-1]:=p-1;
cols[2*i]:=cosTable[p];
cols[2*i-1]:=cosTable[p-1];
fi;
od;
# scan coset 1 through the current subgroup generator and collect the
# factors of its inverse (!) in rel.
app2[1] := 2;
app2[2] := 1;
app2[3] := 2 * length - 1;
app2[4] := 1;
ApplyRel2( app2, cols, nums );
# add as last factor the generator number j.
rel := app2[7];
last := Length( rel );
if last > 0 and rel[last] = - j then
last := last - 1;
rel := rel{ [1 .. last] };
else
last := last + 1;
rel[last] := j;
fi;
# add the resulting subgroup relator to rels.
if last > 0 then
MakeCanonical( rel );
if Length( rel ) > 0 and not rel in rels then
AddSet( rels, Immutable(CopyRel(rel)));
fi;
fi;
else
# trivial generator
AddSet(rels,[j]);
fi;
od;
CompletionBar(InfoFpGroup,2,"Generator Loop:",false);
# make mutable again to overwrite
rels:=List(rels,ShallowCopy);
# renumber the generators in the relators, if necessary.
numgens := Length( aug.subgroupGenerators );
treelength := Length( aug.tree[1] );
if numgens < treelength then
convert := aug.conversionList;
for rel in rels do
for i in [ 1 .. Length( rel ) ] do
if rel[i] > 0 then
rel[i] := convert[rel[i]];
else
rel[i] := - convert[-rel[i]];
fi;
od;
od;
fi;
return rels;
end );
#############################################################################
##
#M SortRelsSortedByStartGen(<relsGen>) sort the relators sorted by start gen
##
## 'SortRelsSortedByStartGen' sorts the relators lists sorted by starting
## generator to get better results of the Reduced Reidemeister-Schreier
## (this is not needed for the Felsch Todd-Coxeter).
##
InstallGlobalFunction( SortRelsSortedByStartGen,
function ( relsGen )
local less, list;
# 'less' defines an ordering on the triples [ nums, cols, startpos ]
less := function ( triple1, triple2 )
local diff, i, k, nums1, nums2;
if triple1[1][1] <> triple2[1][1] then
return triple1[1][1] < triple2[1][1];
fi;
nums1 := triple1[1]; nums2 := triple2[1];
i := triple1[3];
diff := triple2[3] - i;
k := i + nums1[1] + 2;
while i < k do
if nums1[i] <> nums2[i+diff] then
return nums1[i] < nums2[i+diff];
fi;
i := i + 2;
od;
return false;
end;
# sort the resulting lists
for list in relsGen do
Sort( list, less );
od;
end );
#############################################################################
##
#M SpanningTree( <coset table> ) . . . . . . . . . . . . . . . spanning tree
##
## 'SpanningTree' returns a spanning tree for the given coset table.
##
InstallGlobalFunction( SpanningTree, function ( cosTable )
local done, i, j, k, numcols, numrows, span1, span2;
# check the given argument to be a coset table.
if not ( IsList( cosTable ) and IsList( cosTable[1] ) ) then
Error( "argument must be a coset table" );
fi;
numcols := Length( cosTable );
numrows := Length( cosTable[1] );
for i in [ 2 .. numcols ] do
if not ( IsList( cosTable[i] ) and
Length( cosTable[i] ) = numrows ) then
Error( "argument must be a coset table" );
fi;
od;
# initialize the spanning tree.
span1 := [ -1, -2 .. -numrows ];
span2 := ListWithIdenticalEntries( numrows, 0 );
span1[1] := 0;
if numrows = 1 then return [ span1, span2 ]; fi;
# find the first occurrence in the table of each coset > 1.
done := [ 1 ];
for i in done do
for j in [ 1 .. numcols ] do
k := cosTable[j][i];
if span1[k] < 0 then
span1[k] := i; span2[k] := j;
Add( done, k );
if Length( done ) = numrows then
return [ span1, span2 ];
fi;
fi;
od;
od;
# you should never come here, the argument is not a valid coset table.
Error( "argument must be a coset table" );
end );
#############################################################################
##
## Extensions for rewriting and homomorphisms
##
#############################################################################
##
#F RewriteWord( <aug>, <word> )
##
InstallGlobalFunction(RewriteWord,function ( aug, word )
local cft, ct, w,l,c,i,j,g,e,ind;
# check the type.
Assert(1,aug.type=2);
# initialize some local variables.
ct := aug.cosetTable;
cft := aug.cosetFactorTable;
# translation table for group generators to numbers
if not IsBound(aug.transtab) then
# should do better, also cope with inverses
aug.transtab:=List(aug.groupGenerators,i->AbsInt(LetterRepAssocWord(i)[1]));
fi;
w:=[];
c:=1; # current coset
#for i in [1..NrSyllables(word)] do
# g:=GeneratorSyllable(word,i);
# e:=ExponentSyllable(word,i);
# if e<0 then
# ind:=2*aug.transtab[g];
# e:=-e;
# else
# ind:=2*aug.transtab[g]-1;
# fi;
# for j in [1..e] do
# # apply the generator, collect cofactor
# if cft[ind][c]<>0 then
# Add(w,cft[ind][c]); #cofactor
# fi;
# c:=ct[ind][c]; # new coset number
# od;
# od;
l:=LetterRepAssocWord(word);
for i in l do
g:=AbsInt(i);
if i<0 then
ind:=2*aug.transtab[g];
else
ind:=2*aug.transtab[g]-1;
fi;
# apply the generator, collect cofactor
if cft[ind][c]<>0 then
Add(w,cft[ind][c]); #cofactor
fi;
c:=ct[ind][c]; # new coset number
od;
# make sure we got back to start
if c<>1 then
return fail;
fi;
return w;
end);
#############################################################################
##
#F DecodedTreeEntry(<tree>,<imgs>,<nr>)
##
InstallGlobalFunction(DecodedTreeEntry,function(tree,imgs,nr)
local eval,t1,t2;
if IsBound(imgs[AbsInt(nr)]) then
if nr>0 then
return imgs[nr];
else
return imgs[-nr]^-1;
fi;
fi;
# as we might not want to construct the full tree, we'll be more specific
if not IsMutable(imgs) then
imgs:=ShallowCopy(imgs); # we will add locally
fi;
t1:=tree[1];
t2:=tree[2];
eval:=function(n)
if not IsBound(imgs[n]) then
imgs[n]:=eval(AbsInt(t1[n]))^SignInt(t1[n])
*eval(AbsInt(t2[n]))^SignInt(t2[n]);
fi;
return imgs[n];
end;
return eval(nr);
end);
#############################################################################
##
#F GeneratorTranslationAugmentedCosetTable(<aug>)
##
## decode the secondary generators as words in the primary generators, using
## the `.subgroupGenerators' and their subset `.primarySubgroupGenerators'.
InstallGlobalFunction(GeneratorTranslationAugmentedCosetTable,function(aug)
local tt,i,t1,t2,tn;
if not IsBound(aug.translationTable) then
if not IsBound(aug.primarySubgroupGenerators) then
aug.primarySubgroupGenerators:=
aug.subgroupGenerators{[1..Length(aug.primaryGeneratorWords)]};
fi;
# now expand the tree to get words for the secondary generators.
# the first elements are just the primary generators
tt:=ShallowCopy(aug.primarySubgroupGenerators);
t1:=aug.tree[1];
t2:=aug.tree[2];
tn:=aug.treeNumbers;
if Length(tn)>0 then
for i in [Length(tt)+1..Maximum(tn)] do
tt[i]:=tt[AbsInt(t1[i])]^SignInt(t1[i])
*tt[AbsInt(t2[i])]^SignInt(t2[i]);
od;
fi;
aug.translationTable:=Immutable(tt);
fi;
return aug.translationTable;
end);
#############################################################################
##
#F SecondaryGeneratorWordsAugmentedCosetTable(<aug>)
##
InstallGlobalFunction(SecondaryGeneratorWordsAugmentedCosetTable,function(aug)
local tt;
if not IsBound(aug.secondaryWords) then
aug.secondaryWords:=Immutable(
List(GeneratorTranslationAugmentedCosetTable(aug),i->
MappedWord(i,aug.primarySubgroupGenerators,aug.primaryGeneratorWords)));
fi;
return aug.secondaryWords;
end);
#############################################################################
##
#F CopiedAugmentedCosetTable(<aug>)
##
## returns a new augmented coset table, equal to the old one. The
## components of this new table are immutable, but new components may be
## added.
## (This function is needed to have different homomorphisms share the same
## augmented coset table data. It must not be applied to augmented coset
## tables which are not of type 2.)
InstallGlobalFunction(CopiedAugmentedCosetTable,function(aug)
local t,j;
if IsBound(aug.isNewAugmentedTable) then
t:=rec(isNewAugmentedTable:=true);
for j in
[ "A", "aug", "ct", "defcount", "from", "homgenims", "homgens",
"index", "n", "offset", "primaryImages", "rels","one","useAddition",
"secondary", "secount", "secondaryImages", "subgens" ] do
if IsBound(aug.(j)) then
t.(j):=aug.(j);
fi;
od;
else
# old version
t:=rec(
isAugmentedCosetTable:=true,
type:=aug.type,
tableType:=aug.tableType,
groupGenerators:=aug.groupGenerators,
groupRelators:=aug.groupRelators,
cosetTable:=aug.cosetTable,
cosetFactorTable:=aug.cosetFactorTable,
primaryGeneratorWords:=aug.primaryGeneratorWords,
tree:=aug.tree,
treeNumbers:=aug.treeNumbers,
numberOfSubgroupGenerators:=aug.numberOfSubgroupGenerators,
nameOfSubgroupGenerators:=aug.nameOfSubgroupGenerators,
subgroupGenerators:=aug.subgroupGenerators
);
if IsBound(aug.secondaryWords) then
t.secondaryWords:=Immutable(aug.secondaryWords);
fi;
if IsBound(aug.conversionList) then
t.conversionList:=aug.conversionList;
fi;
if IsBound(aug.primarySubgroupGenerators) then
t.primarySubgroupGenerators:=Immutable(aug.primarySubgroupGenerators);
fi;
if IsBound(aug.subgroupRelators) then
t.subgroupRelators:=Immutable(aug.subgroupRelators);
fi;
if IsBound(aug.translationTable) then
t.translationTable:=Immutable(aug.translationTable);
fi;
fi;
return t;
end);
# New implemention of the Modified Todd-Coxeter (MTC) algorithm, based on
# Chapter 5 of the "Handbook of Computational Group Theory", by Derek F.
# Holt (refered # to as "Handbook" from here on). Function names after the
# NEWTC_ agree with those of sections 5.2, 5.3 of the Handbook.
NEWTC_AddDeduction:=function(list,ded)
if not ded in list then
Add(list,ded);
fi;
end;
# the tables produced internally are indexed at rec.offset+k for generator
# number k, that is in the form ...,-2,-1,empty,1,2,...
# This avoids lots of even/od decisions and the cost of the empty list is
# neglegible.
NEWTC_Compress:=function(DATA,purge)
local ct,c,a,b,offset,x,to,p,dw,doa,aug;
doa:=DATA.augmented;
dw:=IsBound(DATA.with);
ct:=DATA.ct;
if doa then
aug:=DATA.aug;
fi;
p:=DATA.p;
offset:=DATA.offset;
c:=0;
to:=[];
for a in [1..DATA.n] do
if p[a]=a then
c:=c+1;
to[a]:=c;
if c<>a then
for x in DATA.A do
if ct[x+offset][a]<>0 then;
b:=ct[x+offset][a];
if b=a then b:=c;fi;
ct[x+offset][c]:=b;
ct[-x+offset][b]:=c;
if doa then
# transfer augemented entry
aug[x+offset][c]:=aug[x+offset][a];
fi;
else
# clear out
ct[x+offset][c]:=0;
if doa then
Unbind(aug[x+offset][c]);
fi;
fi;
od;
if dw then
DATA.with[c]:=DATA.with[a];
b:=DATA.from[a];
while b<>to[b] do
b:=to[b];
od;
DATA.from[c]:=b;
fi;
fi;
else
b:=a;
while p[b]<>b do
b:=p[b];
od;
to[a]:=b;
fi;
od;
if purge then
for x in DATA.A do
for a in [Length(ct[x+offset]),Length(ct[x+offset])-1..c+1] do
Unbind(ct[x+offset][a]);
if doa then
Unbind(aug[x+offset][a]);
fi;
od;
od;
if dw then
for a in [Length(DATA.with),Length(DATA.with)-1..c+1] do
Unbind(DATA.with[a]);
Unbind(DATA.from[a]);
od;
fi;
fi;
if IsBound(DATA.ds) then
for x in DATA.ds do
a:=to[x[1]];
while x[1]<>a do
x[1]:=a;
a:=to[a];
od;
od;
Assert(2,Maximum(List(DATA.ds,x->x[1]))<=c);
fi;
DATA.n:=c;
DATA.p:=[1..DATA.n];
if doa then
DATA.pp:=ListWithIdenticalEntries(DATA.n,DATA.one);
fi;
DATA.dead:=0;
end;
NEWTC_Define:=function(DATA,i,a)
# both augmented or not
local c,o,n,j,au;
n:=DATA.n;
o:=DATA.offset;
c:=DATA.ct;
n:=n+1;
DATA.n:=n;
if n>DATA.limit then
if ValueOption("quiet")=true then return fail;fi;
Error( "the coset enumeration has defined more ",
"than ", DATA.limit, " cosets\n");
DATA.limit:=DATA.limit*2;
DATA.limtrigger:=Int(9/10*DATA.limit);
fi;
DATA.p[n]:=n;
# clear out
for j in DATA.A do
c[j+o][n]:=0;
od;
c[o+a][i]:=n;
c[o-a][n]:=i;
if DATA.augmented then
DATA.aug[o+a][i]:=DATA.one;
DATA.aug[o-a][n]:=DATA.one;
DATA.pp[n]:=DATA.one;
fi;
NEWTC_AddDeduction(DATA.deductions,[i,a]);
#if IsBound(DATA.ds) then Add(DATA.ds,[i,a]); fi;
DATA.defcount:=DATA.defcount+1;
if IsBound(DATA.with) then
if DATA.with[i]=-a then Error("bleh!");fi;
DATA.with[n]:=a;
DATA.from[n]:=i;
fi;
#ForAny(DATA.A,x->ForAny([1..Length(c[x+o])],y->not
# IsBound(c[x+o][y]))) then
# Error("hehe");
#fi;
return true; # indicating no quiet fail
end;
NEWTC_Coincidence:=function(DATA,a,b)
local Rep,Merge,ct,offset,l,q,i,c,x,d,p,mu,nu;
if a=b then return;fi;
Rep:=function(kappa)
local lambda,rho,mu;
lambda:=kappa;
rho:=p[lambda];
while rho<>lambda do
lambda:=rho;rho:=p[lambda];
od;
mu:=kappa;rho:=p[mu];
while rho<>lambda do
p[mu]:=lambda;mu:=rho;rho:=p[mu];
od;
return lambda;
end;
Merge:=function(k,a)
local phi,psi,mu,nu;
phi:=Rep(k);
psi:=Rep(a);
if phi<>psi then
mu:=Minimum(phi,psi);
nu:=Maximum(phi,psi);
p[nu]:=mu;
l:=l+1;
q[l]:=nu;
DATA.dead:=DATA.dead+1;
fi;
end;
ct:=DATA.ct;
offset:=DATA.offset;
p:=DATA.p;
l:=0;
q:=[];
Merge(a,b);i:=1;
while i<=l do
c:=q[i];
i:=i+1;
#RemoveSet(DATA.omega,c);
for x in DATA.A do
if ct[x+offset][c]<>0 then
d:=ct[x+offset][c];
ct[x+offset][c]:=0;
ct[-x+offset][d]:=0;
mu:=Rep(c);
nu:=Rep(d);
if ct[x+offset][mu]<>0 then
Merge(nu,ct[x+offset][mu]);
elif ct[-x+offset][nu]<>0 then
Merge(mu,ct[-x+offset][nu]);
else
ct[x+offset][mu]:=nu;
ct[-x+offset][nu]:=mu;
NEWTC_AddDeduction(DATA.deductions,[mu,x]);
fi;
fi;
od;
od;
end;
NEWTC_ModifiedCoincidence:=function(DATA,a,b,w)
local MRep,MMerge,ct,offset,l,q,i,c,x,d,p,pp,mu,nu,aug,v,Sekundant;
# decide whether secondary generators will be introduced
Sekundant:=function(w)
if Length(w)<=1 or DATA.useAddition then
return w;
fi;
DATA.secount:=DATA.secount+1;
DATA.secondary[DATA.secount]:=w;
return [DATA.secount];
end;
MRep:=function(kappa)
local lambda,rho,mu,s;
lambda:=kappa;
rho:=p[lambda];
if rho=lambda then return lambda; fi;
s:=DATA.s; # re-used array to trace back compression path
while rho<>lambda do
s[rho]:=lambda;
lambda:=rho;rho:=p[lambda];
od;
rho:=s[lambda];
while rho<>kappa do
mu:=rho;
rho:=s[mu];
p[rho]:=lambda;
if DATA.useAddition then
pp[rho]:=pp[rho]+pp[mu];
else
pp[rho]:=Sekundant(WordProductLetterRep(pp[rho],pp[mu]));
fi;
od;
return lambda;
end;
MMerge:=function(k,a,w)
local phi,psi,mu,nu;
phi:=MRep(k);
psi:=MRep(a);
if phi>psi then
p[phi]:=psi;
if DATA.useAddition then
pp[phi]:=-pp[k]+w+pp[a];
else
pp[phi]:=Sekundant(WordProductLetterRep(-Reversed(pp[k]),w,pp[a]));
fi;
l:=l+1;
q[l]:=phi;
DATA.dead:=DATA.dead+1;
elif psi>phi then
p[psi]:=phi;
if DATA.useAddition then
pp[psi]:=-pp[a]-w+pp[k];
else
pp[psi]:=Sekundant(WordProductLetterRep(-Reversed(pp[a]),-Reversed(w),pp[k]));
fi;
l:=l+1;
q[l]:=psi;
DATA.dead:=DATA.dead+1;
fi;
end;
ct:=DATA.ct;
aug:=DATA.aug;
offset:=DATA.offset;
p:=DATA.p;
pp:=DATA.pp;
l:=0;
q:=[];
MMerge(a,b,w);i:=1;
while i<=l do
c:=q[i];
i:=i+1;
for x in DATA.A do
if ct[x+offset][c]<>0 then
d:=ct[x+offset][c];
ct[-x+offset][d]:=0;
mu:=MRep(c);
nu:=MRep(d);
if ct[x+offset][mu]<>0 then
if DATA.useAddition then
v:=-pp[d]-aug[x+offset][c]+pp[c]+aug[x+offset][mu];
else
v:=WordProductLetterRep(-Reversed(pp[d]),-Reversed(aug[x+offset][c]),
pp[c],aug[x+offset][mu]);
fi;
MMerge(nu,ct[x+offset][mu],v);
elif ct[-x+offset][nu]<>0 then
if DATA.useAddition then
v:=-pp[c]+aug[x+offset][c]+pp[d]+aug[-x+offset][nu];
else
v:=WordProductLetterRep(-Reversed(pp[c]),aug[x+offset][c],
pp[d],aug[-x+offset][nu]);
fi;
MMerge(mu,ct[-x+offset][nu],v);
else
ct[x+offset][mu]:=nu;
ct[-x+offset][nu]:=mu;
if DATA.useAddition then
v:=-pp[c]+aug[x+offset][c]+pp[d];
aug[x+offset][mu]:=v;
aug[-x+offset][nu]:=-v;
else
v:=WordProductLetterRep(-Reversed(pp[c]),aug[x+offset][c],pp[d]);
aug[x+offset][mu]:=v;
aug[-x+offset][nu]:=-Reversed(v);
fi;
NEWTC_AddDeduction(DATA.deductions,[mu,x]);
fi;
fi;
od;
od;
# pp is not needed any longer
for i in q do
Unbind(pp[i]);
od;
end;
# superseded by kernel function TC_QUICK_SCAN, left here for debugging purposes.
NEWTC_QuickScanLibraryVersion:=function(c,offset,alpha,w)
local f,b,r,i,j;
f:=alpha;i:=1;
r:=Length(w);
# forward scan
while i<=r and c[w[i]+offset][f]<>0 do
f:=c[w[i]+offset][f];
i:=i+1;
od;
if i>r then
if f<>alpha then
w[1]:=i;w[2]:=f;
return true;
fi;
return false;
fi;
#backward scan
b:=alpha;j:=r;
while j>=i and c[-w[j]+offset][b]<>0 do
b:=c[-w[j]+offset][b];
j:=j-1;
od;
if j<=i then
w[1]:=i;w[2]:=f;w[3]:=j;w[4]:=b;
return true;
fi;
return false;
end;
NEWTC_Scan:=function(DATA,alpha,w)
local c,offset,f,b,r,i,j,t;
c:=DATA.ct;
offset:=DATA.offset;
t:=TC_QUICK_SCAN(c,offset,alpha,w,DATA.scandata);
if t=false then return; fi;
r:=Length(w);
i:=DATA.scandata[1]; # result of forward scan
f:=DATA.scandata[2];
if i>r then
if f<>alpha then
NEWTC_Coincidence(DATA,f,alpha);
fi;
return;
fi;
j:=DATA.scandata[3]; # result of backward scan
b:=DATA.scandata[4];
if j<i then
NEWTC_Coincidence(DATA,f,b);
elif j=i then
# deduction
c[w[i]+offset][f]:=b;
c[-w[i]+offset][b]:=f;
NEWTC_AddDeduction(DATA.deductions,[f,w[i]]);
fi;
return;
# the following is the original, old, code including loops. It is left here
# for debugging purposes
# f:=alpha;i:=1;
# r:=Length(w);
# # forward scan
# while i<=r and c[w[i]+offset][f]<>0 do
# f:=c[w[i]+offset][f];
# i:=i+1;
# od;
# if i>r then
# if f<>alpha then
# Coincidence(DATA,f,alpha);
# fi;
# return;
# fi;
#
# #backward scan
# b:=alpha;j:=r;
# while j>=i and c[-w[j]+offset][b]<>0 do
# b:=c[-w[j]+offset][b];
# j:=j-1;
# od;
# if j<i then
# Coincidence(DATA,f,b);
# elif j=i then
# # deduction
# c[w[i]+offset][f]:=b;
# c[-w[i]+offset][b]:=f;
# Add(DATA.deductions,[f,w[i]]);
# fi;
end;
NEWTC_ModifiedScan:=function(DATA,alpha,w,y)
local c,offset,f,b,r,i,j,fp,bp,t;
#Info(InfoFpGroup,3,"MS",alpha,w,y,"\n");
c:=DATA.ct;
offset:=DATA.offset;
t:=TC_QUICK_SCAN(c,offset,alpha,w,DATA.scandata);
if t=false then return; fi;
f:=alpha;i:=1;
fp:=DATA.one;
r:=Length(w);
# forward scan
while i<=r and c[w[i]+offset][f]<>0 do
if DATA.useAddition then
fp:=fp+DATA.aug[w[i]+offset][f];
else
fp:=WordProductLetterRep(fp,DATA.aug[w[i]+offset][f]);
fi;
f:=c[w[i]+offset][f];
i:=i+1;
od;
if i>r then
if f<>alpha then
if DATA.useAddition then
NEWTC_ModifiedCoincidence(DATA,f,alpha,-fp+y);
else
NEWTC_ModifiedCoincidence(DATA,f,alpha,WordProductLetterRep(-Reversed(fp),y));
fi;
fi;
return;
fi;
#Info(InfoFpGroup,3,"MS2\n");
#backward scan
b:=alpha;j:=r;
bp:=y;
while j>=i and c[-w[j]+offset][b]<>0 do
if DATA.useAddition then
bp:=bp+DATA.aug[-w[j]+offset][b];
else
bp:=WordProductLetterRep(bp,DATA.aug[-w[j]+offset][b]);
fi;
b:=c[-w[j]+offset][b];
j:=j-1;
od;
if j<i then
if DATA.useAddition then
NEWTC_ModifiedCoincidence(DATA,f,b,-fp+bp);
else
NEWTC_ModifiedCoincidence(DATA,f,b,WordProductLetterRep(-Reversed(fp),bp));
fi;
elif j=i then
# deduction
c[w[i]+offset][f]:=b;
c[-w[i]+offset][b]:=f;
if DATA.useAddition then
DATA.aug[w[i]+offset][f]:=-fp+bp;
DATA.aug[-w[i]+offset][b]:=-bp+fp;
else
DATA.aug[w[i]+offset][f]:=WordProductLetterRep(-Reversed(fp),bp);
DATA.aug[-w[i]+offset][b]:=WordProductLetterRep(-Reversed(bp),fp);
fi;
NEWTC_AddDeduction(DATA.deductions,[f,w[i]]);
fi;
end;
NEWTC_ScanAndFill:=function(DATA,alpha,w)
local c,offset,f,b,r,i,j;
c:=DATA.ct;
offset:=DATA.offset;
r:=Length(w);
f:=alpha;i:=1;
b:=alpha;j:=r;
while i<=j do
# forward scan
while i<=r and c[w[i]+offset][f]<>0 do
f:=c[w[i]+offset][f];
i:=i+1;
od;
if i>r then
if f<>alpha then
NEWTC_Coincidence(DATA,f,alpha);
fi;
return;
fi;
#backward scan
while j>=i and c[-w[j]+offset][b]<>0 do
b:=c[-w[j]+offset][b];
j:=j-1;
od;
if j<i then
NEWTC_Coincidence(DATA,f,b);
elif j=i then
# deduction
c[w[i]+offset][f]:=b;
c[-w[i]+offset][b]:=f;
NEWTC_AddDeduction(DATA.deductions,[f,w[i]]);
return;
else
NEWTC_Define(DATA,f,w[i]);
fi;
od;
end;
NEWTC_ModifiedScanAndFill:=function(DATA,alpha,w,y)
local c,offset,f,b,r,i,j,fp,bp;
c:=DATA.ct;
offset:=DATA.offset;
f:=alpha;i:=1;
fp:=DATA.one;
r:=Length(w);
b:=alpha;j:=r;
bp:=y;
while i<=j do #N
# forward scan
while i<=r and c[w[i]+offset][f]<>0 do
if DATA.useAddition then
fp:=fp+DATA.aug[w[i]+offset][f];
else
fp:=WordProductLetterRep(fp,DATA.aug[w[i]+offset][f]);
fi;
f:=c[w[i]+offset][f];
i:=i+1;
od;
if i>r then
if f<>alpha then
NEWTC_ModifiedCoincidence(DATA,f,alpha,WordProductLetterRep(-Reversed(fp),y));
fi;
return;
fi;
#backward scan
while j>=i and c[-w[j]+offset][b]<>0 do
if DATA.useAddition then
bp:=bp+DATA.aug[-w[j]+offset][b];
else
bp:=WordProductLetterRep(bp,DATA.aug[-w[j]+offset][b]);
fi;
b:=c[-w[j]+offset][b];
j:=j-1;
od;
if j<i then
if DATA.useAddition then
NEWTC_ModifiedCoincidence(DATA,f,b,-fp+bp);
else
NEWTC_ModifiedCoincidence(DATA,f,b,WordProductLetterRep(-Reversed(fp),bp));
fi;
elif j=i then
# deduction
c[w[i]+offset][f]:=b;
c[-w[i]+offset][b]:=f;
if DATA.useAddition then
DATA.aug[w[i]+offset][f]:=-fp+bp;
DATA.aug[-w[i]+offset][b]:=-bp+fp;
else
DATA.aug[w[i]+offset][f]:=WordProductLetterRep(-Reversed(fp),bp);
DATA.aug[-w[i]+offset][b]:=WordProductLetterRep(-Reversed(bp),fp);
fi;
NEWTC_AddDeduction(DATA.deductions,[f,w[i]]);
return;
else
NEWTC_Define(DATA,f,w[i]);
fi;
od;
end;
NEWTC_ProcessDeductions:=function(DATA)
# both augmented and not
local ded,offset,pair,alpha,x,p,w;
ded:=DATA.deductions;
offset:=DATA.offset;
p:=DATA.p;
while Length(ded)>0 do
pair:=ded[Length(ded)];
Unbind(ded[Length(ded)]);
alpha:=pair[1];x:=pair[2];
if p[alpha]=alpha then
for w in DATA.ccr[x+offset] do
if DATA.augmented then
NEWTC_ModifiedScan(DATA,alpha,w,DATA.one);
else
NEWTC_Scan(DATA,alpha,w);
fi;
if p[alpha]<alpha then
break; # coset has been eliminated
fi;
od;
fi;
# separate 'if' check, as the `break;` only ends innermost loop
if p[alpha]=alpha then
alpha:=DATA.ct[x+offset][alpha]; # beta
if p[alpha]=alpha then
# AH, 9/13/18: It's R^c_{x^-1}, so -x
for w in DATA.ccr[offset-x] do
if DATA.augmented then
NEWTC_ModifiedScan(DATA,alpha,w,DATA.one);
else
NEWTC_Scan(DATA,alpha,w);
fi;
if p[alpha]<alpha then
break; # coset has been eliminated
fi;
od;
fi;
fi;
od;
end;
NEWTC_DoCosetEnum:=function(freegens,freerels,subgens,aug,trace)
local m,offset,rels,ri,ccr,i,r,ct,A,a,w,n,DATA,p,ds,dr,
oldead,with,collapse,j,from,pp,PERCFACT,ap,ordertwo;
# indicate at what change threshold display of coset Nr. should happen
PERCFACT:=ValueOption("display");
if not IsInt(PERCFACT) then PERCFACT:=100; fi;
m:=Length(freegens);
A:=List(freegens,LetterRepAssocWord);
Assert(0,ForAll(A,x->Length(x)=1 and x[1]>0));
if List(A,x->x[1])<>[1..m] then
Error("noncanonical generator order not yet possible");
fi;
offset:=m+1;
rels:=ShallowCopy(freerels);
rels:=Filtered(freerels, x -> Length(x) > 0);
SortBy(rels,Length);
ri:=Union(rels,List(rels,x->x^-1));
ri:=List(ri,LetterRepAssocWord);
SortBy(ri,Length);
A:=Concatenation([1..m],-[1..m]);
# are generators known to be of order 2?
ordertwo:=[];
for i in [1..Length(ri)] do
w:=ri[i];
if Length(w)=2 and Length(Set(w))=1 then
Unbind(ri[i]); # not needed any longer
a:=AbsInt(w[1]);
if not a in ordertwo then
Info(InfoFpGroup,1,"Generator ",a," has order 2");
AddSet(ordertwo,a);
A:=Filtered(A,x->x<>-a);
fi;
fi;
od;
ri:=Filtered(ri,x->IsBound(x));
# cyclic conjugates, sort by first letter
ccr:=List([1..2*m+1],x->[]);
for i in ri do
r:=i;
while not r in ccr[offset+r[1]] do
AddSet(ccr[offset+r[1]],Immutable(r));
r:=Concatenation(r{[2..Length(r)]},r{[1]});
od;
od;
# coset table in slightly different format: row (offset+x) is for
# generator x
ct:=List([1..offset+m],x->[0]);Unbind(ct[offset]);
n:=1;
p:=[1];
collapse:=[];
DATA:=rec(ct:=ct,p:=p,ccr:=ccr,rels:=List(rels,LetterRepAssocWord),
subgens:=subgens,
subgword:=List(subgens,x->LetterRepAssocWord(UnderlyingElement(x))),
n:=n,offset:=offset,A:=A,limit:=2^23,
deductions:=[],dead:=0,defcount:=0,
ordertwo:=ordertwo,s:=[],
# a global list for the kernel scan function to return 4 variables
scandata:=[0,0,0,0]);
i:=ValueOption("limit");
if i<>fail and Int(i)<>fail then
DATA.limit:=i;
fi;
DATA.limtrigger:=Int(9/10*DATA.limit);
if aug<>false then
DATA.isCyclicMtcTable:=false;
DATA.useAddition:=false;
if ValueOption("cyclic")<>fail and Length(subgens)=1 then
DATA.isCyclicMtcTable:=true;
DATA.isAbelianizedMtcTable:=false;
DATA.useAddition:=true;
DATA.one:=0;
elif ValueOption("abelian")<>fail then
DATA.isAbelianizedMtcTable:=true;
DATA.one:=ListWithIdenticalEntries(Length(subgens),0);
DATA.useAddition:=true;
else
DATA.isAbelianizedMtcTable:=false;
DATA.one:=[];
fi;
aug:=List([1..offset+m],x->[]);Unbind(aug[offset]);
pp:=[DATA.one];
DATA.aug:=aug;
DATA.pp:=pp;
DATA.secondary:=[];
DATA.secount:=Length(subgens); # last to be used
DATA.augmented:=true;
else
DATA.augmented:=false;
fi;
for a in ordertwo do
DATA.ct[offset-a]:=DATA.ct[offset+a];
if DATA.augmented then
DATA.aug[offset-a]:=DATA.aug[offset+a];
fi;
od;
if trace<>false then
with:=[0]; # generator by which a coset was defined
DATA.with:=with;
from:=[0];
DATA.from:=from;
fi;
Info( InfoFpGroup, 2, " \t defined\t deleted\t alive\t\t maximal");
for w in [1..Length(subgens)] do
if DATA.augmented then
if DATA.isCyclicMtcTable then
NEWTC_ModifiedScanAndFill(DATA,1,DATA.subgword[w],1);
elif DATA.isAbelianizedMtcTable then
i:=ShallowCopy(DATA.one);
i[w]:=1;
NEWTC_ModifiedScanAndFill(DATA,1,DATA.subgword[w],i);
else
NEWTC_ModifiedScanAndFill(DATA,1,DATA.subgword[w],[w]);
fi;
else
NEWTC_ScanAndFill(DATA,1,DATA.subgword[w]);
fi;
od;
NEWTC_ProcessDeductions(DATA);
# words we want to trace early (as they might reduce the number of
# definitions
if trace<>false then
#trace:=Concatenation(trace,ri); #don't seem to help
for w in trace do
if IsList(w[1]) then
w:=w[1]; # get word from value
fi;
repeat
i:=1;
ap:=1;
while ap<=Length(w) do
a:=w[ap];
if ct[a+offset][i]=0 then
dr:=NEWTC_Define(DATA,i,a);
if dr=fail then return fail;fi;
NEWTC_ProcessDeductions(DATA);
#i:=p[i]; # in case there is a change
ap:=Length(w)+10;
fi;
i:=ct[a+offset][i];
ap:=ap+1;
od;
until ap=Length(w)+1;
od;
fi;
i:=1;
while i<=DATA.n do
for a in A do
if p[i]=i then
if ct[a+offset][i]=0 then
dr:=NEWTC_Define(DATA,i,a);
if dr=fail then return fail;fi;
oldead:=DATA.dead;
NEWTC_ProcessDeductions(DATA);
if PERCFACT*(DATA.dead-oldead)>DATA.n then
if DATA.n>1000 then
Info( InfoFpGroup, 2, "\t", DATA.defcount, "\t\t", DATA.dead,
"\t\t", DATA.n-DATA.dead, "\t\t", DATA.n );
fi;
if IsBound(DATA.with) then
# collapse -- find collapse word
# in two different ways (as they can differ after compression)
# first trace through the coset table, this uses the prior
# reductions
j:=i;
while j<>p[j] do
j:=p[j];
od;
w:=[a]; # last letter added
while j<>1 do
Assert(2,j=p[j]);
Add(w,with[j]);
Assert(2,0<>ct[-with[j]+offset][j]);
j:=ct[-with[j]+offset][j]; # unapply this generator
od;
# free reduce -- partial collapse can lead to not free cancellation
# and fix order
w:=Reversed(FreelyReducedLetterRepWord(w));
#w1:=w;
j:=PositionProperty(collapse,x->x[1]=w);
if j=fail then
Add(collapse,[w,DATA.dead-oldead]); # word that caused a collapse
else
collapse[j][2]:=Maximum(collapse[j][2],DATA.dead-oldead);
fi;
# now use the `from' list (which does not collapse under
# coincidences, only under compression) and not the coset table,
# as it # keeps the old definition order, not yet using coincidence
j:=i;
w:=[a]; # last letter added
while j<>1 do
Add(w,with[j]);
j:=from[j];
od;
# free reduce -- partial collapse can lead to not free
# cancellation and fix order
w:=Reversed(FreelyReducedLetterRepWord(w));
j:=PositionProperty(collapse,x->x[1]=w);
if j=fail then
Add(collapse,[w,DATA.dead-oldead]); # word caused collapse
else
collapse[j][2]:=Maximum(collapse[j][2],DATA.dead-oldead);
fi;
Info(InfoFpGroup,3,"collapse ",DATA.dead-oldead);
fi;
fi;
fi;
fi;
od;
# conditions for compression: Over half the table used, and
if 2*DATA.n>DATA.limit and
# at least 33% trash (4=1+1/0.33)
( 4*DATA.dead>DATA.n or
# over limtrigger and at least 2% (55=1+1/0.02) trash
(51*DATA.dead>DATA.n and DATA.n>DATA.limtrigger) ) then
Info( InfoFpGroup, 2, "\t", DATA.defcount, "\t\t", DATA.dead,
"\t\t", DATA.n-DATA.dead, "\t\t", DATA.n );
i:=Number([1..i],x->p[x]=x);
NEWTC_Compress(DATA,false);
p:=DATA.p;
if DATA.augmented then
pp:=DATA.pp;
fi;
if DATA.n>DATA.limtrigger then
DATA.limtrigger:=Maximum(DATA.limit-1,DATA.n+2);
fi;
fi;
i:=i+1;
od;
NEWTC_Compress(DATA,true); # always compress at the end
DATA.index:=DATA.n;
if Length(collapse)>0 then
Info(InfoFpGroup,3,DATA.defcount," definitions");
# which collapses gave at least 1%
collapse:=Filtered(collapse,x->x[2]*PERCFACT>DATA.n and not x in trace and
# not prefix of any trace
not ForAny(trace,y->y[1]{[1..Minimum(Length(x),Length(y[1]))]}=x
# or proper prefix of another in collapse
and not ForAny(collapse,y->Length(y)>Length(x) and
y{[1..Length(x)]}=x)));
if Length(collapse)>0 then
# give list for improvement
# type is c_ollapse
return
rec(type:="c",collapse:=collapse,limit:=DATA.limit,defcount:=DATA.defcount,data:=DATA);
fi;
fi;
return rec(type:="t",limit:=DATA.limit,defcount:=DATA.defcount,data:=DATA);
end;
#freegens,fgreerels,subgens,doaugmented,trace
# Options: limit, quiet (return fail if run out of space)
# cyclic (if given and 1 generator do special case of cyclic rewriting)
InstallGlobalFunction(NEWTC_CosetEnumerator,function(arg)
local freegens,freerels,subgens,aug,trace,e,ldc,up,bastime,start,bl,bw,first,timerFunc;
timerFunc := GET_TIMER_FROM_ReproducibleBehaviour();
freegens:=arg[1];
freerels:=arg[2];
subgens:=arg[3];
aug:=IsBound(arg[4]);
trace:=IsBound(arg[5]);
if aug<>false then
aug:=arg[4];
fi;
if aug<>false then
# if augmented, optimize by default
if trace=false then
trace:=[];
else
trace:=arg[5];
fi;
elif trace<>false then
trace:=arg[5];
fi;
start:=timerFunc();
if aug and trace=false then
e:=NEWTC_DoCosetEnum(freegens,freerels,subgens,aug,trace);
if e=fail then return fail;fi;
else
e:=NEWTC_DoCosetEnum(freegens,freerels,subgens,false,trace);
if e=fail then return fail;fi;
bastime:=timerFunc()-start;
bl:=e.defcount;
bw:=[];
ldc:=infinity;
up:=0;
start:=timerFunc();
first:=true;
while trace<>false and e.type="c" and (up<=2 or
2*(timerFunc()-start)<=bastime) do
#up<=2 do
ldc:=e.defcount;
if first=true then
first:=e.defcount;
Info(InfoFpGroup,1,"optimize definition sequence");
fi;
Append(trace,Filtered(e.collapse,x->x[2]>2));
SortBy(trace,x->-x[2]);
e:=NEWTC_DoCosetEnum(freegens,freerels,subgens,false,trace:
# that's what we had last time -- no need to whine
limit:=e.limit);
if e=fail then return fail;fi;
if e.defcount/bl<98/100 then
bl:=e.defcount;
bw:=ShallowCopy(trace);
fi;
# 2% improvement threshold
if 102/100*e.defcount<=ldc then
up:=0;
start:=timerFunc();
else
up:=up+1;
fi;
od;
if first<>true then
Info(InfoFpGroup,1,"Reduced ",first," definitions to ",e.defcount);
fi;
if aug then
# finally do the augmented with best
e:=NEWTC_DoCosetEnum(freegens,freerels,subgens,true,bw:
# that's what we had last time -- no need to whine
limit:=e.limit);
if e=fail then return fail;fi;
fi;
fi;
if not aug then
# return the ordinary coset table in standard formatting
up:=[];
for start in [1..Length(freegens)] do
Add(up,start+e.data.offset);
Add(up,-start+e.data.offset);
od;
ldc:=e.data.ct{up};
StandardizeTable(ldc);
return ldc;
fi;
aug:=rec(isNewAugmentedTable:=true,
isCyclicMtcTable:=e.data.isCyclicMtcTable,
isAbelianizedMtcTable:=e.data.isAbelianizedMtcTable,
useAddition:=e.data.useAddition,
n:=e.data.n,
A:=e.data.A,
index:=e.data.index,
rels:=e.data.rels,
ct:=e.data.ct,
one:=e.data.one,
aug:=e.data.aug,
defcount:=e.data.defcount,
secount:=e.data.secount,
secondary:=e.data.secondary,
subgens:=e.data.subgens,
subgword:=e.data.subgword,
offset:=e.data.offset
);
if IsBound(e.data.from) then
aug.from:=e.data.from;
fi;
return aug;
end);
NEWTC_Rewrite:=function(arg)
local DATA,start,w,offset,c,i,j;
DATA:=arg[1];
start:=arg[2];
w:=arg[3];
offset:=DATA.offset;
c:=DATA.one;
i:=start;
for j in w do
if DATA.useAddition then
c:=c+DATA.aug[j+offset][i];
else
c:=WordProductLetterRep(c,DATA.aug[j+offset][i]);
fi;
i:=DATA.ct[j+offset][i];
od;
if Length(arg)>3 and arg[4]<>i then
Error("Trace did not end at expected coset");
fi;
return c;
end;
NEWTC_ReplacedStringCyclic:=function(s,r)
local p,new,start;
if Length(s)<Length(r) then
return s;
fi;
# TODO: Replace cyclically, that is allow the substring to hang out over the
# end and start again. This is easiest done by having a cylci version of
# `PositionSublist'.
p:=PositionSublist(s,r);
if p<>fail then
new:=s{[1..p-1]};
start:=p+Length(r);
p:=PositionSublist(s,r,start);
while p<>fail do
new:=WordProductLetterRep(new,s{[start..p-1]});
start:=p+Length(r);
p:=PositionSublist(s,r,start);
od;
new:=WordProductLetterRep(new,s{[start..Length(s)]});
return new;
else
return s;
fi;
end;
InstallGlobalFunction(NEWTC_CyclicSubgroupOrder,function(DATA)
local rels,r,i,w;
rels:=0;
r:=NEWTC_Rewrite(DATA,1,DATA.subgword[1])-1;
rels:=Gcd(rels,r);
for i in [1..DATA.n] do
for w in DATA.rels do
r:=NEWTC_Rewrite(DATA,i,w);
rels:=Gcd(rels,r);
od;
od;
return rels;
end);
NEWTC_AbelianizedRelatorsSubgroup:=function(DATA)
local rels,r,i,w,subnum;
subnum:=Length(DATA.subgens);
rels:=[];
for i in [1..subnum] do
r:=ShallowCopy(NEWTC_Rewrite(DATA,1,DATA.subgword[i]));
r[i]:=r[i]-1;
if not IsZero(r) and not r in rels and not -r in rels then
AddSet(rels,r);
fi;
od;
for i in [1..DATA.n] do
CompletionBar(InfoFpGroup,2,"Coset Loop: ",i/DATA.n);
for w in DATA.rels do
r:=NEWTC_Rewrite(DATA,i,w);
if not IsZero(r) and not r in rels and not -r in rels then
AddSet(rels,r);
fi;
od;
od;
CompletionBar(InfoFpGroup,2,"Coset Loop: ",0);
return rels;
end;
#############################################################################
##
#M RelatorMatrixAbelianizedSubgroupMtc( <G>, <H> ) . . . . . relator matrix
#M . . . . . . . . . . . . . . . . . . . . . . for an abelianized subgroup
##
## 'RelatorMatrixAbelianizedSubgroupMtc' uses the Modified Todd-Coxeter
## coset representative enumeration method to compute a matrix of abelian-
## ized defining relators for a subgroup H of a finitely presented group G.
##
InstallGlobalFunction( RelatorMatrixAbelianizedSubgroupMtc,
function ( G, H )
local aug,rels;
# check the arguments to be a finitely presented group and a subgroup of
# that group.
if not ( IsSubgroupFpGroup( G ) and IsGroupOfFamily( G ) ) then
Error( "<G> must be a finitely presented group" );
fi;
if not IsSubgroupFpGroup( H ) or FamilyObj( H ) <> FamilyObj( G ) then
Error( "<H> must be a subgroup of <G>" );
fi;
# do a Modified Todd-Coxeter coset representative enumeration to
# construct an augmented coset table of H.
aug := NEWTC_CosetEnumerator(FreeGeneratorsOfFpGroup(G),RelatorsOfFpGroup(G),GeneratorsOfGroup(H),true,false:abelian:=true);
# determine a set of abelianized subgroup relators.
rels:=NEWTC_AbelianizedRelatorsSubgroup(aug);
return rels;
end );
# DATA, [parameter,string]
# parameter is:
# 0: Full reduction
# 1: Do a quick reduction without trying to eliminate all secondary gens.
# -1: No relators
InstallGlobalFunction(NEWTC_PresentationMTC,function(arg)
local DATA,rels,i,j,w,f,r,s,fam,new,ri,a,offset,p,rset,re,start,stack,pres,
subnum,bad,warn,parameter,str;
DATA:=arg[1];
if Length(arg)=1 then
parameter:=0;
else
parameter:=arg[2];
fi;
if Length(arg)>2 then
str:=arg[3];
else
str:="%";
fi;
offset:=DATA.offset;
subnum:=Length(DATA.subgens);
rels:=[];
for i in [1..subnum] do
r:=WordProductLetterRep(NEWTC_Rewrite(DATA,1,DATA.subgword[i]),[-i]);
if Length(r)>0 then
Add(rels,r);
fi;
od;
stack:=[];
if parameter<>-1 then
for i in [1..DATA.n] do
CompletionBar(InfoFpGroup,2,"Coset Loop: ",i/DATA.n);
for w in DATA.rels do
r:=NEWTC_Rewrite(DATA,i,w);
MakeCanonical(r);
ri:=Length(r);
# reduce with others
for j in rels do
r:=NEWTC_ReplacedStringCyclic(r,j);
r:=NEWTC_ReplacedStringCyclic(r,-Reversed(j));
od;
Info(InfoFpGroup,3,"Relatorlen ",ri,"->",Length(r));
if Length(r)>0 then
Add(stack,r);
while Length(stack)>0 do
r:=stack[Length(stack)];
Unbind(stack[Length(stack)]);
ri:=-Reversed(r);
rset:=Set([r,ri]);
# reduce others
j:=1;
while j<=Length(rels) do
s:=rels[j];
for re in rset do;
s:=NEWTC_ReplacedStringCyclic(s,re);
od;
if not IsIdenticalObj(s,rels[j]) then
if Length(s)>0 then
Add(stack,s);
fi;
rels:=WordProductLetterRep(rels{[1..j-1]},rels{[j+1..Length(rels)]});
else
j:=j+1;
fi;
od;
Add(rels,r);
SortBy(rels,Length);
# does it occur in the augmented table?
for a in DATA.A do
for j in [1..DATA.n] do
s:=DATA.aug[a+offset][j];
if Length(s)>=Length(r) then
for re in rset do
s:=NEWTC_ReplacedStringCyclic(s,re);
od;
DATA.aug[a+offset][j]:=s;
fi;
od;
od;
od;
fi;
od;
od;
CompletionBar(InfoFpGroup,2,"Coset Loop: ",0);
fi;
# add definitions of secondary generators
for i in [subnum+1..DATA.secount] do
r:=WordProductLetterRep(DATA.secondary[i],[-i]);
Add(rels,r);
od;
f:=FreeGroup(DATA.secount,str);
fam:=FamilyObj(One(f));
rels:=List(rels,x->AssocWordByLetterRep(fam,x));
pres:=PresentationFpGroup(f/rels);
TzOptions(pres).protected:=subnum;
TzOptions(pres).printLevel:=InfoLevel(InfoFpGroup);
if parameter=1 then
TzSearch(pres);
TzOptions(pres).lengthLimit:=pres!.tietze[TZ_TOTAL]+1;
fi;
TzGoGo(pres);
if IsEvenInt(parameter) and Length(GeneratorsOfPresentation(pres))>subnum then
warn:=true;
# Help Tietze with elimination
bad:=Reversed(List(GeneratorsOfPresentation(pres)
{[subnum+1..Length(GeneratorsOfPresentation(pres))]},
x->LetterRepAssocWord(x)[1]));
for i in bad do
r:=DATA.secondary[i];
re:=true;
while re do
s:=[];
re:=false;
for j in r do
if AbsInt(j)>subnum then
re:=true;
if j>0 then
Append(s,DATA.secondary[j]);
else
Append(s,-Reversed(DATA.secondary[-j]));
fi;
else
Add(s,j);
fi;
od;
Info(InfoFpGroup,2,"Length =",Length(s));
r:=s;
if warn and Length(s)>100*Sum(rels,Length) then
warn:=false;
Error(
"Trying to eliminate all auxillary generators might cause the\n",
"size of the presentation to explode. Proceed at risk!");
fi;
od;
r:=AssocWordByLetterRep(fam,Concatenation(r,[-i]));
AddRelator(pres,r);
TzSearch(pres);
TzEliminate(pres,i);
od;
Assert(1,Length(GeneratorsOfPresentation(pres))=subnum);
fi;
r:=List(GeneratorsOfPresentation(pres){
[subnum+1..Length(GeneratorsOfPresentation(pres))]},
x->LetterRepAssocWord(x)[1]);
pres!.secondarywords:=r;
return pres;
end);
#############################################################################
##
#M PresentationSubgroupMtc(<G>, <H> [,<string>] [,<print level>] ) . . . . .
#M Tietze record for a subgroup
##
## 'PresentationSubgroupMtc' uses the Modified Todd-Coxeter coset represent-
## ative enumeration method to compute a presentation (i.e. a presentation
## record) for a subgroup H of a finitely presented group G. The generators
## in the resulting presentation will be named <string>1, <string>2, ... ,
## the default string is `\"_x\"'.
##
InstallGlobalFunction( PresentationSubgroupMtc,function ( arg )
local G,H,string,printlevel,DATA,i;
# check the first two arguments to be a finitely presented group and a
# subgroup of that group.
G := arg[1];
if not ( IsSubgroupFpGroup( G ) and IsGroupOfFamily( G ) ) then
Error( "<G> must be a finitely presented group" );
fi;
H := arg[2];
if not IsSubgroupFpGroup( H ) or FamilyObj( H ) <> FamilyObj( G ) then
Error( "<H> must be a subgroup of <G>" );
fi;
# initialize the generators name string and the print level.
string := "_x";
printlevel := 1;
# get the optional parameters.
for i in [ 3 .. 4 ] do
if Length( arg ) >= i then
if IsInt( arg[i] ) then printlevel := arg[i];
elif IsString( arg[i] ) then string := arg[i];
else
Error( "optional parameter must be a string or an integer" );
fi;
fi;
od;
DATA:=NEWTC_CosetEnumerator(FreeGeneratorsOfFpGroup(G),
RelatorsOfFpGroup(G),
List(GeneratorsOfGroup(H),UnderlyingElement),true,
# for compatibility, do not try the optimization
false);
return NEWTC_PresentationMTC(DATA,0,string);
end);
#####################################
# The following code is not used any longer and is relics of the old Mtc
# implementation.
#############################################################################
##
#E sgpres.gi . . . . . . . . . . . . . . . . . . . . . . . . . .. ends here