1############################################################################# 2## 3## This file is part of GAP, a system for computational discrete algebra. 4## This file's authors include Volkmar Felsch, Alexander Hulpke. 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 finitely presented groups (fp groups). 12## Methods for subgroups of fp groups can also be found in `sgpres.gi'. 13## 14## 1. methods for elements of f.p. groups 15## 2. methods for f.p. groups 16## 17 18 19############################################################################# 20## 21## 1. methods for elements of f.p. groups 22## 23 24############################################################################# 25## 26#M ElementOfFpGroup( <fam>, <elm> ) 27## 28InstallMethod( ElementOfFpGroup, 29 "for a family of f.p. group elements, and an assoc. word", 30 true, 31 [ IsElementOfFpGroupFamily, IsAssocWordWithInverse ], 32 0, 33 function( fam, elm ) 34 return Objectify( fam!.defaultType, [ Immutable( elm ) ] ); 35 end ); 36 37 38############################################################################# 39## 40#M PrintObj( <elm> ) . . . . . . . for packed word in default representation 41## 42InstallMethod( PrintObj,"for an element of an f.p. group (default repres.)", 43 true, [ IsElementOfFpGroup and IsPackedElementDefaultRep ], 0, 44function( obj ) 45 Print( obj![1] ); 46end ); 47 48############################################################################# 49## 50#M ViewObj( <elm> ) . . . . . . . for packed word in default representation 51## 52InstallMethod( ViewObj,"for an element of an f.p. group (default repres.)", 53 true, [ IsElementOfFpGroup and IsPackedElementDefaultRep ],0, 54function( obj ) 55 View( obj![1] ); 56end ); 57 58############################################################################# 59## 60#M String( <elm> ) . . . . . . . for packed word in default representation 61## 62InstallMethod( String,"for an element of an f.p. group (default repres.)", 63 true, [ IsElementOfFpGroup and IsPackedElementDefaultRep ],0, 64function( obj ) 65 return String( obj![1] ); 66end ); 67 68 69############################################################################# 70## 71#M UnderlyingElement( <elm> ) . . . . . . . . . . for element of f.p. group 72## 73InstallMethod( UnderlyingElement, 74 "for an element of an f.p. group (default repres.)", 75 true, 76 [ IsElementOfFpGroup and IsPackedElementDefaultRep ], 77 0, 78 obj -> obj![1] ); 79 80 81############################################################################# 82## 83#M ExtRepOfObj( <elm> ) . . . . . . . . . . . . . for element of f.p. group 84## 85InstallMethod( ExtRepOfObj, 86 "for an element of an f.p. group (default repres.)", 87 true, 88 [ IsElementOfFpGroup and IsPackedElementDefaultRep ], 89 0, 90 obj -> ExtRepOfObj( obj![1] ) ); 91 92InstallOtherMethod( Length, 93 "for an element of an f.p. group (default repres.)", true, 94 [ IsElementOfFpGroup and IsPackedElementDefaultRep ],0, 95 x->Length(UnderlyingElement(x))); 96 97InstallOtherMethod(Subword,"for an element of an f.p. group (default repres.)",true, 98 [ IsElementOfFpGroup and IsPackedElementDefaultRep, IsInt, IsInt ],0, 99function(word,a,b) 100 return ElementOfFpGroup(FamilyObj(word),Subword(UnderlyingElement(word),a,b)); 101end); 102 103 104############################################################################# 105## 106#M InverseOp( <elm> ) . . . . . . . . . . . . . . for element of f.p. group 107## 108InstallMethod( InverseOp, "for an element of an f.p. group", true, 109 [ IsElementOfFpGroup ],0, 110function(obj) 111local fam,w; 112 fam:= FamilyObj( obj ); 113 w:=Inverse(UnderlyingElement(obj)); 114 if HasFpElementNFFunction(fam) and 115 IsBound(fam!.reduce) and fam!.reduce=true then 116 w:=FpElementNFFunction(fam)(w); 117 fi; 118 return ElementOfFpGroup( fam,w); 119end ); 120 121############################################################################# 122## 123#M One( <fam> ) . . . . . . . . . . . . . for family of f.p. group elements 124## 125InstallOtherMethod( One, 126 "for a family of f.p. group elements", 127 true, 128 [ IsElementOfFpGroupFamily ], 129 0, 130 fam -> ElementOfFpGroup( fam, One( fam!.freeGroup ) ) ); 131 132 133############################################################################# 134## 135#M One( <elm> ) . . . . . . . . . . . . . . . . . for element of f.p. group 136## 137InstallMethod( One, "for an f.p. group element", true, [ IsElementOfFpGroup ], 138 0, obj -> One( FamilyObj( obj ) ) ); 139 140# a^0 calls OneOp, so we have to catch this as well. 141InstallMethod( OneOp, "for an f.p. group element", true,[IsElementOfFpGroup ], 142 0, obj -> One( FamilyObj( obj ) ) ); 143 144 145############################################################################# 146## 147#M \*( <elm1>, <elm2> ) . . . . . . . . . for two elements of a f.p. group 148## 149InstallMethod( \*, "for two f.p. group elements", 150 IsIdenticalObj, [ IsElementOfFpGroup, IsElementOfFpGroup ], 0, 151function( left, right ) 152local fam,w; 153 fam:= FamilyObj( left ); 154 w:=UnderlyingElement(left)*UnderlyingElement(right); 155 if HasFpElementNFFunction(fam) and 156 IsBound(fam!.reduce) and fam!.reduce=true then 157 w:=FpElementNFFunction(fam)(w); 158 fi; 159 return ElementOfFpGroup( fam,w); 160end ); 161 162############################################################################# 163## 164#M \=( <elm1>, <elm2> ) . . . . . . . . . for two elements of a f.p. group 165## 166InstallMethod( \=, "for two f.p. group elements", IsIdenticalObj, 167 [ IsElementOfFpGroup, IsElementOfFpGroup ],0, 168# this is the only method that may ever be called! 169function( left, right ) 170 if UnderlyingElement(left)=UnderlyingElement(right) then 171 return true; 172 fi; 173 return FpElmEqualityMethod(FamilyObj(left))(left,right); 174end ); 175 176############################################################################# 177## 178#M \<( <elm1>, <elm2> ) . . . . . . . . . for two elements of a f.p. group 179## 180InstallMethod( \<, "for two f.p. group elements", IsIdenticalObj, 181 [ IsElementOfFpGroup, IsElementOfFpGroup ],0, 182# this is the only method that may ever be called! 183function( left, right ) 184 return FpElmComparisonMethod(FamilyObj(left))(left,right); 185end ); 186 187InstallMethod(FPFaithHom,"try perm or pc hom",true,[IsFamily],0, 188function( fam ) 189local hom,gp,f; 190 gp:=CollectionsFamily(fam)!.wholeGroup; 191 if HasIsFinite(gp) and not IsFinite(gp) then 192 return fail; 193 fi; 194 if HasIsomorphismPermGroup(gp) then return IsomorphismPermGroup(gp); fi; 195 if HasIsomorphismPcGroup(gp) then return IsomorphismPcGroup(gp); fi; 196 197 if HasSize(gp) then 198 f:=Factors(Size(gp)); 199 if Length(Set(f))=1 then 200 SetIsPGroup(gp,true); 201 SetPrimePGroup(gp,f[1]); 202 elif Length(Set(f))=2 then 203 SetIsSolvableGroup(gp,true); 204 fi; 205 fi; 206 if HasIsPGroup(gp) and IsPGroup(gp) then 207 if Size(gp)=1 then 208 # special case trivial group 209 hom:=GroupHomomorphismByImagesNC(gp,Group(()), 210 GeneratorsOfGroup(gp), 211 List(GeneratorsOfGroup(gp),x->())); 212 SetEpimorphismFromFreeGroup(Image(hom), 213 GroupHomomorphismByImagesNC(FreeGroupOfFpGroup(gp),Image(hom), 214 FreeGeneratorsOfFpGroup(gp), 215 List(GeneratorsOfGroup(gp),x->Image(hom,x)))); 216 return hom; 217 fi; 218 # nilpotent 219 f:=Factors(Size(gp)); 220 hom:=EpimorphismPGroup(gp,f[1],Length(f)); 221 elif HasIsSolvableGroup(gp) and IsSolvableGroup(gp) then 222 # solvable 223 hom:=EpimorphismSolvableQuotient(gp,Size(gp)); 224 if Size(Image(hom))<>Size(gp) then 225 hom:=IsomorphismPermGroup(gp); 226 fi; 227 elif HasSize(gp) and Size(gp)<=10000 then 228 hom:=IsomorphismPermGroup(gp); 229 else 230 hom:=IsomorphismPermGroupOrFailFpGroup(gp); 231 fi; 232 if hom<>fail then 233 SetEpimorphismFromFreeGroup(Image(hom), 234 GroupHomomorphismByImagesNC(FreeGroupOfFpGroup(gp),Image(hom), 235 FreeGeneratorsOfFpGroup(gp), 236 List(GeneratorsOfGroup(gp),x->Image(hom,x)))); 237 fi; 238 return hom; 239end); 240 241# the heuristics about what comparison methods to use for < and = are all 242# concentrated in the following function to make the decision tree clear 243# without having to rely on method ranking and to ensure that both < and = 244# are treated the same way. 245# Note that the total ordering used may depend on what is known about the 246# group at the time of the first comparison. (See manual) (See manual) (See 247# manual) (See manual) 248MakeFpGroupCompMethod:=function(CMP) 249 return function(fam) 250 local hom,f,com; 251 # if a normal form method is known, and it is not known to be crummy 252 if HasFpElementNFFunction(fam) and not IsBound(fam!.hascrudeFPENFF) then 253 f:=FpElementNFFunction(fam); 254 com:=x->f(UnderlyingElement(x)); 255 # if we know a faithful representation, use it 256 elif HasFPFaithHom(fam) and 257 FPFaithHom(fam)<>fail then 258 hom:=FPFaithHom(fam); 259 com:=x->Image(hom,x); 260 # if neither is known, try a faithful representation (forcing its 261 # computation) 262 elif FPFaithHom(fam)<>fail then 263 hom:=FPFaithHom(fam); 264 com:=x->Image(hom,x); 265 #T Here one could try more elaborate things first 266 # otherwise force computation of a normal form. 267 else 268 f:=FpElementNFFunction(fam); 269 com:=x->f(UnderlyingElement(x)); 270 fi; 271 SetCanEasilyCompareElements(fam,true); 272 SetCanEasilySortElements(fam,true); 273 # now build the comparison function 274 return function(left,right) 275 return CMP(com(left),com(right)); 276 end; 277 end; 278end; 279 280InstallMethod( FpElmEqualityMethod, "generic dispatcher", 281true,[IsElementOfFpGroupFamily],0,MakeFpGroupCompMethod(\=)); 282 283InstallMethod( FpElmComparisonMethod, "generic dispatcher", true, 284[IsElementOfFpGroupFamily],0,MakeFpGroupCompMethod(\<)); 285 286 287############################################################################# 288## 289#M Order <elm> ) 290## 291InstallMethod( Order,"fp group element", [ IsElementOfFpGroup ],0, 292function( elm ) 293local fam; 294 fam:=FamilyObj(elm); 295 if not HasFPFaithHom(fam) or FPFaithHom(fam)=fail then 296 TryNextMethod(); # don't try the hard way 297 fi; 298 return Order(Image(FPFaithHom(fam),elm)); 299end ); 300 301############################################################################# 302## 303#M Random <gp> ) 304## 305InstallMethodWithRandomSource( Random, 306 "for a random source and an fp group", 307 [ IsRandomSource, IsSubgroupFpGroup and IsFinite], 308function( rs, gp ) 309local fam,hom; 310 fam:=ElementsFamily(FamilyObj(gp)); 311 hom:=FPFaithHom(fam); 312 if hom=fail then 313 TryNextMethod(); 314 fi; 315 return PreImagesRepresentative(hom,Random(rs, Image(hom,gp))); 316end ); 317 318############################################################################# 319## 320#M MappedWord( <x>, <gens1>, <gens2> ) 321## 322InstallOtherMethod( MappedWord,"for fp group element",IsElmsCollsX, 323 [ IsPackedElementDefaultRep, IsElementOfFpGroupCollection and IsList, 324 IsList ], 325 0, 326function(w,g,i) 327 # just defer to the underlying elements, then use the good method there 328 return MappedWord(UnderlyingElement(w),List(g,UnderlyingElement),i); 329end); 330 331############################################################################# 332## 333#M FpGrpMonSmgOfFpGrpMonSmgElement(<elm>) 334## 335InstallMethod(FpGrpMonSmgOfFpGrpMonSmgElement, 336 "for an element of an fp group", true, 337 [IsElementOfFpGroup], 0, 338 x -> CollectionsFamily(FamilyObj(x))!.wholeGroup); 339 340 341############################################################################# 342## 343## 2. methods for f.p. groups 344## 345 346InstallGlobalFunction(IndexCosetTab,function(t) 347 if Length(t)=0 then 348 return 1; 349 else 350 return Length(t[1]); 351 fi; 352end); 353 354InstallMethod( PseudoRandom,"subgroups fp group: force generators",true, 355 [IsSubgroupFpGroup],0, 356function( grp ) 357local gens, lim, n, r, l, w, a,la,f,up; 358 gens:=GeneratorsOfGroup(grp); 359 lim:=ValueOption("radius"); 360 if lim=fail then 361 return Group_PseudoRandom(grp); 362 else 363 n:=2*Length(gens)-1; 364 if not IsBound(grp!.randomrange) or lim<>grp!.randlim then 365 # there are 1+(n+1)(1+n+n^2+...+n^(lim-1))=(n^lim*(n+1)-2)/(n-1) 366 # words of length up to lim in the free group on |gens| generators 367 if n=1 then 368 grp!.randomrange:=[1..Minimum(lim,2^28-1)]; 369 f:=1; 370 else 371 up:=(n^lim*(n+1)-2)/(n-1); 372 if up>=2^28 then 373 f:=Int(up/2^28+1); 374 grp!.randomrange:=[1..2^28-1]; 375 else 376 grp!.randomrange:=[1..up]; 377 f:=1; 378 fi; 379 fi; 380 l:=[Int(1/f),Int((n+2)/f)]; 381 a:=n+1; 382 for r in [2..lim+1] do 383 a:=a*n; 384 l[r+1]:=l[r]+Maximum(1,Int(a/f)); 385 od; 386 grp!.randdist:=l; 387 grp!.randlim:=lim; 388 fi; 389 r:=Random(grp!.randomrange); # equal distribution of uncancelled words 390 l:=1; 391 while r>grp!.randdist[l] do 392 l:=l+1; 393 od; 394 l:=l-1; 395 # we multiply a lot here, but multiplication is cheap 396 w:=One(grp); 397 la:=false; 398 n:=n+1; 399 for r in [1..l] do 400 repeat 401 a:=Random(1,n); 402 until a<>la; 403 if a>Length(gens) then 404 la:=a-Length(gens); 405 w:=w/gens[la]; 406 else 407 w:=w*gens[a]; 408 la:=a+Length(gens); 409 fi; 410 od; 411 return w; 412 fi; 413end); 414 415############################################################################# 416## 417#M SubgroupOfWholeGroupByCosetTable(<fpfam>,<tab>) 418## 419InstallGlobalFunction(SubgroupOfWholeGroupByCosetTable,function(fam,tab) 420local S; 421 S := Objectify(NewType(fam,IsGroup and IsAttributeStoringRep ), 422 rec() ); 423 SetParent(S,fam!.wholeGroup); 424 SetCosetTableInWholeGroup(S,tab); 425 SetIndexInWholeGroup(S,IndexCosetTab(tab)); 426 return S; 427end); 428 429############################################################################# 430## 431#M SubgroupOfWholeGroupByQuotientSubgroup(<fpfam>,<Q>,<U>) 432## 433InstallGlobalFunction(SubgroupOfWholeGroupByQuotientSubgroup,function(fam,Q,U) 434local S; 435# if (IsPermGroup(Q) or IsPcGroup(Q)) and Index(Q,U)=1 then 436# # we get the full group 437# S:=fam!.wholeGroup; 438# if not IsBound(S!.quot) then # in case some algorithm wants it 439# S!.quot:=GroupWithGenerators(List(GeneratorsOfGroup(S),i->())); 440# S!.sub:=S!.quot; 441# fi; 442# return S; 443# fi; 444 445 Assert(1,Length(GeneratorsOfGroup(Q))=Length(GeneratorsOfGroup(fam!.wholeGroup))); 446 S := Objectify(NewType(fam, IsGroup and 447 IsSubgroupOfWholeGroupByQuotientRep and IsAttributeStoringRep ), 448 rec(quot:=Q,sub:=U) ); 449 SetParent(S,fam!.wholeGroup); 450 if CanComputeIndex(Q,U) and HasSize(Q) then 451 SetIndexInWholeGroup(S,IndexNC(Q,U)); 452 if IndexNC(Q,U)<infinity then 453 SetIsFinitelyGeneratedGroup(S,true); 454 fi; 455 elif HasIsFinite(Q) and IsFinite(Q) then 456 SetIsFinitelyGeneratedGroup(S,true); 457 fi; 458 # transfer normality information 459 if (HasIsNormalInParent(U) and Q=Parent(U)) or 460 (HasGeneratorsOfGroup(U) and Length(GeneratorsOfGroup(U))=0) or 461 (CanComputeSize(U) and Size(U)=1) then 462 SetIsNormalInParent(S,true); 463 fi; 464 return S; 465end); 466 467 468BindGlobal("MakeNiceDirectQuots",function(G,H) 469 local hom, a, b; 470 if not ((IsPermGroup(G!.quot) and IsPermGroup(H!.quot)) or 471 (IsPcGroup(G!.quot) and IsPcGroup(H!.quot))) then 472 # force permrep 473 if not IsPermGroup(G!.quot) then 474 hom:=IsomorphismPermGroup(G!.quot); 475 a:=GroupWithGenerators( 476 List(GeneratorsOfGroup(G!.quot),i->Image(hom,i)),()); 477 b:=Image(hom,G!.sub); 478 G:=SubgroupOfWholeGroupByQuotientSubgroup(FamilyObj(G),a,b); 479 fi; 480 481 if not IsPermGroup(H!.quot) then 482 hom:=IsomorphismPermGroup(H!.quot); 483 a:=GroupWithGenerators( 484 List(GeneratorsOfGroup(H!.quot),i->Image(hom,i)),()); 485 b:=Image(hom,H!.sub); 486 H:=SubgroupOfWholeGroupByQuotientSubgroup(FamilyObj(H),a,b); 487 fi; 488 fi; 489 return [G,H]; 490end); 491 492 493InstallGlobalFunction(TracedCosetFpGroup,function(t,elm,p) 494local i,j,e,pos,ex; 495 ex:=ExtRepOfObj(elm); 496 for i in [1,3..(Length(ex)-1)] do 497 e:=ex[i+1]; 498 if e<0 then 499 pos:=2*ex[i]; 500 e:=-e; 501 else 502 pos:=2*ex[i]-1; 503 fi; 504 for j in [1..e] do 505 p:=t[pos][p]; 506 od; 507 od; 508 return p; 509end); 510 511 512############################################################################# 513## 514#M \in ( <elm>, <U> ) in subgroup of fp group 515## 516InstallMethod( \in, "subgroup of fp group", IsElmsColls, 517 [ IsMultiplicativeElementWithInverse, IsSubgroupFpGroup ], 0, 518function(elm,U) 519 return TracedCosetFpGroup(CosetTableInWholeGroup(U), 520 UnderlyingElement(elm),1)=1; 521end); 522 523InstallMethod( \in, "subgroup of fp group by quotient rep", IsElmsColls, 524 [ IsMultiplicativeElementWithInverse, 525 IsSubgroupFpGroup and IsSubgroupOfWholeGroupByQuotientRep], 0, 526function(elm,U) 527 # transfer elm in factor 528 elm:=UnderlyingElement(elm); 529 elm:=MappedWord(elm,FreeGeneratorsOfWholeGroup(U), 530 GeneratorsOfGroup(U!.quot)); 531 532 return elm in U!.sub; 533end); 534 535 536############################################################################# 537## 538#M \=( <U>, <V> ) . . . . . . . . . for two subgroups of a f.p. group 539## 540InstallMethod( \=, "subgroups of fp group", IsIdenticalObj, 541 [ IsSubgroupFpGroup, IsSubgroupFpGroup ], 0, 542function( left, right ) 543 return IndexInWholeGroup(left)=IndexInWholeGroup(right) 544 and IsSubset(left,right) and IsSubset(right,left); 545end ); 546 547############################################################################# 548## 549#M IsSubset( <U>, <V> ) . . . . . . . . . for two subgroups of a f.p. group 550## 551InstallMethod( IsSubset, "subgroups of fp group: test generators", 552 IsIdenticalObj, 553 [ IsSubgroupFpGroup, # don't use the `CanEasilyTestMembership' filter here 554 # as the generator list may be empty. 555 IsSubgroupFpGroup and HasGeneratorsOfGroup], 0, 556function(left,right) 557 if Length(GeneratorsOfGroup(right))>0 558 and not CanEasilyTestMembership(left) then 559 TryNextMethod(); 560 fi; 561 return ForAll(GeneratorsOfGroup(right),i->i in left); 562end); 563 564InstallMethod(IsSubset,"subgroups of fp group by quot. rep",IsIdenticalObj, 565 [ IsSubgroupFpGroup and IsSubgroupOfWholeGroupByQuotientRep, 566 IsSubgroupFpGroup and IsSubgroupOfWholeGroupByQuotientRep], 0, 567function(G,H) 568local A,B,U,V,W,E,F,map; 569 # trivial plausibility 570 if HasIndexInWholeGroup(G) and HasIndexInWholeGroup(H) and 571 IndexInWholeGroup(G)>IndexInWholeGroup(H) then 572 return false; 573 fi; 574 575 A:=G!.quot; 576 B:=H!.quot; 577 U:=G!.sub; 578 V:=H!.sub; 579 # are we represented in the same quotient? 580 if GeneratorsOfGroup(A)=GeneratorsOfGroup(B) then 581 # we are, compare simply in the quotient 582 return IsSubset(U,V); 583 fi; 584 585 # now we have to test ``subsetness'' in the subdirect product defined by 586 # the quotients. WLOG the whole group is this subdirect product S 587 # A | |S | B Let E<A and F<B be the normal subgroups 588 # | | | whose factors are glued together. We have 589 # E / / \ \ F E=(ker(S->B))->A 590 # / / \ \ F=(ker(S->A))->B 591 # \ / 592 # \ / 593 # Then G>H if and only if the following two conditions hold: 594 # 1) The image of G in B contains V. 595 # 2) G contains ker(S->B) (so with 1 it is sufficient, this is trivially 596 # neccessary as H contains this kernel). 597 # This condition is fulfilled, if U>E 598 599 # To compute this, first note that F is generated (as normal subgroup) by 600 # the relators of A evaluated in the generators of B. This is the 601 # coKernel of a mapping A->B 602 if not IsTrivial(V) then 603 map:=GroupGeneralMappingByImagesNC(A,B,GeneratorsOfGroup(A), 604 GeneratorsOfGroup(B)); 605 F:=CoKernelOfMultiplicativeGeneralMapping(map); 606 W:=ClosureGroup(F, 607 List(GeneratorsOfGroup(U),i->ImagesRepresentative(map,i))); 608 if not IsSubset(W,V) then 609 return false; # condition 1 610 fi; 611 fi; 612 613 map:=GroupGeneralMappingByImagesNC(B,A,GeneratorsOfGroup(B), 614 GeneratorsOfGroup(A)); 615 E:=CoKernelOfMultiplicativeGeneralMapping(map); 616 return IsSubset(U,E); 617end); 618 619InstallMethod( IsSubset, "subgp fp group: via quotient rep", IsIdenticalObj, 620 [ IsSubgroupFpGroup, IsSubgroupFpGroup ], 0, 621function(left,right) 622 return IsSubset(AsSubgroupOfWholeGroupByQuotient(left), 623 AsSubgroupOfWholeGroupByQuotient(right)); 624end); 625 626InstallMethod( CanComputeIsSubset, "whole fp family group", IsIdenticalObj, 627 [ IsSubgroupFpGroup and IsWholeFamily, IsSubgroupFpGroup ], 0, 628function(left,right) 629 return true; 630end); 631 632InstallMethod(IsNormalOp,"subgroups of fp group by quot. rep in full fp grp.", 633 IsIdenticalObj, [ IsSubgroupFpGroup and IsWholeFamily, 634 IsSubgroupFpGroup and IsSubgroupOfWholeGroupByQuotientRep], 0, 635function(G,H) 636 return IsNormal(H!.quot,H!.sub); 637end); 638 639InstallMethod(IsFinitelyGeneratedGroup,"subgroups of fp group",true, 640 [IsSubgroupFpGroup],0, 641function(U) 642local G; 643 G:=FamilyObj(U)!.wholeGroup; 644 if not IsFinitelyGeneratedGroup(G) then 645 TryNextMethod(); 646 fi; 647 if CanComputeIndex(G,U) and Index(G,U)<infinity then 648 return true; 649 fi; 650 Info(InfoWarning,1, 651 "Forcing index computation to test whether subgroup is finitely generated" 652 ); 653 if Index(G,U)<infinity then 654 return true; 655 fi; 656 TryNextMethod(); # give up 657end); 658 659############################################################################# 660## 661#M GeneratorsOfGroup( <F> ) . . . . . . . . . . . . . . . for a f.p. group 662## 663InstallMethod( GeneratorsOfGroup, "for whole family f.p. group", true, 664 [ IsSubgroupFpGroup and IsGroupOfFamily ], 0, 665function( F ) 666local Fam; 667 Fam:= ElementsFamily( FamilyObj( F ) ); 668 return List( FreeGeneratorsOfFpGroup( F ), g -> ElementOfFpGroup( Fam, g ) ); 669end ); 670 671 672############################################################################# 673## 674#M AbelianInvariants( <G> ) . . . . . . . . . . . . . . . . . for a fp group 675## 676InstallMethod( AbelianInvariants, 677 "for a finitely presented group", 678 true, 679 [ IsSubgroupFpGroup and IsGroupOfFamily ], 680 0, 681 682function( G ) 683 local Fam, # elements family of <G> 684 mat, # relator matrix of <G> 685 gens, # generators of free group 686 genind, # their indices 687 row, # a row of <mat> 688 rel, # a relator of <G> 689 p, # position of <g> or its inverse in <gens> 690 i, # loop variable 691 word, 692 inv; 693 694 Fam := ElementsFamily( FamilyObj( G ) ); 695 gens := FreeGeneratorsOfFpGroup( G ); 696 genind:=List(gens,i->AbsInt(LetterRepAssocWord(i)[1])); 697 698 # handle groups with no relators 699 if IsEmpty( RelatorsOfFpGroup( G ) ) then 700 return [ 1 .. Length( gens ) ] * 0; 701 fi; 702 703 # make the relator matrix 704 mat := []; 705 for rel in RelatorsOfFpGroup( G ) do 706 row := []; 707 for i in [ 1 .. Length( gens ) ] do 708 row[i] := 0; 709 od; 710 #for i in [ 1 .. NrSyllables( rel ) ] do 711 # p := Position( genind, GeneratorSyllable(rel,i)); 712 # row[p]:=row[p]+ExponentSyllable(rel,i); 713 #od; 714 word:=LetterRepAssocWord(rel); 715 for i in [1..Length(rel)] do 716 p:=Position(genind,AbsInt(word[i])); 717 row[p]:=row[p]+SignInt(word[i]); 718 od; 719 Add( mat, row ); 720 od; 721 722 # diagonalize the matrix 723 DiagonalizeMat( Integers, mat ); 724 725 # return the abelian invariants 726 inv:=AbelianInvariantsOfList( DiagonalOfMat( mat ) ); 727 if 0 in inv then 728 SetSize(G,infinity); 729 elif Length(gens)=1 or (HasIsAbelian(G) and IsAbelian(G)) then 730 # abelian 731 SetSize(G,Product(inv)); 732 fi; 733 return inv; 734end ); 735 736 737############################################################################# 738## 739#M AbelianInvariants( <H> ) . . . . . . . . . . for a subgroup of a fp group 740## 741InstallMethod( AbelianInvariants, 742 "for a subgroup of a finitely presented group", true, 743 [ IsSubgroupFpGroup ], 0, 744function(H) 745 746 local G,inv; 747 748 if IsGroupOfFamily(H) then 749 TryNextMethod(); 750 fi; 751 752 # Get the whole group `G' of `H'. 753 G:= FamilyObj(H)!.wholeGroup; 754 755 # Call the global function for subgroups of f.p. groups. 756 inv:=AbelianInvariantsSubgroupFpGroup( G, H ); 757 if 0 in inv then 758 SetSize(H,infinity); 759 elif HasIsAbelian(H) and IsAbelian(H) then 760 # abelian 761 SetSize(H,Product(inv)); 762 fi; 763 return inv; 764end ); 765 766############################################################################# 767## 768#M IsInfiniteAbelianizationGroup( <G> ) . . . . . . . . . . . for a fp group 769## 770BindGlobal("HasFullColumnRankIntMatDestructive",function( mat ) 771 local n, rb, next, primes, mp, r, pm, ns, nns, j, p, i; 772 n:=Length(mat[1]); 773 if Length(mat)<n then 774 return false; 775 fi; 776 # first check modulo some primes 777 rb:=0; 778 next:=7; 779 primes:=[2,7,251]; 780 for p in primes do 781 mp:=ImmutableMatrix(p,mat*Z(p)^0); 782 r:=RankMat(mp); 783 if rb>0 and r<>rb and next<250 then 784 next:=NextPrimeInt(next); 785 Add(primes,next); 786 fi; 787 rb:=Maximum(r,rb); 788 Info(InfoMatrix,2,"Rank modulo ",p,":",r); 789 if rb=n then 790 return true; 791 fi; 792 if p=251 then 793 pm:=125; 794 ns:=NullspaceMat(TransposedMat(mp)); 795 nns:=[]; 796 for i in ns do 797 r:=List(i,Int); 798 for j in [1..Length(r)] do 799 if r[j]>pm then r[j]:=r[j]-p;fi; 800 od; 801 if IsZero(mat*r) then 802 Info(InfoMatrix,2,"Kernel element modulo lifts!"); 803 return false; 804 fi; 805 Add(nns,r); 806 od; 807 fi; 808 od; 809 if rb<n-1 then 810 # the modulo calculation gesses rank `rb'. If this is the rank, then rb+1 811 # columns should be dependent! 812 r:=[1..rb+1]; 813 mp:=List(mat,x->x{r}); 814 TriangulizeIntegerMat(mp); 815 if Number(mp,x->not IsZero(x))<=rb then 816 # we are missing full rank already in the first rb+1 columns 817 return false; 818 fi; 819 fi; 820 821 # it failed -- hard work 822 Info(InfoMatrix,2,"reduced calculation failed"); 823 TriangulizeIntegerMat(mat); 824 return Number(mat,x->not IsZero(x))=n; 825end); 826 827 828InstallMethod( IsInfiniteAbelianizationGroup, 829 "for a finitely presented group", 830 true, 831 [ IsSubgroupFpGroup and IsGroupOfFamily ], 832 0, 833 834function( G ) 835 local Fam, # elements family of <G> 836 mat, # relator matrix of <G> 837 gens, # generators of free group 838 genind, # their indices 839 row, # a row of <mat> 840 rel, # a relator of <G> 841 p, # position of <g> or its inverse in <gens> 842 i, # loop variable 843 word,r, 844 inv; 845 846 Fam := ElementsFamily( FamilyObj( G ) ); 847 gens := FreeGeneratorsOfFpGroup( G ); 848 genind:=List(gens,i->AbsInt(LetterRepAssocWord(i)[1])); 849 850 # handle groups with no relators 851 if IsEmpty( RelatorsOfFpGroup( G ) ) then 852 return Length(gens)>0; 853 fi; 854 855 # make the relator matrix 856 mat := []; 857 for rel in RelatorsOfFpGroup( G ) do 858 row := []; 859 for i in [ 1 .. Length( gens ) ] do 860 row[i] := 0; 861 od; 862 #for i in [ 1 .. NrSyllables( rel ) ] do 863 # p := Position( genind, GeneratorSyllable(rel,i)); 864 # row[p]:=row[p]+ExponentSyllable(rel,i); 865 #od; 866 word:=LetterRepAssocWord(rel); 867 for i in [1..Length(rel)] do 868 p:=Position(genind,AbsInt(word[i])); 869 row[p]:=row[p]+SignInt(word[i]); 870 od; 871 Add( mat, row ); 872 od; 873 874 if Length(mat)=0 then 875 return false; 876 fi; 877 if Length(mat)>=Length(mat[1]) then 878 if HasFullColumnRankIntMatDestructive(mat) then 879 return false; 880 fi; 881 fi; 882 SetSize(G,infinity); 883 return true; 884 885end ); 886 887 888############################################################################# 889## 890#M IsInfiniteAbelianizationGroup( <H> ) . . . . for a subgroup of a fp group 891## 892InstallMethod( IsInfiniteAbelianizationGroup, 893 "for a subgroup of a finitely presented group", true, 894 [ IsSubgroupFpGroup ], 0, 895function(H) 896 local G,mat,r; 897 898 if IsGroupOfFamily(H) then 899 TryNextMethod(); 900 fi; 901 902 # Get the whole group `G' of `H'. 903 G:= FamilyObj(H)!.wholeGroup; 904 905 # Call the global function for subgroups of f.p. groups. 906 mat:=RelatorMatrixAbelianizedSubgroupRrs(G,H); 907 if Length(mat)=0 then 908 return false; 909 fi; 910 911 if Length(mat)>=Length(mat[1]) then 912 if HasFullColumnRankIntMatDestructive(mat) then 913 return false; 914 fi; 915 fi; 916 SetSize(G,infinity); 917 return true; 918 919end); 920 921# a free group has infinite abelianization if and only if it is non-trivial 922InstallTrueMethod( IsInfiniteAbelianizationGroup, IsFreeGroup and IsNonTrivial ); 923InstallTrueMethod( HasIsInfiniteAbelianizationGroup, IsFreeGroup and IsTrivial ); 924 925############################################################################# 926## 927#M IsPerfectGroup( <H> ) 928## 929InstallMethod( IsPerfectGroup, 930 "for a (subgroup of a) finitely presented group", true, 931 [ IsSubgroupFpGroup ], 0, 932# for fp groups `AbelianInvariants' works. 933 G -> IsEmpty( AbelianInvariants( G ) ) ); 934 935############################################################################# 936## 937#M DerivedSubgroup( <G> ) . . . . . . . . . . . . . . . . . for a fp group 938## 939InstallMethod( DerivedSubgroup, "for a finitely presented group", true, 940 [ IsSubgroupFpGroup and IsGroupOfFamily ], 0, 941function(G) 942local hom,u; 943 hom:=MaximalAbelianQuotient(G); 944 if Size(Range(hom))=1 then 945 return G; # this is needed because the trivial quotient is represented 946 # as fp group on no generators 947 fi; 948 u:=PreImage(hom,TrivialSubgroup(Range(hom))); 949 SetIndexInWholeGroup(u,Size(Range(hom))); 950 if IsFreeGroup(G) and not IsAbelian(G) then 951 SetIsFinite(u,false); 952 SetIsFinitelyGeneratedGroup(u,false); 953 fi; 954 return u; 955end); 956 957InstallMethod( DerivedSubgroup, "subgroup of a finitely presented group", true, 958 [ IsSubgroupFpGroup ], 0, 959function(G) 960local iso,hom,u; 961 iso:=IsomorphismFpGroup(G); 962 hom:=MaximalAbelianQuotient(Range(iso)); 963 if HasAbelianInvariants(Range(iso)) then 964 SetAbelianInvariants(G,AbelianInvariants(Range(iso))); 965 fi; 966 if HasIsAbelian(G) and IsAbelian(G) then 967 return TrivialSubgroup(G); 968 elif Size(Image(hom))=infinity then 969 # test a special case -- one generator 970 if Length(GeneratorsOfGroup(G))=1 then 971 SetIsAbelian(G,true); 972 return TrivialSubgroup(G); 973 fi; 974 Error("Derived subgroup has infinite index, cannot represent"); 975 elif Size(Range(hom))=1 then 976 return G; # this is needed because the trivial quotient is represented 977 # as fp group on no generators 978 fi; 979 hom:=CompositionMapping(hom,iso); 980 u:=PreImage(hom,TrivialSubgroup(Range(hom))); 981 if HasIndexInWholeGroup(G) then 982 SetIndexInWholeGroup(u,IndexInWholeGroup(G)*Size(Range(hom))); 983 fi; 984 return u; 985end); 986 987 988############################################################################# 989## 990#M CosetTable( <G>, <H> ) . . . . coset table of a finitely presented group 991## 992InstallMethod( CosetTable, 993 "for finitely presented groups", 994 true, 995 [ IsSubgroupFpGroup and IsGroupOfFamily, IsSubgroupFpGroup ], 996 0, 997function( G, H ); 998 999 if G <> FamilyObj(H)!.wholeGroup then 1000 Error( "<H> must be a subgroup of <G>" ); 1001 fi; 1002 return CosetTableInWholeGroup(H); 1003 1004end ); 1005 1006 1007############################################################################# 1008## 1009#M CosetTableNormalClosure( <G>, <H> ) . . coset table of the normal closure 1010#M of a subgroup in a finitely presented group 1011## 1012InstallMethod( CosetTableNormalClosure, 1013 "for finitely presented groups", 1014 true, 1015 [ IsSubgroupFpGroup and IsGroupOfFamily, IsSubgroupFpGroup ], 1016 0, 1017function( G, H ); 1018 1019 if G <> FamilyObj( H )!.wholeGroup then 1020 Error( "<H> must be a subgroup of <G>" ); 1021 fi; 1022 return CosetTableNormalClosureInWholeGroup( H ); 1023 1024end ); 1025 1026 1027############################################################################# 1028## 1029#M CosetTableFromGensAndRels( <fgens>, <grels>, <fsgens> ) . . . . . . . . . 1030#M do a coset enumeration 1031## 1032## 'CosetTableFromGensAndRels' is the working horse for computing a coset 1033## table of H in G where G is a finitley presented group, H is a subgroup of 1034## G, and G is the whole group of H. It applies a Felsch strategy Todd- 1035## Coxeter coset enumeration. The expected parameters are 1036## 1037## \beginitems 1038## fgens & generators of the free group F associated to G, 1039## 1040## grels & relators of G, 1041## 1042## fsgens & preimages of the subgroup generators of H in F. 1043## \enditems 1044## 1045## `CosetTableFromGensAndRels' processes two options (see 1046## chapter~"Options"): 1047## \beginitems 1048## `max' & The limit of the number of cosets to be defined. If the 1049## enumeration does not finish with this number of cosets, an error is 1050## raised and the user is asked whether she wants to continue 1051## 1052## `silent' & if set to `true' the algorithm will not rais the error 1053## mentioned under option `max' but silently return `fail'. This can be 1054## useful if an enumeration is only wanted unless it becomes too big. 1055## \enditems 1056InstallGlobalFunction( CosetTableFromGensAndRels, 1057function ( fgens, grels, fsgens ) 1058 Info( InfoFpGroup, 3, "CosetTableFromGensAndRels called:" ); 1059 # catch trivial subgroup generators 1060 if ForAny(fsgens,i->Length(i)=0) then 1061 fsgens:=Filtered(fsgens,i->Length(i)>0); 1062 fi; 1063 if Length(fgens)=0 then 1064 return []; 1065 fi; 1066 # call the TC plugin. Option ensures no factorization takes place in printing 1067 # (which can confuse the ACE interface). 1068 return TCENUM.CosetTableFromGensAndRels(fgens,grels,fsgens:printnopowers:=true); 1069end); 1070 1071# this function implements the library version of the Todd-Coxeter routine. 1072BindGlobal("GTC_CosetTableFromGensAndRels",function(arg) 1073 local fgens,grels,fsgens, 1074 next, prev, # next and previous coset on lists 1075 firstFree, lastFree, # first and last free coset 1076 firstDef, lastDef, # first and last defined coset 1077 table, # columns in the table for gens 1078 rels, # representatives of the relators 1079 relsGen, # relators sorted by start generator 1080 subgroup, # rows for the subgroup gens 1081 deductions, # deduction queue 1082 i, gen, inv, # loop variables for generator 1083 g, # loop variable for generator col 1084 rel, # loop variables for relation 1085 p, p1, p2, # generator position numbers 1086 app, # arguments list for 'MakeConsequences' 1087 limit, # limit of the table 1088 maxlimit, # maximal size of the table 1089 j, # integer variable 1090 length, length2, # length of relator (times 2) 1091 cols, 1092 nums, 1093 l, 1094 nrdef, # number of defined cosets 1095 nrmax, # maximal value of the above 1096 nrdel, # number of deleted cosets 1097 nrinf, # number for next information message 1098 infstep, 1099 silent, # do we want the algorithm to silently 1100 # return `fail' if the algorithm did not 1101 # finish in the permitted size? 1102 TCEOnBreakMessage, # to provide a local OnBreakMessage 1103 SavedOnBreakMessage; # the value of OnBreakMessage before 1104 # this function was called 1105 1106 fgens:=arg[1]; 1107 grels:=arg[2]; 1108 fsgens:=arg[3]; 1109 # give some information 1110 Info( InfoFpGroup, 2, " defined deleted alive maximal"); 1111 nrdef := 1; 1112 nrmax := 1; 1113 nrdel := 0; 1114 # to give tidy instructions if one enters a break-loop 1115 SavedOnBreakMessage := OnBreakMessage; 1116 TCEOnBreakMessage := function(n) 1117 Print( "type 'return;' if you want to continue with a new limit of ", 1118 n, " cosets,\n", 1119 "type 'quit;' if you want to quit the coset enumeration,\n", 1120 "type 'maxlimit := 0; return;' in order to continue without a ", 1121 "limit\n" ); 1122 OnBreakMessage := SavedOnBreakMessage; 1123 end; 1124 1125 # initialize size of the table 1126 maxlimit := ValueOption("max"); 1127 if maxlimit = fail or not (IsInt(maxlimit) or maxlimit=infinity) then 1128 maxlimit := CosetTableDefaultMaxLimit; 1129 fi; 1130 infstep:=QuoInt(maxlimit,10); 1131 nrinf := infstep; 1132 limit := CosetTableDefaultLimit; 1133 if limit > maxlimit and maxlimit > 0 then 1134 limit := maxlimit; 1135 fi; 1136 1137 silent := ValueOption("silent") = true; 1138 1139 # define one coset (1) 1140 firstDef := 1; lastDef := 1; 1141 firstFree := 2; lastFree := limit; 1142 1143 # make the lists that link together all the cosets 1144 next := [ 2 .. limit + 1 ]; next[1] := 0; next[limit] := 0; 1145 prev := [ 0 .. limit - 1 ]; prev[2] := 0; 1146 1147 # compute the representatives for the relators 1148 rels := RelatorRepresentatives( grels ); 1149 1150 # make the columns for the generators 1151 table := []; 1152 for gen in fgens do 1153 g := ListWithIdenticalEntries( limit, 0 ); 1154 Add( table, g ); 1155 if not ( gen^2 in rels or gen^-2 in rels ) then 1156 g := ListWithIdenticalEntries( limit, 0 ); 1157 fi; 1158 Add( table, g ); 1159 od; 1160 1161 # make the rows for the relators and distribute over relsGen 1162 relsGen := RelsSortedByStartGen( fgens, rels, table, true ); 1163 1164 # make the rows for the subgroup generators 1165 subgroup := []; 1166 for rel in fsgens do 1167 #T this code should use ExtRepOfObj -- its faster 1168 # cope with SLP elms 1169 if IsStraightLineProgElm(rel) then 1170 rel:=EvalStraightLineProgElm(rel); 1171 fi; 1172 length := Length( rel ); 1173 if length>0 then 1174 length2 := 2 * length; 1175 nums := [ ]; nums[length2] := 0; 1176 cols := [ ]; cols[length2] := 0; 1177 1178 # compute the lists. 1179 i := 0; j := 0; 1180 while i < length do 1181 i := i + 1; j := j + 2; 1182 gen := Subword( rel, i, i ); 1183 p := Position( fgens, gen ); 1184 if p = fail then 1185 p := Position( fgens, gen^-1 ); 1186 p1 := 2 * p; 1187 p2 := 2 * p - 1; 1188 else 1189 p1 := 2 * p - 1; 1190 p2 := 2 * p; 1191 fi; 1192 nums[j] := p1; cols[j] := table[p1]; 1193 nums[j-1] := p2; cols[j-1] := table[p2]; 1194 od; 1195 Add( subgroup, [ nums, cols ] ); 1196 fi; 1197 od; 1198 1199 # add an empty deduction list 1200 deductions := []; 1201 1202 # make the structure that is passed to 'MakeConsequences' 1203 app := [ table, next, prev, relsGen, subgroup ]; 1204 1205 # we do not want minimal gaps to be marked in the coset table 1206 app[12] := 0; 1207 1208 # run over all the cosets 1209 while firstDef <> 0 do 1210 1211 # run through all the rows and look for undefined entries 1212 for i in [ 1 .. Length( table ) ] do 1213 gen := table[i]; 1214 1215 if gen[firstDef] <= 0 then 1216 1217 inv := table[i + 2*(i mod 2) - 1]; 1218 1219 # if necessary expand the table 1220 if firstFree = 0 then 1221 if 0 < maxlimit and maxlimit <= limit then 1222 if silent then 1223 if ValueOption("returntable")=true then 1224 return table; 1225 else 1226 return fail; 1227 fi; 1228 fi; 1229 maxlimit := Maximum(maxlimit*2,limit*2); 1230 OnBreakMessage := function() 1231 TCEOnBreakMessage(maxlimit); 1232 end; 1233 Error( "the coset enumeration has defined more ", 1234 "than ", limit, " cosets\n"); 1235 fi; 1236 next[2*limit] := 0; 1237 prev[2*limit] := 2*limit-1; 1238 for g in table do g[2*limit] := 0; od; 1239 for l in [ limit+2 .. 2*limit-1 ] do 1240 next[l] := l+1; 1241 prev[l] := l-1; 1242 for g in table do g[l] := 0; od; 1243 od; 1244 next[limit+1] := limit+2; 1245 prev[limit+1] := 0; 1246 for g in table do g[limit+1] := 0; od; 1247 firstFree := limit+1; 1248 limit := 2*limit; 1249 lastFree := limit; 1250 fi; 1251 1252 # update the debugging information 1253 nrdef := nrdef + 1; 1254 if nrmax <= firstFree then 1255 nrmax := firstFree; 1256 fi; 1257 1258 # define a new coset 1259 gen[firstDef] := firstFree; 1260 inv[firstFree] := firstDef; 1261 next[lastDef] := firstFree; 1262 prev[firstFree] := lastDef; 1263 lastDef := firstFree; 1264 firstFree := next[firstFree]; 1265 next[lastDef] := 0; 1266 1267 # set up the deduction queue and run over it until it's empty 1268 app[6] := firstFree; 1269 app[7] := lastFree; 1270 app[8] := firstDef; 1271 app[9] := lastDef; 1272 app[10] := i; 1273 app[11] := firstDef; 1274 nrdel := nrdel + MakeConsequences( app ); 1275 firstFree := app[6]; 1276 lastFree := app[7]; 1277 firstDef := app[8]; 1278 lastDef := app[9]; 1279 1280 # give some information 1281 if nrinf <= nrdef+nrdel then 1282 Info( InfoFpGroup, 3, "\t", nrdef, "\t", nrinf-nrdef, 1283 "\t", 2*nrdef-nrinf, "\t", nrmax ); 1284 nrinf := ( Int(nrdef+nrdel)/infstep + 1 ) * infstep; 1285 fi; 1286 1287 fi; 1288 od; 1289 1290 firstDef := next[firstDef]; 1291 od; 1292 1293 Info( InfoFpGroup, 2, "\t", nrdef, "\t", nrdel, "\t", nrdef-nrdel, "\t", 1294 nrmax ); 1295 1296 # separate pairs of identical table columns. 1297 for i in [ 1 .. Length( fgens ) ] do 1298 if IsIdenticalObj( table[2*i-1], table[2*i] ) then 1299 table[2*i] := StructuralCopy( table[2*i-1] ); 1300 fi; 1301 od; 1302 1303 # standardize the table 1304 StandardizeTable( table ); 1305 1306 # return the table 1307 return table; 1308end); 1309 1310GAPTCENUM.CosetTableFromGensAndRels := GTC_CosetTableFromGensAndRels; 1311 1312if IsHPCGAP then 1313 MakeReadOnlyObj( GAPTCENUM ); 1314fi; 1315 1316 1317############################################################################# 1318## 1319#M CosetTableInWholeGroup( <H> ) . . . . . . coset table of an fp subgroup 1320#M in its whole group 1321## 1322## is equivalent to `CosetTable( <G>, <H> )' where <G> is the (unique) 1323## finitely presented group such that <H> is a subgroup of <G>. 1324## 1325InstallMethod( TryCosetTableInWholeGroup,"for finitely presented groups", 1326 true, [ IsSubgroupFpGroup ], 0, 1327function( H ) 1328 local G, # whole group of <H> 1329 fgens, # generators of the free group F asscociated to G 1330 grels, # relators of G 1331 sgens, # subgroup generators of H 1332 fsgens, # preimages of subgroup generators in F 1333 T; # coset table 1334 1335 # do we know it already? 1336 if HasCosetTableInWholeGroup(H) then 1337 return CosetTableInWholeGroup(H); 1338 fi; 1339 1340 # Get whole group <G> of <H>. 1341 G := FamilyObj( H )!.wholeGroup; 1342 1343 # get some variables 1344 fgens := FreeGeneratorsOfFpGroup( G ); 1345 grels := RelatorsOfFpGroup( G ); 1346 sgens := GeneratorsOfGroup( H ); 1347 fsgens := List( sgens, gen -> UnderlyingElement( gen ) ); 1348 1349 # Construct the coset table of <G> by <H>. 1350 T := CosetTableFromGensAndRels( fgens, grels, fsgens ); 1351 1352 if T<>fail then 1353 SetCosetTableInWholeGroup(H,T); 1354 fi; 1355 return T; 1356 1357end ); 1358 1359InstallMethod( CosetTableInWholeGroup,"for finitely presented groups", 1360 true, [ IsSubgroupFpGroup ], 0, 1361function( H ) 1362 # don't get trapped by a `silent' option lingering around. 1363 return TryCosetTableInWholeGroup(H:silent:=false); 1364end ); 1365 1366InstallMethod( CosetTableInWholeGroup,"from augmented table Rrs", 1367 true, [ IsSubgroupFpGroup and HasAugmentedCosetTableRrsInWholeGroup], 0, 1368function( H ) 1369 return AugmentedCosetTableRrsInWholeGroup(H).cosetTable; 1370end ); 1371 1372InstallMethod(CosetTableInWholeGroup,"ByQuoSubRep",true, 1373 [IsSubgroupOfWholeGroupByQuotientRep],0, 1374function(G) 1375 # construct coset table 1376 return CosetTableBySubgroup(G!.quot,G!.sub); 1377end); 1378 1379 1380############################################################################# 1381## 1382#M CosetTableNormalClosureInWholeGroup( <H> ) . . . . . coset table of the 1383#M normal closure of an fp subgroup in its whole group 1384## 1385## is equivalent to `CosetTableNormalClosure( <G>, <H> )' where <G> is the 1386## (unique) finitely presented group such that <H> is a subgroup of <G>. 1387## 1388InstallMethod( CosetTableNormalClosureInWholeGroup, 1389 "for finitely presented groups", 1390 true, [ IsSubgroupFpGroup ], 0, 1391function( H ) 1392 local G, # whole group of H 1393 F, # associated free group 1394 fgens, # generators of F 1395 grels, # relators of G 1396 sgens, # subgroup generators of H 1397 fsgens, # preimages of subgroup generators in F 1398 krels, # relators of the normal closure N of H in G 1399 K, # factor group of F isomorphic to G/N 1400 T; # coset table 1401 1402 # do we know it already? 1403 if HasCosetTableNormalClosureInWholeGroup( H ) then 1404 T := CosetTableNormalClosureInWholeGroup( H ); 1405 else 1406 # Get whole group G of H. 1407 G := FamilyObj( H )!.wholeGroup; 1408 1409 # get some variables 1410 F := FreeGroupOfFpGroup( G ); 1411 fgens := GeneratorsOfGroup( F ); 1412 grels := RelatorsOfFpGroup( G ); 1413 sgens := GeneratorsOfGroup( H ); 1414 fsgens := List( sgens, gen -> UnderlyingElement( gen ) ); 1415 1416 # construct a factor group K of F isomorphic to the factor group of G 1417 # by the normal closure N of H. 1418 krels := Concatenation( grels, fsgens ); 1419 K := F / krels; 1420 1421 # get the coset table of N in G by constructing the coset table of 1422 # the trivial subgroup in K. 1423 T := CosetTable( K, TrivialSubgroup( K ) ); 1424 Info( InfoFpGroup, 1, "index is ", IndexCosetTab(T) ); 1425 fi; 1426 1427 return T; 1428 1429end ); 1430 1431 1432############################################################################# 1433## 1434#F StandardizeTable( <table> [, <standard>] ) . . . standardize coset table 1435## 1436## standardizes a coset table. 1437## 1438InstallGlobalFunction( StandardizeTable, function( arg ) 1439 1440 local standard, table; 1441 1442 # get the arguments 1443 table := arg[1]; 1444 if Length( arg ) > 1 then 1445 standard := arg[2]; 1446 else 1447 standard := CosetTableStandard; 1448 fi; 1449 if standard <> "lenlex" and standard <> "semilenlex" then 1450 Error( "unknown coset table standard" ); 1451 fi; 1452 if standard = "lenlex" then 1453 standard := 0; 1454 else 1455 standard := 1; 1456 fi; 1457 1458 # call an appropriate kernel function which does the job 1459 StandardizeTableC( table, standard ); 1460 1461end ); 1462 1463 1464############################################################################# 1465## 1466#F StandardizeTable2( <table>, <table2> [, <standard>] ) . standardize ACT 1467## 1468## standardizes an augmented coset table. 1469## 1470InstallGlobalFunction( StandardizeTable2, function( arg ) 1471 1472 local standard, table, table2; 1473 1474 # get the arguments 1475 table := arg[1]; 1476 table2 := arg[2]; 1477 if Length( arg ) > 2 then 1478 standard := arg[3]; 1479 else 1480 standard := CosetTableStandard; 1481 fi; 1482 if standard <> "lenlex" and standard <> "semilenlex" then 1483 Error( "unknown coset table standard" ); 1484 fi; 1485 if standard = "lenlex" then 1486 standard := 0; 1487 else 1488 standard := 1; 1489 fi; 1490 1491 # call an appropriate kernel function which does the job 1492 StandardizeTable2C( table, table2, standard ); 1493 1494end ); 1495 1496 1497############################################################################# 1498## 1499#M Display( <G> ) . . . . . . . . . . . . . . . . . . . display an fp group 1500## 1501InstallMethod( Display, 1502 "for finitely presented groups", 1503 true, 1504 [ IsSubgroupFpGroup and IsGroupOfFamily ], 1505 0, 1506 1507function( G ) 1508 local gens, # generators o the free group 1509 rels, # relators of <G> 1510 nrels, # number of relators 1511 i; # loop variable 1512 1513 gens := FreeGeneratorsOfFpGroup( G ); 1514 rels := RelatorsOfFpGroup( G ); 1515 Print( "generators = ", gens, "\n" ); 1516 nrels := Length( rels ); 1517 Print( "relators = [" ); 1518 if nrels > 0 then 1519 Print( "\n ", rels[1] ); 1520 for i in [ 2 .. nrels ] do 1521 Print( ",\n ", rels[i] ); 1522 od; 1523 fi; 1524 Print( " ]\n" ); 1525end ); 1526 1527 1528############################################################################# 1529## 1530#F FactorGroupFpGroupByRels( <G>, <elts> ) 1531## 1532## Returns the factor group G/N of G by the normal closure N of <elts> where 1533## <elts> is expected to be a list of elements of G. 1534## 1535InstallGlobalFunction( FactorGroupFpGroupByRels, 1536function( G, elts ) 1537 local F, # free group associated to G and to G/N 1538 grels, # relators of G 1539 words, # representative words in F for the elements in elts 1540 rels; # relators of G/N 1541 1542 # get some local variables 1543 F := FreeGroupOfFpGroup( G ); 1544 grels := RelatorsOfFpGroup( G ); 1545 words := List( elts, g -> UnderlyingElement( g ) ); 1546 1547 # get relators for G/N 1548 rels := Concatenation( grels, words ); 1549 1550 # return the resulting factor group G/N 1551 return F / rels; 1552end ); 1553 1554############################################################################# 1555## 1556#M FactorFreeGroupByRelators(<F>,<rels>) . factor of free group by relators 1557## 1558BindGlobal( "FactorFreeGroupByRelators", function( F, rels ) 1559 local G, fam, gens,typ; 1560 1561 # Create a new family. 1562 fam := NewFamily( "FamilyElementsFpGroup", IsElementOfFpGroup ); 1563 1564 # Create the default type for the elements. 1565 fam!.defaultType := NewType( fam, IsPackedElementDefaultRep ); 1566 1567 fam!.freeGroup := F; 1568 fam!.relators := Immutable( rels ); 1569 typ:=IsSubgroupFpGroup and IsWholeFamily and IsAttributeStoringRep; 1570 if IsFinitelyGeneratedGroup(F) then 1571 typ:=typ and IsFinitelyGeneratedGroup; 1572 fi; 1573 1574 # Create the group. 1575 G := Objectify( 1576 NewType( CollectionsFamily( fam ), typ ), rec() ); 1577 1578 # Mark <G> to be the 'whole group' of its later subgroups. 1579 FamilyObj( G )!.wholeGroup := G; 1580 SetFilterObj(G,IsGroupOfFamily); 1581 1582 # Create generators of the group. 1583 gens:= List( GeneratorsOfGroup( F ), g -> ElementOfFpGroup( fam, g ) ); 1584 SetGeneratorsOfGroup( G, gens ); 1585 if IsEmpty( gens ) then 1586 SetOne( G, ElementOfFpGroup( fam, One( F ) ) ); 1587 fi; 1588 1589 # trivial infinity deduction 1590 if Length(gens)>Length(rels) then 1591 SetSize(G,infinity); 1592 SetIsFinite(G,false); 1593 fi; 1594 1595 return G; 1596end ); 1597 1598 1599############################################################################# 1600## 1601#M \/( <F>, <rels> ) . . . . . . . . . . for free group and list of relators 1602## 1603InstallOtherMethod( \/, 1604 "for free groups and relators", 1605 IsIdenticalObj, 1606 [ IsFreeGroup, IsCollection ], 1607 0, 1608 FactorFreeGroupByRelators ); 1609 1610InstallOtherMethod( \/, 1611 "for fp groups and relators", 1612 IsIdenticalObj, 1613 [ IsFpGroup, IsCollection ], 1614 0, 1615 FactorGroupFpGroupByRels ); 1616 1617InstallOtherMethod( \/, 1618 "for free groups and a list of equations", 1619 IsElmsColls, 1620 [ IsFreeGroup, IsCollection ], 1621 0, 1622 {F, rels} -> FactorFreeGroupByRelators(F, List(rels, r -> r[1] / r[2]))); 1623 1624InstallOtherMethod( \/, 1625 "for fp groups and a list of equations", 1626 IsElmsColls, 1627 [ IsFpGroup, IsCollection ], 1628 0, 1629 {F, rels} -> FactorGroupFpGroupByRels(F, List(rels, r -> r[1] / r[2]))); 1630 1631############################################################################# 1632## 1633#M \/( <F>, <rels> ) . . . . . . . for free group and empty list of relators 1634## 1635InstallOtherMethod( \/, 1636 "for a free group and an empty list of relators", 1637 true, 1638 [ IsFreeGroup, IsEmpty ], 1639 0, 1640 FactorFreeGroupByRelators ); 1641 1642############################################################################# 1643## 1644#M FreeGeneratorsOfFpGroup( F ) . . generators of the underlying free group 1645## 1646InstallMethod( FreeGeneratorsOfFpGroup, "for a finitely presented group", 1647 true, 1648 [ IsSubgroupFpGroup and IsGroupOfFamily ], 0, 1649 G -> GeneratorsOfGroup( FreeGroupOfFpGroup( G ) ) ); 1650 1651############################################################################# 1652## 1653#M FreeGeneratorsOfWholeGroup( U ) . . generators of the underlying free group 1654## 1655InstallMethod( FreeGeneratorsOfWholeGroup, 1656 "for a finitely presented group", 1657 true, 1658 [ IsSubgroupFpGroup ], 0, 1659 G -> GeneratorsOfGroup( ElementsFamily(FamilyObj( G ))!.freeGroup ) ); 1660 1661############################################################################# 1662## 1663#M FreeGroupOfFpGroup( F ) . . . . . . underlying free group of an fp group 1664## 1665InstallMethod( FreeGroupOfFpGroup, "for a finitely presented group", true, 1666 [ IsSubgroupFpGroup and IsGroupOfFamily ], 0, 1667 G -> ElementsFamily( FamilyObj( G ) )!.freeGroup ); 1668 1669 1670############################################################################# 1671## 1672#M IndexNC( <G>, <H> ) 1673## 1674InstallMethod( IndexNC, 1675 "for finitely presented groups", 1676 [ IsSubgroupFpGroup, IsSubgroupFpGroup ], 1677function(G,H) 1678 # catch a stupid case 1679 if IsIdenticalObj(G,H) then 1680 return 1; 1681 fi; 1682 return IndexInWholeGroup(H)/IndexInWholeGroup(G); 1683end); 1684 1685 1686############################################################################# 1687## 1688#M IndexOp( <G>, <H> ) . . . . . . . . . . . for whole family and f.p. group 1689## 1690## We can avoid the `IsSubset' check of the default `IndexOp' method, 1691## and also the division of the `IndexNC' method. 1692## 1693InstallMethod( IndexOp, 1694 "for finitely presented group in whole group", 1695 IsIdenticalObj, 1696 [ IsSubgroupFpGroup and IsWholeFamily, IsSubgroupFpGroup ], 1697function(G,H) 1698 return IndexInWholeGroup(H); 1699end); 1700 1701InstallMethod( CanComputeIndex,"subgroups fp groups",IsIdenticalObj, 1702 [IsGroup and HasIndexInWholeGroup,IsGroup and HasIndexInWholeGroup], 1703 ReturnTrue); 1704 1705InstallMethod( CanComputeIndex,"subgroup of full fp groups",IsIdenticalObj, 1706 [IsGroup and IsWholeFamily,IsGroup and HasIndexInWholeGroup], 1707 ReturnTrue); 1708 1709InstallMethod( CanComputeIndex,"subgroup of full fp groups",IsIdenticalObj, 1710 [IsGroup and IsWholeFamily,IsGroup and HasCosetTableInWholeGroup], 1711 ReturnTrue); 1712 1713 1714############################################################################# 1715## 1716#M IndexInWholeGroup( <H> ) . . . . . . index of a subgroup in an fp group 1717## 1718InstallMethod(IndexInWholeGroup,"subgroup fp",true,[IsSubgroupFpGroup],0, 1719function( H ) 1720local T,i; 1721 # Get the coset table of <H> in its whole group. 1722 T := CosetTableInWholeGroup( H ); 1723 i:=IndexCosetTab( T ); 1724 if HasGeneratorsOfGroup(H) and Length(GeneratorsOfGroup(H))=0 then 1725 SetSize(FamilyObj(H)!.wholeGroup,i); 1726 fi; 1727 return i; 1728end ); 1729 1730InstallMethod(IndexInWholeGroup,"subgroup fp by quotient",true, 1731 [IsSubgroupFpGroup and IsSubgroupOfWholeGroupByQuotientRep],0, 1732function(U) 1733 return Index(U!.quot,U!.sub); 1734end); 1735 1736InstallMethod( IndexInWholeGroup, "for full fp group", 1737 [ IsSubgroupFpGroup and IsWholeFamily ], a->1); 1738 1739############################################################################# 1740## 1741#M ConjugateGroup(<U>,<g>) U^g 1742## 1743InstallMethod(ConjugateGroup,"subgroups of fp group with coset table", 1744 IsCollsElms, [IsSubgroupFpGroup and HasCosetTableInWholeGroup, 1745 IsMultiplicativeElementWithInverse],0, 1746function(U,g) 1747local t, w, wi, word, pos, V, i; 1748 t:=CosetTableInWholeGroup(U); 1749 if Length(t)<2 then 1750 return U; # the whole group 1751 fi; 1752 1753 # the image of g in the permutation group 1754 w:=UnderlyingElement(g); 1755 wi:=[1..IndexCosetTab(t)]; 1756# for i in [1..NumberSyllables(w)] do 1757# e:=ExponentSyllable(w,i); 1758# if e<0 then 1759# pos:=2*GeneratorSyllable(w,i); 1760# e:=-e; 1761# else 1762# pos:=2*GeneratorSyllable(w,i)-1; 1763# fi; 1764# for j in [1..e] do 1765# wi:=t[pos]{wi}; # multiply permutations 1766# od; 1767# od; 1768 word:=LetterRepAssocWord(w); 1769 for i in [1..Length(word)] do 1770 if word[i]<0 then 1771 pos:=-2*word[i]; 1772 else 1773 pos:=2*word[i]-1; 1774 fi; 1775 wi:=t[pos]{wi}; # multiply permutations 1776 od; 1777 1778 w:=PermList(wi)^-1; 1779 t:=List(t,i->OnTuples(i{wi},w)); 1780 StandardizeTable(t); 1781 V:=SubgroupOfWholeGroupByCosetTable(FamilyObj(U),t); 1782 1783 if HasGeneratorsOfGroup(U) then 1784 SetGeneratorsOfGroup(V,List(GeneratorsOfGroup(U),i->i^g)); 1785 fi; 1786 return V; 1787end); 1788 1789InstallMethod(ConjugateGroup,"subgroups of fp group by quotient", 1790 IsCollsElms, [ IsSubgroupFpGroup and IsSubgroupOfWholeGroupByQuotientRep, 1791 IsMultiplicativeElementWithInverse],0, 1792function(U,elm) 1793 # transfer elm in factor 1794 elm:=UnderlyingElement(elm); 1795 elm:=MappedWord(elm,FreeGeneratorsOfWholeGroup(U), 1796 GeneratorsOfGroup(U!.quot)); 1797 1798 return SubgroupOfWholeGroupByQuotientSubgroup(FamilyObj(U),U!.quot, 1799 ConjugateGroup(U!.sub,elm)); 1800end); 1801 1802InstallMethod(AsSubgroupOfWholeGroupByQuotient,"create",true, 1803 [IsSubgroupFpGroup],0, 1804function(U) 1805local tab,Q,A; 1806 tab:=CosetTableInWholeGroup(U); 1807 Q:=GroupWithGenerators(List(tab{[1,3..Length(tab)-1]},PermList)); 1808 #T: try to improve via blocks 1809 1810 A:=Stabilizer(Q,1); 1811 U:=SubgroupOfWholeGroupByQuotientSubgroup(FamilyObj(U),Q,A); 1812 return U; 1813end); 1814 1815InstallMethod(AsSubgroupOfWholeGroupByQuotient,"is already",true, 1816 [IsSubgroupOfWholeGroupByQuotientRep],0,x->x); 1817 1818############################################################################# 1819## 1820#F DefiningQuotientHomomorphism(<U>) 1821## 1822InstallGlobalFunction(DefiningQuotientHomomorphism,function(U) 1823local hom; 1824 if not IsSubgroupOfWholeGroupByQuotientRep(U) then 1825 Error("<U> must be in quotient representation"); 1826 fi; 1827 hom:=GroupHomomorphismByImagesNC(FamilyObj(U)!.wholeGroup, 1828 U!.quot, 1829 GeneratorsOfGroup(FamilyObj(U)!.wholeGroup), 1830 GeneratorsOfGroup(U!.quot)); 1831 SetIsSurjective(hom,true); 1832 return hom; 1833end); 1834 1835############################################################################# 1836## 1837#M CoreOp(<U>,<V>) . intersection of two fin. pres. groups 1838## 1839InstallMethod(CoreOp,"subgroups of fp group: use quotient rep",IsIdenticalObj, 1840 [IsSubgroupFpGroup,IsSubgroupFpGroup],0, 1841function(V,U) 1842 return Core(V,AsSubgroupOfWholeGroupByQuotient(U)); 1843end); 1844 1845InstallMethod(CoreOp,"subgroups of fp group by quotient",IsIdenticalObj, 1846 [IsSubgroupFpGroup, 1847 IsSubgroupFpGroup and IsSubgroupOfWholeGroupByQuotientRep],0, 1848function(V,U) 1849local q,gens; 1850 # map the generators of V in the quotient 1851 gens:=GeneratorsOfGroup(V); 1852 gens:=List(gens,UnderlyingElement); 1853 q:=U!.quot; 1854 gens:=List(gens,i->MappedWord(i,FreeGeneratorsOfWholeGroup(U), 1855 GeneratorsOfGroup(q))); 1856 return SubgroupOfWholeGroupByQuotientSubgroup(FamilyObj(U),q, 1857 Core(SubgroupNC(q,gens),U!.sub)); 1858end); 1859 1860############################################################################# 1861## 1862#M Intersection2(<G>,<H>) . intersection of two fin. pres. groups 1863## 1864InstallMethod(Intersection2,"subgroups of fp group",IsIdenticalObj, 1865 [IsSubgroupFpGroup,IsSubgroupFpGroup],0, 1866function ( G, H ) 1867 local 1868 Fam, # group family 1869 rels, # representatives for the relators 1870 table, # coset table for <I> in its parent 1871 nrcos, # number of cosets of <I> 1872 tableG, # coset table of <G> 1873 nrcosG, # number of cosets of <G> 1874 tableH, # coset table of <H> 1875 nrcosH, # number of cosets of <H> 1876 pargens, # generators of Parent(G) 1877 freegens, # free generators of Parent(G) 1878 nrgens, # number of generators of the parent of <G> and <H> 1879 ren, # if 'ren[<i>]' is 'nrcosH * <iG> + <iH>' then the 1880 # coset <i> of <I> corresponds to the intersection 1881 # of the pair of cosets <iG> of <G> and <iH> of <H> 1882 ner, # the inverse mapping of 'ren' 1883 cos, # coset loop variable 1884 gen, # generator loop variable 1885 img; # image of <cos> under <gen> 1886 1887 Fam:=FamilyObj(G); 1888 # handle trivial cases 1889 if IsIdenticalObj(G,Fam!.wholeGroup) then 1890 return H; 1891 elif IsIdenticalObj(H,Fam!.wholeGroup) then 1892 return G; 1893 fi; 1894 1895 # its worth to check inclusion first 1896 if IndexInWholeGroup(G)<=IndexInWholeGroup(H) and IsSubset(G,H) then 1897 return H; 1898 elif IndexInWholeGroup(H)<=IndexInWholeGroup(G) and IsSubset(H,G) then 1899 return G; 1900 fi; 1901 1902 tableG := CosetTableInWholeGroup(G); 1903 nrcosG := IndexCosetTab( tableG ) + 1; 1904 tableH := CosetTableInWholeGroup(H); 1905 nrcosH := IndexCosetTab( tableH ) + 1; 1906 1907 if nrcosH<=nrcosG and HasGeneratorsOfGroup(G) then 1908 if ForAll(GeneratorsOfGroup(G),i->i in H) then 1909 return G; 1910 fi; 1911 elif nrcosG<=nrcosH and HasGeneratorsOfGroup(H) then 1912 if ForAll(GeneratorsOfGroup(H),i->i in G) then 1913 return H; 1914 fi; 1915 fi; 1916 1917 pargens:=GeneratorsOfGroup(Fam!.wholeGroup); 1918 freegens:=FreeGeneratorsOfFpGroup(Fam!.wholeGroup); 1919 # initialize the table for the intersection 1920 rels := RelatorRepresentatives( RelatorsOfFpGroup( Fam!.wholeGroup ) ); 1921 nrgens := Length(freegens); 1922 table := []; 1923 for gen in [ 1 .. nrgens ] do 1924 table[ 2*gen-1 ] := []; 1925 table[ 2*gen ] := []; 1926 od; 1927 1928 # set up the renumbering 1929 ren := ListWithIdenticalEntries(nrcosG*nrcosH,0); 1930 ner := ListWithIdenticalEntries(nrcosG*nrcosH,0); 1931 ren[ 1*nrcosH + 1 ] := 1; 1932 ner[ 1 ] := 1*nrcosH + 1; 1933 nrcos := 1; 1934 1935 # the coset table for the intersection is the transitive component of 1 1936 # in the *tensored* permutation representation 1937 cos := 1; 1938 while cos <= nrcos do 1939 1940 # loop over all entries in this row 1941 for gen in [ 1 .. nrgens ] do 1942 1943 # get the coset pair 1944 img := nrcosH * tableG[ 2*gen-1 ][ QuoInt( ner[ cos ], nrcosH ) ] 1945 + tableH[ 2*gen-1 ][ ner[ cos ] mod nrcosH ]; 1946 1947 # if this pair is new give it the next available coset number 1948 if ren[ img ] = 0 then 1949 nrcos := nrcos + 1; 1950 ren[ img ] := nrcos; 1951 ner[ nrcos ] := img; 1952 fi; 1953 1954 # and enter it into the coset table 1955 table[ 2*gen-1 ][ cos ] := ren[ img ]; 1956 table[ 2*gen ][ ren[ img ] ] := cos; 1957 1958 od; 1959 1960 cos := cos + 1; 1961 od; 1962 1963 return SubgroupOfWholeGroupByCosetTable(Fam,table); 1964end); 1965 1966InstallMethod(Intersection2,"subgroups of fp group by quotient",IsIdenticalObj, 1967 [IsSubgroupFpGroup and IsSubgroupOfWholeGroupByQuotientRep, 1968 IsSubgroupFpGroup and IsSubgroupOfWholeGroupByQuotientRep],0, 1969function ( G, H ) 1970local d,A,B,e1,e2,Ag,Bg,s,sg,u,v; 1971 1972 # it is not worth to check inclusion first since we're reducing afterwards 1973 #if IndexInWholeGroup(G)<=IndexInWholeGroup(H) and IsSubset(G,H) then 1974 # return H; 1975 #elif IndexInWholeGroup(H)<=IndexInWholeGroup(G) and IsSubset(H,G) then 1976 # return G; 1977 #fi; 1978 1979 A:=MakeNiceDirectQuots(G,H); 1980 G:=A[1]; 1981 H:=A[2]; 1982 1983 A:=G!.quot; 1984 B:=H!.quot; 1985 d:=DirectProduct(A,B); 1986 e1:=Embedding(d,1); 1987 e2:=Embedding(d,2); 1988 Ag:=GeneratorsOfGroup(A); 1989 Bg:=GeneratorsOfGroup(B); 1990 # form the sdp 1991 sg:=List([1..Length(Ag)],i->Image(e1,Ag[i])*Image(e2,Bg[i])); 1992 s:=SubgroupNC(d,sg); 1993 if HasSize(A) and HasSize(B) and IsPermGroup(s) then 1994 StabChainOptions(s).limit:=Size(d); 1995 fi; 1996 1997 # get both subgroups in the direct product via the projections 1998 # instead of intersecting both preimages with s we only intersect the 1999 # intersection 2000 2001 u:=PreImagesSet(Projection(d,1),G!.sub); 2002 if HasSize(B) then 2003 SetSize(u,Size(G!.sub)*Size(B)); 2004 fi; 2005 v:=PreImagesSet(Projection(d,2),H!.sub); 2006 if HasSize(A) then 2007 SetSize(v,Size(H!.sub)*Size(A)); 2008 fi; 2009 u:=Intersection(u,v); 2010 if Size(u)>1 and Size(s)<Size(d) then 2011 u:=Intersection(u,s); 2012 fi; 2013 2014 # reduce 2015 if HasSize(s) and IsPermGroup(s) and (Size(s)=Size(A) or Size(s)=Size(B) 2016 or NrMovedPoints(s)>1000) then 2017 d:=SmallerDegreePermutationRepresentation(s:cheap); 2018 A:=SubgroupNC(Range(d),List(GeneratorsOfGroup(s),x->ImagesRepresentative(d,x))); 2019 if NrMovedPoints(A)<NrMovedPoints(s) then 2020 Info(InfoFpGroup,3,"reduced degree from ",NrMovedPoints(s)," to ", 2021 NrMovedPoints(A)); 2022 s:=A; 2023 u:=Image(d,u); 2024 fi; 2025 fi; 2026 2027 return SubgroupOfWholeGroupByQuotientSubgroup(FamilyObj(G),s,u); 2028end); 2029 2030############################################################################# 2031## 2032#M ClosureGroup( <G>, <obj> ) 2033## 2034InstallMethod( ClosureGroup, "subgrp fp: by quotient subgroup",IsCollsElms, 2035 [IsSubgroupFpGroup and HasParent and IsSubgroupOfWholeGroupByQuotientRep, 2036 IsMultiplicativeElementWithInverse ], 0, 2037function( U, elm ) 2038local Q,V,hom; 2039 Q:=U!.quot; 2040 # transfer elm in factor 2041 elm:=UnderlyingElement(elm); 2042 elm:=MappedWord(elm,FreeGeneratorsOfWholeGroup(U),GeneratorsOfGroup(Q)); 2043 if elm in U!.sub then 2044 return U; # no new group 2045 fi; 2046 2047 V:=ClosureSubgroup(U!.sub,elm); 2048 # do we want to get a smaller representation? 2049 if IsPermGroup(Q) and Length(MovedPoints(Q))>2*Index(Q,V) then 2050#T better IndexNC? 2051 # we can improve the degree 2052 hom:=ActionHomomorphism(Q,RightTransversal(Q,V),OnRight,"surjective"); 2053 Q:=GroupWithGenerators(List(GeneratorsOfGroup(Q),i->Image(hom,i))); 2054 return 2055 SubgroupOfWholeGroupByQuotientSubgroup(FamilyObj(U),Q,Stabilizer(Q,1)); 2056 else 2057 # close 2058 return SubgroupOfWholeGroupByQuotientSubgroup(FamilyObj(U),Q,V); 2059 fi; 2060end ); 2061 2062InstallMethod( ClosureGroup, "subgrp fp: Has coset table",IsCollsElms, 2063 [ IsSubgroupFpGroup and HasParent and HasCosetTableInWholeGroup, 2064 IsMultiplicativeElementWithInverse ], 0, 2065function( U, elm ) 2066local tab,Q,es,eo,b; 2067 tab:=CosetTableInWholeGroup(U); 2068 tab:=List(tab{[1,3..Length(tab)-1]},PermList); 2069 Q:=GroupWithGenerators(tab); 2070 elm:=UnderlyingElement(elm); 2071 elm:=MappedWord(elm,FreeGeneratorsOfWholeGroup(U),tab); 2072 if 1^elm=1 then 2073 return U; # no new group 2074 fi; 2075 2076 es:=SubgroupNC(Q,[elm]); 2077 # form a block system 2078 eo:=Orbit(es,1); # block seed 2079 b:=[[1]]; # this is guaranteed to be overwritten at least once 2080 while not IsSubset(b[1],eo) do 2081 # fuse to new blocks 2082 b:=Blocks(Q,[1..IndexInWholeGroup(U)],eo); 2083 eo:=Union(List(b[1],i->Orbit(es,i))); # all orbits of elm on the new block 2084 od; # until the block does not grow any more under es. 2085 2086 b:=ActionHomomorphism(Q,b,OnSets,"surjective"); 2087 tab:=List(tab,i->ImageElm(b,i)); 2088 Q:=GroupWithGenerators(tab); 2089 return 2090 SubgroupOfWholeGroupByQuotientSubgroup(FamilyObj(U),Q,Stabilizer(Q,1)); 2091 2092end ); 2093 2094 2095# override default because we want to close the larger group with the smaller 2096InstallMethod( ClosureGroup, "for subgroup of fp group, and subgroup", 2097 IsIdenticalObj,[IsSubgroupFpGroup and HasParent,IsSubgroupFpGroup ],0, 2098function( U, V ) 2099 if IndexInWholeGroup(U)<IndexInWholeGroup(V) then 2100 return ClosureGroup(V,U); 2101 fi; 2102 return ClosureGroup(U,GeneratorsOfGroup(V)); 2103end ); 2104 2105 2106############################################################################# 2107## 2108#M KnowsHowToDecompose(<G>,<gens>) 2109## 2110InstallMethod( KnowsHowToDecompose,"fp groups: Say yes if finite index", 2111 IsIdenticalObj, [ IsSubgroupFpGroup, IsList ], 0, 2112function(G,l) 2113 return CanComputeIndex(FamilyObj(G)!.wholeGroup,G) 2114 and IndexInWholeGroup(G)<infinity; 2115end); 2116 2117############################################################################# 2118## 2119#M IsAbelian( <G> ) . . . . . . . . . . . . test if an fp group is abelian 2120## 2121InstallMethod( IsAbelian, "for finitely presented groups", true, 2122 [ IsSubgroupFpGroup and IsGroupOfFamily ], 0, 2123function( G ) 2124 local isAbelian, # result 2125 gens, # generators of <G> 2126 fgens, # generators of the associated free group 2127 rels, # relators of <G> 2128 one, # identity element of <G> 2129 g, h, # two generators of <G> 2130 i, k; # loop variables 2131 2132 gens := GeneratorsOfGroup( G ); 2133 fgens := FreeGeneratorsOfFpGroup( G ); 2134 rels := RelatorsOfFpGroup( G ); 2135 one := One( G ); 2136 isAbelian := true; 2137 for i in [ 1 .. Length( gens ) - 1 ] do 2138 g := fgens[i]; 2139 for k in [ i + 1 .. Length( fgens ) ] do 2140 h := fgens[k]; 2141 isAbelian := isAbelian and ( 2142 Comm( g, h ) in rels 2143 or Comm( h, g ) in rels 2144 or Comm( gens[i], gens[k] ) = one 2145 ); 2146 od; 2147 od; 2148 return isAbelian; 2149 2150end ); 2151 2152InstallMethod( IsAbelian, "finite fp grp", true, 2153 [ IsSubgroupFpGroup and HasSize and IsFinite ], 0, 2154function(G) 2155local l; 2156 l:=AbelianInvariants(G); 2157 if 0 in l then 2158 Error("G not finite"); 2159 fi; 2160 return Product(l,1)=Size(G); 2161end); 2162 2163############################################################################# 2164## 2165#M IsTrivial( <G> ) . . . . . . . . . . . . . . . . . test if <G> is trivial 2166## 2167InstallMethod( IsTrivial, 2168 "for finitely presented groups", 2169 true, 2170 [ IsSubgroupFpGroup and IsGroupOfFamily ], 2171 0, 2172 2173function( G ) 2174 if 0 = Length( GeneratorsOfGroup( G ) ) then 2175 return true; 2176 else 2177 return Size( G ) = 1; 2178 fi; 2179end ); 2180#T why is this just a method for f.p. groups? 2181 2182 2183############################################################################# 2184## 2185#F NextIterator_LowIndexSubgroupsFpGroup( <iter> ) 2186#F IsDoneIterator_LowIndexSubgroupsFpGroup( <iter> ) 2187#F ShallowCopy_LowIndexSubgroupsFpGroup( <iter> ) 2188## 2189BindGlobal( "NextIterator_LowIndexSubgroupsFpGroup", function( iter ) 2190 local result; 2191 2192 if not IsDoneIterator( iter ) then 2193 result:= iter!.data.nextSubgroup; 2194 iter!.data.nextSubgroup:= fail; 2195 return result; 2196 fi; 2197 Error( "iterator is exhausted" ); 2198 end ); 2199 2200BindGlobal( "IsDoneIterator_LowIndexSubgroupsFpGroup", function( iter ) 2201 local G, # parent group 2202 ngens, # number of generators of associated free group 2203 index, # maximal index of subgroups to be determined 2204 exclude, # true, if element classes to be excluded are given 2205 excludeGens, # table columns corresponding to gens to be excluded 2206 excludeWords, # words to be excluded, sorted by start generator 2207 subs, # number of found subgroups of <G> 2208 sub, # one subgroup 2209 gens, # generators of <sub> 2210 table, # coset table 2211 nrgens, # 2*(number of generators)+1 2212 nrcos, # number of cosets in the coset table 2213 definition, # "definition" 2214 choice, # "choice" 2215 deduction, # "deduction" 2216 action, # 'action[<i>]' is definition or choice or deduction 2217 actgen, # 'actgen[<i>]' is the gen where this action was 2218 actcos, # 'actcos[<i>]' is the coset where this action was 2219 nract, # number of actions 2220 nrded, # number of deductions already handled 2221 coinc, # 'true' if a coincidence happened 2222 gen, # current generator 2223 cos, # current coset 2224 rels, # representatives for the relators 2225 relsGen, # relators sorted by start generator 2226 subgroup, # rows for the subgroup gens 2227 nrsubgrp, # number of subgroups 2228 app, # arguments list for 'ApplyRel' 2229 later, # 'later[<i>]' is <> 0 if <i> is smaller than 1 2230 nrfix, # index of a subgroup in its normalizer 2231 pair, # loop variable for subgroup generators as pairs 2232 rel, # loop variable for relators 2233 triple, # loop variable for relators as triples 2234 r, s, # renumbering lists 2235 x, y, # loop variables 2236 g, c, d, # loop variables 2237 p, # generator position numbers 2238 length, # relator length 2239 numgen, 2240 numcos, 2241 perms, # permutations on the cosets 2242 Q, # Quotient group 2243 done, 2244 i, j; # loop variables 2245 2246 # Do nothing if we know already that the iterator is exhausted, 2247 # or if we know aleady the next subgroup. 2248 if iter!.data.isDone then 2249 return true; 2250 elif iter!.data.nextSubgroup <> fail then 2251 return false; 2252 fi; 2253 2254 # Compute the next subgroup if there is one. 2255 G := iter!.data.G; 2256 ngens := iter!.data.ngens; 2257 index := iter!.data.index; 2258 exclude := iter!.data.exclude; 2259 excludeGens := iter!.data.excludeGens; 2260 excludeWords := iter!.data.excludeWords; 2261 subs := iter!.data.subs; 2262 table := iter!.data.table; 2263 nrcos := iter!.data.nrcos; 2264 action := iter!.data.action; 2265 actgen := iter!.data.actgen; 2266 actcos := iter!.data.actcos; 2267 nract := iter!.data.nract; 2268 gen := iter!.data.gen; 2269 cos := iter!.data.cos; 2270 relsGen := iter!.data.relsGen; 2271 later := iter!.data.later; 2272 r := iter!.data.r; 2273 s := iter!.data.s; 2274 subgroup := iter!.data.subgroup; 2275 2276 nrsubgrp := Length( subgroup ); 2277 app := ListWithIdenticalEntries( 4, 0 ); 2278 2279 definition := 1; 2280 choice := 2; 2281 deduction := 3; 2282 2283 nrgens := 2 * ngens + 1; 2284 2285 # do an exhaustive backtrack search 2286 while 1 < nract or table[1][1] < 2 do 2287 2288 # find the next choice that does not already appear in this col. 2289 c := table[ gen ][ cos ]; 2290 repeat 2291 c := c + 1; 2292 until index < c or table[ gen+1 ][ c ] = 0; 2293 2294 # if there is a further choice try it 2295 if action[nract] <> definition and c <= index then 2296 2297 # remove the last choice from the table 2298 d := table[ gen ][ cos ]; 2299 if d <> 0 then 2300 table[ gen+1 ][ d ] := 0; 2301 fi; 2302 2303 # enter it in the table 2304 table[ gen ][ cos ] := c; 2305 table[ gen+1 ][ c ] := cos; 2306 2307 # and put information on the action stack 2308 if c = nrcos + 1 then 2309 nrcos := nrcos + 1; 2310 action[ nract ] := definition; 2311 else 2312 action[ nract ] := choice; 2313 fi; 2314 2315 # run through the deduction queue until it is empty 2316 nrded := nract; 2317 coinc := false; 2318 while nrded <= nract and not coinc do 2319 2320 # check given exclude elements to be excluded 2321 if exclude then 2322 numgen := actgen[nrded]; 2323 numcos := actcos[nrded]; 2324 if excludeGens[numgen] = 1 and 2325 numcos = table[numgen][numcos] then 2326 coinc := true; 2327 else 2328 length := Length( excludeWords[actgen[nrded]] ); 2329 i := 1; 2330 while i <= length and not coinc do 2331 triple := excludeWords[actgen[nrded]][i]; 2332 app[1] := triple[3]; 2333 app[2] := actcos[ nrded ]; 2334 app[3] := -1; 2335 app[4] := app[2]; 2336 if not ApplyRel( app, triple[2] ) and 2337 app[1] = app[3] + 1 then 2338 coinc := true; 2339 fi; 2340 i := i + 1; 2341 od; 2342 fi; 2343 fi; 2344 2345 # if there are still subgroup generators apply them 2346 i := 1; 2347 while i <= nrsubgrp and not coinc do 2348 pair := subgroup[i]; 2349 app[1] := 2; 2350 app[2] := 1; 2351 app[3] := Length(pair[2])-1; 2352 app[4] := 1; 2353 if ApplyRel( app, pair[2] ) then 2354 if pair[2][app[1]][app[2]] <> 0 then 2355 coinc := true; 2356 elif pair[2][app[3]][app[4]] <> 0 then 2357 coinc := true; 2358 else 2359 pair[2][app[1]][app[2]] := app[4]; 2360 pair[2][app[3]][app[4]] := app[2]; 2361 nract := nract + 1; 2362 action[ nract ] := deduction; 2363 actgen[ nract ] := pair[1][app[1]]; 2364 actcos[ nract ] := app[2]; 2365 fi; 2366 fi; 2367 i := i + 1; 2368 od; 2369 2370 # apply all relators that start with this generator 2371 length := Length( relsGen[actgen[nrded]] ); 2372 i := 1; 2373 while i <= length and not coinc do 2374 triple := relsGen[actgen[nrded]][i]; 2375 app[1] := triple[3]; 2376 app[2] := actcos[ nrded ]; 2377 app[3] := -1; 2378 app[4] := app[2]; 2379 if ApplyRel( app, triple[2] ) then 2380 if triple[2][app[1]][app[2]] <> 0 then 2381 coinc := true; 2382 elif triple[2][app[3]][app[4]] <> 0 then 2383 coinc := true; 2384 else 2385 triple[2][app[1]][app[2]] := app[4]; 2386 triple[2][app[3]][app[4]] := app[2]; 2387 nract := nract + 1; 2388 action[ nract ] := deduction; 2389 actgen[ nract ] := triple[1][app[1]]; 2390 actcos[ nract ] := app[2]; 2391 fi; 2392 fi; 2393 i := i + 1; 2394 od; 2395 2396 nrded := nrded + 1; 2397 od; 2398 2399 # unless there was a coincidence check lexicography 2400 if not coinc then 2401 nrfix := 1; 2402 x := 1; 2403 while x < nrcos and not coinc do 2404 x := x + 1; 2405 2406 # set up the renumbering 2407 for i in [1..nrcos] do 2408 r[i] := 0; 2409 s[i] := 0; 2410 od; 2411 r[x] := 1; s[1] := x; 2412 2413 # run through the old and the new table in parallel 2414 c := 1; y := 1; 2415 2416 #while c <= nrcos and not coinc and later[x] = 0 do 2417 done := coinc or later[x] <> 0; 2418 while c <= nrcos and not done do 2419 2420 2421 # get the corresponding coset for the new table 2422 d := s[c]; 2423 2424 # loop over the entries in this row 2425 g := 1; 2426 #while g < nrgens 2427 # and c <= nrcos and not coinc and later[x] = 0 do 2428 while g<nrgens and not done do 2429 2430 # if either entry is missing we cannot decide yet 2431 if table[g][c] = 0 or table[g][d] = 0 then 2432 c := nrcos + 1; 2433 done:=true; 2434 2435 # if old and new contain defs, extend the renumbering 2436 elif table[g][c] = y+1 and r[ table[g][d] ] = 0 then 2437 y := y + 1; 2438 r[ table[g][d] ] := y; 2439 s[ y ] := table[g][d]; 2440 2441 # if only new is a definition 2442 elif r[ table[g][d] ] = 0 then 2443 later[x] := nract; 2444 done:=true; 2445 2446 # if olds entry is smaller, old must be earlier 2447 elif table[g][c] < r[ table[g][d] ] then 2448 later[x] := nract; 2449 done := true; 2450 2451 # if news entry is smaller, test if new contains sgr 2452 elif r[ table[g][d] ] < table[g][c] then 2453 2454 # check that <x> fixes <H> 2455 coinc := true; 2456 for pair in subgroup do 2457 app[1] := 2; 2458 app[2] := x; 2459 app[3] := Length(pair[2])-1; 2460 app[4] := x; 2461 if ApplyRel( app, pair[2] ) then 2462 2463 # coincidence: <x> does not fix <H> 2464 if pair[2][app[1]][app[2]] <> 0 then 2465 later[x] := nract; 2466 coinc := false; 2467 elif pair[2][app[3]][app[4]] <> 0 then 2468 later[x] := nract; 2469 coinc := false; 2470 2471 # non-closure (ded): <x> may not fix <H> 2472 else 2473 coinc := false; 2474 fi; 2475 2476 # non-closure (not ded): <x> may not fix <H> 2477 elif app[1] <= app[3] then 2478 coinc := false; 2479 fi; 2480 2481 od; 2482 2483 # # if old is the smaller one very good 2484 # elif table[g][c] < r[ table[g][d] ] then 2485 # later[x] := nract; 2486 done:=true; 2487 2488 fi; 2489 2490 g := g + 2; 2491 od; 2492 2493 c := c + 1; 2494 od; 2495 2496 if c = nrcos + 1 then 2497 nrfix := nrfix + 1; 2498 fi; 2499 2500 od; 2501 fi; 2502 2503 # if there was no coincidence 2504 if not coinc then 2505 2506 # look for another empty place 2507 c := cos; 2508 g := gen; 2509 while c <= nrcos and table[ g ][ c ] <> 0 do 2510 g := g + 2; 2511 if g = nrgens then 2512 c := c + 1; 2513 g := 1; 2514 fi; 2515 od; 2516 2517 # if there is an empty place, make this a new choice point 2518 if c <= nrcos then 2519 2520 nract := nract + 1; 2521 action[ nract ] := choice; # necessary? 2522 gen := g; 2523 actgen[ nract ] := gen; 2524 cos := c; 2525 actcos[ nract ] := cos; 2526 table[ gen ][ cos ] := 0; # necessary? 2527 2528 # otherwise we found a subgroup 2529 else 2530 2531 # Increase the counter. 2532 subs:= subs + 1; 2533 2534 # give some information 2535 Info( InfoFpGroup, 2, " class ", subs, 2536 " of index ", nrcos, 2537 " and length ", nrcos / nrfix ); 2538 2539 # instead of a coset table, 2540 # create the permutation action on the cosets 2541 perms:=[]; 2542 for g in [ 1 .. ngens ] do 2543 perms[g]:=PermList(table[2*g-1]{[1..nrcos]}); 2544 od; 2545 Q:=Group(perms); 2546 sub:=SubgroupOfWholeGroupByQuotientSubgroup(FamilyObj(G), 2547 Q,Stabilizer(Q,1)); 2548 2549 if HasSize( G ) and Size(G)<>infinity then 2550 SetSize( sub, Size( G ) / Index(G,sub) ); 2551 fi; 2552 2553 # undo all deductions since the previous choice point 2554 while action[ nract ] = deduction do 2555 g := actgen[ nract ]; 2556 c := actcos[ nract ]; 2557 d := table[ g ][ c ]; 2558 if g mod 2 = 1 then 2559 table[ g ][ c ] := 0; 2560 table[ g+1 ][ d ] := 0; 2561 else 2562 table[ g ][ c ] := 0; 2563 table[ g-1 ][ d ] := 0; 2564 fi; 2565 nract := nract - 1; 2566 od; 2567 for x in [2..index] do 2568 if nract <= later[x] then 2569 later[x] := 0; 2570 fi; 2571 od; 2572 2573 # Update the variable components of the iterator. 2574 iter!.data.nrcos := nrcos; 2575 iter!.data.nract := nract; 2576 iter!.data.gen := gen; 2577 iter!.data.cos := cos; 2578 iter!.data.subs := subs; 2579 iter!.data.nextSubgroup := sub; 2580 2581 return false; 2582 2583 fi; 2584 2585 # if there was a coincendence go back to the current choice point 2586 else 2587 2588 # undo all deductions since the previous choice point 2589 while action[ nract ] = deduction do 2590 g := actgen[ nract ]; 2591 c := actcos[ nract ]; 2592 d := table[ g ][ c ]; 2593 table[ g ][ c ] := 0; 2594 if g mod 2 = 1 then 2595 table[ g+1 ][ d ] := 0; 2596 else 2597 table[ g-1 ][ d ] := 0; 2598 fi; 2599 nract := nract - 1; 2600 od; 2601 for x in [2..index] do 2602 if nract <= later[x] then 2603 later[x] := 0; 2604 fi; 2605 od; 2606 2607 fi; 2608 2609 # go back to the previous choice point if there are no more choices 2610 else 2611 2612 # undo the choice point 2613 if action[ nract ] = definition then 2614 nrcos := nrcos - 1; 2615 fi; 2616 # undo all deductions since the previous choice point 2617 repeat 2618 g := actgen[ nract ]; 2619 c := actcos[ nract ]; 2620 d := table[ g ][ c ]; 2621 table[ g ][ c ] := 0; 2622 if g mod 2 = 1 then 2623 table[ g+1 ][ d ] := 0; 2624 else 2625 table[ g-1 ][ d ] := 0; 2626 fi; 2627 nract := nract - 1; 2628 until action[ nract ] <> deduction; 2629 2630 for x in [2..index] do 2631 if nract <= later[x] then 2632 later[x] := 0; 2633 fi; 2634 od; 2635 2636 cos := actcos[ nract ]; 2637 gen := actgen[ nract ]; 2638 2639 fi; 2640 2641 od; 2642 2643 # give some final information 2644 Info( InfoFpGroup, 1, "LowIndexSubgroupsFpGroup done. Found ", 2645 subs, " classes" ); 2646 2647 # The iterator is exhausted. 2648 iter!.data.isDone := true; 2649 return true; 2650 end ); 2651 2652BindGlobal( "ShallowCopy_LowIndexSubgroupsFpGroup", 2653 iter -> rec( data:= StructuralCopy( iter!.data ) ) ); 2654 2655 2656############################################################################# 2657## 2658#M DoLowIndexSubgroupsFpGroupIterator( <G>, <H>, <index>[, <excluded>] ) . . 2659#M . . . . . . . find subgroups of small index in a finitely presented group 2660## 2661BindGlobal( "DoLowIndexSubgroupsFpGroupIteratorWithSubgroupAndExclude", 2662 function( arg ) 2663 local G, # parent group 2664 H, # subgroup to be included in all resulting subgroups 2665 index, # maximal index of subgroups to be determined 2666 exclude, # true, if element classes to be excluded are given 2667 excludeList, # representatives of element classes to be excluded 2668 result, # result in the trivial case 2669 fgens, # generators of associated free group 2670 ngens, # number of generators of G 2671 involutions, # indices of involutory gens of G 2672 excludeGens, # table columns corresponding to gens to be excluded 2673 excludeWords, # words to be excluded, sorted by start generator 2674 table, # coset table 2675 gen, # current generator 2676 subgroup, # rows for the subgroup gens 2677 rel, # loop variable for relators 2678 r, s, # renumbering lists 2679 i, j, g, # loop variables 2680 p, p1, p2, # generator position numbers 2681 length, # relator length 2682 length2, # twice a relator length 2683 cols, 2684 nums, 2685 word; # loop variable for words to be excluded 2686 2687 # give some information 2688 Info( InfoFpGroup, 1, "LowIndexSubgroupsFpGroup called" ); 2689 2690 # check the arguments 2691 G := arg[1]; 2692 H := arg[2]; 2693 if not ( IsSubgroupFpGroup( G ) and IsGroupOfFamily( G ) ) then 2694 Error( "<G> must be a finitely presented group" ); 2695 elif not IsSubgroupFpGroup( H ) or FamilyObj( H ) <> FamilyObj( G ) then 2696 Error( "<H> must be a subgroup of <G>" ); 2697 fi; 2698 index := arg[3]; 2699 2700 # initialize the exclude lists, if elements to be excluded are given 2701 exclude := Length( arg ) > 3 and not IsEmpty( arg[4] ); 2702 if exclude then 2703 excludeList := arg[4]; 2704 fi; 2705 2706 # handle the special case index = 1. 2707 if index = 1 then 2708 result:= TrivialIterator( G ); 2709 if exclude then 2710 NextIterator( result ); 2711 fi; 2712 return result; 2713 fi; 2714 2715 # get some local variables 2716 fgens := FreeGeneratorsOfFpGroup( G ); 2717 ngens := Length( fgens ); 2718 involutions := IndicesInvolutaryGenerators( G ); 2719 2720 # initialize table 2721 table := []; 2722 for i in [ 1 .. Length( fgens ) ] do 2723 g := ListWithIdenticalEntries( index, 0 ); 2724 Add( table, g ); 2725 if not i in involutions then 2726 g:= ShallowCopy( g ); 2727 fi; 2728 Add( table, g ); 2729 od; 2730 2731 # prepare the exclude lists 2732 excludeGens := fail; 2733 excludeWords := fail; 2734 if exclude then 2735 2736 # mark the column numbers of the generators to be excluded 2737 excludeGens := ListWithIdenticalEntries( 2 * ngens, 0 ); 2738 for i in [ 1 .. ngens ] do 2739 gen := fgens[i]; 2740 if gen in excludeList or gen^-1 in excludeList then 2741 excludeGens[2*i-1] := 1; 2742 excludeGens[2*i] := 1; 2743 fi; 2744 od; 2745 2746 # make the rows for the words of length > 1 to be excluded 2747 excludeWords := []; 2748 for word in excludeList do 2749 if Length( word ) > 1 then 2750 Add( excludeWords, word ); 2751 fi; 2752 od; 2753 excludeWords := RelsSortedByStartGen( 2754 fgens, excludeWords, table, false ); 2755 2756 fi; 2757 2758 # make the rows for the subgroup generators 2759 subgroup := []; 2760 for rel in Filtered(List( GeneratorsOfGroup( H ), UnderlyingElement ), 2761 x->not IsOne(x)) do 2762 length := Length( rel ); 2763 length2 := 2 * length; 2764 nums := [ ]; nums[length2] := 0; 2765 cols := [ ]; cols[length2] := 0; 2766 2767 # compute the lists. 2768 i := 0; j := 0; 2769 while i < length do 2770 i := i + 1; j := j + 2; 2771 gen := Subword( rel, i, i ); 2772 p := Position( fgens, gen ); 2773 if p = fail then 2774 p := Position( fgens, gen^-1 ); 2775 p1 := 2 * p; 2776 p2 := 2 * p - 1; 2777 else 2778 p1 := 2 * p - 1; 2779 p2 := 2 * p; 2780 fi; 2781 nums[j] := p1; cols[j] := table[p1]; 2782 nums[j-1] := p2; cols[j-1] := table[p2]; 2783 od; 2784 Add( subgroup, [ nums, cols ] ); 2785 od; 2786 2787 # initialize the renumbering lists 2788 r := [ ]; r[index] := 0; 2789 s := [ ]; s[index] := 0; 2790 2791 return IteratorByFunctions( rec( 2792 # functions 2793 IsDoneIterator := IsDoneIterator_LowIndexSubgroupsFpGroup, 2794 NextIterator := NextIterator_LowIndexSubgroupsFpGroup, 2795 ShallowCopy := ShallowCopy_LowIndexSubgroupsFpGroup, 2796 2797 data:= rec( 2798 # data components that need no update for the next calls 2799 G := G, 2800 ngens := ngens, 2801 index := index, 2802 exclude := exclude, 2803 excludeGens := excludeGens, 2804 excludeWords := excludeWords, 2805 subs := 0, # the number of subgroups up to now 2806 table := table, 2807 action := [ 2 ], # 'action[<i>]' is definition or 2808 # choice or deduction 2809 actgen := [ 1 ], # 'actgen[<i>]' is the gen where 2810 # this action was 2811 actcos := [ 1 ], # 'actcos[<i>]' is the coset where 2812 # this action was 2813 relsGen := RelsSortedByStartGen( fgens, 2814 RelatorRepresentatives( RelatorsOfFpGroup( G ) ), 2815 table, true ), 2816 # relators sorted by start generator 2817 later := ListWithIdenticalEntries( index, 0 ), 2818 # 'later[<i>]' is <> 0 if <i> is 2819 # smaller than 1 2820 r := r, 2821 s := s, 2822 subgroup := subgroup, 2823 2824 # data components that must be updated before leaving the function 2825 nrcos := 1, # no. of cosets in the table 2826 nract := 1, 2827 gen := 1, # current generator 2828 cos := 1, # current coset 2829 isDone := false, # we do not know this 2830 nextSubgroup := fail, # we do not compute the first group 2831 ) ) ); 2832 end ); 2833 2834InstallMethod( LowIndexSubgroupsFpGroupIterator, 2835 "full f.p. group, subgroup of it -- still the old code", 2836 IsFamFamX, 2837 [ IsSubgroupFpGroup and IsWholeFamily, IsSubgroupFpGroup, IsPosInt ], 2838 # use this only if the newer method bailed out because a nontrivial 2839 # subgroup was submitted as second argument 2840 -1, 2841 DoLowIndexSubgroupsFpGroupIteratorWithSubgroupAndExclude ); 2842 2843InstallMethod( LowIndexSubgroupsFpGroupIterator, 2844 "supply trivial subgroup, with exclusion list", 2845 [ IsSubgroupFpGroup and IsWholeFamily, IsPosInt, IsList ], 2846 function( G, n, excluded ) 2847 return DoLowIndexSubgroupsFpGroupIteratorWithSubgroupAndExclude( G, 2848 TrivialSubgroup( G ), n, excluded ); 2849 end ); 2850 2851InstallMethod( LowIndexSubgroupsFpGroupIterator, 2852 "full f.p. group, subgroup of it, with exclusion list", 2853 IsFamFamXY, 2854 [ IsSubgroupFpGroup and IsWholeFamily, IsSubgroupFpGroup, IsPosInt, 2855 IsList], 2856 DoLowIndexSubgroupsFpGroupIteratorWithSubgroupAndExclude ); 2857 2858 2859# newer version of low index -- currently does not support contained subgroups 2860# or exclusion lists 2861BindGlobal("LowIndSubs_NextIter",function(iter) 2862local res; 2863 if not IsDoneIterator( iter ) then 2864 res:= iter!.data.nextSubgroup; 2865 iter!.data.nextSubgroup:= fail; 2866 return res; 2867 fi; 2868 Error( "iterator is exhausted" ); 2869end); 2870 2871BindGlobal("IsDoneIter_LowIndSubs",function(iter) 2872local data, G, N, ts, rels, m, mm, stack1, stack2, mu, nu, s, t, n, i, sj, 2873j, ok, b,k,tr; 2874 2875 data:=iter!.data; 2876 if data.isDone then 2877 return true; 2878 elif data.nextSubgroup<>fail then 2879 return false; 2880 fi; 2881 2882 G:=data.G; 2883 N:=data.N; 2884 ts:=data.ts; 2885 rels:=data.rels; 2886 m:=Length(FreeGeneratorsOfFpGroup(G)); 2887 mm:=2*m-1; 2888 2889 # stacks for the kernel 2890 stack1:=List([1..2*N],i->0); 2891 stack2:=List([1..2*N],i->0); 2892 2893 # these are scratch space for the kernel (partial permutations) 2894 mu:=ListWithIdenticalEntries(N,0); 2895 nu:=ListWithIdenticalEntries(N,0); 2896 Objectify(TYPE_LOWINDEX_DATA,mu); 2897 Objectify(TYPE_LOWINDEX_DATA,nu); 2898 2899 tr:=[2*m,2*m-1..1]; 2900 2901 while Length(ts)>0 do 2902 s:=ts[Length(ts)]; 2903 t:=s[1]; 2904 n:=s[2]; 2905 i:=s[3]; 2906 sj:=s[4]; 2907 if i>mm then 2908 i:=1; 2909 sj:=sj+1; 2910 fi; 2911 j:=sj; 2912 Unbind(ts[Length(ts)]); 2913 2914 # find first open entry 2915 ok:=true; 2916 while ok and j<=n do 2917 if j>sj then 2918 i:=1; 2919 fi; 2920 while ok and i<=mm do 2921 if t[i][j]=0 then 2922 # try n+1 2923 ok:=false; 2924 if n<N then 2925 #s:=List(t,ShallowCopy); 2926 s:=[]; 2927 for k in tr do 2928 #Add(s,ShallowCopy(k)); 2929 s[k]:=ShallowCopy(t[k]); 2930 od; 2931 s[i][j]:=n+1; 2932 s[i+1][n+1]:=j; 2933 #Try(s,n+1,i,j); 2934 stack1[1]:=j;stack2[1]:=i; 2935 if LOWINDEX_COSET_SCAN(s,rels,stack1,stack2) 2936 and LOWINDEX_IS_FIRST(s,n+1,mu,nu) then 2937 Add(ts,[s,n+1,i+2,j]); 2938 fi; 2939 fi; 2940 2941 # try other values (reverse order so that stack process gives same 2942 # traversal order as recursion) 2943 for b in [n,n-1..1] do 2944 if t[i+1][b]=0 then 2945 # define 2946 if b>1 then 2947 #s:=List(t,ShallowCopy); 2948 s:=[]; 2949 for k in tr do 2950 #Add(s,ShallowCopy(k)); 2951 s[k]:=ShallowCopy(t[k]); 2952 od; 2953 else 2954 # no neeed to copy as this is the last branch. 2955 s:=t; 2956 fi; 2957 s[i][j]:=b; 2958 s[i+1][b]:=j; 2959 #Try(s,n,i,j); 2960 stack1[1]:=j;stack2[1]:=i; 2961 if LOWINDEX_COSET_SCAN(s,rels,stack1,stack2) 2962 and LOWINDEX_IS_FIRST(s,n,mu,nu) then 2963 if b=1 then 2964 ok:=true; 2965 else 2966 Add(ts,[s,n,i+2,j]); 2967 fi; 2968 fi; 2969 2970 fi; 2971 od; 2972 2973 fi; 2974 i:=i+2; 2975 od; 2976 j:=j+1; 2977 od; 2978 # table is complete 2979 if ok then 2980 data.cnt:=data.cnt+1; 2981 s:=List(t{[1,3..mm]},i->PermList(i{[1..n]})); 2982 b:=GroupWithGenerators(s,()); 2983 Info( InfoFpGroup, 2, " class ", data.cnt, " of index ", n, 2984 ", quotient size ",Size(b)); 2985 data.nextSubgroup:=SubgroupOfWholeGroupByQuotientSubgroup( 2986 FamilyObj(G),b,Stabilizer(b,1)); 2987 #" and length ", nrcos / nrfix ); 2988 return false; 2989 fi; 2990 od; 2991 data.isDone:=true; 2992 return true; 2993end); 2994 2995BindGlobal("DoLowIndexSubgroupsFpGroupIterator",function(G,S,N) 2996local m, mm, rels, rel,w, wo, ok, a, k, t, ts, data, i, j; 2997 2998 if Length(GeneratorsOfGroup(S))>0 then 2999 TryNextMethod(); 3000 fi; 3001 3002 m:=Length(FreeGeneratorsOfFpGroup(G)); 3003 mm:=2*m-1; 3004 rels:=List([1..2*m],i->[]); 3005 for i in RelatorsOfFpGroup(G) do 3006 w:=LetterRepAssocWord(i); 3007 # cyclic reduction 3008 while Length(w)>0 and w[1]=-w[Length(w)] do 3009 w:=w{[2..Length(w)-1]}; 3010 od; 3011 3012 if Length(w)>0 then 3013 # all conjugates of w and inverse 3014 wo:=ShallowCopy(w); 3015 for j in [1..2] do 3016 MakeImmutable(w); 3017 ok:=true; 3018 while ok do 3019 if w[1]<0 then 3020 a:=-2*w[1]; 3021 else 3022 a:=2*w[1]-1; 3023 fi; 3024 if not w in rels[a] then 3025 AddSet(rels[a],w); 3026 # cyclic permutation 3027 w:=Concatenation(w{[2..Length(w)]},[w[1]]); 3028 MakeImmutable(w); 3029 else 3030 # relator known -- this means we have processed everything that 3031 # is to come 3032 ok:=false; 3033 fi; 3034 od; 3035 if j=1 then 3036 # invert wo 3037 w:=Reversed(-wo); 3038 fi; 3039 od; 3040 fi; 3041 od; 3042 3043 # translate rels: 3044 for i in [1..Length(rels)] do 3045 for j in [1..Length(rels[i])] do 3046 rel:=rels[i][j]; 3047 w:=[Length(rel)]; # Length in position 1 (as we change to data type...) 3048 for k in rel do 3049 if k<0 then k:=-2*k; else k:=2*k-1;fi; 3050 Add(w,k); 3051 od; 3052 MakeImmutable(w); 3053 rels[i][j]:=w; 3054 od; 3055 od; 3056 3057 LOWINDEX_PREPARE_RELS(rels); 3058 3059 t:=List([1..2*m],i->ListWithIdenticalEntries(N,0)); 3060 3061 ts:=[[t,1,1,1]]; 3062 data:=rec(G:=G, 3063 N:=N, 3064 ts:=ts, 3065 rels:=rels, 3066 cnt:=0, 3067 nextSubgroup:=fail, 3068 isDone:=false); 3069 3070 return IteratorByFunctions(rec( 3071 IsDoneIterator:=IsDoneIter_LowIndSubs, 3072 NextIterator:=LowIndSubs_NextIter, 3073 ShallowCopy:=Error, 3074 data:=data)); 3075 3076end); 3077 3078 3079 3080############################################################################# 3081## 3082#M LowIndexSubgroupsFpGroupIterator( <G>[, <H>], <index>[, <excluded>] ) . . 3083## 3084InstallMethod( LowIndexSubgroupsFpGroupIterator, 3085 "supply trivial subgroup", 3086 [ IsSubgroupFpGroup, IsPosInt ], 3087 function( G, n ) 3088 return LowIndexSubgroupsFpGroupIterator( G, 3089 TrivialSubgroup( Parent( G ) ), n ); 3090 end ); 3091 3092InstallMethod( LowIndexSubgroupsFpGroupIterator, 3093 "full f.p. group, subgroup of it", 3094 IsFamFamX, 3095 [ IsSubgroupFpGroup and IsWholeFamily, IsSubgroupFpGroup, IsPosInt ], 3096 DoLowIndexSubgroupsFpGroupIterator ); 3097 3098InstallMethod( LowIndexSubgroupsFpGroupIterator, 3099 "subgroups of f.p. group", 3100 IsFamFamX, 3101 [ IsSubgroupFpGroup, IsSubgroupFpGroup, IsPosInt ], 3102 function( G, H, ind ) 3103 local fpi; 3104 3105 fpi:= IsomorphismFpGroup( G ); 3106 3107 return IteratorByFunctions( rec( 3108 NextIterator := function( iter ) 3109 local u, v; 3110 3111 u:= NextIterator( iter!.fullIterator ); 3112 v:= PreImagesSet( fpi, u ); 3113 SetIndexInWholeGroup( v, 3114 IndexInWholeGroup( G ) * IndexInWholeGroup( u ) ); 3115 return v; 3116 end, 3117 IsDoneIterator := iter -> IsDoneIterator( iter!.fullIterator ), 3118 ShallowCopy := iter -> rec( fullIterator:= iter!.fullIterator ), 3119 fullIterator := LowIndexSubgroupsFpGroupIterator( Range( fpi ), 3120 Image( fpi, H ), ind ), 3121 ) ); 3122 end ); 3123 3124 3125############################################################################# 3126## 3127#M LowIndexSubgroupsFpGroup(<G>,<H>,<index>[,<excluded>]) . . find subgroups 3128#M of small index in a finitely presented group 3129## 3130BindGlobal( "DoLowIndexSubgroupsFpGroupViaIterator", function( arg ) 3131 local iter, result; 3132 3133 iter:= CallFuncList( LowIndexSubgroupsFpGroupIterator, arg ); 3134 result:= []; 3135 while not IsDoneIterator( iter ) do 3136 Add( result, NextIterator( iter ) ); 3137 od; 3138 return result; 3139 end ); 3140 3141InstallMethod(LowIndexSubgroupsFpGroup, "subgroups of full fp group", 3142 IsFamFamX, 3143 [IsSubgroupFpGroup and IsWholeFamily,IsSubgroupFpGroup,IsPosInt],0, 3144 DoLowIndexSubgroupsFpGroupViaIterator ); 3145 3146InstallMethod(LowIndexSubgroups, "FpFroups, using LowIndexSubgroupsFpGroup", 3147 true, 3148 [IsSubgroupFpGroup,IsPosInt], 3149 # rank higher than method for finit groups using maximal subgroups 3150 {} -> RankFilter(IsGroup and IsFinite), 3151 LowIndexSubgroupsFpGroup ); 3152 3153InstallOtherMethod(LowIndexSubgroupsFpGroup, 3154 "subgroups of full fp group, with exclusion list", IsFamFamXY, 3155 [IsSubgroupFpGroup and IsWholeFamily,IsSubgroupFpGroup,IsPosInt,IsList],0, 3156 DoLowIndexSubgroupsFpGroupViaIterator ); 3157 3158InstallOtherMethod(LowIndexSubgroupsFpGroup, 3159 "supply trivial subgroup", true, 3160 [IsSubgroupFpGroup,IsPosInt],0, 3161function(G,n) 3162 return LowIndexSubgroupsFpGroup(G,TrivialSubgroup(Parent(G)),n); 3163end); 3164 3165InstallOtherMethod( LowIndexSubgroupsFpGroup, 3166 "with exclusion list, supply trivial subgroup", 3167 [ IsSubgroupFpGroup and IsWholeFamily, IsPosInt, IsList ], 3168 function( G, n, exclude ) 3169 return LowIndexSubgroupsFpGroup( G, TrivialSubgroup( G ), n, exclude ); 3170 end); 3171 3172InstallMethod(LowIndexSubgroupsFpGroup, "subgroups of fp group", 3173 IsFamFamX, [IsSubgroupFpGroup,IsSubgroupFpGroup,IsPosInt],0, 3174function(G,H,ind) 3175local fpi,u,l,i,a; 3176 fpi:=IsomorphismFpGroup(G); 3177 u:=LowIndexSubgroupsFpGroup(Range(fpi),Image(fpi,H),ind); 3178 3179 l:=[]; 3180 for i in u do 3181 a:=PreImagesSet(fpi,i); 3182 SetIndexInWholeGroup(a,IndexInWholeGroup(G)*IndexInWholeGroup(i)); 3183 Add(l,a); 3184 od; 3185 return l; 3186end); 3187 3188 3189 3190############################################################################# 3191## 3192#M NormalizerOp(<G>,<H>) 3193## 3194InstallMethod(NormalizerOp,"subgroups of fp group: find stabilizing cosets", 3195 IsIdenticalObj,[IsSubgroupFpGroup,IsSubgroupFpGroup],0, 3196function ( G, H ) 3197local N, # normalizer of <H> in <G>, result 3198 Ntab, # normalizer coset table 3199 pargens, # parent generators 3200 table, # coset table of <H> in its parent 3201 nrcos, # number of cosets in the table 3202 nrgens, # 2*(number of generators of <H>s parent)+1 3203 iseql, # true if coset <c> normalizes <H> 3204 r, # renumbering of the coset table 3205 t, # list of renumbered cosets 3206 n, # number of renumbered cosets 3207 c, i, j, k, # coset loop variables 3208 g, # generator loop variable 3209 tgi, tgj, # table entries 3210 d; # orbit length 3211 3212 # compute the normalizer in the full group. 3213 3214 # first we need the coset table of <H> 3215 table := CosetTableInWholeGroup(H); 3216 pargens:=GeneratorsOfGroup(FamilyObj(G)!.wholeGroup); 3217 nrcos := IndexCosetTab( table ); 3218 nrgens := 2*Length( pargens ) + 1; 3219 3220 # find the cosets of <H> in its parent whose elements normalize <H> 3221 N := [1]; 3222 t := 0 * [ 1 .. nrcos ]; 3223 for c in [ 2 .. nrcos ] do 3224 3225 # test if the renumbered table is equal to the original table 3226 r := 0 * [ 1 .. nrcos ]; 3227 r[c] := 1; 3228 t[1] := c; 3229 n := 1; 3230 k := 1; 3231 iseql := true; 3232 while k < nrcos and iseql do 3233 j := t[k]; 3234 i := r[j]; 3235 g := 1; 3236 while g < nrgens and iseql do 3237 tgi := table[g][i]; 3238 tgj := table[g][j]; 3239 if r[tgj] = 0 then 3240 n := n + 1; 3241 t[n] := tgj; 3242 r[tgj] := tgi; 3243 else 3244 iseql := r[tgj] = tgi; 3245 fi; 3246 g := g + 2; 3247 od; 3248 k := k + 1; 3249 od; 3250 3251 # add the index of this coset if it normalizes 3252 if iseql then 3253 AddSet(N,c); 3254 fi; 3255 3256 od; 3257 3258 # now N is the block representing the normalizer cosets. 3259 3260 if Length(N)=1 then 3261 # self-normalizing 3262 N:=H; 3263 else 3264 # form the whole block system 3265 table:=List(table{[1,3..Length(table)-1]},PermList); 3266 N:=Orbit(Group(table,()),N,OnSets); 3267 N:=Set(N); 3268 d:=Length(N); 3269 3270 # make a table for the action on these blocks. 3271 N:=List(table,i->Permutation(i,N,OnSets)); 3272 Ntab:=[]; 3273 for c in N do 3274 Add(Ntab,OnTuples([1..d],c)); 3275 Add(Ntab,OnTuples([1..d],c^-1)); 3276 od; 3277 StandardizeTable(Ntab); 3278 3279 N:=SubgroupOfWholeGroupByCosetTable(FamilyObj(H),Ntab); 3280 fi; 3281 3282 # if necessary intersect with G 3283 if HasIsWholeFamily(G) and IsWholeFamily(G) then 3284 return N; 3285 fi; 3286 N:=Intersection(G,N); 3287 3288 return N; 3289end); 3290 3291InstallMethod(NormalizerOp,"subgroups of fp group by quot. rep", 3292 IsIdenticalObj, 3293 [ IsSubgroupFpGroup and IsSubgroupOfWholeGroupByQuotientRep, 3294 IsSubgroupFpGroup and IsSubgroupOfWholeGroupByQuotientRep], 0, 3295function(G,H) 3296local d,A,B,e1,e2,Ag,Bg,s,sg,u,v; 3297 3298 A:=MakeNiceDirectQuots(G,H); 3299 G:=A[1]; 3300 H:=A[2]; 3301 3302 A:=G!.quot; 3303 B:=H!.quot; 3304 # are we represented in the same quotient? 3305 if GeneratorsOfGroup(A)=GeneratorsOfGroup(B) then 3306 # we are, compute simply in the quotient 3307 return SubgroupOfWholeGroupByQuotientSubgroup(FamilyObj(G),G!.quot, 3308 Normalizer(G!.sub,H!.sub)); 3309 fi; 3310 3311 d:=DirectProduct(A,B); 3312 e1:=Embedding(d,1); 3313 e2:=Embedding(d,2); 3314 Ag:=GeneratorsOfGroup(A); 3315 Bg:=GeneratorsOfGroup(B); 3316 # form the sdp 3317 sg:=List([1..Length(Ag)],i->Image(e1,Ag[i])*Image(e2,Bg[i])); 3318 s:=SubgroupNC(d,sg); 3319 Assert(1,GeneratorsOfGroup(s)=sg); 3320 3321 # get both subgroups in the direct product via the projections 3322 # instead of intersecting both preimages with s we only intersect the 3323 # intersection 3324 u:=PreImagesSet(Projection(d,1),G!.sub); 3325 v:=PreImagesSet(Projection(d,2),H!.sub); 3326 u:=Intersection(u,s); 3327 v:=Intersection(v,s); 3328 3329 return SubgroupOfWholeGroupByQuotientSubgroup(FamilyObj(G),s, 3330 Normalizer(u,v)); 3331 3332end); 3333 3334InstallMethod(NormalizerOp,"in whole group by quot. rep", 3335 IsIdenticalObj, 3336 [ IsSubgroupFpGroup and IsWholeFamily, 3337 IsSubgroupFpGroup and IsSubgroupOfWholeGroupByQuotientRep], 0, 3338function(G,H) 3339 return SubgroupOfWholeGroupByQuotientSubgroup(FamilyObj(G),H!.quot, 3340 Normalizer(H!.quot,H!.sub)); 3341end); 3342 3343 3344############################################################################# 3345## 3346#F MostFrequentGeneratorFpGroup( <G> ) . . . . . . . most frequent generator 3347## 3348## is an internal function which is used in some applications of coset 3349## table methods. It returns the first of those generators of the given 3350## finitely presented group <G> which occur most frequently in the 3351## relators. 3352## 3353InstallGlobalFunction( MostFrequentGeneratorFpGroup, function ( G ) 3354 3355 local altered, gens, gens2, i, i1, i2, k, max, j, num, numgens, 3356 numrels, occur, power, rel, relj, rels, set; 3357 3358#@@ # check the first argument to be a finitely presented group. 3359#@@ if not ( IsRecord( G ) and IsBound( G.isFpGroup ) and G.isFpGroup ) then 3360#@@ Error( "argument must be a finitely presented group" ); 3361#@@ fi; 3362 3363 # Get some local variables. 3364 gens := FreeGeneratorsOfFpGroup( G ); 3365 rels := RelatorsOfFpGroup( G ); 3366 numgens := Length( gens ); 3367 numrels := Length( rels ); 3368 3369 # Initialize a counter. 3370 occur := ListWithIdenticalEntries( numgens, 0 ); 3371 power := ListWithIdenticalEntries( numgens, 0 ); 3372 3373 # initialize a list of the generators and their inverses 3374 gens2 := [ ]; gens2[numgens] := 0; 3375 for i in [ 1 .. numgens ] do 3376 gens2[i] := AbsInt(LetterRepAssocWord(gens[i])[1]); 3377 gens2[numgens+i] := -gens2[i]; 3378 od; 3379 3380 # convert the relators to vectors of generator numbers and count their 3381 # occurrences. 3382 for j in [ 1 .. numrels ] do 3383 3384 # convert the j-th relator to a Tietze relator 3385 relj := LetterRepAssocWord(rels[j]); 3386 i1 := 1; 3387 i2 := Length( relj ); 3388 while i1 < i2 and relj[i1]=-relj[i2] do 3389 i1 := i1 + 1; 3390 i2 := i2 - 1; 3391 od; 3392 rel := List([i1..i2], i -> Position( gens2, relj[i] )); 3393 3394 # count the occurrences of the generators in rel 3395 for i in [ 1 .. Length( rel ) ] do 3396 k := rel[i]; 3397 if k = fail then 3398 Error( "given relator is not a word in the generators" ); 3399 elif k <= numgens then 3400 occur[k] := occur[k] + 1; 3401 else 3402 k := k - numgens; 3403 rel[i] := -k; 3404 occur[k] := occur[k] + 1; 3405 fi; 3406 od; 3407 # check the current relator for being a power relator. 3408 set := Set( rel ); 3409 if Length( set ) = 2 then 3410 num := [ 0, 0 ]; 3411 for i in rel do 3412 if i = set[1] then num[1] := num[1] + 1; 3413 else num[2] := num[2] + 1; fi; 3414 od; 3415 if num[1] = 1 then 3416 power[AbsInt( set[2] )] := AbsInt( set[1] ); 3417 elif num[2] = 1 then 3418 power[AbsInt( set[1] )] := AbsInt( set[2] ); 3419 fi; 3420 fi; 3421 od; 3422 3423 # increase the occurrences numbers of generators which are roots of 3424 # other ones, but avoid infinite loops. 3425 i := 1; 3426 altered := true; 3427 while altered do 3428 altered := false; 3429 for j in [ i .. numgens ] do 3430 if power[j] > 0 and power[power[j]] = 0 then 3431 occur[j] := occur[j] + occur[power[j]]; 3432 power[j] := 0; 3433 altered := true; 3434 if i = j then i := i + 1; fi; 3435 fi; 3436 od; 3437 od; 3438 3439 # find the most frequently occurring generator and return it. 3440 i := 1; 3441 max := occur[1]; 3442 for j in [ 2 .. numgens ] do 3443 if occur[j] > max then 3444 i := j; 3445 max := occur[j]; 3446 fi; 3447 od; 3448 gens := GeneratorsOfGroup( G ); 3449 return gens[i]; 3450end ); 3451 3452 3453############################################################################# 3454## 3455#F RelatorRepresentatives(<rels>) . set of representatives of a list of rels 3456## 3457## 'RelatorRepresentatives' returns a set of relators, that contains for 3458## each relator in the list <rels> its minimal cyclical permutation (which 3459## is automatically cyclically reduced). 3460## 3461InstallGlobalFunction( RelatorRepresentatives, function ( rels ) 3462local reps, word, length, fam, reversed, cyc, min, g, rel, i; 3463 3464 reps := [ ]; 3465 3466 # loop over all nontrivial relators 3467 for rel in rels do 3468 3469# length := NrSyllables( rel ); 3470# if length > 0 then 3471# 3472# # invert the exponents to their negative values in order to get 3473# # an appropriate lexicographical ordering of the relators. 3474# fam := FamilyObj( rel ); 3475# 3476# list := ShallowCopy(ExtRepOfObj( rel )); 3477# for i in [ 2, 4 .. Length( list ) ] do 3478# list[i] := -list[i]; 3479# od; 3480# reversed := ObjByExtRep( fam, list ); 3481# 3482## # find the minimal cyclic permutation 3483# cyc := reversed; 3484# min := cyc; 3485# if cyc^-1 < min then min := cyc^-1; fi; 3486# for i in [ 1 .. length ] do 3487# g:=ObjByExtRep(fam,[GeneratorSyllable(reversed,i), 3488# SignInt(ExponentSyllable(reversed,i))]); 3489# for j in [1..AbsInt(ExponentSyllable(reversed,i))] do 3490# cyc := cyc ^ g; 3491# if cyc < min then min := cyc; fi; 3492# if cyc^-1 < min then min := cyc^-1; fi; 3493# od; 3494# od; 3495# 3496# # if the relator is new, add it to the representatives 3497# min:=Immutable([ Length( min ), min ] ); 3498# if not min in reps then 3499# AddSet( reps,min); 3500# fi; 3501# 3502# fi; 3503 3504 3505 word:=LetterRepAssocWord(rel); 3506 length:=Length(word); 3507 if length>0 then 3508 # invert the exponents to their negative values in order to get 3509 # an appropriate lexicographical ordering of the relators. 3510 fam:=FamilyObj( rel ); 3511 reversed:=AssocWordByLetterRep(fam,-word); 3512 3513 # find the minimal cyclic permutation 3514 cyc:=reversed; 3515 min:=cyc; 3516 if cyc^-1<min then min:=cyc^-1;fi; 3517 for i in [1..length] do 3518 g:=AssocWordByLetterRep(fam,word{[i]}); 3519 cyc:=cyc^g; 3520 if cyc<min then min:=cyc;fi; 3521 if cyc^-1<min then min:=cyc^-1;fi; 3522 od; 3523 3524 # if the relator is new, add it to the representatives 3525 min:=Immutable([ Length( min ), min ] ); 3526 if not min in reps then 3527 AddSet( reps,min); 3528 fi; 3529 3530 fi; 3531 od; 3532 3533 # reinvert the exponents. 3534 for i in [ 1 .. Length( reps ) ] do 3535 rel := reps[i][2]; 3536 fam := FamilyObj( rel ); 3537# list := ShallowCopy(ExtRepOfObj( rel )); 3538# for j in [ 2, 4 .. Length( list ) ] do 3539# list[j] := -list[j]; 3540# od; 3541# reps[i] := ObjByExtRep( fam, list ); 3542 reps[i]:=AssocWordByLetterRep(fam,-LetterRepAssocWord(rel)); 3543 od; 3544 3545 # return the representatives 3546 return reps; 3547end ); 3548 3549 3550############################################################################# 3551## 3552#M RelatorsOfFpGroup( F ) 3553## 3554InstallMethod( RelatorsOfFpGroup, 3555 "for finitely presented group", 3556 true, 3557 [ IsSubgroupFpGroup and IsGroupOfFamily ], 0, 3558 G -> ElementsFamily( FamilyObj( G ) )!.relators ); 3559 3560 3561############################################################################# 3562## 3563#M IndicesInvolutaryGenerators( F ) 3564## 3565InstallMethod( IndicesInvolutaryGenerators, "for finitely presented group", 3566 true, [ IsSubgroupFpGroup and IsGroupOfFamily ], 0, 3567function(G) 3568local g,r; 3569 g:=FreeGeneratorsOfFpGroup(G); 3570 r:=RelatorsOfFpGroup(G); 3571 r:=Filtered(r,i->NumberSyllables(i)=1); 3572 return Filtered([1..Length(g)],i->g[i]^2 in r or g[i]^-2 in r); 3573end); 3574 3575 3576############################################################################# 3577## 3578#F RelsSortedByStartGen( <gens>, <rels>, <table> [, <ignore> ] ) 3579#F relators sorted by start generator 3580## 3581## 'RelsSortedByStartGen' is a subroutine of the Felsch Todd-Coxeter and 3582## the Reduced Reidemeister-Schreier routines. It returns a list which for 3583## each generator or inverse generator contains a list of all cyclically 3584## reduced relators, starting with that element, which can be obtained by 3585## conjugating or inverting given relators. The relators are represented as 3586## lists of the coset table columns corresponding to the generators and, in 3587## addition, as lists of the respective column numbers. 3588## 3589## Square relators will be ignored if ignore = true. The default value of 3590## ignore is false. 3591## 3592InstallGlobalFunction( RelsSortedByStartGen, function ( arg ) 3593local gens, # group generators 3594 gennums, # indices of generators 3595 rels, # relators 3596 table, # coset table 3597 ignore, # if true, ignore square relators 3598 relsGen, # resulting list 3599 rel, cyc, # one relator and cyclic permutation 3600 length, extleng, # length and extended length of rel 3601 base, base2, # base length of rel 3602 gen, # one generator in rel 3603 exp, # syllable exponent 3604 es, # exponents sum 3605 nums, invnums, # numbers list and inverse 3606 cols, invcols, # columns list and inverse 3607 p, p1, p2, # positions of generators 3608 l,m,poslist, 3609 i, j, k; # loop variables 3610 3611 # get the arguments 3612 gens := arg[1]; 3613 # the indices of the generators 3614 gennums:= List(gens,i->AbsInt(LetterRepAssocWord(i)[1])); 3615 3616 poslist:=List([1..Maximum(gennums)],i->Position(gennums,i)); 3617 rels := arg[2]; 3618 table := arg[3]; 3619 ignore := false; 3620 if Length( arg ) > 3 then ignore := arg[4]; fi; 3621 3622 # check that the table has the right number of columns 3623 if 2 * Length(gens) <> Length(table) then 3624 Error( "table length is inconsistent with number of generators" ); 3625 fi; 3626 3627 # initialize the list to be constructed 3628 relsGen := [ ]; relsGen[2*Length(gens)] := 0; 3629 for i in [ 1 .. Length(gens) ] do 3630 relsGen[ 2*i-1 ] := []; 3631 if not IsIdenticalObj( table[ 2*i-1 ], table[ 2*i ] ) then 3632 relsGen[ 2*i ] := []; 3633 else 3634 relsGen[ 2*i ] := relsGen[ 2*i-1 ]; 3635 fi; 3636 od; 3637 3638 # now loop over all parent group relators 3639 for rel in rels do 3640 3641 # get the length and the basic length of relator rel 3642 length := Length( rel ); 3643 base := 1; 3644 3645# cyc := rel ^ Subword( rel, base, base ); 3646# while cyc <> rel do 3647# base := base + 1; 3648# cyc := cyc ^ Subword( rel, base, base ); 3649# od; 3650 3651 # work in letter rep 3652 es:=LetterRepAssocWord(rel); 3653 3654 base:=2; 3655 l:=Length(es); 3656 m:=l-base+1; 3657 3658 while (base<=l) and (es{[base..l]}<>es{[1..m]} or 3659 es{[1..base-1]}<>es{[m+1..l]}) do 3660 base:=base+1; 3661 m:=m-1; 3662 od; 3663 base:=base-1; 3664 3665# m:=base; 3666# base:=1; 3667# cyc := rel ^ Subword( rel, base, base ); 3668# while cyc <> rel do 3669# base := base + 1; 3670# cyc := cyc ^ Subword( rel, base, base ); 3671# od; 3672# if m<>base then 3673# Error("Y"); 3674# fi; 3675 3676 # ignore square relators 3677 if length <> 2 or base <> 1 or not ignore then 3678 3679 # initialize the columns and numbers lists corresponding to the 3680 # current relator 3681 base2 := 2 * base; 3682 extleng := 2 * ( base + length ) - 1; 3683 nums := [ ]; nums[extleng] := 0; 3684 cols := [ ]; cols[extleng] := 0; 3685 invnums := [ ]; invnums[extleng] := 0; 3686 invcols := [ ]; invcols[extleng] := 0; 3687 3688 # compute the lists 3689 i := 0; j := 1; k := base2 + 3; 3690 rel:=LetterRepAssocWord(rel); 3691 while i < base do 3692 i := i + 1; j := j + 2; k := k - 2; 3693 gen := rel[i]; 3694 if gen>0 then 3695 p:=poslist[gen]; 3696 p1 := 2 * p - 1; 3697 p2 := 2 * p; 3698 else 3699 p:=poslist[-gen]; 3700 p1 := 2 * p; 3701 p2 := 2 * p - 1; 3702 fi; 3703 nums[j] := p1; invnums[k-1] := p1; 3704 nums[j-1] := p2; invnums[k] := p2; 3705 cols[j] := table[p1]; invcols[k-1] := table[p1]; 3706 cols[j-1] := table[p2]; invcols[k] := table[p2]; 3707 Add( relsGen[p1], [ nums, cols, j ] ); 3708 Add( relsGen[p2], [ invnums, invcols, k ] ); 3709 od; 3710 3711 while j < extleng do 3712 j := j + 1; 3713 nums[j] := nums[j-base2]; invnums[j] := invnums[j-base2]; 3714 cols[j] := cols[j-base2]; invcols[j] := invcols[j-base2]; 3715 od; 3716 3717 nums[1] := length; invnums[1] := length; 3718 cols[1] := 2 * length - 3; invcols[1] := cols[1]; 3719 fi; 3720 od; 3721 3722 # return the list 3723 return relsGen; 3724end ); 3725 3726############################################################################# 3727## 3728#M FinIndexCyclicSubgroupGenerator( <G>, <maxtable> ) 3729## 3730## tries to find a cyclic subgroup of finite index. This tries coset 3731## enumerations with cumulatively bigger coset tables up to table size 3732## <maxtable>. It returns `fail' if no table could be found. 3733BindGlobal("FinIndexCyclicSubgroupGenerator",function(G,maxtable) 3734local fgens,grels,max,gens,t,Attempt,perms,short; 3735 fgens:=FreeGeneratorsOfFpGroup(G); 3736 grels:=RelatorsOfFpGroup(G); 3737 max:=ValueOption("max"); 3738 if max=fail then 3739 max:=CosetTableDefaultMaxLimit; 3740 fi; 3741 max:=Minimum(max,maxtable); 3742 3743 # take the generators, most frequent first 3744 gens:=GeneratorsOfGroup(G); 3745 t:=MostFrequentGeneratorFpGroup(G); 3746 gens:=Concatenation([t, 3747 #pseudorandom element - try if it works 3748 PseudoRandom(G:radius:=Random(2,3))], 3749 Filtered(gens,j->UnderlyingElement(j)<>UnderlyingElement(t))); 3750 gens:=Set(List(gens,UnderlyingElement)); 3751 3752 # recursive search (via smaller and smaller partitions) for a finite index 3753 # subgroup 3754 Attempt:=function(sgens) 3755 local l,m,t,trial; 3756 l:=Length(sgens); 3757 m:=Int((l-1)/2)+1; #middle, rounded up 3758 3759 trial:=sgens{[1..m]}; 3760 Info(InfoFpGroup,1,"FIS: trying ",trial); 3761 t:=CosetTableFromGensAndRels(fgens,grels, 3762 trial:silent:=true,max:=max); 3763 if t<>fail and Length(trial)>1 then 3764 Unbind(t); 3765 t:=Attempt(trial); 3766 if t<>fail then 3767 return t; 3768 fi; 3769 fi; 3770 if t=fail then 3771 trial:=sgens{[m+1..l]}; 3772 Info(InfoFpGroup,1,"FIS: trying other half ",trial); 3773 t:=CosetTableFromGensAndRels(fgens,grels, 3774 List(trial,UnderlyingElement):silent:=true,max:=max); 3775 if t=fail then 3776 return fail; 3777 elif Length(trial)>1 then 3778 Unbind(t); 3779 return Attempt(trial); 3780 fi; 3781 fi; 3782 Info(InfoFpGroup,1,"FIS: found ",IndexCosetTab(t)); 3783 return [trial[1],t,max]; 3784 end; 3785 3786 while max<=maxtable do 3787 t:=Attempt(gens); 3788 if t<>fail then 3789 # do not try to redo the work if the index is comparatively small, as 3790 # it's not worth doing double work in this case. 3791 if Length(t[2][1])<100 then 3792 return [ElementOfFpGroup(FamilyObj(One(G)),t[1]),max]; 3793 fi; 3794 3795 perms:=List(t[2]{[1,3..Length(t[2])-1]},PermList); 3796 short:=FreeGeneratorsOfFpGroup(G); 3797 short:=Concatenation(short, List(short,Inverse)); 3798 short:=Set(List(Concatenation(List([1..3],x->Arrangements(short,x))), 3799 Product)); 3800 short:=List(short, 3801 x->[Order(MappedWord(x,FreeGeneratorsOfFpGroup(G),perms)),x]); 3802 # prefer large order and short word length 3803 SortBy(short,x->[x[1],-Length(x[2])]); 3804 Info(InfoFpGroup,1,"FIS: better ",short[Length(short)][1]); 3805 return [ElementOfFpGroup(FamilyObj(One(G)),short[Length(short)][2]), 3806 max]; 3807 fi; 3808 if max*3/2<maxtable and max*2>maxtable then 3809 max:=maxtable; 3810 else 3811 max:=max*2; 3812 fi; 3813 if max<=maxtable then 3814 Info(InfoWarning,1, 3815 "Coset table calculation failed -- trying with bigger table limit"); 3816 fi; 3817 od; 3818 return fail; 3819end); 3820 3821############################################################################# 3822## 3823#M Size( <G> ) . . . . . . . . . . . . . size of a finitely presented group 3824## 3825InstallMethod(Size, "for finitely presented groups", true, 3826 [ IsSubgroupFpGroup and IsGroupOfFamily ], 0, 3827function( G ) 3828local fgens, # generators of the free group 3829 rels, # relators of <G> 3830 H, # subgroup of <G> 3831 gen, # generator of cyclic subgroup 3832 max, # maximal coset table length required 3833 e, 3834 T; # coset table of <G> by <H> 3835 3836 fgens := FreeGeneratorsOfFpGroup( G ); 3837 rels := RelatorsOfFpGroup( G ); 3838 3839 # handle free and trivial group 3840 if 0 = Length( fgens ) then 3841 return 1; 3842 elif 0 = Length(rels) then 3843 return infinity; 3844 3845 # handle nontrivial fp group by computing the index of its trivial 3846 # subgroup 3847 else 3848 # the abelian invariants are comparatively cheap 3849 if 0 in AbelianInvariants(G) then 3850 return infinity; 3851 fi; 3852 # the group could be quite big -- try to find a cyclic subgroup of 3853 # finite index. 3854 gen:=FinIndexCyclicSubgroupGenerator(G,infinity); 3855 max:=gen[2]; 3856 gen:=gen[1]; 3857 3858 H := Subgroup(G,[gen]); 3859 T := NEWTC_CosetEnumerator( FreeGeneratorsOfFpGroup(G), 3860 RelatorsOfFpGroup(G),GeneratorsOfGroup(H),true,false: 3861 cyclic:=true,limit:=1+max ); 3862 e:=NEWTC_CyclicSubgroupOrder(T); 3863 if e=0 then 3864 return infinity; 3865 else 3866 return T.index * e; 3867 fi; 3868 fi; 3869 3870end ); 3871 3872 3873############################################################################# 3874## 3875#M Size( <H> ) . . . . . . size of s subgroup of a finitely presented group 3876## 3877InstallMethod(Size,"subgroups of finitely presented groups",true, 3878 [ IsSubgroupFpGroup ], 0, 3879 3880function( H ) 3881 local G; 3882 3883 # Get whole group <G> of <H>. 3884 G := FamilyObj( H )!.wholeGroup; 3885 3886 # Compute the size of <G> and the index of <H> in <G>. 3887 return Size( G ) / IndexInWholeGroup( H ); 3888 3889end ); 3890 3891InstallMethod(Size,"infinite abelianization",true, 3892 [IsSubgroupFpGroup and HasAbelianInvariants],0, 3893function(G) 3894 if 0 in AbelianInvariants(G) then 3895 return infinity; 3896 else 3897 TryNextMethod(); 3898 fi; 3899end); 3900 3901 3902############################################################################# 3903## 3904#M IsomorphismPermGroup(<G>) 3905## 3906InstallGlobalFunction(IsomorphismPermGroupOrFailFpGroup, 3907function(arg) 3908local mappow, G, max, p, gens, rels, comb, i, l, m, H, t, gen, silent, sz, 3909 t1, bad, trial, b, bs, r, nl, o, u, rp, eo, rpo, e, e2, sc, j, z, 3910 timerFunc; 3911 3912 timerFunc := GET_TIMER_FROM_ReproducibleBehaviour(); 3913 3914 mappow:=function(n,g,e) 3915 while e>0 do 3916 n:=n^g; 3917 e:=e-1; 3918 od; 3919 return n; 3920 end; 3921 3922 G:=arg[1]; 3923 if HasIsomorphismPermGroup(G) then 3924 return IsomorphismPermGroup(G); 3925 fi; 3926 3927 # abelian invariants is comparatively cheap 3928 if 0 in AbelianInvariants(G) then 3929 SetSize(G,infinity); 3930 return fail; 3931 fi; 3932 3933 if Length(arg)>1 then 3934 max:=arg[2]; 3935 else 3936 max:=CosetTableDefaultMaxLimit; 3937 fi; 3938 3939 # handle free and trivial group 3940 if 0 = Length( FreeGeneratorsOfFpGroup( G )) then 3941 p:=GroupHomomorphismByImagesNC(G,GroupByGenerators([],()),[],[]); 3942 SetIsomorphismPermGroup(G,p); 3943 return p; 3944 fi; 3945 3946 gens:=FreeGeneratorsOfFpGroup(G); 3947 rels:=RelatorsOfFpGroup(G); 3948 3949 # build combinations 3950 comb:=[gens]; 3951 i:=1; 3952 while i<=Length(comb) do 3953 l:=Length(comb[i]); 3954 if l>1 then 3955 m:=Int((l-1)/2)+1; 3956 Add(comb,comb[i]{[1..m]}); 3957 Add(comb,comb[i]{[m+1..l]}); 3958 fi; 3959 i:=i+1; 3960 od; 3961 comb:=Concatenation( 3962 # a few combs: all gen but one 3963 List( 3964 Set([1..3],i->Random(1,Length(gens))), 3965 i->gens{Difference([1..Length(gens)],[i])}), 3966 # first combination is full list and thus uninteresting 3967 comb{[2..Length(comb)]}); 3968 Add(comb,[]); 3969 3970 H:=[]; # indicate pseudo-size 0 3971 if not HasSize(G) then 3972 Info(InfoFpGroup,1,"First compute size via cyclic subgroup"); 3973 t:=FinIndexCyclicSubgroupGenerator(G,max); 3974 if t<>fail then 3975 gen:=t[1]; 3976 Unbind(t); 3977 t := NEWTC_CosetEnumerator( FreeGeneratorsOfFpGroup(G), 3978 RelatorsOfFpGroup(G),[gen],true,false: 3979 cyclic:=true,limit:=1+max,quiet:=true ); 3980 fi; 3981 if t=fail then 3982 # we cannot get the size within the permitted limits -- give up 3983 return fail; 3984 fi; 3985 e:=NEWTC_CyclicSubgroupOrder(t); 3986 if e=0 then 3987 SetSize(G,infinity); 3988 return fail; 3989 fi; 3990 sz:=e*t.index; 3991 SetSize(G,sz); 3992 Info(InfoFpGroup,1,"found size ",sz); 3993 if sz>200*t.index then 3994 # try the corresponding perm rep 3995 p:=t.ct{t.offset+[1..Length(FreeGeneratorsOfFpGroup(G))]}; 3996 Unbind(t); 3997 3998 for j in [1..Length(p)] do 3999 p[j]:=PermList(p[j]); 4000 od; 4001 H:= GroupByGenerators( p ); 4002 # compute stabilizer chain with size info. 4003 StabChain(H,rec(limit:=sz)); 4004 if Size(H)<sz then 4005 # don't try this again 4006 comb:=Filtered(comb,i->i<>[gen]); 4007 fi; 4008 else 4009 # for memory reasons it might be better to try other perm rep first 4010 Unbind(t); 4011 fi; 4012 4013 elif Size(G)=infinity then 4014 return fail; 4015 fi; 4016 4017 sz:=Size(G); 4018 if sz*10>max then 4019 max:=sz*10; 4020 fi; 4021 4022 t1:=timerFunc(); 4023 bad:=[]; 4024 i:=1; 4025 while Size(H)<sz and i<=Length(comb) do 4026 trial:=comb[i]; 4027 if not ForAny(bad,i->IsSubset(i,trial)) then 4028 Info(InfoFpGroup,1,"Try subgroup ",trial); 4029 t:=CosetTableFromGensAndRels(gens,rels,trial:silent:=true,max:=max ); 4030 if t<>fail then 4031 Info(InfoFpGroup,1,"has index ",IndexCosetTab(t)); 4032 p:=t{[1,3..Length(t)-1]}; 4033 Unbind(t); 4034 for j in [1..Length(p)] do 4035 p[j]:=PermList(p[j]); 4036 od; 4037 H:= GroupByGenerators( p ); 4038 # compute stabilizer chain with size info. 4039 if Length(trial)=0 then 4040 # regular is faithful 4041 SetSize(H,sz); 4042 else 4043 StabChain(H,rec(limit:=sz)); 4044 fi; 4045 else 4046 # note that this subset fails a coset enumeration 4047 Add(bad,Set(trial)); 4048 fi; 4049 fi; 4050 4051 i:=i+1; 4052 od; 4053 4054 if Size(H)<sz then 4055 # we did not succeed 4056 return fail; 4057 fi; 4058 4059 Info(InfoFpGroup,1,"faithful representation of degree ",NrMovedPoints(H)); 4060 4061 # regular case? 4062 if Size(H)=NrMovedPoints(H) then 4063 t1:=timerFunc()-t1; 4064 # try to find a cyclic subgroup that gives a faithful rep. 4065 b:=fail; 4066 bs:=1; 4067 t1:=t1*4; 4068 repeat 4069 t1:=t1+timerFunc(); 4070 r:=Random(H); 4071 nl:=[]; 4072 o:=Order(r); 4073 Info(InfoFpGroup,3,"try ",o); 4074 u:=DivisorsInt(o); 4075 for i in u do 4076 if i>bs and not ForAny(nl,z->IsInt(i/z)) then 4077 rp:=r^(o/i); 4078 eo:=[1]; # {1} is a base 4079 for z in [2..i] do 4080 Add(eo,eo[Length(eo)]^rp); 4081 od; 4082 rpo:=[0..i-1]; 4083 SortParallel(eo,rpo); 4084 e:=ShallowCopy(eo); 4085 repeat 4086 bad:=false; 4087 for z in GeneratorsOfGroup(H) do 4088 e2:=Set(List(e,j->mappow(1/z,rp,rpo[Position(eo,j)])^z)); 4089 if not 1 in e2 then 4090 Error("one!"); 4091 fi; 4092 e:=Filtered(e,i->i in e2); 4093 bad:=bad or Length(e)<Length(e2); 4094 od; 4095 until not bad; 4096 sc:=Length(e); 4097 if sc=1 then 4098 b:=rp; 4099 bs:=i; 4100 Info(InfoFpGroup,3,"better order ",bs); 4101 else 4102 Info(InfoFpGroup,3,"core size ",sc); 4103 AddSet(nl,sc); # collect core sizes 4104 fi; 4105 fi; 4106 od; 4107 t1:=t1-timerFunc(); 4108 until t1<0; 4109 if b<>fail then 4110 b:=Orbit(H,Set(OrbitPerms([b],1)),OnSets); 4111 b:=ActionHomomorphism(H,b,OnSets); 4112 H:=Group(List(GeneratorsOfGroup(H),i->Image(b,i)),()); 4113 Info(InfoFpGroup,2,"nonregular degree ",NrMovedPoints(H)); 4114 SetSize(H,sz); 4115 fi; 4116 4117 fi; 4118 4119 p:=SmallerDegreePermutationRepresentation(H:cheap); 4120 # tell the family that we can now compare elements 4121 SetCanEasilyCompareElements(FamilyObj(One(G)),true); 4122 SetCanEasilySortElements(FamilyObj(One(G)),true); 4123 4124 r:=Range(p); 4125 SetSize(r,Size(H)); 4126 p:= GroupHomomorphismByImagesNC(G,r,GeneratorsOfGroup(G), 4127 List(GeneratorsOfGroup(H),i->Image(p,i))); 4128 SetIsInjective(p,true); 4129 i:=NrMovedPoints(Range(p)); 4130 if i<NrMovedPoints(H) then 4131 Info(InfoFpGroup,1,"improved to degree ",i); 4132 fi; 4133 SetIsomorphismPermGroup(G,p); 4134 return p; 4135end); 4136 4137InstallMethod(IsomorphismPermGroup,"for full finitely presented groups", 4138 true, [ IsGroup and IsSubgroupFpGroup and IsGroupOfFamily ], 4139 # as this method may be called to compare elements we must get higher 4140 # than a method for finite groups (via right multiplication). 4141 {} -> RankFilter(IsFinite and IsGroup), 4142function(G) 4143 return IsomorphismPermGroupOrFailFpGroup(G,10^30); 4144end); 4145 4146InstallMethod(IsomorphismPermGroup,"for subgroups of finitely presented groups", 4147 true, [ IsGroup and IsSubgroupFpGroup ], 4148 # even if we don't demand to know to be finite, we have to assume it. 4149 {} -> RankFilter(IsFinite and IsGroup), 4150function(G) 4151local P,imgs,hom; 4152 Size(G); 4153 P:=FamilyObj(G)!.wholeGroup; 4154 if (HasSize(P) and Size(P)<10^6) or HasIsomorphismPermGroup(P) then 4155 hom:=IsomorphismPermGroup(P); 4156 imgs:=List(GeneratorsOfGroup(G),i->Image(hom,i)); 4157 hom:=GroupHomomorphismByImagesNC(G,Subgroup(Range(hom),imgs), 4158 GeneratorsOfGroup(G),imgs); 4159 else 4160 hom:=IsomorphismFpGroup(P); 4161 hom:=hom*IsomorphismPermGroup(Image(hom)); 4162 fi; 4163 SetIsBijective(hom,true); 4164 return hom; 4165end); 4166 4167InstallOtherMethod(IsomorphismPermGroup,"for family of fp words",true, 4168 [IsElementOfFpGroupFamily],0, 4169function(fam) 4170 # use the full group 4171 return IsomorphismPermGroup(CollectionsFamily(fam)!.wholeGroup); 4172end); 4173 4174InstallMethod(IsomorphismPcGroup, 4175 "for finitely presented groups that know their size", 4176 true, [ IsGroup and IsSubgroupFpGroup and IsFinite and HasSize],0, 4177function(G) 4178local s, a, hom; 4179 s:=Size(G); 4180 if not (HasIsWholeFamily(G) and IsWholeFamily(G)) then 4181 a:=IsomorphismFpGroup(G); 4182 G:=Image(a); 4183 SetSize(G,s); 4184 else 4185 a:=fail; 4186 fi; 4187 hom:=EpimorphismSolvableQuotient(G,s); 4188 if Size(Image(hom))<>s then 4189 Error("group is not solvable"); 4190 else 4191 SetIsInjective(hom, true); 4192 fi; 4193 if a<>fail then 4194 hom:=a*hom; 4195 fi; 4196 return hom; 4197end); 4198 4199############################################################################# 4200## 4201#M FactorCosetAction( <G>, <U> ) 4202## 4203InstallMethod(FactorCosetAction,"for full fp group on subgroup", 4204 IsIdenticalObj,[IsSubgroupFpGroup and IsGroupOfFamily,IsSubgroupFpGroup], 4205 5,# we want this to be better than the method below for the subgroup in 4206 # quotient rep. 4207function(G,U) 4208local t; 4209 t:=CosetTableInWholeGroup(U); 4210 t:=List(t{[1,3..Length(t)-1]},PermList); 4211 return GroupHomomorphismByImagesNC( G, GroupByGenerators( t ), 4212 GeneratorsOfGroup( G ), t ); 4213end); 4214 4215InstallMethod(FactorCosetAction,"for subgroups of an fp group", 4216 IsIdenticalObj,[IsSubgroupFpGroup,IsSubgroupFpGroup],0, 4217function(G,U) 4218 return FactorCosetAction(G,AsSubgroupOfWholeGroupByQuotient(U)); 4219end); 4220 4221InstallMethod(FactorCosetAction,"subgrp in quotient Rep", IsIdenticalObj, 4222 [IsSubgroupFpGroup, 4223 IsSubgroupFpGroup and IsSubgroupOfWholeGroupByQuotientRep],0, 4224function(G,U) 4225local gens,q,h; 4226 # map the generators of G in the quotient 4227 gens:=GeneratorsOfGroup(G); 4228 gens:=List(gens,UnderlyingElement); 4229 q:=U!.quot; 4230 gens:=List(gens,i->MappedWord(i,FreeGeneratorsOfWholeGroup(U), 4231 GeneratorsOfGroup(q))); 4232 h:=FactorCosetAction(SubgroupNC(q,gens),U!.sub); 4233 gens:=List(gens,i->ImagesRepresentative(h,i)); 4234 return GroupHomomorphismByImagesNC( G, Range(h), 4235 GeneratorsOfGroup( G ), gens ); 4236end); 4237 4238 4239############################################################################# 4240## 4241#F SubgroupGeneratorsCosetTable(<freegens>,<fprels>,<table>) 4242## determines subgroup generators from free generators, relators and 4243## coset table. It returns elements of the free group! 4244## 4245InstallGlobalFunction( SubgroupGeneratorsCosetTable, 4246 function ( freegens, fprels, table ) 4247 local gens, # generators for the subgroup 4248 rels, # representatives for the relators 4249 relsGen, # relators sorted by start generator 4250 deductions, # deduction queue 4251 ded, # index of current deduction in above 4252 nrdeds, # current number of deductions in above 4253 nrgens, 4254 cos, # loop variable for coset 4255 i, gen, inv, # loop variables for generator 4256 g, # loop variable for generator col 4257 triple, # loop variable for relators as triples 4258 app, # arguments list for 'ApplyRel' 4259 x, y, c; 4260 4261 nrgens := 2 * Length( freegens ) + 1; 4262 gens := []; 4263 4264 table:=List(table,ShallowCopy); 4265 # make all entries in the table negative 4266 for cos in [ 1 .. IndexCosetTab( table ) ] do 4267 for gen in table do 4268 if 0 < gen[cos] then 4269 gen[cos] := -gen[cos]; 4270 fi; 4271 od; 4272 od; 4273 4274 # make the rows for the relators and distribute over relsGen 4275 rels := RelatorRepresentatives( fprels ); 4276 relsGen := RelsSortedByStartGen( freegens, rels, table ); 4277 4278 # make the structure that is passed to 'ApplyRel' 4279 app := ListWithIdenticalEntries(4,0); 4280 4281 # run over all the cosets 4282 cos := 1; 4283 while cos <= IndexCosetTab( table ) do 4284 4285 # run through all the rows and look for undefined entries 4286 for i in [1..Length(freegens)] do 4287 gen := table[2*i-1]; 4288 4289 if gen[cos] < 0 then 4290 4291 inv := table[2*i]; 4292 4293 # make the Schreier generator for this entry 4294 x := One(freegens[1]); 4295 c := cos; 4296 while c <> 1 do 4297 g := nrgens - 1; 4298 y := nrgens - 1; 4299 while 0 < g do 4300 if AbsInt(table[g][c]) <= AbsInt(table[y][c]) then 4301 y := g; 4302 fi; 4303 g := g - 2; 4304 od; 4305 x := freegens[ y/2 ] * x; 4306 c := AbsInt(table[y][c]); 4307 od; 4308 x := x * freegens[ i ]; 4309 c := AbsInt( gen[ cos ] ); 4310 while c <> 1 do 4311 g := nrgens - 1; 4312 y := nrgens - 1; 4313 while 0 < g do 4314 if AbsInt(table[g][c]) <= AbsInt(table[y][c]) then 4315 y := g; 4316 fi; 4317 g := g - 2; 4318 od; 4319 x := x * freegens[ y/2 ]^-1; 4320 c := AbsInt(table[y][c]); 4321 od; 4322 if x <> One(x) then 4323 Add( gens, x ); 4324 fi; 4325 4326 # define a new coset 4327 gen[cos] := - gen[cos]; 4328 inv[ gen[cos] ] := cos; 4329 4330 # set up the deduction queue and run over it until it's empty 4331 deductions := [ [i,cos] ]; 4332 nrdeds := 1; 4333 ded := 1; 4334 while ded <= nrdeds do 4335 4336 # apply all relators that start with this generator 4337 for triple in relsGen[deductions[ded][1]] do 4338 app[1] := triple[3]; 4339 app[2] := deductions[ded][2]; 4340 app[3] := -1; 4341 app[4] := app[2]; 4342 if ApplyRel( app, triple[2] ) then 4343 triple[2][app[1]][app[2]] := app[4]; 4344 triple[2][app[3]][app[4]] := app[2]; 4345 nrdeds := nrdeds + 1; 4346 deductions[nrdeds] := [triple[1][app[1]],app[2]]; 4347 fi; 4348 od; 4349 4350 ded := ded + 1; 4351 od; 4352 4353 fi; 4354 od; 4355 4356 cos := cos + 1; 4357 od; 4358 4359 # return the generators 4360 return gens; 4361end ); 4362 4363# methods to compute subgroup generators. We have to be careful that 4364# computed generators and computed augmented coset tables are consistent. 4365 4366 4367############################################################################# 4368## 4369#M GeneratorsOfGroup 4370## 4371InstallMethod(GeneratorsOfGroup,"subgroup fp, via augmented coset table",true, 4372 [IsSubgroupFpGroup],0, 4373function(U) 4374 # Compute the augmented coset table. This will set the generators 4375 # component 4376 AugmentedCosetTableInWholeGroup(U); 4377 return GeneratorsOfGroup(U); 4378end); 4379 4380 4381############################################################################# 4382## 4383#M IntermediateSubgroups(<G>,<U>) 4384## 4385InstallMethod(IntermediateSubgroups,"fp group via quotient subgroups", 4386 IsIdenticalObj, [IsSubgroupFpGroup,IsSubgroupFpGroup],0, 4387function(G,U) 4388local A,B,Q,gens,int,i,fam; 4389 U:=AsSubgroupOfWholeGroupByQuotient(U); 4390 Q:=U!.quot; 4391 A:=U!.sub; 4392 # generators of G in permutation image 4393 gens:=List(GeneratorsOfGroup(G),elm-> 4394 MappedWord(UnderlyingElement(elm), 4395 FreeGeneratorsOfWholeGroup(U),GeneratorsOfGroup(Q))); 4396 B:=Subgroup(Q,gens); 4397 int:=IntermediateSubgroups(B,A); 4398 B:=[]; 4399 fam:=FamilyObj(U); 4400 for i in int.subgroups do 4401 Add(B,SubgroupOfWholeGroupByQuotientSubgroup(fam,Q,i)); 4402 od; 4403 return rec(subgroups:=B,inclusions:=int.inclusions); 4404end); 4405 4406# test whether abelian invariants can be mapped 4407InstallGlobalFunction(CanMapFiniteAbelianInvariants,function(from,to) 4408local pf,pt,fp,tp,p,i,f; 4409 # first get primes and then run for each prime 4410 pf:=Union(List(from,Factors)); 4411 pt:=Union(List(to,Factors)); 4412 if not IsSubset(pf,pt) then 4413 return false; 4414 fi; 4415 for p in pf do 4416 fp:=[]; 4417 for i in from do 4418 f:=Filtered(Factors(i),x->x=p); 4419 if Length(f)>0 then 4420 Add(fp,Product(f)); 4421 fi; 4422 od; 4423 tp:=[]; 4424 for i in to do 4425 f:=Filtered(Factors(i),x->x=p); 4426 if Length(f)>0 then 4427 Add(tp,Product(f)); 4428 fi; 4429 od; 4430 #Print(fp,tp,"\n"); 4431 if Length(fp)<Length(tp) then return false;fi; 4432 Sort(fp);Sort(tp); 4433 fp:=Reversed(fp); 4434 tp:=Reversed(tp); 4435 if ForAny([1..Length(tp)],i->fp[i]<tp[i]) then 4436 return false; 4437 fi; 4438 od; 4439 return true; 4440end); 4441 4442 4443############################################################################# 4444## 4445#F GQuotients(<F>,<G>) . . . . . epimorphisms from F onto G up to conjugacy 4446## 4447InstallMethod(GQuotients,"whole fp group to finite group",true, 4448 [IsSubgroupFpGroup and IsWholeFamily,IsGroup and IsFinite],1, 4449function (F,G) 4450local Fgens, # generators of F 4451 rels, # power relations 4452 cl, # classes of G 4453 imgo,imgos,sel, 4454 e, # excluded orders (for which the presentation collapses 4455 u, # trial generating set's group 4456 pimgs, # possible images 4457 val, # its value 4458 i,j, # loop 4459 ma, 4460 dp,emb1,emb2, # direct product 4461 sameKernel, 4462 A,bigG,Gmap,opt, 4463 h; # epis 4464 4465 Fgens:=GeneratorsOfGroup(F); 4466 4467 if Length(Fgens)=0 then 4468 if Size(G)>1 then 4469 return []; 4470 else 4471 return [GroupHomomorphismByImagesNC(F,G,[],[])]; 4472 fi; 4473 fi; 4474 4475 if Size(G)=1 then 4476 return [GroupHomomorphismByImagesNC(F,G,Fgens, 4477 List(Fgens,i->One(G)))]; 4478 elif Length(Fgens)=1 then 4479 Info(InfoMorph,1,"Cyclic group: only one quotient possible"); 4480 # a cyclic group has at most one quotient 4481 4482 # force size (in abelian invariants) 4483 e:=AbelianInvariants(F); 4484 4485 if not IsCyclic(G) or (IsFinite(F) and not IsInt(Size(F)/Size(G))) then 4486 return []; 4487 else 4488 # get the cyclic gens 4489 h:=First(AsList(G),i->Order(i)=Size(G)); 4490 # just map them 4491 return [GroupHomomorphismByImagesNC(F,G,Fgens,[h])]; 4492 fi; 4493 fi; 4494 4495 # try abelian part first 4496 if not IsPerfectGroup(G) then 4497 ma:=ShallowCopy(AbelianInvariants(F)); 4498 for i in [1..Length(ma)] do 4499 if ma[i]=0 then ma[i]:=Size(G);fi; # the largest interesting bit 4500 od; 4501 if CanMapFiniteAbelianInvariants(ma,AbelianInvariants(G))=false then 4502 return []; 4503 fi; 4504 fi; 4505 4506 bigG:=G; # generic settings 4507 Gmap:=fail; 4508 4509 # try to reduce with automorphisms 4510 if IsSolvableGroup(G) and Length(Fgens)>2 4511 and ValueOption("noauto")<>true then 4512 A:=AutomorphismGroup(G); 4513 if (IsSolvableGroup(A) or Size(G)<10000) and 4514 not ForAll(GeneratorsOfGroup(A),IsInnerAutomorphism) then 4515 4516 # could decide based on HasGeneralizedPcgs...SemidirectProduct(A,G); 4517 i:=IsomorphismPermGroup(A); # IsomorphismPc might be composition 4518 bigG:=SemidirectProduct(Image(i),InverseGeneralMapping(i),G); 4519 Gmap:=Embedding(bigG,2); 4520 G:=Image(Gmap); 4521 Gmap:=InverseGeneralMapping(Gmap); 4522 fi; 4523 fi; 4524 4525 cl:=Filtered(ConjugacyClasses(bigG),x->Representative(x) in G); 4526 4527 # search relators in only one generator 4528 rels:=ListWithIdenticalEntries(Length(Fgens),false); 4529 4530 for i in RelatorsOfFpGroup(F) do 4531 if NrSyllables(i)=1 then 4532 # found relator in only one generator 4533 val:=Position(List(FreeGeneratorsOfFpGroup(F),j->GeneratorSyllable(j,1)), 4534 GeneratorSyllable(i,1)); 4535 u:=AbsInt(ExponentSyllable(i,1)); 4536 if rels[val]=false then 4537 rels[val]:=u; 4538 else 4539 rels[val]:=Gcd(rels[val],u); 4540 fi; 4541 fi; 4542 od; 4543 4544 4545 # exclude orders 4546 e:=Set(List(cl,i->Order(Representative(i)))); 4547 e:=List(Fgens,i->ShallowCopy(e)); 4548 for i in [1..Length(Fgens)] do 4549 if rels[i]<>false then 4550 e[i]:=Filtered(e[i],j->rels[i]<>j and IsInt(rels[i]/j)); 4551 fi; 4552 od; 4553 e:=ExcludedOrders(F,e); 4554 4555 # find potential images 4556 pimgs:=[]; 4557 4558 for i in [1..Length(Fgens)] do 4559 if rels[i]<>false then 4560 Info(InfoMorph,2,"generator order must divide ",rels[i]); 4561 u:=Filtered(cl,j->IsInt(rels[i]/Order(Representative(j)))); 4562 else 4563 Info(InfoMorph,2,"no restriction on generator order"); 4564 u:=ShallowCopy(cl); 4565 fi; 4566 u:=Filtered(u,j->not Order(Representative(j)) in e[i]); 4567 Add(pimgs,u); 4568 od; 4569 4570 val:=Product(pimgs,i->Sum(i,Size)); 4571 Info(InfoMorph,1,List(pimgs,Length)," possibilities, Value: ",val); 4572 4573 val:=1; 4574 opt:=rec(gens:=Fgens,to:=bigG, 4575 from:=F, free:=FreeGeneratorsOfFpGroup(F), 4576 rels:=List(RelatorsOfFpGroup(F),i->[i,1])); 4577 4578 if G=bigG then 4579 val:=val+4; # surjective 4580 else 4581 opt.condition:=hom->Size(Image(hom))=Size(G); 4582 fi; 4583 4584 if ValueOption("findall")<>false then 4585 val:=val+8; # onlyone 4586 fi; 4587 h:=MorClassLoop(bigG,pimgs,opt,val); 4588 if not IsList(h) then h:=[h];fi; 4589 4590 #if ForAny(h,x->opt.condition(x)=false) then Error("CRAP");fi; 4591 4592 Info(InfoMorph,1,"Found ",Length(h)," maps, test kernels"); 4593 4594 dp:=DirectProduct(G,G); 4595 emb1:=Embedding(dp,1); 4596 emb2:=Embedding(dp,2); 4597 sameKernel:=function(m1,m2) 4598 local a; 4599 m1:=MappingGeneratorsImages(m1)[2]; 4600 m2:=MappingGeneratorsImages(m2)[2]; 4601 a:=List([1..Length(Fgens)],i-> 4602 ImagesRepresentative(emb1,m1[i])*ImagesRepresentative(emb2,m2[i])); 4603 return Size(SubgroupNC(dp,a))=Size(G); 4604 end; 4605 4606 imgos:=[]; 4607 cl:=[]; 4608 u:=[]; 4609 for i in h do 4610 imgo:=List(Fgens,j->Image(i,j)); 4611 imgo:=Concatenation(imgo,MorFroWords(imgo)); 4612 # fingerprint: Order of fros and commuting indication 4613 imgo:=Concatenation(List(imgo,Order), 4614 Concatenation(List([1..Length(imgo)], 4615 a->Filtered([a+1..Length(imgo)],x->IsOne(Comm(imgo[a],imgo[x])))))); 4616 sel:=Filtered([1..Length(imgos)],i->imgos[i]=imgo); 4617 #Info(InfoMorph,3,"|sel|=",Length(sel)); 4618 if Length(sel)=0 then 4619 Add(imgos,imgo); 4620 Add(cl,i); 4621 else 4622 for j in sel do 4623 if not IsBound(u[j]) then 4624 u[j]:=KernelOfMultiplicativeGeneralMapping(cl[j]); 4625 fi; 4626 od; 4627 4628 #e:=KernelOfMultiplicativeGeneralMapping(i); 4629 if not ForAny(cl{sel},x->sameKernel(x,i)) then 4630 Add(imgos,imgo); 4631 Add(cl,i); 4632 #u[Length(cl)]:=e; 4633 fi; 4634 4635 fi; 4636 od; 4637 4638 Info(InfoMorph,1,Length(h)," found -> ",Length(cl)," homs"); 4639 if Gmap<>fail then 4640 cl:=List(cl,x->x*Gmap); 4641 fi; 4642 return cl; 4643end); 4644 4645InstallMethod(GQuotients,"subgroup of an fp group",true, 4646 [IsSubgroupFpGroup,IsGroup and IsFinite],1, 4647function (F,G) 4648local e,fpi; 4649 fpi:=IsomorphismFpGroup(F); 4650 e:=GQuotients(Range(fpi),G); 4651 return List(e,i->fpi*i); 4652end); 4653 4654# new style conversion functions 4655BindGlobal("GroupwordToMonword",function(id,w) 4656local m,i; 4657 m:=[]; 4658 for i in LetterRepAssocWord(w) do 4659 if i>0 then 4660 Add(m,2*i-1); 4661 else 4662 Add(m,-2*i); 4663 fi; 4664 od; 4665 return AssocWordByLetterRep(FamilyObj(id),m); 4666end); 4667 4668BindGlobal("MonwordToGroupword",function(id,w) 4669local g,i,x; 4670 g:=[]; 4671 for i in LetterRepAssocWord(w) do 4672 if IsOddInt(i) then 4673 x:=(i+1)/2; 4674 else 4675 x:=-i/2; 4676 fi; 4677 # free cancellation 4678 if Length(g)>0 and x=-g[Length(g)] then 4679 Unbind(g[Length(g)]); 4680 else 4681 Add(g,x); 4682 fi; 4683 od; 4684 return AssocWordByLetterRep(FamilyObj(id),g); 4685end); 4686 4687################################################ 4688# Gpword2MSword 4689# Change a word in the free group into a word 4690# in the free monoid: Generator numbers doubled 4691# The first <shift> generators in the semigroup are used for identity elements 4692BindGlobal("Gpword2MSword",function(id, w,shift) 4693local 4694 wlist, # external rep of the word 4695 i; # loop variable 4696 4697 wlist:=LetterRepAssocWord(w); 4698 if Length(wlist) = 0 then # it is the identity 4699 return id; 4700 fi; 4701 wlist:=ShallowCopy(2*wlist); 4702 for i in [1..Length(wlist)] do 4703 if wlist[i]<0 then 4704 wlist[i]:=-wlist[i]-1; 4705 fi; 4706 od; 4707 return AssocWordByLetterRep(FamilyObj(id),wlist+shift); 4708end); 4709 4710################################################ 4711# MSword2gpword 4712# Change a word in the free monoid into a word 4713# in the free group monoid: Generator numbers halved 4714# The first <shift> generators in the semigroup are used for identity elements 4715BindGlobal("MSword2gpword",function( id, w,shift ) 4716local wlist, i,l; 4717 4718 wlist:=LetterRepAssocWord(w); 4719 if Length(wlist) = 0 then # it is the identity 4720 return id; 4721 fi; 4722 wlist:=ShallowCopy(1/2*(wlist-shift)); 4723 #zero entries correspond to identity elements (in semigroup case) 4724 4725 for i in [1..Length(wlist)] do 4726 if not IsInt(wlist[i]) then 4727 wlist[i]:=-wlist[i]-1/2; 4728 fi; 4729 od; 4730 4731 # free cancellation and removal of identities 4732 w:=[]; 4733 l:=0; 4734 i:=1; 4735 while i<=Length(wlist) do 4736 if wlist[i]<>0 then 4737 if l=0 or w[l]<>-wlist[i] then 4738 l:=l+1; 4739 w[l]:=wlist[i]; 4740 else 4741 l:=l-1; 4742 fi; 4743 fi; 4744 i:=i+1; 4745 od; 4746 if l<Length(w) then 4747 w:=w{[1..l]}; 4748 fi; 4749 4750 return AssocWordByLetterRep(FamilyObj(id),w); 4751end); 4752 4753############################################################################# 4754## 4755#M IsomorphismFpSemigroup( <G> ) 4756## 4757## for a finitely presented group. 4758## Returns an isomorphism to a finitely presented semigroup. 4759## 4760InstallMethod(IsomorphismFpSemigroup,"for fp groups", 4761 true, [IsFpGroup], 0, 4762function(g) 4763 4764 local i, rel, # loop variable 4765 freegp, # free group underlying g 4766 id, # identity of free group 4767 gensfreegp, # semigroup generators of the free group 4768 freesmg, # free semigroup on the generators gensfreegp 4769 gensfreesmg, # generators of freesmg 4770 idgen, # identity generator 4771 newrels, # relations 4772 rels, # relators of g 4773 smgrel, # relators transformed into relation in the semigroup 4774 semi, # fp semigroup 4775 isomfun, # the isomorphism function 4776 invfun, # the inverse isomorphism function 4777 gpword2semiword, 4778 smgword2gpword, 4779 gens, 4780 hom; 4781 4782 # first we create the fp semigroup 4783 4784 # get the free group underlying the fp group given 4785 freegp := FreeGroupOfFpGroup( g ); 4786 # and get its semigroup generators 4787 gensfreegp := List(GeneratorsOfSemigroup( freegp ),String); 4788 freesmg := FreeSemigroup(gensfreegp{[1..Length(gensfreegp)]}); 4789 4790 # now give names to the generators of freesmg 4791 gensfreesmg := GeneratorsOfSemigroup( freesmg ); 4792 idgen := gensfreesmg[1]; 4793 4794 # now relations that make the free smg into a group 4795 # first the ones concerning the identity 4796 newrels := [ [idgen*idgen,idgen] ]; 4797 for i in [ 2 .. Length(gensfreesmg) ] do 4798 Add(newrels, [idgen*gensfreesmg[i], gensfreesmg[i]]); 4799 Add(newrels, [gensfreesmg[i]*idgen, gensfreesmg[i]]); 4800 od; 4801 4802 # then relations gens * gens^-1 = idgen (and the other way around) 4803 for i in [2..Length(gensfreesmg)] do 4804 if IsOddInt( i ) then 4805 Add( newrels, [gensfreesmg[i]*gensfreesmg[i-1],idgen]); 4806 else 4807 Add( newrels, [gensfreesmg[i]*gensfreesmg[i+1],idgen]); 4808 fi; 4809 od; 4810 4811 # now add the relations from the fp group to newrels 4812 # We have to transform relators into relations in the free semigroup 4813 # (in particular we have to transform the words in the free 4814 # group to words in the free semigroup) 4815 rels := RelatorsOfFpGroup( g ); 4816 for rel in rels do 4817 smgrel:= [Gpword2MSword(idgen, rel,1), idgen ]; 4818 Add( newrels, smgrel ); 4819 od; 4820 4821 # finally create the fp semigroup 4822 semi := FactorFreeSemigroupByRelations( freesmg, newrels); 4823 gens := GeneratorsOfSemigroup( semi ); 4824 4825 isomfun := x -> ElementOfFpSemigroup( FamilyObj(gens[1] ), 4826 Gpword2MSword( idgen, UnderlyingElement(x),1 )); 4827 4828 # Further addition from Chris Wensley 4829 id := One( freegp ); 4830 invfun := x->ElementOfFpGroup(FamilyObj(One(g)), 4831 MSword2gpword( id, UnderlyingElement( x ),1 ) ); 4832 # CW - end 4833 4834 hom:=MagmaIsomorphismByFunctionsNC(g, semi, isomfun, invfun); 4835 return hom; 4836end); 4837 4838############################################################################# 4839## 4840#M IsomorphismFpMonoid( <G> ) 4841## 4842## for a free group or a finitely presented group. 4843## Returns an isomorphism to a finitely presented monoid. 4844## If the option ``relations'' is given, it must be a list of relations 4845## given by words in the free group. The monoid then is created with these 4846## relations (plus the ``inverse'' relations). 4847## 4848 4849InstallGlobalFunction("IsomorphismFpMonoidGeneratorsFirst", 4850function(g) 4851local freegp, gens, mongens, s, t, p, freemon, gensmon, id, newrels, 4852 rels, w, monrel, mon, monfam, isomfun, idg, invfun, hom, i, j, rel; 4853 4854 # can we use attribute? 4855 if HasIsomorphismFpMonoid(g) and IsBound(IsomorphismFpMonoid(g)!.type) and 4856 IsomorphismFpMonoid(g)!.type=1 then 4857 return IsomorphismFpMonoid(g); 4858 fi; 4859 4860 # first we create the fp mon 4861 4862 # get the free group underlying the fp group given 4863 freegp := FreeGroupOfFpGroup( g ); 4864 gens:=GeneratorsOfGroup(g); 4865 4866 # make monoid generators. Inverses are chosen to be bigger than original 4867 # elements 4868 mongens:=[]; 4869 for i in gens do 4870 s:=String(i); 4871 Add(mongens,s); 4872 if ForAll(s,x->x in CHARS_UALPHA or x in CHARS_LALPHA) then 4873 # inverse: change casification 4874 t:=""; 4875 for j in [1..Length(s)] do 4876 p:=Position(CHARS_LALPHA,s[j]); 4877 if p<>fail then 4878 Add(t,CHARS_UALPHA[p]); 4879 else 4880 p:=Position(CHARS_UALPHA,s[j]); 4881 Add(t,CHARS_LALPHA[p]); 4882 fi; 4883 od; 4884 s:=t; 4885 else 4886 s:=Concatenation(s,"^-1"); 4887 fi; 4888 Add(mongens,s); 4889 od; 4890 4891 freemon:=FreeMonoid(mongens); 4892 gensmon:=GeneratorsOfMonoid( freemon); 4893 id:=Identity(freemon); 4894 newrels:=[]; 4895 # inverse relators 4896 for i in [1..Length(gens)] do 4897 Add(newrels,[gensmon[2*i-1]*gensmon[2*i],id]); 4898 Add(newrels,[gensmon[2*i]*gensmon[2*i-1],id]); 4899 od; 4900 4901 rels:=ValueOption("relations"); 4902 if rels=fail then 4903 # now add the relations from the fp group to newrels 4904 # We have to transform relators into relations in the free monoid 4905 # (in particular we have to transform the words in the free 4906 # group to words in the free monoid) 4907 rels := RelatorsOfFpGroup( g ); 4908 for rel in rels do 4909 w:=rel; 4910 #w:=LetterRepAssocWord(rel); 4911 #l:=QuoInt(Length(w)+1,2); 4912 #v:=[]; 4913 #for i in [Length(w),Length(w)-1..l+1] do 4914 # Add(v,-w[i]); 4915 #od; 4916 #w:=w{[1..l]}; 4917 w:=GroupwordToMonword(id,w); 4918 #v:=Gpword2MSword(idmon,AssocWordByLetterRep(FamilyObj(rel),v),0); 4919 #Info(InfoFpGroup,1,rel," : ",w," -> ",v); 4920 monrel:= [w,id]; 4921 Add( newrels, monrel ); 4922 od; 4923 else 4924 if not ForAll(Flat(rels),x->x in FreeGroupOfFpGroup(g)) then 4925 Info(InfoFpGroup,1,"Converting relation words into free group"); 4926 rels:=List(rels,i->List(i,UnderlyingElement)); 4927 fi; 4928 for rel in rels do 4929 Add(newrels,List(rel,x->GroupwordToMonword(id,x))); 4930 od; 4931 fi; 4932 4933 # finally create the fp monoid 4934 mon := FactorFreeMonoidByRelations( freemon, newrels); 4935 gens := GeneratorsOfMonoid( mon); 4936 monfam := FamilyObj(Representative(mon)); 4937 4938 isomfun := x -> ElementOfFpMonoid( monfam, 4939 GroupwordToMonword( id, UnderlyingElement(x) )); 4940 4941 idg := One( freegp ); 4942 invfun := x -> ElementOfFpGroup( FamilyObj(One(g)), 4943 MonwordToGroupword( idg, UnderlyingElement( x ) ) ); 4944 hom:=MagmaIsomorphismByFunctionsNC(g, mon, isomfun, invfun); 4945 hom!.type:=1; 4946 if not HasIsomorphismFpMonoid(g) then 4947 SetIsomorphismFpMonoid(g,hom); 4948 fi; 4949 return hom; 4950end); 4951 4952InstallMethod(IsomorphismFpMonoid,"for an fp group", 4953 true, [IsFpGroup], 0, IsomorphismFpMonoidGeneratorsFirst); 4954 4955InstallGlobalFunction("IsomorphismFpMonoidInversesFirst", 4956function(g) 4957 4958 local i, rel, # loop variable 4959 freegp, # free group underlying g 4960 id, # identity of free group 4961 gensfreegp, # semigroup generators of the free group 4962 freemon, # free monoid on the generators gensfreegp 4963 gensfreemon, # generators of freemon 4964 idmon, # identity generator 4965 newrels, # relations 4966 rels, # relators of g 4967 monrel, # relators transformed into relation in the monoid 4968 mon , # fp monoid 4969 isomfun, # the isomorphism function 4970 invfun, # the inverse isomorphism function 4971 monfam, # the family of the monoid's elements 4972 gens, 4973 l,v,w, 4974 hom; 4975 4976 # can we use attribute? 4977 if HasIsomorphismFpMonoid(g) and IsBound(IsomorphismFpMonoid(g)!.type) and 4978 IsomorphismFpMonoid(g)!.type=0 then 4979 return IsomorphismFpMonoid(g); 4980 fi; 4981 4982 # first we create the fp mon 4983 4984 # get the free group underlying the fp group given 4985 freegp := FreeGroupOfFpGroup( g ); 4986 # and get its monoid generators 4987 gensfreegp := List(GeneratorsOfMonoid( freegp ),String); 4988 freemon := FreeMonoid(gensfreegp); 4989 4990 # now give names to the generators of freemon 4991 gensfreemon := GeneratorsOfMonoid( freemon); 4992 # and to its identity 4993 idmon := Identity(freemon); 4994 4995 # now relations that make the free mon into a group 4996 # ie relations gens * gens^-1 = idmon(and the other way around) 4997 newrels := []; 4998 for i in [1..Length(gensfreemon)] do 4999 if IsOddInt( i ) then 5000 Add( newrels, [gensfreemon[i]*gensfreemon[i+1],idmon]); 5001 else 5002 Add( newrels, [gensfreemon[i]*gensfreemon[i-1],idmon]); 5003 fi; 5004 od; 5005 5006 # now add the relations from the fp group to newrels 5007 rels:=ValueOption("relations"); 5008 if rels=fail then 5009 5010 # We have to transform relators into relations in the free monoid 5011 # (in particular we have to transform the words in the free 5012 # group to words in the free monoid) 5013 rels := RelatorsOfFpGroup( g ); 5014 for rel in rels do 5015 w:=LetterRepAssocWord(rel); 5016 l:=QuoInt(Length(w)+1,2); 5017 v:=[]; 5018 for i in [Length(w),Length(w)-1..l+1] do 5019 Add(v,-w[i]); 5020 od; 5021 w:=w{[1..l]}; 5022 w:=Gpword2MSword(idmon,AssocWordByLetterRep(FamilyObj(rel),w),0); 5023 v:=Gpword2MSword(idmon,AssocWordByLetterRep(FamilyObj(rel),v),0); 5024 Info(InfoFpGroup,1,rel," : ",w," -> ",v); 5025 monrel:= [w,v]; 5026 Add( newrels, monrel ); 5027 od; 5028 else 5029 if not ForAll(Flat(rels),x->x in FreeGroupOfFpGroup(g)) then 5030 Info(InfoFpGroup,1,"Converting relation words into free group"); 5031 rels:=List(rels,i->List(i,UnderlyingElement)); 5032 fi; 5033 for rel in rels do 5034 Add(newrels,List(rel,x->Gpword2MSword(idmon,x,0))); 5035 od; 5036 fi; 5037 5038 # finally create the fp monoid 5039 mon := FactorFreeMonoidByRelations( freemon, newrels); 5040 gens := GeneratorsOfMonoid( mon); 5041 monfam := FamilyObj(Representative(mon)); 5042 5043 isomfun := x -> ElementOfFpMonoid( monfam, 5044 Gpword2MSword( idmon, UnderlyingElement(x),0 )); 5045 5046 id := One( freegp ); 5047 invfun := x -> ElementOfFpGroup( FamilyObj(One(g)), 5048 MSword2gpword( id, UnderlyingElement( x ),0 ) ); 5049 hom:=MagmaIsomorphismByFunctionsNC(g, mon, isomfun, invfun); 5050 hom!.type:=0; 5051 if not HasIsomorphismFpMonoid(g) then 5052 SetIsomorphismFpMonoid(g,hom); 5053 fi; 5054 return hom; 5055end); 5056 5057InstallGlobalFunction(SetReducedMultiplication,function(o) 5058local fam; 5059 fam:=FamilyObj(One(o)); 5060 fam!.reduce:=true; # turn on reduction 5061 # force determination of the attribute 5062 FpElementNFFunction(fam); 5063end); 5064 5065InstallMethod(FpElementNFFunction,true,[IsElementOfFpGroupFamily],0, 5066# default reduction -- 5067function(fam) 5068local iso,k,id,f; 5069 # first try whether the group is ``small'' 5070 iso:=FPFaithHom(fam); 5071 if iso<>fail and Size(Image(iso))<50000 then 5072 k:=ImagesSource(iso); 5073 #return function(w) 5074 # if not w in FreeGroupOfFpGroup(Source(iso)) then Error("flasch");fi; 5075 # w:=ElementOfFpGroup(fam,w); 5076 # Print("wa=",w,"\n"); 5077 # w:=ImageElm(iso,w); 5078 # Print("wb=",w,"\n"); 5079 # w:=Factorization(k,w); 5080 # Print("wc=",w,"\n"); 5081 # return UnderlyingElement(w); 5082 #end; 5083 return w->UnderlyingElement(Factorization(k,Image(iso,ElementOfFpGroup(fam,w)))); 5084 fi; 5085 iso:=IsomorphismFpMonoidGeneratorsFirst(CollectionsFamily(fam)!.wholeGroup); 5086 f:=FreeMonoidOfFpMonoid(Range(iso)); 5087 k:=ReducedConfluentRewritingSystem(Range(iso), 5088 BasicWreathProductOrdering(f,GeneratorsOfMonoid(f))); 5089 id:=UnderlyingElement(Image(iso,One(fam))); 5090 return w->MonwordToGroupword(UnderlyingElement(One(fam)), 5091 ReducedForm(k,GroupwordToMonword(id,w))); 5092end); 5093 5094############################################################################# 5095## 5096#M ViewObj(<G>) 5097## 5098InstallMethod(ViewObj,"fp group",true,[IsSubgroupFpGroup], 5099 10,# to override the pure `Size' method 5100function(G) 5101 if IsFreeGroup(G) then TryNextMethod();fi; 5102 if IsGroupOfFamily(G) then 5103 Print("<fp group"); 5104 if HasSize(G) then 5105 Print(" of size ",Size(G)); 5106 fi; 5107 if Length(GeneratorsOfGroup(G)) > GAPInfo.ViewLength * 10 then 5108 Print(" with ",Length(GeneratorsOfGroup(G))," generators>"); 5109 else 5110 Print(" on the generators ",GeneratorsOfGroup(G),">"); 5111 fi; 5112 else 5113 Print("Group("); 5114 if HasGeneratorsOfGroup(G) then 5115 if not IsBound(G!.gensWordLengthSum) then 5116 G!.gensWordLengthSum:=Sum(List(GeneratorsOfGroup(G), 5117 i->Length(UnderlyingElement(i)))); 5118 fi; 5119 if G!.gensWordLengthSum <= GAPInfo.ViewLength * 30 then 5120 Print(GeneratorsOfGroup(G)); 5121 else 5122 Print("<",Length(GeneratorsOfGroup(G))," generators>"); 5123 fi; 5124 else 5125 Print("<fp, no generators known>"); 5126 fi; 5127 Print(")"); 5128 fi; 5129end); 5130 5131############################################################################# 5132## 5133#M ExcludedOrders(<G>) 5134## 5135InstallMethod(StoredExcludedOrders,"fp group",true, 5136 [IsSubgroupFpGroup and 5137 # for each gen: first entry: excluded orders, second: tested orders 5138 # (superset) 5139 IsGroupOfFamily],0,G->List(GeneratorsOfGroup(G),x->[[],[]])); 5140 5141InstallGlobalFunction(ExcludedOrders, 5142function(arg) 5143local f,a,b,i,j,gens,tstord,excl,p,s; 5144 f:=arg[1]; 5145 s:=StoredExcludedOrders(f); 5146 gens:=FreeGeneratorsOfFpGroup(f); 5147 if Length(arg)>1 then 5148 tstord:=List(arg[2],ShallowCopy); 5149 else 5150 tstord:=List(gens,i->[1]); 5151 for i in RelatorsOfFpGroup(f) do 5152 for j in [1..NumberSyllables(i)] do 5153 a:=AbsInt(ExponentSyllable(i,j)); 5154 if a>1 then 5155 UniteSet(tstord[GeneratorSyllable(i,j)],DivisorsInt(a)); 5156 fi; 5157 od; 5158 od; 5159 fi; 5160 5161 # take those orders we know already to be true 5162 excl:=List([1..Length(gens)],i->ShallowCopy(Intersection(tstord[i],s[i][1]))); 5163 5164 for i in [1..Length(tstord)] do 5165 # remove orders which have been tested once 5166 tstord[i]:=Difference(tstord[i],s[i][2]); 5167 od; 5168 5169 for i in [1..Length(gens)] do 5170 for j in Reversed(tstord[i]) do 5171 AddSet(s[i][2],j); 5172 if ForAny(excl[i],k->IsInt(k/j)) then 5173 # we know it even with a power => is true 5174 AddSet(excl[i],j); 5175 AddSet(s[i][1],j); 5176 else 5177 p:=PresentationFpGroup(f,0); 5178 AddRelator(p,p!.generators[i]^j); 5179 TzInitGeneratorImages(p); 5180 TzGoGo(p); 5181 if Length(p!.generators)=0 then 5182 AddSet(excl[i],j); 5183 AddSet(s[i][1],j); 5184 else 5185 if i=1 then 5186 b:=[gens[2]]; 5187 else 5188 b:=[gens[1]]; 5189 fi; 5190 a:=CosetTableFromGensAndRels(gens, 5191 Concatenation(RelatorsOfFpGroup(f),[gens[i]^j]),b: 5192 max:=15999,silent); 5193 if IsList(a) and Length(a[1])=1 then 5194 a:=FpGroupPresentation(p); 5195 b:=List(b,x->MappedWord(x,FreeGeneratorsOfFpGroup(f),TzImagesOldGens(p))); 5196 b:=List(b,x->MappedWord(x,p!.generators,GeneratorsOfGroup(a))); 5197 # now we can try the size. Ensure we use the generator we know 5198 a:=NEWTC_CosetEnumerator(FreeGeneratorsOfFpGroup(a),RelatorsOfFpGroup(a), 5199 List(b,UnderlyingElement), true, false : cyclic := true, 5200 limit := 50000 ); 5201 if NEWTC_CyclicSubgroupOrder(a)=1 then 5202 AddSet(excl[i],j); 5203 AddSet(s[i][1],j); 5204 fi; 5205 fi; 5206 fi; 5207 fi; 5208 od; 5209 od; 5210 return excl; 5211end); 5212 5213# redispatcher -- some group methods require finiteness 5214RedispatchOnCondition(CompositionSeries,true,[IsFpGroup],[IsFinite],0); 5215 5216InstallMethod(NormalClosureOp,"whole fp group with normal subgroup", 5217 IsIdenticalObj,[IsSubgroupFpGroup and IsWholeFamily,IsSubgroupFpGroup],0, 5218function(G,U) 5219 return SubgroupOfWholeGroupByCosetTable(FamilyObj(G), 5220 CosetTableNormalClosureInWholeGroup(U)); 5221end); 5222 5223InstallMethod(LowerCentralSeriesOfGroup,"fp group", 5224 true, [IsSubgroupFpGroup],0, 5225function(G) 5226local epi,q,lcs; 5227 epi:=EpimorphismNilpotentQuotient(G); 5228 q:=Image(epi); 5229 if ForAny(Collected(Factors(Size(q))),i->i[2]>1000) then 5230 # As this point is probably never reached, writing extra code for this 5231 # is not pressing... 5232 Error("Warning: Class was restricted, this might not be the full quotient"); 5233 fi; 5234 lcs:=LowerCentralSeriesOfGroup(q); 5235 return List(lcs,i->PreImage(epi,i)); 5236end); 5237 5238# this function might not terminate if there is an infinite index. 5239# for infinite index we'd need a nilpotent quotient 5240CoSuFp:=function(G,U) 5241local f,i,j,rels,H,iso,img,quo,hom; 5242 if not IsNormal(G,U) then 5243 TryNextMethod(); 5244 fi; 5245 # produce a quotient by forcing that U becomes central. The kernel is the 5246 # commutator group 5247 f:=FreeGroupOfFpGroup(G); 5248 rels:=ShallowCopy(RelatorsOfFpGroup(G)); 5249 for i in GeneratorsOfGroup(U) do 5250 i:=UnderlyingElement(i); 5251 for j in GeneratorsOfGroup(f) do 5252 Add(rels,Comm(j,i)); 5253 od; 5254 od; 5255 H:=f/rels; 5256 5257 # is the quotient already nilpotent? If yes, putting something central 5258 # below will keep it nilpotent 5259 quo:=G/U; 5260 if IsNilpotentGroup(quo) then 5261 # we run the NQ one class further 5262 iso:=EpimorphismNilpotentQuotient(H,Length(LowerCentralSeriesOfGroup(quo))); 5263 else 5264 # the factor is not nilpotent. So we go via a permutation rep. 5265 iso:=IsomorphismPermGroup(H); 5266 Size(H); # in older versions, IsomorphismPermGroup does not set the size. 5267 if IsSolvableGroup(Image(iso)) then 5268 iso:=IsomorphismPcGroup(H); 5269 fi; 5270 fi; 5271 5272 hom:=GroupHomomorphismByImagesNC(G,Image(iso),GeneratorsOfGroup(G), 5273 List(GeneratorsOfGroup(H),i->Image(iso,i))); 5274 return KernelOfMultiplicativeGeneralMapping(hom); 5275end; 5276 5277InstallMethod(CommutatorSubgroup,"whole fp group with normal subgroup", 5278 IsIdenticalObj,[IsSubgroupFpGroup and IsWholeFamily,IsSubgroupFpGroup],0, 5279 CoSuFp); 5280 5281InstallMethod(CommutatorSubgroup,"normal subgroup with whole fp group", 5282 IsIdenticalObj, [IsSubgroupFpGroup,IsSubgroupFpGroup and IsWholeFamily],0, 5283function(N,G) 5284 return CoSuFp(G,N); 5285end); 5286 5287# if neither is the full group we'll have to transfer in a new group 5288InstallMethod(CommutatorSubgroup,"normal subgroup with whole fp group", 5289 IsIdenticalObj, [IsSubgroupFpGroup,IsSubgroupFpGroup],0, 5290function(U,V) 5291local W,iso; 5292 if IndexInWholeGroup(U)>IndexInWholeGroup(V) then 5293 # swap 5294 W:=U;U:=V;V:=W; 5295 fi; 5296 if not IsSubgroup(U,V) or not IsNormal(U,V) then 5297 TryNextMethod(); 5298 fi; 5299 if Index(U,V)=1 then 5300 return DerivedSubgroup(U); 5301 fi; 5302 iso:=IsomorphismFpGroup(U); 5303 W:=CommutatorSubgroup(Image(iso),Image(iso,V)); 5304 return PreImage(iso,W); 5305end); 5306 5307############################################################################# 5308## 5309#M RightTransversal fp group 5310## 5311DeclareRepresentation( "IsRightTransversalFpGroupRep", 5312 IsRightTransversalRep, [ "group", "subgroup", "table", "iso","reps" ] ); 5313 5314InstallMethod(RightTransversalOp, "via coset table", 5315 IsIdenticalObj,[IsSubgroupFpGroup,IsSubgroupFpGroup],0, 5316function(OG,U) 5317local G,T,gens,g,reps,ng,index,i,j,ndef,n,iso; 5318 G:=OG; 5319 5320 # if G is not the whole group, we need to translate to a new fp group 5321 if HasIsWholeFamily(G) and IsWholeFamily(G) then 5322 iso:=IdentityMapping(G); 5323 else 5324 iso:=IsomorphismFpGroup(G); 5325 G:=Range(iso); 5326 fi; 5327 5328 # Find short representative words (in the image) 5329 # this code is thanks to Derek Holt 5330 T:=CosetTableInWholeGroup(ImagesSet(iso,U)); 5331 gens := []; 5332 for g in GeneratorsOfGroup(G) do 5333 Add(gens,g); Add(gens,g^-1); 5334 od; 5335 ng := Length(gens); 5336 index := IndexCosetTab(T); 5337 reps := [Identity(G)]; 5338 5339 if index=1 then 5340 # trivial case 5341 return Objectify( NewType( FamilyObj( OG ), 5342 IsRightTransversalFpGroupRep and IsList and 5343 IsDuplicateFreeList and IsAttributeStoringRep ), 5344 rec( group := OG, 5345 subgroup := U, 5346 iso:=iso, 5347 table:=T, 5348 reps:=List(reps,i->PreImagesRepresentative(iso,i)))); 5349 fi; 5350 5351 ndef := 1; 5352 for j in [1..index] do 5353 for i in [1..ng] do 5354 n := T[i][j]; 5355 if not IsBound(reps[n]) then 5356 reps[n] := reps[j]*gens[i]; 5357 #This assumes that reps[j] is already defined - but 5358 #this is true because T is 'standardized' 5359 ndef := ndef+1; 5360 if ndef=index then 5361 return Objectify( NewType( FamilyObj( OG ), 5362 IsRightTransversalFpGroupRep and IsList and 5363 IsDuplicateFreeList and IsAttributeStoringRep ), 5364 rec( group := OG, 5365 subgroup := U, 5366 iso:=iso, 5367 table:=T, 5368 reps:=List(reps,i->PreImagesRepresentative(iso,i)))); 5369 fi; 5370 fi; 5371 od; 5372 od; 5373 Error("huh?"); 5374end); 5375 5376InstallMethod( \[\], "right transversal fp group", true, 5377 [ IsList and IsRightTransversalFpGroupRep, IsPosInt ], 0, 5378function( cs, num ) 5379 return cs!.reps[num]; 5380end ); 5381 5382InstallOtherMethod( Position,"right transversal fp gp.", 5383 [ IsList and IsRightTransversalFpGroupRep, 5384 IsMultiplicativeElementWithInverse,IsZeroCyc ], 0, 5385function( cs, elm,zero ) 5386local a; 5387 a:=TracedCosetFpGroup(cs!.table, 5388 UnderlyingElement(ImagesRepresentative(cs!.iso,elm)),1); 5389 if (HasIsTrivial(cs!.subgroup) and IsTrivial(cs!.subgroup)) 5390 or cs!.reps[a]=elm then 5391 return a; 5392 else 5393 return fail; 5394 fi; 5395end ); 5396 5397InstallMethod( PositionCanonical,"right transversal fp gp.", IsCollsElms, 5398 [ IsList and IsRightTransversalFpGroupRep, 5399 IsMultiplicativeElementWithInverse ], 0, 5400function( cs, elm ) 5401 return TracedCosetFpGroup(cs!.table, 5402 UnderlyingElement(ImagesRepresentative(cs!.iso,elm)),1); 5403end ); 5404 5405InstallMethod( Enumerator,"fp gp.", true,[IsSubgroupFpGroup and IsFinite],0, 5406 G->RightTransversal(G,TrivialSubgroup(G))); 5407 5408InstallGlobalFunction(NewmanInfinityCriterion,function(G,p) 5409local GO,q,d,e,b,r,val,agemo,ngens; 5410 if not IsPrimeInt(p) then 5411 Error("<p> must be a prime"); 5412 fi; 5413 GO:=G; 5414 if not (HasIsWholeFamily(G) and IsWholeFamily(G)) then 5415 G:=Image(IsomorphismFpGroup(G)); 5416 fi; 5417 b:=Length(GeneratorsOfGroup(G)); 5418 r:=Length(RelatorsOfFpGroup(G)); 5419 val:=fail; 5420 ngens:=32; 5421 repeat 5422 ngens:=ngens*8; 5423 q:=PQuotient(G,p,2,ngens); 5424 until q<>fail; 5425 q:=Image(EpimorphismQuotientSystem(q)); 5426 q:=ShallowCopy(PCentralSeries(q,p)); 5427 if Length(q)=1 then 5428 Error("Trivial <p> quotient"); 5429 fi; 5430 if Length(q)=2 then 5431 Add(q,q[2]); # maximal quotient is abelian, second term is trivial 5432 fi; 5433 d:=LogInt(Index(q[1],q[2]),p); 5434 5435 if p=2 then 5436 e:=LogInt(Index(q[2],q[3]),p); 5437 Info(InfoFpGroup,1,b," generators, ",r," relators, p=",p,", d=",d," e=",e); 5438 q:=r-b+d; 5439 if q<d^2/2+d/2-e then 5440 Info(InfoFpGroup,1,"infinite by criterion 1"); 5441 val:=true; 5442 else 5443 Info(InfoFpGroup,2,"r-b=",r-b," d^2/2+d/2-d-e=",d^2/2-d/2-e); 5444 fi; 5445 if q<=d^2/2-d/2-e+(e-d/2-d^2/4)*d/2 then 5446 Info(InfoFpGroup,1,"infinite by criterion 2"); 5447 val:=true; 5448 else 5449 Info(InfoFpGroup,2,"r-b=",r-b," d^2/2-d/2-e+(e-d/2-d^2/4)*d/2-d=", 5450 d^2/2-d/2-e+(e-d/2-d^2/4)*d/2-d); 5451 fi; 5452 else 5453 # can we cut short the agemo calculation? 5454 if ForAll(GeneratorsOfGroup(q[1]),i->IsOne(i^p)) and 5455 IsCentral(q[1],q[2]) then 5456 # all generators have order p. q[2] has exponent p. As q[2] is 5457 # central, the commutators of generators are central and 5458 # (ab)^p=a^p*b^p*[a,b]^(p(p-1)/2)=1. So the agemo is trivial. 5459 agemo:=TrivialSubgroup(q[1]); 5460 else 5461 agemo:=Agemo(q[1],p); 5462 fi; 5463 5464 q[2]:=ClosureSubgroup(q[2],agemo); 5465 q[3]:=ClosureSubgroup(q[3],agemo); 5466 e:=LogInt(Index(q[2],q[3]),p); 5467 Info(InfoFpGroup,1,b," generators, ",r," relators, p=",p,", d=",d," e=",e); 5468 q:=r-b+d; 5469 if q<d^2/2-d/2-e then 5470 Info(InfoFpGroup,1,"infinite by criterion 1"); 5471 val:=true; 5472 fi; 5473 if q<=d^2/2-d/2-e+(e+d/2-d^2/4)*d/2 then 5474 Info(InfoFpGroup,1,"infinite by criterion 2"); 5475 val:=true; 5476 fi; 5477 fi; 5478 if val=true then 5479 SetIsFinite(G,false); 5480 SetSize(G,infinity); 5481 if not IsIdenticalObj(G,GO) then 5482 SetIsFinite(GO,false); 5483 SetSize(GO,infinity); 5484 fi; 5485 fi; 5486 return val; 5487end); 5488 5489InstallGlobalFunction(FibonacciGroup,function(arg) 5490local r,n,f,gens,rels; 5491 if Length(arg)=1 then 5492 r:=2; 5493 n:=arg[1]; 5494 else 5495 r:=arg[1]; 5496 n:=arg[2]; 5497 fi; 5498 f:=FreeGroup(n); 5499 gens:=GeneratorsOfGroup(f); 5500 rels:=List([1..n],i->Product([0..r-1],j-> 5501 gens[((i+j-1)mod n)+1])/gens[((i+r-1)mod n)+1]); 5502 return f/rels; 5503end); 5504 5505############################################################################# 5506## Direct product operation for FpGroups Robert F. Morse 5507## 5508#M DirectProductOp( <list>, <G> ) 5509## 5510InstallMethod( DirectProductOp, 5511 "for a list of fp groups, and a fp group", 5512 true, 5513 [ IsList, IsFpGroup ], 0, 5514 function( list, fpgp ) 5515 5516 local freeprod, # Free product of the list of groups given 5517 freegrp, # Underlying free group for direct product 5518 rels, # relations for direct product 5519 dirprod, # Direct product to be returned 5520 dinfo, # Direct product info 5521 geni, genj, # Generators of the embeddings 5522 idgens, # list of identity elements used in for projection 5523 p1,p2, # Position indices for embeddings and projections 5524 i,j,gi,gj; # index vaiables 5525 5526 5527 ## Check the arguments. Each element of the list must be an FpGroup 5528 ## 5529 if ForAny( list, G -> not IsFpGroup( G ) ) then 5530 TryNextMethod(); 5531 fi; 5532 5533 ## Create the free product of the list of groups 5534 ## 5535 freeprod := FreeProductOp(list,fpgp); 5536 5537 ## Set up the initial generators and relations for the direct 5538 ## product from free product 5539 ## 5540 freegrp := FreeGroupOfFpGroup(freeprod); 5541 rels := ShallowCopy(RelatorsOfFpGroup(freeprod)); 5542 5543 ## Add relations for the direct product 5544 ## 5545 for i in [1..Length(list)-1] do 5546 for j in [i+1..Length(list)] do 5547 5548 ## Get the corresponding generators of each base 5549 ## group in the free product via their embeddings and 5550 ## form the relations for the direct product -- each 5551 ## generator is each base group commutes with every other 5552 ## generator in the other base groups. 5553 ## 5554 geni := GeneratorsOfGroup(Image(Embedding(freeprod,i))); 5555 genj := GeneratorsOfGroup(Image(Embedding(freeprod,j))); 5556 5557 for gi in geni do 5558 for gj in genj do 5559 Add(rels, UnderlyingElement(Comm(gi,gj))); 5560 od; 5561 od; 5562 od; 5563 5564 od; 5565 5566 ## Create the direct product as an FpGroup 5567 ## 5568 dirprod := freegrp/rels; 5569 5570 ## Initialize the directproduct info 5571 ## 5572 dinfo := rec(groups := list, embeddings := [], projections := []); 5573 5574 ## Build embeddings and projections for direct product info 5575 ## 5576 ## Initialize generator index in free product 5577 ## 5578 p1 := 1; 5579 5580 for i in [1..Length(list)] do 5581 5582 ## Compute the generator indices to map embedding 5583 ## into direct product 5584 ## 5585 geni := GeneratorsOfGroup(Image(Embedding(freeprod,i))); 5586 p2 := p1+Length(geni)-1; 5587 5588 ## Compute a list of generators most of which are the 5589 ## identity to compute the projection mapping 5590 ## 5591 idgens := List([1..Length(GeneratorsOfGroup(dirprod))], g-> 5592 Identity(list[i])); 5593 idgens{[p1..p2]} := GeneratorsOfGroup(list[i]); 5594 5595 ## Build the embedding for group list[i] 5596 ## 5597 dinfo.embeddings[i] := 5598 GroupHomomorphismByImagesNC(list[i], dirprod, 5599 GeneratorsOfGroup(list[i]), 5600 GeneratorsOfGroup(dirprod){[p1..p2]}); 5601 5602 ## Build the projection for group list[i] 5603 ## 5604 dinfo.projections[i] := 5605 GroupHomomorphismByImagesNC(dirprod,list[i], 5606 GeneratorsOfGroup(dirprod), idgens); 5607 5608 ## Set next starting point. 5609 ## 5610 p1 := p2+1; 5611 od; 5612 5613 ## Set information and return dirprod 5614 ## 5615 SetDirectProductInfo( dirprod, dinfo ); 5616 return dirprod; 5617 5618 end 5619); 5620 5621# Textbook application of Smith normal form. 5622# The function is careful to handle empty matrices and to return 5623# the generators in the order corresponding to AbelianInvariants. 5624# If the FpGroup is abelian, then it is suitable as a method for 5625# IndependentGeneratorsOfAbelianGroup. 5626IndependentGeneratorsOfMaximalAbelianQuotientOfFpGroup := function( G ) 5627 local gens, matrix, snf, base, ord, cti, row, g, o, cf, j, i; 5628 5629 gens := FreeGeneratorsOfFpGroup( G ); 5630 if Size( gens ) = 0 then return []; fi; 5631 matrix := List( RelatorsOfFpGroup( G ), rel -> 5632 List( gens, gen -> ExponentSumWord( rel, gen ) ) ); 5633 if Size( matrix ) = 0 then return gens; fi; 5634 snf := NormalFormIntMat( matrix, 1+8+16 ); 5635 5636 base := []; 5637 ord := []; 5638 cti := snf.coltrans^-1; 5639 for i in [ 1 .. Length(cti) ] do 5640 row := cti[i]; 5641 if i <= Length( snf.normal ) then o := snf.normal[i][i]; else o := 0; fi; 5642 if o <> 1 then 5643 # get the involved prime factors 5644 g := LinearCombinationPcgs( gens, row, One(G) ); 5645 cf := Collected( Factors( o ) ); 5646 if Length( cf ) > 1 then 5647 for j in cf do 5648 j := j[1] ^ j[2]; 5649 Add( ord, j ); 5650 Add( base, g^(o/j) ); 5651 od; 5652 else 5653 Add( base, g ); 5654 Add( ord, o ); 5655 fi; 5656 fi; 5657 od; 5658 SortParallel( ord, base ); 5659 base := List( base, gen -> MappedWord( gen, gens, GeneratorsOfGroup( G ) ) ); 5660 return base; 5661end; 5662 5663InstallMethod( IndependentGeneratorsOfAbelianGroup, 5664 "for abelian fpgroup, use Smith normal form", 5665 [ IsFpGroup and IsAbelian ], 5666 IndependentGeneratorsOfMaximalAbelianQuotientOfFpGroup ); 5667 5668InstallValue(TRIVIAL_FP_GROUP,FreeGroup(0,"TrivGp")/[]); 5669