1############################################################################# 2## 3## This file is part of GAP, a system for computational discrete algebra. 4## This file's authors include Volkmar Felsch. 5## 6## Copyright of GAP belongs to its developers, whose names are too numerous 7## to list here. Please refer to the COPYRIGHT file for details. 8## 9## SPDX-License-Identifier: GPL-2.0-or-later 10## 11## This file contains the methods for subgroup presentations in finitely 12## presented groups (fp groups). 13## 14 15 16############################################################################# 17## 18#M AbelianInvariantsNormalClosureFpGroupRrs( <G>, <H> ) . . . . . . . . . . 19#M . . . . . abelian invariants of the normal closure of the subgroup H of G 20## 21## uses the Reduced Reidemeister-Schreier method to compute the abelian 22## invariants of the normal closure of a subgroup <H> of a finitely 23## presented group <G>. 24## 25InstallGlobalFunction( AbelianInvariantsNormalClosureFpGroupRrs, 26function ( G, H ) 27local M; 28 M:=RelatorMatrixAbelianizedNormalClosureRrs( G, H ); 29 if Length(M)=0 then 30 return []; 31 else 32 M:=ReducedRelationMat(M); 33 DiagonalizeMat( Integers, M ); 34 return AbelianInvariantsOfList(DiagonalOfMat(M)); 35 fi; 36end ); 37 38 39############################################################################# 40## 41#M AbelianInvariantsSubgroupFpGroupMtc( <G>, <H> ) . . . . . . . . . . . . . 42#M . . . . . abelian invariants of the normal closure of the subgroup H of G 43## 44## uses the Modified Todd-Coxeter method to compute the abelian 45## invariants of a subgroup <H> of a finitely presented group <G>. 46## 47InstallGlobalFunction( AbelianInvariantsSubgroupFpGroupMtc, 48function ( G, H ) 49local M; 50 M:=RelatorMatrixAbelianizedSubgroupMtc( G, H ); 51 if Length(M)=0 then 52 return []; 53 else 54 M:=ReducedRelationMat(M); 55 DiagonalizeMat( Integers, M ); 56 return AbelianInvariantsOfList(DiagonalOfMat(M)); 57 fi; 58end ); 59 60 61############################################################################# 62## 63#M AbelianInvariantsSubgroupFpGroupRrs( <G>, <H> ) . . . . . . . . . . . . . 64#M AbelianInvariantsSubgroupFpGroupRrs( <G>, <costab> ) . . . . . . . . . . 65#M . . . . . abelian invariants of the normal closure of the subgroup H of G 66## 67## uses the Reduced Reidemeister-Schreier method to compute the abelian 68## invariants of a subgroup <H> of a finitely presented group <G>. 69## 70## Alternatively to the subgroup <H>, its coset table <table> in <G> may be 71## given as second argument. 72## 73InstallGlobalFunction( AbelianInvariantsSubgroupFpGroupRrs, 74function ( G, H ) 75local M; 76 M:=RelatorMatrixAbelianizedSubgroupRrs( G, H ); 77 if M=fail then 78 if ValueOption("cheap")=true then return fail;fi; 79 Info(InfoWarning,1, 80 "exponent too large, abelianized coset enumeration aborted"); 81 Info(InfoWarning,1,"calculation will be slow"); 82 M:=MaximalAbelianQuotient(H); # this is in the library, so no overflow 83 return AbelianInvariants(Range(M)); 84 elif Length(M)=0 then 85 return []; 86 else 87 M:=ReducedRelationMat(M); 88 DiagonalizeMat( Integers, M ); 89 return AbelianInvariantsOfList(DiagonalOfMat(M)); 90 fi; 91end ); 92 93 94############################################################################# 95## 96#M AugmentedCosetTableInWholeGroup 97## 98InstallGlobalFunction(AugmentedCosetTableInWholeGroup, 99function(arg) 100local aug,H,wor,w; 101 H:=arg[1]; 102 if Length(arg)=1 then 103 return AugmentedCosetTableRrsInWholeGroup(H); 104 fi; 105 wor:=List(arg[2],UnderlyingElement); # words for given elements 106 # is there an MTc table we can use? 107 if HasAugmentedCosetTableMtcInWholeGroup(H) then 108 aug := AugmentedCosetTableMtcInWholeGroup( H ); 109 if IsSubset(aug.primaryGeneratorWords,wor) or 110 IsSubset(SecondaryGeneratorWordsAugmentedCosetTable(aug),wor) then 111 return aug; 112 fi; 113 fi; 114 # try the Rrs table 115 aug := AugmentedCosetTableRrsInWholeGroup( H ); 116 if IsSubset(aug.primaryGeneratorWords,wor) or 117 IsSubset(SecondaryGeneratorWordsAugmentedCosetTable(aug),wor) then 118 return aug; 119 fi; 120 121 # still not: need completely new table 122 w:=FamilyObj(H)!.wholeGroup; 123 aug:=AugmentedCosetTableMtc(w,SubgroupNC(w,arg[2]),2,"y" ); 124 125 return aug; 126end); 127 128 129############################################################################# 130## 131#M AugmentedCosetTableMtcInWholeGroup 132## 133InstallMethod( AugmentedCosetTableMtcInWholeGroup, 134 "subgroup of fp group", true, [IsSubgroupFpGroup], 0, 135function( H ) 136 local G, aug; 137 G := FamilyObj( H )!.wholeGroup; 138 aug := AugmentedCosetTableMtc( G, H, 2, "y" ); 139 return aug; 140end); 141 142 143############################################################################# 144## 145#M AugmentedCosetTableRrsInWholeGroup 146## 147InstallMethod( AugmentedCosetTableRrsInWholeGroup, 148 "subgroup of fp group", true, [IsSubgroupFpGroup], 0, 149function( H ) 150 local G, costab, fam, aug, gens; 151 G := FamilyObj( H )!.wholeGroup; 152 costab := CosetTableInWholeGroup( H ); 153 aug := AugmentedCosetTableRrs( G, costab, 2, "y" ); 154 155 # if H has not yet any generators, we store them (and then also can store 156 # the coset table as Mtc table) 157 if not (HasGeneratorsOfGroup(H) 158 or HasAugmentedCosetTableMtcInWholeGroup(H)) then 159 SetAugmentedCosetTableMtcInWholeGroup(H,aug); 160 gens := aug.primaryGeneratorWords; 161 # do we need to wrap? 162 if not IsFreeGroup( G ) then 163 fam := ElementsFamily( FamilyObj( H ) ); 164 gens := List( gens, i -> ElementOfFpGroup( fam, i ) ); 165 fi; 166 SetGeneratorsOfGroup( H, gens ); 167 fi; 168 169 return aug; 170end); 171 172############################################################################# 173## 174#M AugmentedCosetTableNormalClosureInWholeGroup( <H> ) . . . augmented coset 175#M table of the normal closure of an fp subgroup in its whole group 176## 177## is equivalent to `AugmentedCosetTableNormalClosure( <G>, <H> )' where <G> 178## is the (unique) finitely presented group such that <H> is a subgroup of 179## <G>. 180## 181InstallMethod( AugmentedCosetTableNormalClosureInWholeGroup, 182 "subgroup of fp group", true, [IsSubgroupFpGroup], 0, 183function( H ) 184 local G, costab, aug; 185 186 # get the whole group G of H 187 G := FamilyObj( H )!.wholeGroup; 188 189 # compute a coset table of the normal closure N of H in G 190 costab := CosetTableNormalClosureInWholeGroup( H ); 191 192 # apply the Reduced Reidemeister-Schreier method to construct an 193 # augmented coset table of N in G 194 aug := AugmentedCosetTableRrs( G, costab, 2, "%" ); 195 196 return aug; 197end ); 198 199 200############################################################################# 201## 202#M AugmentedCosetTableMtc( <G>, <H>, <type>, <string> ) . . . . . . . . . . 203#M . . . . . . . . . . . . . do an MTC and return the augmented coset table 204## 205## is an internal function used by the subgroup presentation functions 206## described in "Subgroup Presentations". It applies a Modified Todd-Coxeter 207## coset representative enumeration to construct an augmented coset table 208## (see "Subgroup presentations") for the given subgroup <H> of <G>. The 209## subgroup generators will be named <string>1, <string>2, ... . 210## 211## Valid types are 1 (for the one generator case), 0 (for the abelianized 212## case), and 2 (for the general case). A type value of -1 is handled in 213## the same way as the case type = 1, but the function will just return the 214## the exponent <aug>.exponent of the given cyclic subgroup <H> and its 215## index <aug>.index in <G> as the only components of the resulting record 216## <aug>. 217## 218InstallGlobalFunction( AugmentedCosetTableMtc, 219 function ( G, H, ttype, string ) 220 221 # check the arguments 222 if not ( IsSubgroupFpGroup( G ) and IsGroupOfFamily( G ) ) then 223 Error( "<G> must be a finitely presented group" ); 224 fi; 225 if FamilyObj( H ) <> FamilyObj( G ) then 226 Error( "<H> must be a subgroup of <G>" ); 227 fi; 228 229 return NEWTC_CosetEnumerator(FreeGeneratorsOfFpGroup(G), 230 RelatorsOfFpGroup(G),GeneratorsOfGroup(H),true); 231end ); 232 233 234 235 236 237############################################################################# 238## 239#M AugmentedCosetTableRrs( <G>, <coset table>, <type>, <string> ) . . . . . 240#M do a RRS and return the augmented coset table 241## 242## 'AugmentedCosetTableRrs' applies the Reduced Reidemeister-Schreier method 243## to construct an augmented coset table for the subgroup of G which is 244## defined by the given coset table. The new subgroup generators will be 245## named <string>1, <string>2, ... . 246## 247InstallGlobalFunction( AugmentedCosetTableRrs, 248 function ( G, table, type, string ) 249 250 local fgens, # generators of asscociated free group 251 grels, # relators of G 252 involutions, # indices of involutory gens of G 253 index, # index of the group in the parent group 254 cosTable, # coset table 255 negTable, # coset table to be built up 256 coFacTable, # coset factor table 257 numcols, # number of columns in the tables 258 numgens, # number of generators 259 F, # a new free group 260 span, # spanning tree 261 ggens, # parent group gens prallel to columns 262 gens, # new generators 263 ngens, # number of new generators 264 defs, # definitions of primary subgroup gens 265 tree, # tree of generators 266 tree1, tree2, # components of tree of generators 267 treelength, # number of gens (primary + secondary) 268 rels, # representatives for the relators 269 relsGen, # relators beginning with a gen 270 deductions, # deduction queue 271 ded, # index of current deduction in above 272 nrdeds, # current number of deductions in above 273 i, ii, gen, inv, # loop variables for generator 274 triple, # loop variable for relators as triples 275 word, factors, # words defining subgroup generators 276 app, # application stack for 'ApplyRel' 277 app2, # application stack for 'ApplyRel2' 278 j, k, # loop variables 279 fac, # tree entry 280 count, # number of negative table entries 281 next, # 282 numoccs, # number of gens which occur in the table 283 occur, # 284 treeNums, # 285 convert, # conversion list for subgroup generators 286 aug, # augmented coset table 287 field, # loop variable for record field names 288 EnterDeduction, # subroutine 289 LoopOverAllCosets; # subroutine 290 291 292 EnterDeduction := function ( ) 293 294 # a deduction has been found, check the current coset table entry. 295 # if triple[2][app[1]][app[2]] <> -app[4] or 296 # triple[2][app[3]][app[4]] <> -app[2] then 297 # Error( "unexpected coset table entry" ); 298 # fi; 299 300 # compute the corresponding factors in "factors". 301 app2[1] := triple[3]; 302 app2[2] := deductions[ded][2]; 303 app2[3] := -1; 304 app2[4] := app2[2]; 305 if not ApplyRel2( app2, triple[2], triple[1] ) then 306 return fail; # rewriting failed b/c too large exponent 307 fi; 308 factors := app2[7]; 309#if Length(factors)>0 then Print(Length(factors)," ",Maximum(factors)," ",Minimum(factors),"\n");fi; 310 311 # ensure that the scan provided a deduction. 312 # if app2[1] - 1 <> app2[3] 313 # or triple[2][app2[1]][app2[2]] <> - app2[4] 314 # or triple[2][app2[3]][app2[4]] <> - app2[2] 315 # then 316 # Error( "the given scan does not provide a deduction" ); 317 # fi; 318 319 # extend the tree to define a proper factor, if necessary. 320 fac := TreeEntry( tree, factors ); 321 322 # now enter the deduction to the tables. 323 triple[2][app2[1]][app2[2]] := app2[4]; 324 coFacTable[triple[1][app2[1]]][app2[2]] := fac; 325 triple[2][app2[3]][app2[4]] := app2[2]; 326 coFacTable[triple[1][app2[3]]][app2[4]] := - fac; 327 nrdeds := nrdeds + 1; 328 deductions[nrdeds] := [ triple[1][app2[1]], app2[2] ]; 329 treelength := tree[3]; 330 count := count - 2; 331 end; 332 333 LoopOverAllCosets:=function() 334 # loop over all the cosets 335 for j in [ 1 .. index ] do 336 CompletionBar(InfoFpGroup,2,"Coset Loop: ",j/index); 337 338 # run through all the rows and look for negative entries 339 for i in [ 1 .. numcols ] do 340 gen := negTable[i]; 341 342 if gen[j] < 0 then 343 344 # add the current Schreier generator to the set of new 345 # subgroup generators, and add the definition as deduction. 346 k := - gen[j]; 347 word := ggens[i]; 348 while k > 1 do 349 word := word * ggens[span[2][k]]^-1; k := span[1][k]; 350 od; 351 k := j; 352 while k > 1 do 353 word := ggens[span[2][k]] * word; k := span[1][k]; 354 od; 355 numgens := numgens + 1; 356 defs[numgens] := word; 357 treelength := treelength + 1; 358 tree[3] := treelength; 359 tree[4] := numgens; 360 if type = 0 then 361 tree1[treelength] := 362 ListWithIdenticalEntries( numgens, 0 ); 363 tree1[treelength][numgens] := 1; 364 tree2[numgens] := 0; 365 else 366 tree1[treelength] := 0; 367 tree2[treelength] := 0; 368 fi; 369 370 # add the definition as deduction. 371 inv := negTable[i + 2*(i mod 2) - 1]; 372 k := - gen[j]; 373 gen[j] := k; 374 coFacTable[i][j] := treelength; 375 if inv[k] < 0 then 376 inv[k] := j; 377 ii := i + 2*(i mod 2) - 1; 378 coFacTable[ii][k] := - treelength; 379 fi; 380 count := count - 2; 381 382 # set up the deduction queue and run over it until it's empty 383 deductions:=[]; 384 deductions[1] := [i,j]; 385 nrdeds := 1; 386 ded := 1; 387 while ded <= nrdeds do 388 389 # apply all relators that start with this generator 390 for triple in relsGen[deductions[ded][1]] do 391 app[1] := triple[3]; 392 app[2] := deductions[ded][2]; 393 app[3] := -1; 394 app[4] := app[2]; 395 if ApplyRel( app, triple[2] ) and 396 triple[2][app[1]][app[2]] < 0 and 397 triple[2][app[3]][app[4]] < 0 then 398 # a deduction has been found: compute the 399 # corresponding factor and enter the deduction to 400 # the tables and to the deductions lists. 401 EnterDeduction( ); 402 if count <= 0 then 403 return; 404 fi; 405 fi; 406 od; 407 408 ded := ded + 1; 409 od; 410 411 fi; 412 od; 413 od; 414 end; 415 416 417 418 # check G to be a finitely presented group. 419 if not ( IsSubgroupFpGroup( G ) and IsGroupOfFamily( G ) ) then 420 Error( "<G> must be a finitely presented group" ); 421 fi; 422 423 # check the type for being 0 or 2. 424 if type <> 0 and type <> 2 then 425 Error( "invalid type; it should be 0 or 2" ); 426 fi; 427 428 # get some local variables 429 fgens := FreeGeneratorsOfFpGroup( G ); 430 grels := RelatorsOfFpGroup( G ); 431 432 # check the number of columns of the given coset table to be twice the 433 # number of generators of the parent group G. 434 numcols := Length( table ); 435 if numcols <> 2 * Length( fgens ) then 436 Error( "parent group and coset table are inconsistent" ); 437 fi; 438 index := IndexCosetTab( table ); 439 440 # get a negative copy of the coset table, and initialize the coset factor 441 # table (parallel to it) by zeros. 442 involutions := IndicesInvolutaryGenerators( G ); 443 if Length( involutions ) = 0 then 444 cosTable := table; 445 else 446 cosTable := [ ]; 447 for i in [ 1 .. Length( fgens ) ] do 448 cosTable[2*i-1] := table[2*i-1]; 449 if i in involutions then 450 cosTable[2*i] := table[2*i-1]; 451 else 452 cosTable[2*i] := table[2*i]; 453 fi; 454 od; 455 fi; 456 negTable := [ ]; 457 coFacTable := [ ]; 458 for i in [ 1 .. Length( fgens ) ] do 459 negTable[2*i-1] := List( cosTable[2*i-1], x -> -x ); 460 coFacTable[2*i-1] := ListWithIdenticalEntries( index, 0 ); 461 if i in involutions then 462 negTable[2*i] := negTable[2*i-1]; 463 coFacTable[2*i] := coFacTable[2*i-1]; 464 else 465 negTable[2*i] := List( cosTable[2*i], x -> -x ); 466 coFacTable[2*i] := ListWithIdenticalEntries( index, 0 ); 467 fi; 468 od; 469 count := index * ( numcols - 2 ) + 2; 470 471 # construct the list relsGen which for each generator or inverse 472 # generator contains a list of all cyclically reduced relators, 473 # starting with that element, which can be obtained by conjugating or 474 # inverting given relators. The relators in relsGen are represented as 475 # lists of the coset table columns corresponding to the generators and, 476 # in addition, as lists of the respective column numbers. 477 rels := RelatorRepresentatives( grels ); 478 relsGen := RelsSortedByStartGen( fgens, rels, negTable, true ); 479 SortRelsSortedByStartGen( relsGen ); 480 481 # check the number of columns to be twice the number of generators of 482 # the parent group G. 483 if numcols <> 2 * Length( fgens ) then 484 Error( "parent group and coset table are inconsistent" ); 485 fi; 486 487 # initialize the tree of secondary generators. 488 tree1 := ListWithIdenticalEntries( 100, 0 ); 489 if type = 0 then 490 tree2 := [ ]; 491 else 492 tree2 := ListWithIdenticalEntries( 100, 0 ); 493 fi; 494 treelength := 0; 495 tree := [ tree1, tree2, treelength, 0, type ]; 496 497 # initialize an empty deduction list 498 deductions := [ ]; deductions[index] := 0; 499 nrdeds := 0; 500 501 # get a spanning tree for the cosets 502 span := SpanningTree( cosTable ); 503 504 # enter the coset definitions into the coset table. 505 for k in [ 2 .. index ] do 506 507 j := span[1][k]; 508 i := span[2][k]; 509 ii := i + 2*(i mod 2) - 1; 510 511 # check the current table entry. 512 if negTable[i][j] <> - k or negTable[ii][k] <> -j then 513 Error( "coset table and spanning tree are inconsistent" ); 514 fi; 515 516 # enter the deduction. 517 negTable[i][j] := k; 518 if negTable[ii][k] < 0 then negTable[ii][k] := j; fi; 519 nrdeds := nrdeds + 1; 520 deductions[nrdeds] := [i,j]; 521 od; 522 523 # make the local structures that are passed to 'ApplyRel' or, via 524 # EnterDeduction, to 'ApplyRel2". 525 app := ListWithIdenticalEntries( 4, 0 ); 526 app2 := ListWithIdenticalEntries( 9, 0 ); 527 if type = 0 then 528 factors := tree2; 529 else 530 factors := [ ]; 531 fi; 532 533 # set those arguments of ApplyRel2 which are global with respect to the 534 # following loops. 535 app2[5] := type; 536 app2[6] := coFacTable; 537 app2[7] := factors; 538 if type = 0 then 539 app2[8] := tree; 540 fi; 541 542 # set up the deduction queue and run over it until it's empty 543 ded := 1; 544 while ded <= nrdeds do 545 if ded mod 50=0 then 546 CompletionBar(InfoFpGroup,2,"Queue: ",ded/nrdeds); 547 fi; 548 549 # apply all relators that start with this generator 550 for triple in relsGen[deductions[ded][1]] do 551 app[1] := triple[3]; 552 app[2] := deductions[ded][2]; 553 app[3] := -1; 554 app[4] := app[2]; 555 if ApplyRel( app, triple[2] ) and triple[2][app[1]][app[2]] < 0 556 and triple[2][app[3]][app[4]] < 0 then 557 # a deduction has been found: compute the corresponding 558 # factor and enter the deduction to the tables and to the 559 # deductions lists. 560 EnterDeduction( ); 561 fi; 562 od; 563 564 ded := ded + 1; 565 od; 566 CompletionBar(InfoFpGroup,2,"Queue: ",false); 567 568 # get a list of the parent group generators parallel to the table 569 # columns. 570 ggens := [ ]; 571 for i in [ 1 .. numcols/2 ] do 572 ggens[2*i-1] := fgens[i]; 573 ggens[2*i] := fgens[i]^-1; 574 od; 575 576 # initialize the list of new subgroup generators 577 numgens := 0; 578 defs := [ ]; 579 580 # loop over cosets 581 LoopOverAllCosets(); 582 CompletionBar(InfoFpGroup,2,"Coset Loop: ",false); 583 584 # save the number of primary subgroup generators and the number of all 585 # subgroup generators in the tree. 586 tree[3] := treelength; 587 588 # get an immutable coset table with no two columns identical. 589 if IsMutable( table ) then 590 cosTable := Immutable( table ); 591 else 592 cosTable := table; 593 fi; 594 595 # separate pairs of identical columns in the coset factor table. 596 for i in [ 1 .. Length( fgens ) ] do 597 if i in involutions then 598 coFacTable[2*i] := StructuralCopy( coFacTable[2*i-1] ); 599 fi; 600 od; 601 602 # create the augmented coset table record. 603 aug := rec( ); 604 aug.isAugmentedCosetTable := true; 605 aug.type := type; 606 aug.tableType := TABLE_TYPE_RRS; 607 aug.groupGenerators := fgens; 608 aug.groupRelators := grels; 609 aug.cosetTable := cosTable; 610 aug.cosetFactorTable := coFacTable; 611 aug.primaryGeneratorWords := defs; 612 aug.tree := tree; 613 614 # renumber the generators such that the primary ones precede the 615 # secondary ones, and sort the tree and the factor table accordingly. 616 if type = 2 then 617 RenumberTree( aug ); 618 619 # determine which generators occur in the augmented table. 620 occur := ListWithIdenticalEntries( treelength, 0 ); 621 for i in [ 1 .. numgens ] do 622 occur[i] := 1; 623 od; 624 numcols := Length( coFacTable ); 625 numoccs := numgens; 626 i := 1; 627 while i < numcols do 628 for next in coFacTable[i] do 629 if next <> 0 then 630 j := AbsInt( next ); 631 if occur[j] = 0 then 632 occur[j] := 1; numoccs := numoccs + 1; 633 fi; 634 fi; 635 od; 636 i := i + 2; 637 od; 638 639 # build up a list of pointers from the occurring generators to the 640 # tree, and define names for the occurring secondary generators. 641 ngens := numgens; 642 treeNums := [ 1 .. numoccs ]; 643 for j in [ numgens+1 .. treelength ] do 644 if occur[j] <> 0 then 645 ngens := ngens + 1; 646 treeNums[ngens] := j; 647 fi; 648 od; 649 aug.treeNumbers := treeNums; 650 651 # get ngens new generators 652 F := FreeGroup( ngens, string ); 653 gens := GeneratorsOfGroup( F ); 654 655 # prepare a conversion list for the subgroup generator numbers if 656 # they do not all occur in the subgroup relators. 657 numgens := Length( gens ); 658 if numgens < treelength then 659 convert := ListWithIdenticalEntries( treelength, 0 ); 660 for i in [ 1 .. numgens ] do 661 convert[treeNums[i]] := i; 662 od; 663 aug.conversionList := convert; 664 fi; 665 aug.numberOfSubgroupGenerators := ngens; 666 aug.nameOfSubgroupGenerators := Immutable( string ); 667 aug.subgroupGenerators := gens; 668 fi; 669 670 # ensure that all components of the augmented coset table are immutable. 671 for field in RecNames( aug ) do 672 MakeImmutable( aug.(field) ); 673 od; 674 675 # display a message 676 numgens := Length( defs ); 677 Info( InfoFpGroup, 1, "RRS defined ", numgens, " primary and ", 678 treelength - numgens, " secondary subgroup generators" ); 679 680 # return the augmented coset table. 681 return aug; 682end ); 683 684 685############################################################################# 686## 687#M AugmentedCosetTableNormalClosure( <G>, <H> ) . . . augmented coset table 688#M of the normal closure of a subgroup in a finitely presented group 689## 690InstallMethod( AugmentedCosetTableNormalClosure, 691 "for finitely presented groups", 692 true, 693 [ IsSubgroupFpGroup and IsGroupOfFamily, IsSubgroupFpGroup ], 694 0, 695function( G, H ); 696 697 if G <> FamilyObj( H )!.wholeGroup then 698 Error( "<H> must be a subgroup of <G>" ); 699 fi; 700 return AugmentedCosetTableNormalClosureInWholeGroup( H ); 701 702end ); 703 704 705############################################################################# 706## 707#M CosetTableBySubgroup(<G>,<H>) 708## 709## returns a coset table for the action of <G> on the cosets of <H>. The 710## columns of the table correspond to the `GeneratorsOfGroup(<G>)'. 711## 712InstallMethod(CosetTableBySubgroup,"coset action",IsIdenticalObj, 713 [IsGroup,IsGroup],0, 714function ( G, H ) 715local column, gens, i, range, table, transversal; 716 717 # construct a permutations representation of G on the cosets of H. 718 gens := GeneratorsOfGroup(G); 719 if not (IsPermGroup(G) and IsPermGroup(H) and 720 IsEqualSet(Orbit(G,1),[1..NrMovedPoints(G)]) and H=Stabilizer(G,1)) then 721 transversal := RightTransversal( G, H ); 722 gens := List( gens, gen -> Permutation( gen, transversal,OnRight ) ); 723 range := [ 1 .. Length( transversal ) ]; 724 else 725 range := [ 1 .. NrMovedPoints(G) ]; 726 fi; 727 728 # initialize the coset table. 729 table := []; 730 731 # construct the columns of the table from the permutations. 732 for i in gens do 733 column := OnTuples( range, i ); 734 Add( table, column ); 735 column:=OnTuples(range,i^-1); 736 Add( table, column ); 737 od; 738 739 # standardize the table and return it. 740 StandardizeTable( table ); 741 return table; 742 743end); 744 745InstallMethod(CosetTableBySubgroup,"use `CosetTableInWholeGroup", 746 IsIdenticalObj, [IsSubgroupFpGroup,IsSubgroupFpGroup],0, 747function(G,H) 748 if IndexInWholeGroup(G)>1 or not IsIdenticalObj(G,Parent(G)) 749 or List(GeneratorsOfGroup(G),UnderlyingElement) 750 <>FreeGeneratorsOfFpGroup(Parent(G)) then 751 TryNextMethod(); 752 fi; 753 return CosetTableInWholeGroup(H); 754end); 755 756 757############################################################################# 758## 759#M CanonicalRelator( <relator> ) . . . . . . . . . . . . canonical relator 760## 761## 'CanonicalRelator' returns the canonical representative of the given 762## relator. 763## 764InstallGlobalFunction( CanonicalRelator, function ( Rel ) 765 766 local i, i1, ii, j, j1, jj, k, k1, kk, length, max, min, rel; 767 768 rel := Rel; 769 length := Length( rel ); 770 max := Maximum( rel ); 771 min := Minimum( rel ); 772 773 if max < - min then 774 i := 0; 775 else 776 i := Position( rel, max, 0 ); 777 k := i; 778 while k <> false do 779 k := Position( rel, max, k ); 780 if k <> false then 781 ii := i; kk := k; k1 := k - 1; 782 while kk <> k1 do 783 if ii = length then ii := 1; else ii := ii + 1; fi; 784 if kk = length then kk := 1; else kk := kk + 1; fi; 785 if rel[kk] > rel[ii] then i := k; kk := k1; 786 elif rel[kk] < rel[ii] then kk := k1; 787 elif kk = k1 then k := false; fi; 788 od; 789 fi; 790 od; 791 fi; 792 793 if - min < max then 794 j := 0; 795 else 796 j := Position( rel, min, 0 ); 797 k := j; 798 while k <> false do 799 k := Position( rel, min, k ); 800 if k <> false then 801 jj := j; kk := k; j1 := j + 1; 802 while jj <> j1 do 803 if jj = 1 then jj := length; else jj := jj - 1; fi; 804 if kk = 1 then kk := length; else kk := kk - 1; fi; 805 if rel[kk] < rel[jj] then j := k; jj := j1; 806 elif rel[kk] > rel[jj] then jj := j1; 807 elif jj = j1 then k := false; fi; 808 od; 809 fi; 810 od; 811 fi; 812 813 if - min = max then 814 if i = 1 then i1 := length; else i1 := i - 1; fi; 815 ii := i; jj := j; 816 while ii <> i1 do 817 if ii = length then ii := 1; else ii := ii + 1; fi; 818 if jj = 1 then jj := length; else jj := jj - 1; fi; 819 if - rel[jj] < rel[ii] then j := 0; ii := i1; 820 elif - rel[jj] > rel[ii] then i := 0; ii := i1; fi; 821 od; 822 fi; 823 824 if i = 0 then rel := - Reversed( rel ); i := length + 1 - j; fi; 825 if i > 1 then rel := Concatenation( 826 rel{ [i..length] }, rel{ [1..i-1] } ); 827 fi; 828 829 return( rel ); 830end ); 831 832 833############################################################################# 834## 835#M CheckCosetTableFpGroup( <G>, <table> ) . . . . . . . checks a coset table 836## 837## 'CheckCosetTableFpGroup' checks whether table is a legal coset table of 838## the finitely presented group G. 839## 840InstallGlobalFunction( CheckCosetTableFpGroup, function ( G, table ) 841 842 local fgens, grels, i, id, index, ngens, perms; 843 844 # check G to be a finitely presented group. 845 if not ( IsSubgroupFpGroup( G ) and IsGroupOfFamily( G ) ) then 846 Error( "<G> must be a finitely presented group" ); 847 fi; 848 849 # check table to be a list of lists. 850 if not ( IsList( table ) and ForAll( table, IsList ) ) then 851 Error( "<table> must be a coset table" ); 852 fi; 853 854 # get some local variables 855 fgens := FreeGeneratorsOfFpGroup( G ); 856 grels := RelatorsOfFpGroup( G ); 857 858 # check the number of columns against the number of group generators. 859 ngens := Length( fgens ); 860 if Length( table ) <> 2 * ngens then 861 Error( "inconsistent number of group generators and table columns" ); 862 fi; 863 864 # check the columns to be permutations of equal degree. 865 index := IndexCosetTab( table ); 866 perms := [ ]; perms[ngens] := 0; 867 for i in [ 1 .. ngens ] do 868 if Length( table[2*i-1] ) <> index then 869 Error( "table has columns of different length" ); 870 fi; 871 perms[i] := PermList( table[2*i-1] ); 872 if PermList( table[2*i] ) <> perms[i]^-1 then 873 Error( "table has inconsistent inverse columns" ); 874 fi; 875 od; 876 877 # check the permutations to act transitively. 878 id := perms[1]^0; 879 if not IsTransitive( GroupByGenerators( perms, id ), [ 1 .. index ] ) then 880 Error( "table does not act transitively" ); 881 fi; 882 883 # check the permutations to satisfy the group relators. 884 if not ForAll( grels, rel -> MappedWord( rel, fgens, perms ) 885 = id ) then 886 Error( "table columns do not satisfy the group relators" ); 887 fi; 888 889end ); 890 891 892############################################################################# 893## 894#M IsStandardized( <costab> ) . . . . . test if coset table is standardized 895## 896InstallGlobalFunction( IsStandardized, function ( table ) 897 898 local i, index, j, next; 899 900 index := IndexCosetTab( table ); 901 j := 1; 902 next := 2; 903 while next < index do 904 for i in [ 1, 3 .. Length( table ) - 1 ] do 905 if table[i][j] >= next then 906 if table[i][j] > next then return false; fi; 907 next := next + 1; 908 fi; 909 od; 910 j := j + 1; 911 od; 912 return true; 913 914end ); 915 916 917############################################################################# 918## 919#R IsPresentationDefaultRep( <pres> ) 920## 921## is the default representation of presentations. 922## `IsPresentationDefaultRep' is a subrepresentation of 923## `IsComponentObjectRep'. 924## 925DeclareRepresentation( "IsPresentationDefaultRep", 926 IsComponentObjectRep and IsAttributeStoringRep, [] ); 927#T eventually the admissible component names should be listed here 928 929 930############################################################################# 931## 932#M \.( <pres>, <nam> ) . . . . . . . . . . . . . . . . . for a presentation 933## 934InstallMethod( \., 935 "for a presentation in default representation", 936 true, 937 [ IsPresentation and IsPresentationDefaultRep, IsPosInt ], 0, 938 function( pres, nam ) 939Error("still record access"); 940 return pres!.( NameRNam( nam ) ); 941 end ); 942 943 944############################################################################# 945## 946#M IsBound\.( <pres>, <nam> ) . . . . . . . . . . . . . . for a presentation 947## 948InstallMethod( IsBound\., 949 "for a presentation in default representation", 950 true, 951 [ IsPresentation and IsPresentationDefaultRep, IsPosInt ], 0, 952 function( pres, nam ) 953Error("still record access"); 954 return IsBound( pres!.( NameRNam( nam ) ) ); 955 end ); 956 957 958############################################################################# 959## 960#M \.\:\=( <pres>, <nam>, <val> ) . . . . . . . . . . . . for a presentation 961## 962InstallMethod( \.\:\=, 963 "for a mutable presentation in default representation", 964 true, 965 [ IsPresentation and IsPresentationDefaultRep and IsMutable, 966 IsPosInt, IsObject ], 0, 967 function( pres, nam, val ) 968Error("still record access"); 969 pres!.( NameRNam( nam ) ):= val; 970 end ); 971 972 973############################################################################# 974## 975#M Unbind\.( <pres>, <nam> ) . . . . . . . . . . . . . . for a presentation 976## 977InstallMethod( Unbind\., 978 "for a mutable presentation in default representation", 979 true, 980 [ IsPresentation and IsPresentationDefaultRep and IsMutable, 981 IsPosInt ], 0, 982 function( pres, nam ) 983Error("still record access"); 984 Unbind( pres!.( NameRNam( nam ) ) ); 985 end ); 986 987 988############################################################################# 989## 990#M PresentationAugmentedCosetTable( <aug>, <string> [,<print level>] ) . . . 991#M create a Tietze record 992## 993## 'PresentationAugmentedCosetTable' creates a presentation, i.e. a Tietze 994## record, from the given augmented coset table. It assumes that <aug> is an 995## augmented coset table of type 2. The generators will be named <string>1, 996## <string>2, ... . 997## 998InstallGlobalFunction( PresentationAugmentedCosetTable, 999 function ( arg ) 1000 1001 local aug, coFacTable, comps, F, fgens, gens, i, invs, lengths, numgens, 1002 numrels, pointers, printlevel, rels, string, T, tietze, total, 1003 tree, treelength, treeNums; 1004 1005 # check the first argument to be an augmented coset table. 1006 aug := arg[1]; 1007 if not ( IsRecord( aug ) and IsBound( aug.isAugmentedCosetTable ) and 1008 aug.isAugmentedCosetTable ) then 1009 Error( "first argument must be an augmented coset table" ); 1010 fi; 1011 1012 # get the generators name. 1013 string := arg[2]; 1014 if not IsString( string ) then 1015 Error( "second argument must be a string" ); 1016 fi; 1017 1018 # check the third argument to be an integer. 1019 printlevel := 1; 1020 if Length( arg ) >= 3 then printlevel := arg[3]; fi; 1021 if not IsInt( printlevel ) then 1022 Error ("third argument must be an integer" ); 1023 fi; 1024 1025 # initialize some local variables. 1026 coFacTable := aug.cosetFactorTable; 1027 tree := ShallowCopy( aug.tree ); 1028 treeNums := ShallowCopy( aug.treeNumbers ); 1029 treelength := Length( tree[1] ); 1030 F := FreeGroup(IsLetterWordsFamily, infinity, string ); 1031 fgens := GeneratorsOfGroup( F ); 1032 gens := ShallowCopy(aug.subgroupGenerators); 1033 rels := List(aug.subgroupRelators,ShallowCopy); 1034 numrels := Length( rels ); 1035 numgens := Length( gens ); 1036 1037 # create the Tietze object. 1038 T := Objectify( NewType( PresentationsFamily, 1039 IsPresentationDefaultRep 1040 and IsPresentation 1041 and IsMutable ), 1042 rec() ); 1043 1044 # construct the relator lengths list. 1045 lengths := List( [ 1 .. numrels ], i -> Length( rels[i] ) ); 1046 total := Sum( lengths ); 1047 1048 # initialize the Tietze stack. 1049 tietze := ListWithIdenticalEntries( TZ_LENGTHTIETZE, 0 ); 1050 tietze[TZ_NUMRELS] := numrels; 1051 tietze[TZ_RELATORS] := rels; 1052 tietze[TZ_LENGTHS] := lengths; 1053 tietze[TZ_FLAGS] := ListWithIdenticalEntries( numrels, 1 ); 1054 tietze[TZ_TOTAL] := total; 1055 1056 # construct the generators and the inverses list, and save the generators 1057 # as components of the Tietze record. 1058 invs := [ ]; invs[2*numgens+1] := 0; 1059 pointers := [ 1 .. treelength ]; 1060 for i in [ 1 .. numgens ] do 1061 invs[numgens+1-i] := i; 1062 invs[numgens+1+i] := - i; 1063 T!.(String( i )) := fgens[i]; 1064 pointers[treeNums[i]] := treelength + i; 1065 od; 1066 invs[numgens+1] := 0; 1067 comps := [ 1 .. numgens ]; 1068 1069 # define the remaining Tietze stack entries. 1070 tietze[TZ_FREEGENS] := fgens; 1071 tietze[TZ_NUMGENS] := numgens; 1072 tietze[TZ_GENERATORS] := List( [ 1 .. numgens ], i -> fgens[i] ); 1073 tietze[TZ_INVERSES] := invs; 1074 tietze[TZ_NUMREDUNDS] := 0; 1075 tietze[TZ_STATUS] := [ 0, 0, -1 ]; 1076 tietze[TZ_MODIFIED] := false; 1077 1078 # define some Tietze record components. 1079 T!.generators := tietze[TZ_GENERATORS]; 1080 T!.tietze := tietze; 1081 T!.components := comps; 1082 T!.nextFree := numgens + 1; 1083 T!.identity := One( fgens[1] ); 1084 SetOne(T,One( fgens[1] )); 1085 1086 # save the tree as component of the Tietze record. 1087 tree[TR_TREENUMS] := treeNums; 1088 tree[TR_TREEPOINTERS] := pointers; 1089 tree[TR_TREELAST] := treelength; 1090 T!.tree := tree; 1091 1092 # save the definitions of the primary generators as words in the original 1093 # group generators. 1094 SetPrimaryGeneratorWords(T,aug.primaryGeneratorWords); 1095 1096 # Since T is mutable, we must set this attribite "manually" 1097 SetTzOptions(T, TzOptions(T)); 1098 1099 # handle relators of length 1 or 2, but do not eliminate any primary 1100 # generators. 1101 TzOptions(T).protected := tree[TR_PRIMARY]; 1102 TzOptions(T).printLevel := printlevel; 1103 if Length(arg)>3 and arg[4]=true then 1104 # the stupid Length1or2 convention might mess up the connection to the 1105 # coset table. 1106 TzInitGeneratorImages(T); 1107 fi; 1108 if numgens>0 then 1109 TzHandleLength1Or2Relators( T ); 1110 fi; 1111 T!.hasRun1Or2:=true; 1112 TzOptions(T).protected := 0; 1113 1114 # sort the relators. 1115 TzSort( T ); 1116 1117 TzOptions(T).printLevel := printlevel; 1118 # return the Tietze record. 1119 return T; 1120end ); 1121 1122 1123############################################################################# 1124## 1125#M PresentationNormalClosureRrs( <G>, <H> [,<string>] ) . . . Tietze record 1126#M for the normal closure of a subgroup 1127## 1128## 'PresentationNormalClosureRrs' uses the Reduced Reidemeister-Schreier 1129## method to compute a presentation (i.e. a presentation record) for the 1130## normal closure N, say, of a subgroup H of a finitely presented group G. 1131## The generators in the resulting presentation will be named <string>1, 1132## <string>2, ... , the default string is `\"_x\"'. 1133## 1134InstallGlobalFunction( PresentationNormalClosureRrs, 1135 function ( arg ) 1136 1137 local G, # given group 1138 H, # given subgroup 1139 string, # given string 1140 F, # associated free group 1141 fgens, # generators of <F> 1142 hgens, # generators of <H> 1143 fhgens, # their preimages in <F> 1144 grels, # relators of <G> 1145 krels, # relators of normal closure <N> 1146 K, # factor group of F isomorphic to G/N 1147 cosTable, # coset table of <G> by <N> 1148 i, # loop variable 1149 aug, # auxiliary coset table of <G> by <N> 1150 T; # resulting Tietze record 1151 1152 # check the first two arguments to be a finitely presented group and a 1153 # subgroup of that group. 1154 G := arg[1]; 1155 if not ( IsSubgroupFpGroup( G ) and IsGroupOfFamily( G ) ) then 1156 Error( "<G> must be a finitely presented group" ); 1157 fi; 1158 H := arg[2]; 1159 if not IsSubgroupFpGroup( H ) or FamilyObj( H ) <> FamilyObj( G ) then 1160 Error( "<H> must be a subgroup of <G>" ); 1161 fi; 1162 1163 # get the generators name. 1164 if Length( arg ) = 2 then 1165 string := "_x"; 1166 else 1167 string := arg[3]; 1168 if not IsString( string ) then 1169 Error( "third argument must be a string" ); 1170 fi; 1171 fi; 1172 1173 # get some local variables 1174 F := FreeGroupOfFpGroup( G ); 1175 fgens := GeneratorsOfGroup( F ); 1176 grels := RelatorsOfFpGroup( G ); 1177 hgens := GeneratorsOfGroup( H ); 1178 fhgens := List( hgens, gen -> UnderlyingElement( gen ) ); 1179 1180 # construct a factor group K of F isomorphic to the factor group of G by 1181 # the normal closure N of H. 1182 krels := Concatenation( grels, fhgens ); 1183 K := F / krels; 1184 1185 # get the coset table of N in G by constructing the coset table of the 1186 # trivial subgroup in K. 1187 cosTable := CosetTable( K, TrivialSubgroup( K ) ); 1188 Info( InfoFpGroup, 1, "index is ", Length( cosTable[1] ) ); 1189 1190# # obsolete: No columns should be equal! 1191# for i in [ 1 .. Length( fgens ) ] do 1192# if IsIdenticalObj( cosTable[2*i-1], cosTable[2*i] ) then 1193# Error( "there is a bug in PresentationNormalClosureRrs" ); fi; od; 1194 1195 # apply the Reduced Reidemeister-Schreier method to construct a coset 1196 # table presentation of N. 1197 aug := AugmentedCosetTableRrs( G, cosTable, 2, string ); 1198 1199 # determine a set of subgroup relators. 1200 aug.subgroupRelators := RewriteSubgroupRelators( aug, aug.groupRelators); 1201 1202 # create a Tietze record for the resulting presentation. 1203 T := PresentationAugmentedCosetTable( aug, string ); 1204 1205 # handle relators of length 1 or 2, but do not eliminate any primary 1206 # generators. 1207 TzOptions(T).protected := T!.tree[TR_PRIMARY]; 1208 TzHandleLength1Or2Relators( T ); 1209 T!.hasRun1Or2:=true; 1210 TzOptions(T).protected := 0; 1211 1212 # sort the relators. 1213 TzSort( T ); 1214 1215 return T; 1216end ); 1217 1218############################################################################# 1219## 1220#M PresentationSubgroupRrs( <G>, <H> [,<string>] ) . . . . . . Tietze record 1221#M PresentationSubgroupRrs( <G>, <costab> [,<string>] ) . . for a subgroup 1222## 1223## 'PresentationSubgroupRrs' uses the Reduced Reidemeister-Schreier method 1224## to compute a presentation (i.e. a presentation record) for a subgroup H 1225## of a finitely presented group G. The generators in the resulting 1226## presentation will be named <string>1, <string>2, ... , the default 1227## string is "_x". 1228## 1229## Alternatively to a finitely presented group, the subgroup H may be given 1230## by its coset table. 1231## 1232InstallGlobalFunction( PresentationSubgroupRrs, function ( arg ) 1233 1234 local aug, G, gens, H, ngens, string, T, table; 1235 1236 # check G to be a finitely presented group. 1237 G := arg[1]; 1238 if not ( IsSubgroupFpGroup( G ) and IsGroupOfFamily( G ) ) then 1239 Error( "<group> must be a finitely presented group" ); 1240 fi; 1241 1242 # get the generators name. 1243 if Length( arg ) = 2 then 1244 string := "_x"; 1245 else 1246 string := arg[3]; 1247 if not IsString( string ) then 1248 Error( "third argument must be a string" ); 1249 fi; 1250 fi; 1251 1252 # check the second argument to be a subgroup or a coset table of G, and 1253 # get the coset table in either case. 1254 H := arg[2]; 1255 if not IsSubgroupFpGroup( H ) or FamilyObj( H ) <> FamilyObj( G ) then 1256 1257 # check the given table to be a legal coset table. 1258 table := H; 1259 CheckCosetTableFpGroup( G, table ); 1260 # ensure that it is standardized. 1261 if not IsStandardized( table) then Print( 1262 "#I Warning: the given coset table is not standardized,\n", 1263 "#I a standardized copy will be used instead.\n" ); 1264 StandardizeTable( StructuralCopy( table ) ); 1265 fi; 1266 1267 # apply the Reduced Reidemeister-Schreier method to construct an 1268 # augmented RRS coset table of H. 1269 aug := AugmentedCosetTableRrs( G, table, 2, string ); 1270 1271 else 1272 1273 # get a copy of an augmented RRS coset table of H in G. 1274 aug := CopiedAugmentedCosetTable( 1275 AugmentedCosetTableRrsInWholeGroup( H ) ); 1276 1277 # insert the required subgroup generator names if necessary. 1278 if aug.nameOfSubgroupGenerators <> string then 1279 aug.nameOfSubgroupGenerators := string; 1280 ngens := aug.numberOfSubgroupGenerators; 1281 gens := GeneratorsOfGroup( FreeGroup( ngens, string ) ); 1282 aug.subgroupGenerators := gens; 1283 fi; 1284 1285 fi; 1286 1287 # determine a set of subgroup relators. 1288 aug.subgroupRelators := RewriteSubgroupRelators( aug, aug.groupRelators); 1289 1290 # create a Tietze record for the resulting presentation. 1291 T := PresentationAugmentedCosetTable( aug, string ); 1292 1293 return T; 1294end ); 1295 1296 1297############################################################################# 1298## 1299#M ReducedRrsWord( <word> ) . . . . . . . . . . . . . . freely reduce a word 1300## 1301## 'ReducedRrsWord' freely reduces the given RRS word and returns the result. 1302## 1303InstallGlobalFunction( ReducedRrsWord, function ( word ) 1304 1305 local i, j, reduced; 1306 1307 # initialize the result. 1308 reduced := []; 1309 1310 # run through the factors of the given word and cancel or add them. 1311 j := 0; 1312 for i in [ 1 .. Length( word ) ] do 1313 if word[i] <> 0 then 1314 if j > 0 and word[i] = - reduced[j] then j := j-1; 1315 else j := j+1; reduced[j] := word[i]; fi; 1316 fi; 1317 od; 1318 1319 if j < Length( reduced ) then 1320 reduced := reduced{ [1..j] }; 1321 fi; 1322 1323 return( reduced ); 1324end ); 1325 1326 1327############################################################################# 1328## 1329#M RelatorMatrixAbelianizedNormalClosureRrs( <G>, <H> ) . . relator matrix 1330#M . . . . . . . . . . . . for the abelianized normal closure of a subgroup 1331## 1332## 'RelatorMatrixAbelianizedNormalClosureRrs' uses the Reduced Reidemeister- 1333## Schreier method to compute a matrix of abelianized defining relators for 1334## the normal closure of a subgroup H of a finitely presented group G. 1335## 1336InstallGlobalFunction( RelatorMatrixAbelianizedNormalClosureRrs, 1337 function ( G, H ) 1338 1339 local F, # associated free group 1340 fgens, # generators of <F> 1341 hgens, # generators of <H> 1342 fhgens, # their preimages in <F> 1343 grels, # relators of <G> 1344 krels, # relators of normal closure <N> 1345 K, # factor group of F isomorphic to G/N 1346 cosTable, # coset table of <G> by <N> 1347 i, # loop variable 1348 aug; # auxiliary coset table of <G> by <N> 1349 1350 # check the arguments to be a finitely presented group and a subgroup of 1351 # that group. 1352 if not ( IsSubgroupFpGroup( G ) and IsGroupOfFamily( G ) ) then 1353 Error( "<G> must be a finitely presented group" ); 1354 fi; 1355 if not IsSubgroupFpGroup( H ) or FamilyObj( H ) <> FamilyObj( G ) then 1356 Error( "<H> must be a subgroup of <G>" ); 1357 fi; 1358 1359 # get some local variables 1360 F := FreeGroupOfFpGroup( G ); 1361 fgens := GeneratorsOfGroup( F ); 1362 grels := RelatorsOfFpGroup( G ); 1363 hgens := GeneratorsOfGroup( H ); 1364 fhgens := List( hgens, gen -> UnderlyingElement( gen ) ); 1365 1366 # construct a factor group K of F isomorphic to the factor group of G by 1367 # the normal closure N of H. 1368 krels := Concatenation( grels, fhgens ); 1369 K := F / krels; 1370 1371 # get the coset table of N in G by constructing the coset table of the 1372 # trivial subgroup in K. 1373 cosTable := CosetTable( K, TrivialSubgroup( K ) ); 1374 Info( InfoFpGroup, 1, "index is ", Length( cosTable[1] ) ); 1375 1376# # obsolete: No columns should be equal! 1377# for i in [ 1 .. Length( fgens ) ] do 1378# if IsIdenticalObj( cosTable[2*i-1], cosTable[2*i] ) then 1379# Error( "there is a bug in RelatorMatrixAbelianizedNormalClosureRrs" ); 1380# fi; od; 1381 1382 # apply the Reduced Reidemeister-Schreier method to construct a coset 1383 # table presentation of N. 1384 aug := AugmentedCosetTableRrs( G, cosTable, 0, "_x" ); 1385 1386 # determine a set of abelianized subgroup relators. 1387 aug.subgroupRelators := RewriteAbelianizedSubgroupRelators( aug, 1388 aug.groupRelators); 1389 1390 return aug.subgroupRelators; 1391 1392end ); 1393 1394RelatorMatrixAbelianizedNormalClosure := 1395 RelatorMatrixAbelianizedNormalClosureRrs; 1396 1397 1398 1399############################################################################# 1400## 1401#M RelatorMatrixAbelianizedSubgroupRrs( <G>, <H> ) . . . relator matrix for 1402#M RelatorMatrixAbelianizedSubgroupRrs( <G>, <costab> ) . . an abelianized 1403#M . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . subgroup 1404## 1405## 'RelatorMatrixAbelianizedSubgroupRrs' uses the Reduced Reidemeister- 1406## Schreier method to compute a matrix of abelianized defining relators for 1407## a subgroup H of a finitely presented group G. 1408## 1409## Alternatively to a finitely presented group, the subgroup H may be given 1410## by its coset table. 1411## 1412InstallGlobalFunction( RelatorMatrixAbelianizedSubgroupRrs, function ( G, H ) 1413 1414 local aug, table,i,j,vec,pres; 1415 1416 # check G to be a finitely presented group. 1417 if not ( IsSubgroupFpGroup( G ) and IsGroupOfFamily( G ) ) then 1418 Error( "<group> must be a finitely presented group" ); 1419 fi; 1420 1421 1422 # check the second argument to be a subgroup or a coset table of G, and 1423 # get the coset table in either case. 1424 if not IsSubgroupFpGroup( H ) or FamilyObj( H ) <> FamilyObj( G ) then 1425 # check the given table to be a legal coset table. 1426 table := H; 1427 CheckCosetTableFpGroup( G, table ); 1428 # ensure that it is standardized. 1429 if not IsStandardized( table) then Print( 1430 "#I Warning: the given coset table is not standardized,\n", 1431 "#I a standardized copy will be used instead.\n" ); 1432 StandardizeTable( StructuralCopy( table ) ); 1433 fi; 1434 else 1435 # construct the coset table of H in G if it is not yet available. 1436 if not HasCosetTableInWholeGroup( H ) then 1437 Info( InfoFpGroup, 1, "index is ", IndexInWholeGroup( H ) ); 1438 fi; 1439 table := CosetTableInWholeGroup( H ); 1440 fi; 1441 1442 # apply the Reduced Reidemeister-Schreier method to construct an 1443 # augmented coset table of H. 1444 aug := AugmentedCosetTableRrs( G, table, 0, "_x" ); 1445 1446 # determine a set of abelianized subgroup relators. 1447 aug.subgroupRelators := RewriteAbelianizedSubgroupRelators( aug, 1448 aug.groupRelators); 1449 if aug.subgroupRelators=fail then 1450 # the abelianized rewriting in the kernel failed because the 1451 # coefficients were to large. 1452 return fail; 1453 1454 fi; 1455 1456 return aug.subgroupRelators; 1457 1458end ); 1459 1460 1461############################################################################# 1462## 1463#M RenumberTree( <augmented coset table> ) . . . . . renumber generators in 1464#M augmented coset table 1465## 1466## 'RenumberTree' is a subroutine of the Reduced Reidemeister-Schreier 1467## routines. It renumbers the generators such that the primary generators 1468## precede the secondary ones. 1469## 1470InstallGlobalFunction( RenumberTree, function ( aug ) 1471 1472 local coFacTable, column, convert, defs, i, index, j, k, null, numcols, 1473 numgens, tree, tree1, tree2, treelength, treesize; 1474 1475 # get factor table, generators, and tree. 1476 coFacTable := aug.cosetFactorTable; 1477 defs := aug.primaryGeneratorWords; 1478 tree := aug.tree; 1479 1480 # truncate the tree, if necessary. 1481 treelength := tree[3]; 1482 treesize := Length( tree[1] ); 1483 if treelength < treesize then 1484 tree[1] := tree[1]{ [ 1 .. treelength ] }; 1485 tree[2] := tree[2]{ [ 1 .. treelength ] }; 1486 fi; 1487 1488 # initialize some local variables. 1489 numcols := Length( coFacTable ); 1490 index := Length( coFacTable[1] ); 1491 numgens := Length( defs ); 1492 1493 # establish a local renumbering list. 1494 convert := ListWithIdenticalEntries( 2 * treelength + 1, 0 ); 1495 null := treelength + 1; 1496 j := treelength + 1; k := numgens + 1; 1497 i := treelength; 1498 while i >= 1 do 1499 if tree[1][i] = 0 then 1500 k := k - 1; convert[null+i] := k; convert[null-i] := - k; 1501 else 1502 j := j - 1; convert[null+i] := j; convert[null-i] := - j; 1503 tree[1][j] := tree[1][i]; tree[2][j] := tree[2][i]; 1504 fi; 1505 i := i - 1; 1506 od; 1507 1508 if convert[null+numgens] <> numgens then 1509 1510 # change the tree entries accordingly. 1511 for i in [1..numgens] do 1512 tree[1][i] := 0; tree[2][i] := 0; 1513 od; 1514 tree1 := tree[1]; tree2 := tree[2]; 1515 for j in [numgens+1..treelength] do 1516 tree1[j] := convert[null+tree1[j]]; 1517 tree2[j] := convert[null+tree2[j]]; 1518 od; 1519 1520 # change the factor table entries accordingly. 1521 for i in [1..numcols] do 1522# -------------- 1523# obsolete condition: columns should never be equal. 1524# if i mod 2 = 1 or 1525# not IsIdenticalObj( coFacTable[i], coFacTable[i-1] ) then 1526if i > 1 and IsIdenticalObj( coFacTable[i], coFacTable[i-1] ) then 1527Error( "there is a bug in RenumberTree" ); fi; 1528# -------------- 1529 column := coFacTable[i]; 1530 for j in [1..index] do 1531 column[j] := convert[null+column[j]]; 1532 od; 1533 od; 1534 1535 fi; 1536end ); 1537 1538 1539############################################################################# 1540## 1541#M RewriteAbelianizedSubgroupRelators( <aug>,<prels> ) . rewrite abelianized 1542#M . . . . . . . . . . . . . subgroup relators from an augmented coset table 1543## 1544## 'RewriteAbelianizedSubgroupRelators' is a subroutine of the Reduced 1545## Reidemeister-Schreier and the Modified Todd-Coxeter routines. It computes 1546## a set of subgroup relators from the coset factor table of an augmented 1547## coset table of type 0 and the relators <prels> of the parent group. 1548## 1549InstallGlobalFunction( RewriteAbelianizedSubgroupRelators, 1550 function ( aug,prels ) 1551 1552 local app2, coFacTable, cols, cosTable, factor, ggensi, grel,greli, i, 1553 index, j, length, nums, numgens, numrels, p, rels, total, tree, 1554 treelength, type,si,ei,nneg,word; 1555 1556 # check the type for being zero. 1557 type := aug.type; 1558 if type <> 0 then 1559 Error( "type of augmented coset table is not zero" ); 1560 fi; 1561 1562 # initialize some local variables. 1563 ggensi := List(aug.groupGenerators,i->AbsInt(LetterRepAssocWord(i)[1])); 1564 cosTable := aug.cosetTable; 1565 coFacTable := aug.cosetFactorTable; 1566 index := Length( cosTable[1] ); 1567 tree := aug.tree; 1568 treelength := tree[3]; 1569 numgens := tree[4]; 1570 total := numgens; 1571 rels := List( [ 1 .. total ], 1572 i -> ListWithIdenticalEntries( numgens, 0 ) ); 1573 numrels := 0; 1574 1575 # display some information. 1576 Info( InfoFpGroup, 2, "index is ", index ); 1577 Info( InfoFpGroup, 2, "number of generators is ", numgens ); 1578 Info( InfoFpGroup, 2, "tree length is ", treelength ); 1579 1580 # initialize the structure that is passed to 'ApplyRel2' 1581 app2 := ListWithIdenticalEntries( 9, 0 ); 1582 app2[5] := type; 1583 app2[6] := coFacTable; 1584 app2[8] := tree; 1585 1586 # loop over all group relators 1587 for greli in [1..Length(prels)] do 1588 CompletionBar(InfoFpGroup,2,"Relator Loop:",greli/Length(prels)); 1589 grel:=prels[greli]; 1590 1591 # get two copies of the group relator, one as a list of words in the 1592 # factor table columns and one as a list of words in the coset table 1593 # column numbers. 1594 length := Length( grel ); 1595 if length>0 then 1596 1597 nums := [ ]; nums[2*length] := 0; 1598 cols := [ ]; cols[2*length] := 0; 1599 1600 i:=0; 1601# for si in [ 1 .. NrSyllables(grel) ] do 1602# p:=2*Position(ggensi,GeneratorSyllable(grel,si)); 1603# nneg:=ExponentSyllable(grel,si)>0; 1604# for ei in [1..AbsInt(ExponentSyllable(grel,si))] do 1605# i:=i+1; 1606# if nneg then 1607# nums[2*i] := p-1; 1608# nums[2*i-1] := p; 1609# cols[2*i] := cosTable[p-1]; 1610# cols[2*i-1] := cosTable[p]; 1611# else 1612# nums[2*i] := p; 1613# nums[2*i-1] := p-1; 1614# cols[2*i] := cosTable[p]; 1615# cols[2*i-1] := cosTable[p-1]; 1616# fi; 1617# od; 1618# od; 1619 word:=LetterRepAssocWord(grel); 1620 for si in [1..Length(word)] do 1621 p:=2*Position(ggensi,AbsInt(word[si])); 1622 i:=i+1; 1623 if word[si]>0 then 1624 nums[2*i]:=p-1; 1625 nums[2*i-1]:=p; 1626 cols[2*i]:=cosTable[p-1]; 1627 cols[2*i-1]:=cosTable[p]; 1628 else 1629 nums[2*i]:=p; 1630 nums[2*i-1]:=p-1; 1631 cols[2*i]:=cosTable[p]; 1632 cols[2*i-1]:=cosTable[p-1]; 1633 fi; 1634 od; 1635 1636 # loop over all cosets and determine the subgroup relators which are 1637 # induced by the current group relator. 1638 for i in [ 1 .. index ] do 1639 1640 # scan the ith coset through the current group relator and 1641 # collect the factors of its invers (!) in rel. 1642 numrels := numrels + 1; 1643 if numrels > total then 1644 total := total + 1; 1645 rels[total] := ListWithIdenticalEntries( numgens, 0 ); 1646 fi; 1647 app2[7] := rels[numrels]; 1648 app2[1] := 2; 1649 app2[2] := i; 1650 app2[3] := 2 * length - 1; 1651 app2[4] := i; 1652 if not ApplyRel2( app2, cols, nums ) then 1653 return fail; 1654 fi; 1655 1656 # add the resulting subgroup relator to rels. 1657 numrels := AddAbelianRelator( rels, numrels ); 1658 od; 1659 fi; 1660 od; 1661 CompletionBar(InfoFpGroup,2,"Relator Loop:",false); 1662 1663 # loop over all primary subgroup generators. 1664 for j in [ 1 .. numgens ] do 1665 CompletionBar(InfoFpGroup,2,"Generator Loop:",j/numgens); 1666 1667 # get two copies of the subgroup generator, one as a list of words in 1668 # the factor table columns and one as a list of words in the coset 1669 # table column numbers. 1670 grel := aug.primaryGeneratorWords[j]; 1671 length := Length( grel ); 1672 1673 if length>0 then 1674 1675 nums := [ ]; nums[2*length] := 0; 1676 cols := [ ]; cols[2*length] := 0; 1677 1678 i:=0; 1679# for si in [ 1 .. NrSyllables(grel) ] do 1680# p:=2*Position(ggensi,GeneratorSyllable(grel,si)); 1681# nneg:=ExponentSyllable(grel,si)>0; 1682# for ei in [1..AbsInt(ExponentSyllable(grel,si))] do 1683# i:=i+1; 1684# if nneg then 1685# nums[2*i] := p-1; 1686# nums[2*i-1] := p; 1687# cols[2*i] := cosTable[p-1]; 1688# cols[2*i-1] := cosTable[p]; 1689# else 1690# nums[2*i] := p; 1691# nums[2*i-1] := p-1; 1692# cols[2*i] := cosTable[p]; 1693# cols[2*i-1] := cosTable[p-1]; 1694# fi; 1695# od; 1696# od; 1697 word:=LetterRepAssocWord(grel); 1698 for si in [1..Length(word)] do 1699 p:=2*Position(ggensi,AbsInt(word[si])); 1700 i:=i+1; 1701 if word[si]>0 then 1702 nums[2*i]:=p-1; 1703 nums[2*i-1]:=p; 1704 cols[2*i]:=cosTable[p-1]; 1705 cols[2*i-1]:=cosTable[p]; 1706 else 1707 nums[2*i]:=p; 1708 nums[2*i-1]:=p-1; 1709 cols[2*i]:=cosTable[p]; 1710 cols[2*i-1]:=cosTable[p-1]; 1711 fi; 1712 od; 1713 1714 # scan coset 1 through the current subgroup generator and collect the 1715 # factors of its invers (!) in rel. 1716 numrels := numrels + 1; 1717 if numrels > total then 1718 total := total + 1; 1719 rels[total] := ListWithIdenticalEntries( numgens, 0 ); 1720 fi; 1721 app2[7] := rels[numrels]; 1722 app2[1] := 2; 1723 app2[2] := 1; 1724 app2[3] := 2 * length - 1; 1725 app2[4] := 1; 1726 if not ApplyRel2( app2, cols, nums ) then 1727 return fail; 1728 fi; 1729 1730 else 1731 # trivial generator 1732 numrels := numrels + 1; 1733 if numrels > total then 1734 total := total + 1; 1735 rels[total] := ListWithIdenticalEntries( numgens, 0 ); 1736 fi; 1737 fi; 1738 1739 # add as last factor the generator number j. 1740 rels[numrels][j] := rels[numrels][j] + 1; 1741 1742 # add the resulting subgroup relator to rels. 1743 numrels := AddAbelianRelator( rels, numrels ); 1744 od; 1745 1746 # reduce the relator list to its proper size. 1747 if numrels < numgens then 1748 for i in [ numrels + 1 .. numgens ] do 1749 rels[i] := ListWithIdenticalEntries( numgens, 0 ); 1750 od; 1751 numrels := numgens; 1752 fi; 1753 for i in [ numrels + 1 .. total ] do 1754 Unbind( rels[i] ); 1755 od; 1756 CompletionBar(InfoFpGroup,2,"Generator Loop:",false); 1757 1758 return rels; 1759end ); 1760 1761 1762############################################################################# 1763## 1764#M RewriteSubgroupRelators( <aug>, <prels> [,<indices>] ) 1765## 1766## 'RewriteSubgroupRelators' is a subroutine of the Reduced Reidemeister- 1767## Schreier and the Modified Todd-Coxeter routines. It computes a set of 1768## subgroup relators from the coset factor table of an augmented coset table 1769## and the relators <prels> of the parent group. It assumes that <aug> 1770## is an augmented coset table of type 2. 1771## If <indices> are given only those cosets are used 1772## 1773InstallGlobalFunction( RewriteSubgroupRelators, 1774function (arg) 1775 1776 local app2, coFacTable, cols, convert, cosTable, factor, ggensi, 1777 greli,grel, i, index, j, last, length, nums, numgens, p, rel, rels, 1778 treelength, type,si,nneg,ei,word,aug,prels,indices; 1779 1780 aug:=arg[1]; 1781 prels:=arg[2]; 1782 # check the type. 1783 type := aug.type; 1784 if type <> 2 then Error( "invalid type; it should be 2" ); fi; 1785 1786 # initialize some local variables. 1787 ggensi := List(aug.groupGenerators,i->AbsInt(LetterRepAssocWord(i)[1])); 1788 cosTable := aug.cosetTable; 1789 coFacTable := aug.cosetFactorTable; 1790 index := Length( cosTable[1] ); 1791 if Length(arg)=2 then 1792 indices:=[1..index]; 1793 else 1794 indices:=arg[3]; 1795 fi; 1796 rels := [ ]; 1797 1798 # initialize the structure that is passed to 'ApplyRel2' 1799 app2 := ListWithIdenticalEntries( 9, 0 ); 1800 app2[5] := type; 1801 app2[6] := coFacTable; 1802 app2[7] := [ ]; app2[7][100] := 0; 1803 1804 # loop over all group relators 1805 for greli in [1..Length(prels)] do 1806 CompletionBar(InfoFpGroup,2,"Relator Loop:",greli/Length(prels)); 1807 grel:=prels[greli]; 1808 length := Length( grel ); 1809 if length > 0 then 1810 1811 # get two copies of the group relator, one as a list of words in the 1812 # factor table columns and one as a list of words in the coset table 1813 # column numbers. 1814 nums := [ ]; nums[2*length] := 0; 1815 cols := [ ]; cols[2*length] := 0; 1816 1817 i:=0; 1818# for si in [ 1 .. NrSyllables(grel) ] do 1819# p:=2*Position(ggensi,GeneratorSyllable(grel,si)); 1820# nneg:=ExponentSyllable(grel,si)>0; 1821# for ei in [1..AbsInt(ExponentSyllable(grel,si))] do 1822# i:=i+1; 1823# if nneg then 1824# nums[2*i] := p-1; 1825# nums[2*i-1] := p; 1826# cols[2*i] := cosTable[p-1]; 1827# cols[2*i-1] := cosTable[p]; 1828# else 1829# nums[2*i] := p; 1830# nums[2*i-1] := p-1; 1831# cols[2*i] := cosTable[p]; 1832# cols[2*i-1] := cosTable[p-1]; 1833# fi; 1834# od; 1835# od; 1836 word:=LetterRepAssocWord(grel); 1837 for si in [1..Length(word)] do 1838 p:=2*Position(ggensi,AbsInt(word[si])); 1839 i:=i+1; 1840 if word[si]>0 then 1841 nums[2*i]:=p-1; 1842 nums[2*i-1]:=p; 1843 cols[2*i]:=cosTable[p-1]; 1844 cols[2*i-1]:=cosTable[p]; 1845 else 1846 nums[2*i]:=p; 1847 nums[2*i-1]:=p-1; 1848 cols[2*i]:=cosTable[p]; 1849 cols[2*i-1]:=cosTable[p-1]; 1850 fi; 1851 od; 1852 1853 # loop over all cosets and determine the subgroup relators which are 1854 # induced by the current group relator. 1855 for i in indices do 1856 1857 # scan the ith coset through the current group relator and 1858 # collect the factors of its inverse (!) in rel. 1859 app2[1] := 2; 1860 app2[2] := i; 1861 app2[3] := 2 * length - 1; 1862 app2[4] := i; 1863 ApplyRel2( app2, cols, nums ); 1864 1865 # add the resulting subgroup relator to rels. 1866 rel := app2[7]; 1867 last := Length( rel ); 1868 if last > 0 then 1869 MakeCanonical( rel ); 1870 if Length( rel ) > 0 and not rel in rels then 1871 AddSet( rels, Immutable(CopyRel( rel ) )); 1872 fi; 1873 fi; 1874 od; 1875 fi; 1876 od; 1877 CompletionBar(InfoFpGroup,2,"Relator Loop:",false); 1878 1879 # loop over all primary subgroup generators. 1880 numgens := Length( aug.primaryGeneratorWords ); 1881 for j in [ 1 .. numgens ] do 1882 CompletionBar(InfoFpGroup,2,"Generator Loop:",j/numgens); 1883 1884 # get two copies of the subgroup generator, one as a list of words in 1885 # the factor table columns and one as a list of words in the coset 1886 # table column numbers. 1887 grel := aug.primaryGeneratorWords[j]; 1888 length := Length( grel ); 1889 1890 if length>0 then 1891 nums := [ ]; nums[2*length] := 0; 1892 cols := [ ]; cols[2*length] := 0; 1893 1894 i:=0; 1895# for si in [ 1 .. NrSyllables(grel) ] do 1896# p:=2*Position(ggensi,GeneratorSyllable(grel,si)); 1897# nneg:=ExponentSyllable(grel,si)>0; 1898# for ei in [1..AbsInt(ExponentSyllable(grel,si))] do 1899# i:=i+1; 1900# if nneg then 1901# nums[2*i] := p-1; 1902# nums[2*i-1] := p; 1903# cols[2*i] := cosTable[p-1]; 1904# cols[2*i-1] := cosTable[p]; 1905# else 1906# nums[2*i] := p; 1907# nums[2*i-1] := p-1; 1908# cols[2*i] := cosTable[p]; 1909# cols[2*i-1] := cosTable[p-1]; 1910# fi; 1911# od; 1912# od; 1913 word:=LetterRepAssocWord(grel); 1914 for si in [1..Length(word)] do 1915 p:=2*Position(ggensi,AbsInt(word[si])); 1916 i:=i+1; 1917 if word[si]>0 then 1918 nums[2*i]:=p-1; 1919 nums[2*i-1]:=p; 1920 cols[2*i]:=cosTable[p-1]; 1921 cols[2*i-1]:=cosTable[p]; 1922 else 1923 nums[2*i]:=p; 1924 nums[2*i-1]:=p-1; 1925 cols[2*i]:=cosTable[p]; 1926 cols[2*i-1]:=cosTable[p-1]; 1927 fi; 1928 od; 1929 1930 # scan coset 1 through the current subgroup generator and collect the 1931 # factors of its inverse (!) in rel. 1932 app2[1] := 2; 1933 app2[2] := 1; 1934 app2[3] := 2 * length - 1; 1935 app2[4] := 1; 1936 ApplyRel2( app2, cols, nums ); 1937 1938 # add as last factor the generator number j. 1939 rel := app2[7]; 1940 last := Length( rel ); 1941 if last > 0 and rel[last] = - j then 1942 last := last - 1; 1943 rel := rel{ [1 .. last] }; 1944 else 1945 last := last + 1; 1946 rel[last] := j; 1947 fi; 1948 # add the resulting subgroup relator to rels. 1949 if last > 0 then 1950 MakeCanonical( rel ); 1951 if Length( rel ) > 0 and not rel in rels then 1952 AddSet( rels, Immutable(CopyRel(rel))); 1953 fi; 1954 fi; 1955 else 1956 # trivial generator 1957 AddSet(rels,[j]); 1958 fi; 1959 od; 1960 CompletionBar(InfoFpGroup,2,"Generator Loop:",false); 1961 1962 # make mutable again to overwrite 1963 rels:=List(rels,ShallowCopy); 1964 1965 # renumber the generators in the relators, if necessary. 1966 numgens := Length( aug.subgroupGenerators ); 1967 treelength := Length( aug.tree[1] ); 1968 if numgens < treelength then 1969 convert := aug.conversionList; 1970 for rel in rels do 1971 for i in [ 1 .. Length( rel ) ] do 1972 if rel[i] > 0 then 1973 rel[i] := convert[rel[i]]; 1974 else 1975 rel[i] := - convert[-rel[i]]; 1976 fi; 1977 od; 1978 od; 1979 fi; 1980 1981 return rels; 1982end ); 1983 1984 1985############################################################################# 1986## 1987#M SortRelsSortedByStartGen(<relsGen>) sort the relators sorted by start gen 1988## 1989## 'SortRelsSortedByStartGen' sorts the relators lists sorted by starting 1990## generator to get better results of the Reduced Reidemeister-Schreier 1991## (this is not needed for the Felsch Todd-Coxeter). 1992## 1993InstallGlobalFunction( SortRelsSortedByStartGen, 1994 function ( relsGen ) 1995 local less, list; 1996 1997 # 'less' defines an ordering on the triples [ nums, cols, startpos ] 1998 less := function ( triple1, triple2 ) 1999 local diff, i, k, nums1, nums2; 2000 2001 if triple1[1][1] <> triple2[1][1] then 2002 return triple1[1][1] < triple2[1][1]; 2003 fi; 2004 2005 nums1 := triple1[1]; nums2 := triple2[1]; 2006 i := triple1[3]; 2007 diff := triple2[3] - i; 2008 k := i + nums1[1] + 2; 2009 while i < k do 2010 if nums1[i] <> nums2[i+diff] then 2011 return nums1[i] < nums2[i+diff]; 2012 fi; 2013 i := i + 2; 2014 od; 2015 2016 return false; 2017 end; 2018 2019 # sort the resulting lists 2020 for list in relsGen do 2021 Sort( list, less ); 2022 od; 2023end ); 2024 2025 2026############################################################################# 2027## 2028#M SpanningTree( <coset table> ) . . . . . . . . . . . . . . . spanning tree 2029## 2030## 'SpanningTree' returns a spanning tree for the given coset table. 2031## 2032InstallGlobalFunction( SpanningTree, function ( cosTable ) 2033 2034 local done, i, j, k, numcols, numrows, span1, span2; 2035 2036 # check the given argument to be a coset table. 2037 if not ( IsList( cosTable ) and IsList( cosTable[1] ) ) then 2038 Error( "argument must be a coset table" ); 2039 fi; 2040 numcols := Length( cosTable ); 2041 numrows := Length( cosTable[1] ); 2042 for i in [ 2 .. numcols ] do 2043 if not ( IsList( cosTable[i] ) and 2044 Length( cosTable[i] ) = numrows ) then 2045 Error( "argument must be a coset table" ); 2046 fi; 2047 od; 2048 2049 # initialize the spanning tree. 2050 span1 := [ -1, -2 .. -numrows ]; 2051 span2 := ListWithIdenticalEntries( numrows, 0 ); 2052 span1[1] := 0; 2053 if numrows = 1 then return [ span1, span2 ]; fi; 2054 2055 # find the first occurrence in the table of each coset > 1. 2056 done := [ 1 ]; 2057 for i in done do 2058 for j in [ 1 .. numcols ] do 2059 k := cosTable[j][i]; 2060 if span1[k] < 0 then 2061 span1[k] := i; span2[k] := j; 2062 Add( done, k ); 2063 if Length( done ) = numrows then 2064 return [ span1, span2 ]; 2065 fi; 2066 fi; 2067 od; 2068 od; 2069 2070 # you should never come here, the argument is not a valid coset table. 2071 Error( "argument must be a coset table" ); 2072end ); 2073 2074############################################################################# 2075## 2076## Extensions for rewriting and homomorphisms 2077## 2078 2079############################################################################# 2080## 2081#F RewriteWord( <aug>, <word> ) 2082## 2083InstallGlobalFunction(RewriteWord,function ( aug, word ) 2084local cft, ct, w,l,c,i,j,g,e,ind; 2085 2086 # check the type. 2087 Assert(1,aug.type=2); 2088 2089 # initialize some local variables. 2090 ct := aug.cosetTable; 2091 cft := aug.cosetFactorTable; 2092 2093 # translation table for group generators to numbers 2094 if not IsBound(aug.transtab) then 2095 # should do better, also cope with inverses 2096 aug.transtab:=List(aug.groupGenerators,i->AbsInt(LetterRepAssocWord(i)[1])); 2097 fi; 2098 2099 w:=[]; 2100 c:=1; # current coset 2101 2102 #for i in [1..NrSyllables(word)] do 2103 # g:=GeneratorSyllable(word,i); 2104 # e:=ExponentSyllable(word,i); 2105 # if e<0 then 2106 # ind:=2*aug.transtab[g]; 2107 # e:=-e; 2108 # else 2109 # ind:=2*aug.transtab[g]-1; 2110 # fi; 2111 # for j in [1..e] do 2112 # # apply the generator, collect cofactor 2113 # if cft[ind][c]<>0 then 2114# Add(w,cft[ind][c]); #cofactor 2115# fi; 2116# c:=ct[ind][c]; # new coset number 2117# od; 2118# od; 2119 l:=LetterRepAssocWord(word); 2120 for i in l do 2121 g:=AbsInt(i); 2122 if i<0 then 2123 ind:=2*aug.transtab[g]; 2124 else 2125 ind:=2*aug.transtab[g]-1; 2126 fi; 2127 # apply the generator, collect cofactor 2128 if cft[ind][c]<>0 then 2129 Add(w,cft[ind][c]); #cofactor 2130 fi; 2131 c:=ct[ind][c]; # new coset number 2132 od; 2133 2134 # make sure we got back to start 2135 if c<>1 then 2136 return fail; 2137 fi; 2138 return w; 2139 2140end); 2141 2142############################################################################# 2143## 2144#F DecodedTreeEntry(<tree>,<imgs>,<nr>) 2145## 2146InstallGlobalFunction(DecodedTreeEntry,function(tree,imgs,nr) 2147local eval,t1,t2; 2148 if IsBound(imgs[AbsInt(nr)]) then 2149 if nr>0 then 2150 return imgs[nr]; 2151 else 2152 return imgs[-nr]^-1; 2153 fi; 2154 fi; 2155# as we might not want to construct the full tree, we'll be more specific 2156 if not IsMutable(imgs) then 2157 imgs:=ShallowCopy(imgs); # we will add locally 2158 fi; 2159 t1:=tree[1]; 2160 t2:=tree[2]; 2161 eval:=function(n) 2162 if not IsBound(imgs[n]) then 2163 imgs[n]:=eval(AbsInt(t1[n]))^SignInt(t1[n]) 2164 *eval(AbsInt(t2[n]))^SignInt(t2[n]); 2165 fi; 2166 return imgs[n]; 2167 end; 2168 return eval(nr); 2169end); 2170 2171############################################################################# 2172## 2173#F GeneratorTranslationAugmentedCosetTable(<aug>) 2174## 2175## decode the secondary generators as words in the primary generators, using 2176## the `.subgroupGenerators' and their subset `.primarySubgroupGenerators'. 2177InstallGlobalFunction(GeneratorTranslationAugmentedCosetTable,function(aug) 2178local tt,i,t1,t2,tn; 2179 if not IsBound(aug.translationTable) then 2180 if not IsBound(aug.primarySubgroupGenerators) then 2181 aug.primarySubgroupGenerators:= 2182 aug.subgroupGenerators{[1..Length(aug.primaryGeneratorWords)]}; 2183 fi; 2184 # now expand the tree to get words for the secondary generators. 2185 # the first elements are just the primary generators 2186 tt:=ShallowCopy(aug.primarySubgroupGenerators); 2187 t1:=aug.tree[1]; 2188 t2:=aug.tree[2]; 2189 tn:=aug.treeNumbers; 2190 if Length(tn)>0 then 2191 for i in [Length(tt)+1..Maximum(tn)] do 2192 tt[i]:=tt[AbsInt(t1[i])]^SignInt(t1[i]) 2193 *tt[AbsInt(t2[i])]^SignInt(t2[i]); 2194 od; 2195 fi; 2196 aug.translationTable:=Immutable(tt); 2197 fi; 2198 return aug.translationTable; 2199end); 2200 2201############################################################################# 2202## 2203#F SecondaryGeneratorWordsAugmentedCosetTable(<aug>) 2204## 2205InstallGlobalFunction(SecondaryGeneratorWordsAugmentedCosetTable,function(aug) 2206local tt; 2207 if not IsBound(aug.secondaryWords) then 2208 aug.secondaryWords:=Immutable( 2209 List(GeneratorTranslationAugmentedCosetTable(aug),i-> 2210 MappedWord(i,aug.primarySubgroupGenerators,aug.primaryGeneratorWords))); 2211 fi; 2212 return aug.secondaryWords; 2213end); 2214 2215############################################################################# 2216## 2217#F CopiedAugmentedCosetTable(<aug>) 2218## 2219## returns a new augmented coset table, equal to the old one. The 2220## components of this new table are immutable, but new components may be 2221## added. 2222## (This function is needed to have different homomorphisms share the same 2223## augmented coset table data. It must not be applied to augmented coset 2224## tables which are not of type 2.) 2225InstallGlobalFunction(CopiedAugmentedCosetTable,function(aug) 2226local t,j; 2227 if IsBound(aug.isNewAugmentedTable) then 2228 t:=rec(isNewAugmentedTable:=true); 2229 for j in 2230 [ "A", "aug", "ct", "defcount", "from", "homgenims", "homgens", 2231 "index", "n", "offset", "primaryImages", "rels","one","useAddition", 2232 "secondary", "secount", "secondaryImages", "subgens" ] do 2233 if IsBound(aug.(j)) then 2234 t.(j):=aug.(j); 2235 fi; 2236 od; 2237 else 2238 # old version 2239 t:=rec( 2240 isAugmentedCosetTable:=true, 2241 type:=aug.type, 2242 tableType:=aug.tableType, 2243 groupGenerators:=aug.groupGenerators, 2244 groupRelators:=aug.groupRelators, 2245 cosetTable:=aug.cosetTable, 2246 cosetFactorTable:=aug.cosetFactorTable, 2247 primaryGeneratorWords:=aug.primaryGeneratorWords, 2248 tree:=aug.tree, 2249 treeNumbers:=aug.treeNumbers, 2250 numberOfSubgroupGenerators:=aug.numberOfSubgroupGenerators, 2251 nameOfSubgroupGenerators:=aug.nameOfSubgroupGenerators, 2252 subgroupGenerators:=aug.subgroupGenerators 2253 ); 2254 if IsBound(aug.secondaryWords) then 2255 t.secondaryWords:=Immutable(aug.secondaryWords); 2256 fi; 2257 2258 if IsBound(aug.conversionList) then 2259 t.conversionList:=aug.conversionList; 2260 fi; 2261 if IsBound(aug.primarySubgroupGenerators) then 2262 t.primarySubgroupGenerators:=Immutable(aug.primarySubgroupGenerators); 2263 fi; 2264 if IsBound(aug.subgroupRelators) then 2265 t.subgroupRelators:=Immutable(aug.subgroupRelators); 2266 fi; 2267 if IsBound(aug.translationTable) then 2268 t.translationTable:=Immutable(aug.translationTable); 2269 fi; 2270 2271 fi; 2272 return t; 2273end); 2274 2275 2276# New implemention of the Modified Todd-Coxeter (MTC) algorithm, based on 2277# Chapter 5 of the "Handbook of Computational Group Theory", by Derek F. 2278# Holt (refered # to as "Handbook" from here on). Function names after the 2279# NEWTC_ agree with those of sections 5.2, 5.3 of the Handbook. 2280 2281NEWTC_AddDeduction:=function(list,ded) 2282 if not ded in list then 2283 Add(list,ded); 2284 fi; 2285end; 2286 2287# the tables produced internally are indexed at rec.offset+k for generator 2288# number k, that is in the form ...,-2,-1,empty,1,2,... 2289# This avoids lots of even/od decisions and the cost of the empty list is 2290# neglegible. 2291 2292NEWTC_Compress:=function(DATA,purge) 2293local ct,c,a,b,offset,x,to,p,dw,doa,aug; 2294 doa:=DATA.augmented; 2295 dw:=IsBound(DATA.with); 2296 ct:=DATA.ct; 2297 if doa then 2298 aug:=DATA.aug; 2299 fi; 2300 p:=DATA.p; 2301 offset:=DATA.offset; 2302 c:=0; 2303 to:=[]; 2304 2305 for a in [1..DATA.n] do 2306 if p[a]=a then 2307 c:=c+1; 2308 to[a]:=c; 2309 if c<>a then 2310 for x in DATA.A do 2311 if ct[x+offset][a]<>0 then; 2312 b:=ct[x+offset][a]; 2313 if b=a then b:=c;fi; 2314 ct[x+offset][c]:=b; 2315 ct[-x+offset][b]:=c; 2316 if doa then 2317 # transfer augemented entry 2318 aug[x+offset][c]:=aug[x+offset][a]; 2319 fi; 2320 else 2321 # clear out 2322 ct[x+offset][c]:=0; 2323 if doa then 2324 Unbind(aug[x+offset][c]); 2325 fi; 2326 fi; 2327 od; 2328 if dw then 2329 DATA.with[c]:=DATA.with[a]; 2330 b:=DATA.from[a]; 2331 while b<>to[b] do 2332 b:=to[b]; 2333 od; 2334 DATA.from[c]:=b; 2335 fi; 2336 fi; 2337 else 2338 b:=a; 2339 while p[b]<>b do 2340 b:=p[b]; 2341 od; 2342 to[a]:=b; 2343 fi; 2344 od; 2345 if purge then 2346 for x in DATA.A do 2347 for a in [Length(ct[x+offset]),Length(ct[x+offset])-1..c+1] do 2348 Unbind(ct[x+offset][a]); 2349 if doa then 2350 Unbind(aug[x+offset][a]); 2351 fi; 2352 od; 2353 od; 2354 if dw then 2355 for a in [Length(DATA.with),Length(DATA.with)-1..c+1] do 2356 Unbind(DATA.with[a]); 2357 Unbind(DATA.from[a]); 2358 od; 2359 fi; 2360 fi; 2361 2362 if IsBound(DATA.ds) then 2363 for x in DATA.ds do 2364 a:=to[x[1]]; 2365 while x[1]<>a do 2366 x[1]:=a; 2367 a:=to[a]; 2368 od; 2369 od; 2370 Assert(2,Maximum(List(DATA.ds,x->x[1]))<=c); 2371 fi; 2372 2373 DATA.n:=c; 2374 DATA.p:=[1..DATA.n]; 2375 if doa then 2376 DATA.pp:=ListWithIdenticalEntries(DATA.n,DATA.one); 2377 fi; 2378 DATA.dead:=0; 2379end; 2380 2381NEWTC_Define:=function(DATA,i,a) 2382# both augmented or not 2383local c,o,n,j,au; 2384 n:=DATA.n; 2385 o:=DATA.offset; 2386 c:=DATA.ct; 2387 n:=n+1; 2388 DATA.n:=n; 2389 if n>DATA.limit then 2390 if ValueOption("quiet")=true then return fail;fi; 2391 Error( "the coset enumeration has defined more ", 2392 "than ", DATA.limit, " cosets\n"); 2393 DATA.limit:=DATA.limit*2; 2394 DATA.limtrigger:=Int(9/10*DATA.limit); 2395 fi; 2396 DATA.p[n]:=n; 2397 # clear out 2398 for j in DATA.A do 2399 c[j+o][n]:=0; 2400 od; 2401 c[o+a][i]:=n; 2402 c[o-a][n]:=i; 2403 if DATA.augmented then 2404 DATA.aug[o+a][i]:=DATA.one; 2405 DATA.aug[o-a][n]:=DATA.one; 2406 DATA.pp[n]:=DATA.one; 2407 fi; 2408 2409 NEWTC_AddDeduction(DATA.deductions,[i,a]); 2410 #if IsBound(DATA.ds) then Add(DATA.ds,[i,a]); fi; 2411 DATA.defcount:=DATA.defcount+1; 2412 if IsBound(DATA.with) then 2413 if DATA.with[i]=-a then Error("bleh!");fi; 2414 DATA.with[n]:=a; 2415 DATA.from[n]:=i; 2416 fi; 2417 #ForAny(DATA.A,x->ForAny([1..Length(c[x+o])],y->not 2418 # IsBound(c[x+o][y]))) then 2419 # Error("hehe"); 2420 #fi; 2421 return true; # indicating no quiet fail 2422end; 2423 2424NEWTC_Coincidence:=function(DATA,a,b) 2425local Rep,Merge,ct,offset,l,q,i,c,x,d,p,mu,nu; 2426 2427 if a=b then return;fi; 2428 2429 Rep:=function(kappa) 2430 local lambda,rho,mu; 2431 lambda:=kappa; 2432 rho:=p[lambda]; 2433 while rho<>lambda do 2434 lambda:=rho;rho:=p[lambda]; 2435 od; 2436 mu:=kappa;rho:=p[mu]; 2437 while rho<>lambda do 2438 p[mu]:=lambda;mu:=rho;rho:=p[mu]; 2439 od; 2440 return lambda; 2441 end; 2442 2443 Merge:=function(k,a) 2444 local phi,psi,mu,nu; 2445 phi:=Rep(k); 2446 psi:=Rep(a); 2447 if phi<>psi then 2448 mu:=Minimum(phi,psi); 2449 nu:=Maximum(phi,psi); 2450 p[nu]:=mu; 2451 l:=l+1; 2452 q[l]:=nu; 2453 DATA.dead:=DATA.dead+1; 2454 fi; 2455 end; 2456 2457 ct:=DATA.ct; 2458 offset:=DATA.offset; 2459 p:=DATA.p; 2460 l:=0; 2461 q:=[]; 2462 Merge(a,b);i:=1; 2463 while i<=l do 2464 c:=q[i]; 2465 i:=i+1; 2466 #RemoveSet(DATA.omega,c); 2467 for x in DATA.A do 2468 if ct[x+offset][c]<>0 then 2469 d:=ct[x+offset][c]; 2470 ct[x+offset][c]:=0; 2471 ct[-x+offset][d]:=0; 2472 mu:=Rep(c); 2473 nu:=Rep(d); 2474 if ct[x+offset][mu]<>0 then 2475 Merge(nu,ct[x+offset][mu]); 2476 elif ct[-x+offset][nu]<>0 then 2477 Merge(mu,ct[-x+offset][nu]); 2478 else 2479 ct[x+offset][mu]:=nu; 2480 ct[-x+offset][nu]:=mu; 2481 NEWTC_AddDeduction(DATA.deductions,[mu,x]); 2482 fi; 2483 fi; 2484 od; 2485 od; 2486end; 2487 2488NEWTC_ModifiedCoincidence:=function(DATA,a,b,w) 2489local MRep,MMerge,ct,offset,l,q,i,c,x,d,p,pp,mu,nu,aug,v,Sekundant; 2490 2491 # decide whether secondary generators will be introduced 2492 Sekundant:=function(w) 2493 if Length(w)<=1 or DATA.useAddition then 2494 return w; 2495 fi; 2496 DATA.secount:=DATA.secount+1; 2497 DATA.secondary[DATA.secount]:=w; 2498 return [DATA.secount]; 2499 end; 2500 2501 MRep:=function(kappa) 2502 local lambda,rho,mu,s; 2503 lambda:=kappa; 2504 rho:=p[lambda]; 2505 if rho=lambda then return lambda; fi; 2506 2507 s:=DATA.s; # re-used array to trace back compression path 2508 while rho<>lambda do 2509 s[rho]:=lambda; 2510 lambda:=rho;rho:=p[lambda]; 2511 od; 2512 rho:=s[lambda]; 2513 while rho<>kappa do 2514 mu:=rho; 2515 rho:=s[mu]; 2516 p[rho]:=lambda; 2517 if DATA.useAddition then 2518 pp[rho]:=pp[rho]+pp[mu]; 2519 else 2520 pp[rho]:=Sekundant(WordProductLetterRep(pp[rho],pp[mu])); 2521 fi; 2522 od; 2523 return lambda; 2524 end; 2525 2526 MMerge:=function(k,a,w) 2527 local phi,psi,mu,nu; 2528 phi:=MRep(k); 2529 psi:=MRep(a); 2530 if phi>psi then 2531 p[phi]:=psi; 2532 if DATA.useAddition then 2533 pp[phi]:=-pp[k]+w+pp[a]; 2534 else 2535 pp[phi]:=Sekundant(WordProductLetterRep(-Reversed(pp[k]),w,pp[a])); 2536 fi; 2537 l:=l+1; 2538 q[l]:=phi; 2539 DATA.dead:=DATA.dead+1; 2540 elif psi>phi then 2541 p[psi]:=phi; 2542 if DATA.useAddition then 2543 pp[psi]:=-pp[a]-w+pp[k]; 2544 else 2545 pp[psi]:=Sekundant(WordProductLetterRep(-Reversed(pp[a]),-Reversed(w),pp[k])); 2546 fi; 2547 l:=l+1; 2548 q[l]:=psi; 2549 DATA.dead:=DATA.dead+1; 2550 fi; 2551 end; 2552 2553 ct:=DATA.ct; 2554 aug:=DATA.aug; 2555 offset:=DATA.offset; 2556 p:=DATA.p; 2557 pp:=DATA.pp; 2558 l:=0; 2559 q:=[]; 2560 MMerge(a,b,w);i:=1; 2561 while i<=l do 2562 c:=q[i]; 2563 i:=i+1; 2564 for x in DATA.A do 2565 if ct[x+offset][c]<>0 then 2566 d:=ct[x+offset][c]; 2567 ct[-x+offset][d]:=0; 2568 mu:=MRep(c); 2569 nu:=MRep(d); 2570 if ct[x+offset][mu]<>0 then 2571 if DATA.useAddition then 2572 v:=-pp[d]-aug[x+offset][c]+pp[c]+aug[x+offset][mu]; 2573 else 2574 v:=WordProductLetterRep(-Reversed(pp[d]),-Reversed(aug[x+offset][c]), 2575 pp[c],aug[x+offset][mu]); 2576 fi; 2577 MMerge(nu,ct[x+offset][mu],v); 2578 elif ct[-x+offset][nu]<>0 then 2579 if DATA.useAddition then 2580 v:=-pp[c]+aug[x+offset][c]+pp[d]+aug[-x+offset][nu]; 2581 else 2582 v:=WordProductLetterRep(-Reversed(pp[c]),aug[x+offset][c], 2583 pp[d],aug[-x+offset][nu]); 2584 fi; 2585 MMerge(mu,ct[-x+offset][nu],v); 2586 else 2587 ct[x+offset][mu]:=nu; 2588 ct[-x+offset][nu]:=mu; 2589 if DATA.useAddition then 2590 v:=-pp[c]+aug[x+offset][c]+pp[d]; 2591 aug[x+offset][mu]:=v; 2592 aug[-x+offset][nu]:=-v; 2593 else 2594 v:=WordProductLetterRep(-Reversed(pp[c]),aug[x+offset][c],pp[d]); 2595 aug[x+offset][mu]:=v; 2596 aug[-x+offset][nu]:=-Reversed(v); 2597 fi; 2598 NEWTC_AddDeduction(DATA.deductions,[mu,x]); 2599 fi; 2600 fi; 2601 od; 2602 od; 2603 # pp is not needed any longer 2604 for i in q do 2605 Unbind(pp[i]); 2606 od; 2607end; 2608 2609# superseded by kernel function TC_QUICK_SCAN, left here for debugging purposes. 2610NEWTC_QuickScanLibraryVersion:=function(c,offset,alpha,w) 2611local f,b,r,i,j; 2612 f:=alpha;i:=1; 2613 r:=Length(w); 2614 # forward scan 2615 while i<=r and c[w[i]+offset][f]<>0 do 2616 f:=c[w[i]+offset][f]; 2617 i:=i+1; 2618 od; 2619 if i>r then 2620 if f<>alpha then 2621 w[1]:=i;w[2]:=f; 2622 return true; 2623 fi; 2624 return false; 2625 fi; 2626 2627 #backward scan 2628 b:=alpha;j:=r; 2629 while j>=i and c[-w[j]+offset][b]<>0 do 2630 b:=c[-w[j]+offset][b]; 2631 j:=j-1; 2632 od; 2633 if j<=i then 2634 w[1]:=i;w[2]:=f;w[3]:=j;w[4]:=b; 2635 return true; 2636 fi; 2637 return false; 2638end; 2639 2640NEWTC_Scan:=function(DATA,alpha,w) 2641local c,offset,f,b,r,i,j,t; 2642 c:=DATA.ct; 2643 offset:=DATA.offset; 2644 t:=TC_QUICK_SCAN(c,offset,alpha,w,DATA.scandata); 2645 2646 if t=false then return; fi; 2647 2648 r:=Length(w); 2649 i:=DATA.scandata[1]; # result of forward scan 2650 f:=DATA.scandata[2]; 2651 if i>r then 2652 if f<>alpha then 2653 NEWTC_Coincidence(DATA,f,alpha); 2654 fi; 2655 return; 2656 fi; 2657 2658 j:=DATA.scandata[3]; # result of backward scan 2659 b:=DATA.scandata[4]; 2660 if j<i then 2661 NEWTC_Coincidence(DATA,f,b); 2662 elif j=i then 2663 # deduction 2664 c[w[i]+offset][f]:=b; 2665 c[-w[i]+offset][b]:=f; 2666 NEWTC_AddDeduction(DATA.deductions,[f,w[i]]); 2667 fi; 2668 return; 2669 2670 2671# the following is the original, old, code including loops. It is left here 2672# for debugging purposes 2673 2674# f:=alpha;i:=1; 2675# r:=Length(w); 2676# # forward scan 2677# while i<=r and c[w[i]+offset][f]<>0 do 2678# f:=c[w[i]+offset][f]; 2679# i:=i+1; 2680# od; 2681# if i>r then 2682# if f<>alpha then 2683# Coincidence(DATA,f,alpha); 2684# fi; 2685# return; 2686# fi; 2687# 2688# #backward scan 2689# b:=alpha;j:=r; 2690# while j>=i and c[-w[j]+offset][b]<>0 do 2691# b:=c[-w[j]+offset][b]; 2692# j:=j-1; 2693# od; 2694# if j<i then 2695# Coincidence(DATA,f,b); 2696# elif j=i then 2697# # deduction 2698# c[w[i]+offset][f]:=b; 2699# c[-w[i]+offset][b]:=f; 2700# Add(DATA.deductions,[f,w[i]]); 2701# fi; 2702 2703end; 2704 2705NEWTC_ModifiedScan:=function(DATA,alpha,w,y) 2706local c,offset,f,b,r,i,j,fp,bp,t; 2707 #Info(InfoFpGroup,3,"MS",alpha,w,y,"\n"); 2708 c:=DATA.ct; 2709 offset:=DATA.offset; 2710 t:=TC_QUICK_SCAN(c,offset,alpha,w,DATA.scandata); 2711 2712 if t=false then return; fi; 2713 2714 f:=alpha;i:=1; 2715 fp:=DATA.one; 2716 r:=Length(w); 2717 # forward scan 2718 while i<=r and c[w[i]+offset][f]<>0 do 2719 if DATA.useAddition then 2720 fp:=fp+DATA.aug[w[i]+offset][f]; 2721 else 2722 fp:=WordProductLetterRep(fp,DATA.aug[w[i]+offset][f]); 2723 fi; 2724 f:=c[w[i]+offset][f]; 2725 i:=i+1; 2726 od; 2727 if i>r then 2728 if f<>alpha then 2729 if DATA.useAddition then 2730 NEWTC_ModifiedCoincidence(DATA,f,alpha,-fp+y); 2731 else 2732 NEWTC_ModifiedCoincidence(DATA,f,alpha,WordProductLetterRep(-Reversed(fp),y)); 2733 fi; 2734 fi; 2735 return; 2736 fi; 2737 #Info(InfoFpGroup,3,"MS2\n"); 2738 2739 #backward scan 2740 b:=alpha;j:=r; 2741 bp:=y; 2742 while j>=i and c[-w[j]+offset][b]<>0 do 2743 if DATA.useAddition then 2744 bp:=bp+DATA.aug[-w[j]+offset][b]; 2745 else 2746 bp:=WordProductLetterRep(bp,DATA.aug[-w[j]+offset][b]); 2747 fi; 2748 b:=c[-w[j]+offset][b]; 2749 j:=j-1; 2750 od; 2751 if j<i then 2752 if DATA.useAddition then 2753 NEWTC_ModifiedCoincidence(DATA,f,b,-fp+bp); 2754 else 2755 NEWTC_ModifiedCoincidence(DATA,f,b,WordProductLetterRep(-Reversed(fp),bp)); 2756 fi; 2757 elif j=i then 2758 # deduction 2759 c[w[i]+offset][f]:=b; 2760 c[-w[i]+offset][b]:=f; 2761 if DATA.useAddition then 2762 DATA.aug[w[i]+offset][f]:=-fp+bp; 2763 DATA.aug[-w[i]+offset][b]:=-bp+fp; 2764 else 2765 DATA.aug[w[i]+offset][f]:=WordProductLetterRep(-Reversed(fp),bp); 2766 DATA.aug[-w[i]+offset][b]:=WordProductLetterRep(-Reversed(bp),fp); 2767 fi; 2768 NEWTC_AddDeduction(DATA.deductions,[f,w[i]]); 2769 fi; 2770end; 2771 2772NEWTC_ScanAndFill:=function(DATA,alpha,w) 2773local c,offset,f,b,r,i,j; 2774 c:=DATA.ct; 2775 offset:=DATA.offset; 2776 r:=Length(w); 2777 f:=alpha;i:=1; 2778 b:=alpha;j:=r; 2779 while i<=j do 2780 # forward scan 2781 while i<=r and c[w[i]+offset][f]<>0 do 2782 f:=c[w[i]+offset][f]; 2783 i:=i+1; 2784 od; 2785 if i>r then 2786 if f<>alpha then 2787 NEWTC_Coincidence(DATA,f,alpha); 2788 fi; 2789 return; 2790 fi; 2791 2792 #backward scan 2793 while j>=i and c[-w[j]+offset][b]<>0 do 2794 b:=c[-w[j]+offset][b]; 2795 j:=j-1; 2796 od; 2797 if j<i then 2798 2799 NEWTC_Coincidence(DATA,f,b); 2800 elif j=i then 2801 # deduction 2802 c[w[i]+offset][f]:=b; 2803 c[-w[i]+offset][b]:=f; 2804 NEWTC_AddDeduction(DATA.deductions,[f,w[i]]); 2805 return; 2806 else 2807 NEWTC_Define(DATA,f,w[i]); 2808 fi; 2809 od; 2810end; 2811 2812NEWTC_ModifiedScanAndFill:=function(DATA,alpha,w,y) 2813local c,offset,f,b,r,i,j,fp,bp; 2814 c:=DATA.ct; 2815 offset:=DATA.offset; 2816 f:=alpha;i:=1; 2817 fp:=DATA.one; 2818 r:=Length(w); 2819 b:=alpha;j:=r; 2820 bp:=y; 2821 while i<=j do #N 2822 # forward scan 2823 while i<=r and c[w[i]+offset][f]<>0 do 2824 if DATA.useAddition then 2825 fp:=fp+DATA.aug[w[i]+offset][f]; 2826 else 2827 fp:=WordProductLetterRep(fp,DATA.aug[w[i]+offset][f]); 2828 fi; 2829 f:=c[w[i]+offset][f]; 2830 i:=i+1; 2831 od; 2832 if i>r then 2833 if f<>alpha then 2834 NEWTC_ModifiedCoincidence(DATA,f,alpha,WordProductLetterRep(-Reversed(fp),y)); 2835 fi; 2836 return; 2837 fi; 2838 2839 #backward scan 2840 while j>=i and c[-w[j]+offset][b]<>0 do 2841 if DATA.useAddition then 2842 bp:=bp+DATA.aug[-w[j]+offset][b]; 2843 else 2844 bp:=WordProductLetterRep(bp,DATA.aug[-w[j]+offset][b]); 2845 fi; 2846 b:=c[-w[j]+offset][b]; 2847 j:=j-1; 2848 od; 2849 if j<i then 2850 if DATA.useAddition then 2851 NEWTC_ModifiedCoincidence(DATA,f,b,-fp+bp); 2852 else 2853 NEWTC_ModifiedCoincidence(DATA,f,b,WordProductLetterRep(-Reversed(fp),bp)); 2854 fi; 2855 elif j=i then 2856 # deduction 2857 c[w[i]+offset][f]:=b; 2858 c[-w[i]+offset][b]:=f; 2859 if DATA.useAddition then 2860 DATA.aug[w[i]+offset][f]:=-fp+bp; 2861 DATA.aug[-w[i]+offset][b]:=-bp+fp; 2862 else 2863 DATA.aug[w[i]+offset][f]:=WordProductLetterRep(-Reversed(fp),bp); 2864 DATA.aug[-w[i]+offset][b]:=WordProductLetterRep(-Reversed(bp),fp); 2865 fi; 2866 NEWTC_AddDeduction(DATA.deductions,[f,w[i]]); 2867 return; 2868 else 2869 NEWTC_Define(DATA,f,w[i]); 2870 fi; 2871 od; 2872end; 2873 2874NEWTC_ProcessDeductions:=function(DATA) 2875# both augmented and not 2876local ded,offset,pair,alpha,x,p,w; 2877 ded:=DATA.deductions; 2878 offset:=DATA.offset; 2879 p:=DATA.p; 2880 while Length(ded)>0 do 2881 pair:=ded[Length(ded)]; 2882 Unbind(ded[Length(ded)]); 2883 alpha:=pair[1];x:=pair[2]; 2884 if p[alpha]=alpha then 2885 for w in DATA.ccr[x+offset] do 2886 if DATA.augmented then 2887 NEWTC_ModifiedScan(DATA,alpha,w,DATA.one); 2888 else 2889 NEWTC_Scan(DATA,alpha,w); 2890 fi; 2891 if p[alpha]<alpha then 2892 break; # coset has been eliminated 2893 fi; 2894 od; 2895 fi; 2896 # separate 'if' check, as the `break;` only ends innermost loop 2897 if p[alpha]=alpha then 2898 alpha:=DATA.ct[x+offset][alpha]; # beta 2899 if p[alpha]=alpha then 2900 # AH, 9/13/18: It's R^c_{x^-1}, so -x 2901 for w in DATA.ccr[offset-x] do 2902 if DATA.augmented then 2903 NEWTC_ModifiedScan(DATA,alpha,w,DATA.one); 2904 else 2905 NEWTC_Scan(DATA,alpha,w); 2906 fi; 2907 if p[alpha]<alpha then 2908 break; # coset has been eliminated 2909 fi; 2910 od; 2911 fi; 2912 fi; 2913 od; 2914end; 2915 2916NEWTC_DoCosetEnum:=function(freegens,freerels,subgens,aug,trace) 2917local m,offset,rels,ri,ccr,i,r,ct,A,a,w,n,DATA,p,ds,dr, 2918 oldead,with,collapse,j,from,pp,PERCFACT,ap,ordertwo; 2919 2920 # indicate at what change threshold display of coset Nr. should happen 2921 PERCFACT:=ValueOption("display"); 2922 if not IsInt(PERCFACT) then PERCFACT:=100; fi; 2923 2924 m:=Length(freegens); 2925 A:=List(freegens,LetterRepAssocWord); 2926 Assert(0,ForAll(A,x->Length(x)=1 and x[1]>0)); 2927 if List(A,x->x[1])<>[1..m] then 2928 Error("noncanonical generator order not yet possible"); 2929 fi; 2930 offset:=m+1; 2931 rels:=ShallowCopy(freerels); 2932 rels:=Filtered(freerels, x -> Length(x) > 0); 2933 SortBy(rels,Length); 2934 ri:=Union(rels,List(rels,x->x^-1)); 2935 ri:=List(ri,LetterRepAssocWord); 2936 SortBy(ri,Length); 2937 A:=Concatenation([1..m],-[1..m]); 2938 2939 # are generators known to be of order 2? 2940 ordertwo:=[]; 2941 for i in [1..Length(ri)] do 2942 w:=ri[i]; 2943 if Length(w)=2 and Length(Set(w))=1 then 2944 Unbind(ri[i]); # not needed any longer 2945 a:=AbsInt(w[1]); 2946 if not a in ordertwo then 2947 Info(InfoFpGroup,1,"Generator ",a," has order 2"); 2948 AddSet(ordertwo,a); 2949 A:=Filtered(A,x->x<>-a); 2950 fi; 2951 fi; 2952 od; 2953 ri:=Filtered(ri,x->IsBound(x)); 2954 2955 2956 # cyclic conjugates, sort by first letter 2957 ccr:=List([1..2*m+1],x->[]); 2958 for i in ri do 2959 r:=i; 2960 while not r in ccr[offset+r[1]] do 2961 AddSet(ccr[offset+r[1]],Immutable(r)); 2962 r:=Concatenation(r{[2..Length(r)]},r{[1]}); 2963 od; 2964 od; 2965 2966 # coset table in slightly different format: row (offset+x) is for 2967 # generator x 2968 ct:=List([1..offset+m],x->[0]);Unbind(ct[offset]); 2969 2970 n:=1; 2971 p:=[1]; 2972 collapse:=[]; 2973 DATA:=rec(ct:=ct,p:=p,ccr:=ccr,rels:=List(rels,LetterRepAssocWord), 2974 subgens:=subgens, 2975 subgword:=List(subgens,x->LetterRepAssocWord(UnderlyingElement(x))), 2976 n:=n,offset:=offset,A:=A,limit:=2^23, 2977 deductions:=[],dead:=0,defcount:=0, 2978 ordertwo:=ordertwo,s:=[], 2979 # a global list for the kernel scan function to return 4 variables 2980 scandata:=[0,0,0,0]); 2981 2982 i:=ValueOption("limit"); 2983 if i<>fail and Int(i)<>fail then 2984 DATA.limit:=i; 2985 fi; 2986 DATA.limtrigger:=Int(9/10*DATA.limit); 2987 2988 if aug<>false then 2989 2990 DATA.isCyclicMtcTable:=false; 2991 DATA.useAddition:=false; 2992 if ValueOption("cyclic")<>fail and Length(subgens)=1 then 2993 DATA.isCyclicMtcTable:=true; 2994 DATA.isAbelianizedMtcTable:=false; 2995 DATA.useAddition:=true; 2996 DATA.one:=0; 2997 elif ValueOption("abelian")<>fail then 2998 DATA.isAbelianizedMtcTable:=true; 2999 DATA.one:=ListWithIdenticalEntries(Length(subgens),0); 3000 DATA.useAddition:=true; 3001 else 3002 DATA.isAbelianizedMtcTable:=false; 3003 DATA.one:=[]; 3004 fi; 3005 aug:=List([1..offset+m],x->[]);Unbind(aug[offset]); 3006 pp:=[DATA.one]; 3007 DATA.aug:=aug; 3008 DATA.pp:=pp; 3009 DATA.secondary:=[]; 3010 DATA.secount:=Length(subgens); # last to be used 3011 DATA.augmented:=true; 3012 3013 else 3014 DATA.augmented:=false; 3015 fi; 3016 3017 for a in ordertwo do 3018 DATA.ct[offset-a]:=DATA.ct[offset+a]; 3019 if DATA.augmented then 3020 DATA.aug[offset-a]:=DATA.aug[offset+a]; 3021 fi; 3022 od; 3023 3024 if trace<>false then 3025 with:=[0]; # generator by which a coset was defined 3026 DATA.with:=with; 3027 from:=[0]; 3028 DATA.from:=from; 3029 fi; 3030 Info( InfoFpGroup, 2, " \t defined\t deleted\t alive\t\t maximal"); 3031 3032 for w in [1..Length(subgens)] do 3033 if DATA.augmented then 3034 if DATA.isCyclicMtcTable then 3035 NEWTC_ModifiedScanAndFill(DATA,1,DATA.subgword[w],1); 3036 elif DATA.isAbelianizedMtcTable then 3037 i:=ShallowCopy(DATA.one); 3038 i[w]:=1; 3039 NEWTC_ModifiedScanAndFill(DATA,1,DATA.subgword[w],i); 3040 else 3041 NEWTC_ModifiedScanAndFill(DATA,1,DATA.subgword[w],[w]); 3042 fi; 3043 else 3044 NEWTC_ScanAndFill(DATA,1,DATA.subgword[w]); 3045 fi; 3046 od; 3047 3048 NEWTC_ProcessDeductions(DATA); 3049 3050 # words we want to trace early (as they might reduce the number of 3051 # definitions 3052 if trace<>false then 3053 #trace:=Concatenation(trace,ri); #don't seem to help 3054 for w in trace do 3055 if IsList(w[1]) then 3056 w:=w[1]; # get word from value 3057 fi; 3058 repeat 3059 i:=1; 3060 ap:=1; 3061 while ap<=Length(w) do 3062 a:=w[ap]; 3063 if ct[a+offset][i]=0 then 3064 dr:=NEWTC_Define(DATA,i,a); 3065 if dr=fail then return fail;fi; 3066 NEWTC_ProcessDeductions(DATA); 3067 #i:=p[i]; # in case there is a change 3068 ap:=Length(w)+10; 3069 fi; 3070 i:=ct[a+offset][i]; 3071 ap:=ap+1; 3072 od; 3073 until ap=Length(w)+1; 3074 od; 3075 fi; 3076 3077 i:=1; 3078 while i<=DATA.n do 3079 3080 for a in A do 3081 if p[i]=i then 3082 if ct[a+offset][i]=0 then 3083 dr:=NEWTC_Define(DATA,i,a); 3084 if dr=fail then return fail;fi; 3085 oldead:=DATA.dead; 3086 NEWTC_ProcessDeductions(DATA); 3087 if PERCFACT*(DATA.dead-oldead)>DATA.n then 3088 if DATA.n>1000 then 3089 Info( InfoFpGroup, 2, "\t", DATA.defcount, "\t\t", DATA.dead, 3090 "\t\t", DATA.n-DATA.dead, "\t\t", DATA.n ); 3091 fi; 3092 if IsBound(DATA.with) then 3093 # collapse -- find collapse word 3094 # in two different ways (as they can differ after compression) 3095 3096 # first trace through the coset table, this uses the prior 3097 # reductions 3098 j:=i; 3099 while j<>p[j] do 3100 j:=p[j]; 3101 od; 3102 w:=[a]; # last letter added 3103 while j<>1 do 3104 Assert(2,j=p[j]); 3105 Add(w,with[j]); 3106 Assert(2,0<>ct[-with[j]+offset][j]); 3107 j:=ct[-with[j]+offset][j]; # unapply this generator 3108 od; 3109 3110 # free reduce -- partial collapse can lead to not free cancellation 3111 # and fix order 3112 w:=Reversed(FreelyReducedLetterRepWord(w)); 3113 #w1:=w; 3114 3115 j:=PositionProperty(collapse,x->x[1]=w); 3116 if j=fail then 3117 Add(collapse,[w,DATA.dead-oldead]); # word that caused a collapse 3118 else 3119 collapse[j][2]:=Maximum(collapse[j][2],DATA.dead-oldead); 3120 fi; 3121 3122 # now use the `from' list (which does not collapse under 3123 # coincidences, only under compression) and not the coset table, 3124 # as it # keeps the old definition order, not yet using coincidence 3125 j:=i; 3126 w:=[a]; # last letter added 3127 while j<>1 do 3128 Add(w,with[j]); 3129 j:=from[j]; 3130 od; 3131 3132 # free reduce -- partial collapse can lead to not free 3133 # cancellation and fix order 3134 w:=Reversed(FreelyReducedLetterRepWord(w)); 3135 3136 j:=PositionProperty(collapse,x->x[1]=w); 3137 if j=fail then 3138 Add(collapse,[w,DATA.dead-oldead]); # word caused collapse 3139 else 3140 collapse[j][2]:=Maximum(collapse[j][2],DATA.dead-oldead); 3141 fi; 3142 3143 Info(InfoFpGroup,3,"collapse ",DATA.dead-oldead); 3144 3145 fi; 3146 fi; 3147 3148 fi; 3149 fi; 3150 od; 3151 3152 # conditions for compression: Over half the table used, and 3153 if 2*DATA.n>DATA.limit and 3154 # at least 33% trash (4=1+1/0.33) 3155 ( 4*DATA.dead>DATA.n or 3156 # over limtrigger and at least 2% (55=1+1/0.02) trash 3157 (51*DATA.dead>DATA.n and DATA.n>DATA.limtrigger) ) then 3158 3159 Info( InfoFpGroup, 2, "\t", DATA.defcount, "\t\t", DATA.dead, 3160 "\t\t", DATA.n-DATA.dead, "\t\t", DATA.n ); 3161 i:=Number([1..i],x->p[x]=x); 3162 NEWTC_Compress(DATA,false); 3163 p:=DATA.p; 3164 if DATA.augmented then 3165 pp:=DATA.pp; 3166 fi; 3167 if DATA.n>DATA.limtrigger then 3168 DATA.limtrigger:=Maximum(DATA.limit-1,DATA.n+2); 3169 fi; 3170 fi; 3171 3172 i:=i+1; 3173 od; 3174 3175 NEWTC_Compress(DATA,true); # always compress at the end 3176 DATA.index:=DATA.n; 3177 3178 if Length(collapse)>0 then 3179 Info(InfoFpGroup,3,DATA.defcount," definitions"); 3180 # which collapses gave at least 1% 3181 collapse:=Filtered(collapse,x->x[2]*PERCFACT>DATA.n and not x in trace and 3182 # not prefix of any trace 3183 not ForAny(trace,y->y[1]{[1..Minimum(Length(x),Length(y[1]))]}=x 3184 # or proper prefix of another in collapse 3185 and not ForAny(collapse,y->Length(y)>Length(x) and 3186 y{[1..Length(x)]}=x))); 3187 if Length(collapse)>0 then 3188 # give list for improvement 3189 # type is c_ollapse 3190 return 3191 rec(type:="c",collapse:=collapse,limit:=DATA.limit,defcount:=DATA.defcount,data:=DATA); 3192 fi; 3193 fi; 3194 3195 return rec(type:="t",limit:=DATA.limit,defcount:=DATA.defcount,data:=DATA); 3196 3197end; 3198 3199#freegens,fgreerels,subgens,doaugmented,trace 3200# Options: limit, quiet (return fail if run out of space) 3201# cyclic (if given and 1 generator do special case of cyclic rewriting) 3202InstallGlobalFunction(NEWTC_CosetEnumerator,function(arg) 3203local freegens,freerels,subgens,aug,trace,e,ldc,up,bastime,start,bl,bw,first,timerFunc; 3204 3205 timerFunc := GET_TIMER_FROM_ReproducibleBehaviour(); 3206 3207 freegens:=arg[1]; 3208 freerels:=arg[2]; 3209 subgens:=arg[3]; 3210 aug:=IsBound(arg[4]); 3211 trace:=IsBound(arg[5]); 3212 if aug<>false then 3213 aug:=arg[4]; 3214 fi; 3215 if aug<>false then 3216 # if augmented, optimize by default 3217 if trace=false then 3218 trace:=[]; 3219 else 3220 trace:=arg[5]; 3221 fi; 3222 elif trace<>false then 3223 trace:=arg[5]; 3224 fi; 3225 start:=timerFunc(); 3226 if aug and trace=false then 3227 e:=NEWTC_DoCosetEnum(freegens,freerels,subgens,aug,trace); 3228 if e=fail then return fail;fi; 3229 else 3230 e:=NEWTC_DoCosetEnum(freegens,freerels,subgens,false,trace); 3231 if e=fail then return fail;fi; 3232 bastime:=timerFunc()-start; 3233 bl:=e.defcount; 3234 bw:=[]; 3235 ldc:=infinity; 3236 up:=0; 3237 start:=timerFunc(); 3238 first:=true; 3239 while trace<>false and e.type="c" and (up<=2 or 3240 2*(timerFunc()-start)<=bastime) do 3241 #up<=2 do 3242 ldc:=e.defcount; 3243 if first=true then 3244 first:=e.defcount; 3245 Info(InfoFpGroup,1,"optimize definition sequence"); 3246 fi; 3247 Append(trace,Filtered(e.collapse,x->x[2]>2)); 3248 SortBy(trace,x->-x[2]); 3249 e:=NEWTC_DoCosetEnum(freegens,freerels,subgens,false,trace: 3250 # that's what we had last time -- no need to whine 3251 limit:=e.limit); 3252 if e=fail then return fail;fi; 3253 if e.defcount/bl<98/100 then 3254 bl:=e.defcount; 3255 bw:=ShallowCopy(trace); 3256 fi; 3257 3258 # 2% improvement threshold 3259 if 102/100*e.defcount<=ldc then 3260 up:=0; 3261 start:=timerFunc(); 3262 else 3263 up:=up+1; 3264 fi; 3265 od; 3266 if first<>true then 3267 Info(InfoFpGroup,1,"Reduced ",first," definitions to ",e.defcount); 3268 fi; 3269 if aug then 3270 # finally do the augmented with best 3271 e:=NEWTC_DoCosetEnum(freegens,freerels,subgens,true,bw: 3272 # that's what we had last time -- no need to whine 3273 limit:=e.limit); 3274 if e=fail then return fail;fi; 3275 fi; 3276 fi; 3277 if not aug then 3278 # return the ordinary coset table in standard formatting 3279 up:=[]; 3280 for start in [1..Length(freegens)] do 3281 Add(up,start+e.data.offset); 3282 Add(up,-start+e.data.offset); 3283 od; 3284 ldc:=e.data.ct{up}; 3285 StandardizeTable(ldc); 3286 return ldc; 3287 fi; 3288 3289 aug:=rec(isNewAugmentedTable:=true, 3290 isCyclicMtcTable:=e.data.isCyclicMtcTable, 3291 isAbelianizedMtcTable:=e.data.isAbelianizedMtcTable, 3292 useAddition:=e.data.useAddition, 3293 n:=e.data.n, 3294 A:=e.data.A, 3295 index:=e.data.index, 3296 rels:=e.data.rels, 3297 ct:=e.data.ct, 3298 one:=e.data.one, 3299 aug:=e.data.aug, 3300 defcount:=e.data.defcount, 3301 secount:=e.data.secount, 3302 secondary:=e.data.secondary, 3303 subgens:=e.data.subgens, 3304 subgword:=e.data.subgword, 3305 offset:=e.data.offset 3306 ); 3307 if IsBound(e.data.from) then 3308 aug.from:=e.data.from; 3309 fi; 3310 return aug; 3311end); 3312 3313NEWTC_Rewrite:=function(arg) 3314local DATA,start,w,offset,c,i,j; 3315 DATA:=arg[1]; 3316 start:=arg[2]; 3317 w:=arg[3]; 3318 offset:=DATA.offset; 3319 c:=DATA.one; 3320 i:=start; 3321 for j in w do 3322 if DATA.useAddition then 3323 c:=c+DATA.aug[j+offset][i]; 3324 else 3325 c:=WordProductLetterRep(c,DATA.aug[j+offset][i]); 3326 fi; 3327 i:=DATA.ct[j+offset][i]; 3328 od; 3329 if Length(arg)>3 and arg[4]<>i then 3330 Error("Trace did not end at expected coset"); 3331 fi; 3332 return c; 3333end; 3334 3335NEWTC_ReplacedStringCyclic:=function(s,r) 3336local p,new,start; 3337 if Length(s)<Length(r) then 3338 return s; 3339 fi; 3340 # TODO: Replace cyclically, that is allow the substring to hang out over the 3341 # end and start again. This is easiest done by having a cylci version of 3342 # `PositionSublist'. 3343 p:=PositionSublist(s,r); 3344 if p<>fail then 3345 new:=s{[1..p-1]}; 3346 start:=p+Length(r); 3347 p:=PositionSublist(s,r,start); 3348 while p<>fail do 3349 new:=WordProductLetterRep(new,s{[start..p-1]}); 3350 start:=p+Length(r); 3351 p:=PositionSublist(s,r,start); 3352 od; 3353 new:=WordProductLetterRep(new,s{[start..Length(s)]}); 3354 return new; 3355 else 3356 return s; 3357 fi; 3358end; 3359 3360 3361InstallGlobalFunction(NEWTC_CyclicSubgroupOrder,function(DATA) 3362local rels,r,i,w; 3363 3364 rels:=0; 3365 r:=NEWTC_Rewrite(DATA,1,DATA.subgword[1])-1; 3366 rels:=Gcd(rels,r); 3367 3368 for i in [1..DATA.n] do 3369 for w in DATA.rels do 3370 r:=NEWTC_Rewrite(DATA,i,w); 3371 rels:=Gcd(rels,r); 3372 od; 3373 od; 3374 3375 return rels; 3376end); 3377 3378NEWTC_AbelianizedRelatorsSubgroup:=function(DATA) 3379local rels,r,i,w,subnum; 3380 3381 subnum:=Length(DATA.subgens); 3382 rels:=[]; 3383 3384 for i in [1..subnum] do 3385 r:=ShallowCopy(NEWTC_Rewrite(DATA,1,DATA.subgword[i])); 3386 r[i]:=r[i]-1; 3387 if not IsZero(r) and not r in rels and not -r in rels then 3388 AddSet(rels,r); 3389 fi; 3390 od; 3391 3392 for i in [1..DATA.n] do 3393 CompletionBar(InfoFpGroup,2,"Coset Loop: ",i/DATA.n); 3394 for w in DATA.rels do 3395 r:=NEWTC_Rewrite(DATA,i,w); 3396 if not IsZero(r) and not r in rels and not -r in rels then 3397 AddSet(rels,r); 3398 fi; 3399 od; 3400 od; 3401 CompletionBar(InfoFpGroup,2,"Coset Loop: ",0); 3402 3403 return rels; 3404end; 3405 3406############################################################################# 3407## 3408#M RelatorMatrixAbelianizedSubgroupMtc( <G>, <H> ) . . . . . relator matrix 3409#M . . . . . . . . . . . . . . . . . . . . . . for an abelianized subgroup 3410## 3411## 'RelatorMatrixAbelianizedSubgroupMtc' uses the Modified Todd-Coxeter 3412## coset representative enumeration method to compute a matrix of abelian- 3413## ized defining relators for a subgroup H of a finitely presented group G. 3414## 3415InstallGlobalFunction( RelatorMatrixAbelianizedSubgroupMtc, 3416function ( G, H ) 3417 3418 local aug,rels; 3419 3420 # check the arguments to be a finitely presented group and a subgroup of 3421 # that group. 3422 if not ( IsSubgroupFpGroup( G ) and IsGroupOfFamily( G ) ) then 3423 Error( "<G> must be a finitely presented group" ); 3424 fi; 3425 if not IsSubgroupFpGroup( H ) or FamilyObj( H ) <> FamilyObj( G ) then 3426 Error( "<H> must be a subgroup of <G>" ); 3427 fi; 3428 3429 # do a Modified Todd-Coxeter coset representative enumeration to 3430 # construct an augmented coset table of H. 3431 aug := NEWTC_CosetEnumerator(FreeGeneratorsOfFpGroup(G),RelatorsOfFpGroup(G),GeneratorsOfGroup(H),true,false:abelian:=true); 3432 3433 # determine a set of abelianized subgroup relators. 3434 rels:=NEWTC_AbelianizedRelatorsSubgroup(aug); 3435 return rels; 3436 3437end ); 3438 3439# DATA, [parameter,string] 3440# parameter is: 3441# 0: Full reduction 3442# 1: Do a quick reduction without trying to eliminate all secondary gens. 3443# -1: No relators 3444InstallGlobalFunction(NEWTC_PresentationMTC,function(arg) 3445local DATA,rels,i,j,w,f,r,s,fam,new,ri,a,offset,p,rset,re,start,stack,pres, 3446 subnum,bad,warn,parameter,str; 3447 3448 DATA:=arg[1]; 3449 if Length(arg)=1 then 3450 parameter:=0; 3451 else 3452 parameter:=arg[2]; 3453 fi; 3454 if Length(arg)>2 then 3455 str:=arg[3]; 3456 else 3457 str:="%"; 3458 fi; 3459 3460 3461 offset:=DATA.offset; 3462 subnum:=Length(DATA.subgens); 3463 rels:=[]; 3464 3465 for i in [1..subnum] do 3466 r:=WordProductLetterRep(NEWTC_Rewrite(DATA,1,DATA.subgword[i]),[-i]); 3467 if Length(r)>0 then 3468 Add(rels,r); 3469 fi; 3470 od; 3471 3472 stack:=[]; 3473 3474 if parameter<>-1 then 3475 3476 for i in [1..DATA.n] do 3477 CompletionBar(InfoFpGroup,2,"Coset Loop: ",i/DATA.n); 3478 for w in DATA.rels do 3479 r:=NEWTC_Rewrite(DATA,i,w); 3480 MakeCanonical(r); 3481 3482 ri:=Length(r); 3483 # reduce with others 3484 for j in rels do 3485 r:=NEWTC_ReplacedStringCyclic(r,j); 3486 r:=NEWTC_ReplacedStringCyclic(r,-Reversed(j)); 3487 od; 3488 Info(InfoFpGroup,3,"Relatorlen ",ri,"->",Length(r)); 3489 3490 if Length(r)>0 then 3491 Add(stack,r); 3492 while Length(stack)>0 do 3493 r:=stack[Length(stack)]; 3494 Unbind(stack[Length(stack)]); 3495 ri:=-Reversed(r); 3496 rset:=Set([r,ri]); 3497 # reduce others 3498 j:=1; 3499 while j<=Length(rels) do 3500 s:=rels[j]; 3501 for re in rset do; 3502 s:=NEWTC_ReplacedStringCyclic(s,re); 3503 od; 3504 if not IsIdenticalObj(s,rels[j]) then 3505 if Length(s)>0 then 3506 Add(stack,s); 3507 fi; 3508 rels:=WordProductLetterRep(rels{[1..j-1]},rels{[j+1..Length(rels)]}); 3509 else 3510 j:=j+1; 3511 fi; 3512 od; 3513 3514 Add(rels,r); 3515 SortBy(rels,Length); 3516 3517 # does it occur in the augmented table? 3518 for a in DATA.A do 3519 for j in [1..DATA.n] do 3520 s:=DATA.aug[a+offset][j]; 3521 if Length(s)>=Length(r) then 3522 for re in rset do 3523 s:=NEWTC_ReplacedStringCyclic(s,re); 3524 od; 3525 DATA.aug[a+offset][j]:=s; 3526 fi; 3527 od; 3528 od; 3529 od; 3530 fi; 3531 od; 3532 od; 3533 CompletionBar(InfoFpGroup,2,"Coset Loop: ",0); 3534 fi; 3535 3536 # add definitions of secondary generators 3537 for i in [subnum+1..DATA.secount] do 3538 r:=WordProductLetterRep(DATA.secondary[i],[-i]); 3539 Add(rels,r); 3540 od; 3541 3542 f:=FreeGroup(DATA.secount,str); 3543 fam:=FamilyObj(One(f)); 3544 rels:=List(rels,x->AssocWordByLetterRep(fam,x)); 3545 pres:=PresentationFpGroup(f/rels); 3546 TzOptions(pres).protected:=subnum; 3547 TzOptions(pres).printLevel:=InfoLevel(InfoFpGroup); 3548 if parameter=1 then 3549 TzSearch(pres); 3550 TzOptions(pres).lengthLimit:=pres!.tietze[TZ_TOTAL]+1; 3551 fi; 3552 TzGoGo(pres); 3553 if IsEvenInt(parameter) and Length(GeneratorsOfPresentation(pres))>subnum then 3554 warn:=true; 3555 # Help Tietze with elimination 3556 bad:=Reversed(List(GeneratorsOfPresentation(pres) 3557 {[subnum+1..Length(GeneratorsOfPresentation(pres))]}, 3558 x->LetterRepAssocWord(x)[1])); 3559 for i in bad do 3560 r:=DATA.secondary[i]; 3561 re:=true; 3562 while re do 3563 s:=[]; 3564 re:=false; 3565 for j in r do 3566 if AbsInt(j)>subnum then 3567 re:=true; 3568 if j>0 then 3569 Append(s,DATA.secondary[j]); 3570 else 3571 Append(s,-Reversed(DATA.secondary[-j])); 3572 fi; 3573 else 3574 Add(s,j); 3575 fi; 3576 od; 3577 Info(InfoFpGroup,2,"Length =",Length(s)); 3578 r:=s; 3579 if warn and Length(s)>100*Sum(rels,Length) then 3580 warn:=false; 3581 Error( 3582 "Trying to eliminate all auxillary generators might cause the\n", 3583 "size of the presentation to explode. Proceed at risk!"); 3584 fi; 3585 od; 3586 r:=AssocWordByLetterRep(fam,Concatenation(r,[-i])); 3587 AddRelator(pres,r); 3588 TzSearch(pres); 3589 TzEliminate(pres,i); 3590 od; 3591 Assert(1,Length(GeneratorsOfPresentation(pres))=subnum); 3592 3593 fi; 3594 r:=List(GeneratorsOfPresentation(pres){ 3595 [subnum+1..Length(GeneratorsOfPresentation(pres))]}, 3596 x->LetterRepAssocWord(x)[1]); 3597 pres!.secondarywords:=r; 3598 return pres; 3599end); 3600 3601############################################################################# 3602## 3603#M PresentationSubgroupMtc(<G>, <H> [,<string>] [,<print level>] ) . . . . . 3604#M Tietze record for a subgroup 3605## 3606## 'PresentationSubgroupMtc' uses the Modified Todd-Coxeter coset represent- 3607## ative enumeration method to compute a presentation (i.e. a presentation 3608## record) for a subgroup H of a finitely presented group G. The generators 3609## in the resulting presentation will be named <string>1, <string>2, ... , 3610## the default string is `\"_x\"'. 3611## 3612InstallGlobalFunction( PresentationSubgroupMtc,function ( arg ) 3613 local G,H,string,printlevel,DATA,i; 3614 3615 # check the first two arguments to be a finitely presented group and a 3616 # subgroup of that group. 3617 G := arg[1]; 3618 if not ( IsSubgroupFpGroup( G ) and IsGroupOfFamily( G ) ) then 3619 Error( "<G> must be a finitely presented group" ); 3620 fi; 3621 H := arg[2]; 3622 if not IsSubgroupFpGroup( H ) or FamilyObj( H ) <> FamilyObj( G ) then 3623 Error( "<H> must be a subgroup of <G>" ); 3624 fi; 3625 3626 # initialize the generators name string and the print level. 3627 string := "_x"; 3628 printlevel := 1; 3629 3630 # get the optional parameters. 3631 for i in [ 3 .. 4 ] do 3632 if Length( arg ) >= i then 3633 if IsInt( arg[i] ) then printlevel := arg[i]; 3634 elif IsString( arg[i] ) then string := arg[i]; 3635 else 3636 Error( "optional parameter must be a string or an integer" ); 3637 fi; 3638 fi; 3639 od; 3640 3641 DATA:=NEWTC_CosetEnumerator(FreeGeneratorsOfFpGroup(G), 3642 RelatorsOfFpGroup(G), 3643 List(GeneratorsOfGroup(H),UnderlyingElement),true, 3644 3645 # for compatibility, do not try the optimization 3646 false); 3647 3648 return NEWTC_PresentationMTC(DATA,0,string); 3649end); 3650 3651 3652 3653##################################### 3654# The following code is not used any longer and is relics of the old Mtc 3655# implementation. 3656