1############################################################################# 2## 3#A ReduceTail 4## 5ReduceTail := function( w, n, Q, d, f ) 6 local i, a, v; 7 8 i := 1; 9 while i < Length(w) and w[i] <= n do i := i+2; od; 10 11 a := w{[1..i-1]}; 12 13 v := Q[1] * 0; 14 while i < Length(w) do 15 v := v + Q[ w[i] - n ] * w[i+1]; 16 i := i+2; 17 od; 18 19 for i in [1..Length(v)] do 20 if d[i] > 1 then v[i] := v[i] mod d[i]; fi; 21 od; 22 23 for i in [1..Length(f)] do 24 Add( a, n+i ); Add( a, v[ f[i] ] ); 25 od; 26 27 return a; 28end; 29 30############################################################################# 31## 32#A SchurExtensionEpimorphism(G) . . . . . . . epimorphism from F/R to F/[R,F] 33## 34InstallMethod( SchurExtensionEpimorphism, "for pcp groups", [IsPcpGroup], function(G) 35 local g, r, n, y, coll, k, i, j, e, sys, ext, extgens, images, epi, ker; 36 37 # handle the trivial group 38 if IsTrivial(G) then 39 return IdentityMapping(G); 40 fi; 41 42 # set up 43 g := Igs(G); 44 n := Length(g); 45 r := List(g, x -> RelativeOrderPcp(x)); 46 47 if n = 1 then 48 ext := AbelianPcpGroup(1, [0]); # the infinite cyclic group 49 return GroupHomomorphismByImagesNC( ext, G, GeneratorsOfGroup(ext), GeneratorsOfGroup(G) );; 50 fi; 51 52 # get collector for extension 53 y := n*(n-1)/2 + Number(r, x -> x>0); 54 coll := FromTheLeftCollector(n+y); 55 56 # add a tail to each power and each positive conjugate relation 57 k := n; 58 for i in [1..n] do 59 SetRelativeOrder(coll, i, r[i]); 60 61 if r[i] > 0 then 62 e := ObjByExponents(coll, ExponentsByIgs(g, g[i]^r[i])); 63 k := k+1; 64 Append(e, [k,1]); 65 SetPower(coll,i,e); 66 fi; 67 68 for j in [1..i-1] do 69 e := ObjByExponents(coll, ExponentsByIgs(g, g[i]^g[j])); 70 k := k+1; 71 Append(e, [k,1]); 72 SetConjugate(coll,i,j,e); 73 od; 74 od; 75 76 # update 77 UpdatePolycyclicCollector(coll); 78 79 # evaluate consistency 80 sys := CRSystem(1, y, 0); 81 EvalConsistency( coll, sys ); 82 83 # determine quotient 84 ext := QuotientBySystem( coll, sys, n ); 85 86 # construct quotient epimorphism 87 extgens := Igs( ext ); 88 images := ListWithIdenticalEntries( Length(extgens), One(G) ); 89 images{[1..n]} := g; 90 91 epi := GroupHomomorphismByImagesNC( ext, G, extgens, images ); 92 SetIsSurjective( epi, true ); 93 ker := Subgroup( ext, extgens{[n+1..Length(extgens)]} ); 94 SetKernelOfMultiplicativeGeneralMapping( epi, ker ); 95 96 return epi; 97end ); 98 99############################################################################# 100## 101#A SchurExtension(G) . . . . . . . . . . . . . . . . . . . . . . . . F/[R,F] 102## 103InstallMethod( SchurExtension, "for groups", [IsGroup], function(G) 104 return Source( SchurExtensionEpimorphism( G ) ); 105end ); 106 107############################################################################# 108## 109#A AbelianInvariantsMultiplier(G) . . . . . . . . . . . . . . . . . . . M(G) 110## 111InstallMethod( AbelianInvariantsMultiplier, "for pcp groups", [IsPcpGroup], function(G) 112 local epi, H, M, T, D, I; 113 114 # a simple check 115 if IsCyclic(G) then return []; fi; 116 117 # otherwise compute 118 epi := SchurExtensionEpimorphism(G); 119 H := Source(epi); 120 M := KernelOfMultiplicativeGeneralMapping(epi); 121 122 # the finite case 123 if IsFinite(G) then 124 T := TorsionSubgroup(M); 125 return AbelianInvariants(T); 126 fi; 127 128 # the general case 129 D := DerivedSubgroup(H); 130 I := Intersection(M, D); 131 return AbelianInvariants(I); 132end ); 133 134############################################################################# 135## 136#A EpimorphismSchurCover(G) . . . . . . . . . . . . . . . M(G) extended by G 137## 138InstallMethod( EpimorphismSchurCover, "for pcp groups", [IsPcpGroup], function(G) 139 local epi, H, M, I, C, cover, g, n, extgens, images, ker; 140 141 if IsCyclic(G) then return IdentityMapping( G ); fi; 142 143 # get full extension F/[R,F] 144 epi := SchurExtensionEpimorphism(G); 145 H := Source(epi); 146 147 # get R/[R,F] 148 M := KernelOfMultiplicativeGeneralMapping(epi); 149 150 # get R cap F' 151 I := Intersection(M, DerivedSubgroup(H)); 152 153 # get complement to I in M 154 C := Subgroup(H, GeneratorsOfPcp( Pcp(M,I,"snf"))); 155 156 if not IsFreeAbelian(C) then Error("wrong complement"); fi; 157 158 # get Schur cover (R cap F') / [R,F] 159 cover := H/C; 160 161 # construct quotient epimorphism 162 g := Igs(G); 163 n := Length(g); 164 extgens := Igs( cover ); 165 images := ListWithIdenticalEntries( Length(extgens), One(G) ); 166 images{[1..n]} := g; 167 168 epi := GroupHomomorphismByImagesNC( cover, G, extgens, images ); 169 SetIsSurjective( epi, true ); 170 ker := Subgroup( cover, extgens{[n+1..Length(extgens)]} ); 171 SetKernelOfMultiplicativeGeneralMapping( epi, ker ); 172 173 return epi; 174end ); 175 176############################################################################# 177## 178#A NonAbelianExteriorSquareEpimorphism(G) . . . . . . . . . G wegde G --> G' 179## 180# FIXME: This function is documented and should be turned into a attribute 181NonAbelianExteriorSquareEpimorphism := function( G ) 182 local lift, D, gens, imgs, epi, lambda; 183 184 if Size(G) = 1 then return IdentityMapping( G ); fi; 185 186 lift := SchurExtensionEpimorphism(G); 187 D := DerivedSubgroup( Source(lift) ); 188 189 gens := GeneratorsOfGroup( D ); 190 imgs := List( gens, g->Image( lift, g ) ); 191 epi := GroupHomomorphismByImagesNC( D, DerivedSubgroup(G), gens, imgs ); 192 SetIsSurjective( epi, true ); 193 194 lambda := function( g, h ) 195 return Comm( PreImagesRepresentative( lift, g ), 196 PreImagesRepresentative( lift, h ) ); 197 end; 198 199 D!.epimorphism := epi; 200 # TODO: Make the crossedPairing accessible via an attribute! 201 D!.crossedPairing := lambda; 202 203 return epi; 204end; 205 206############################################################################# 207## 208#A NonAbelianExteriorSquare(G) . . . . . . . . . . . . . . . . . .(G wegde G) 209## 210InstallMethod( NonAbelianExteriorSquare, "for pcp groups", [IsPcpGroup], function(G) 211 return Source( NonAbelianExteriorSquareEpimorphism( G ) ); 212end ); 213 214############################################################################# 215## 216#A NonAbelianExteriorSquarePlus(G) . . . . . . . . . . (G wegde G) by (G x G) 217## 218## This is the group tau(G) in our paper. 219## 220## The following function computes the embedding of the non-abelian exterior 221## square of G into tau(G). 222## 223# FIXME: This function is documented and should be turned into an attribute 224NonAbelianExteriorSquarePlusEmbedding := function(G) 225 local g, n, r, w, extlift, F, f, D, d, m, s, c, i, 226 e, j, gens, imgs, k, alpha, S, embed; 227 228 if Size(G) = 1 then return G; fi; 229 230 # set up 231 g := Igs(G); 232 n := Length(g); 233 r := List(g, x -> RelativeOrderPcp(x)); 234 w := List([1..2*n], x -> 0); 235 236 extlift := NonAbelianExteriorSquareEpimorphism( G ); 237 238 # F/[R,F] = G* 239 F := Parent( Source( extlift ) ); 240 f := Pcp(F); 241 242 # the non-abelian exterior square D = G^G 243 D := Source( extlift ); 244 d := Pcp(D); 245 m := Length(d); 246 s := RelativeOrdersOfPcp(d); 247 248# Print( "# NonAbelianExteriorSquarePlus: Setting up collector with ", 2*n+m, 249# " generators\n" ); 250 251 # set up collector for non-abelian exterior square plus 252 c := FromTheLeftCollector(2*n+m); 253 254 # the relators of GxG 255 for i in [1..n] do 256 257 # relative order and power 258 if r[i] > 0 then 259 SetRelativeOrder(c, i, r[i]); 260 e := ExponentsByIgs(g, g[i]^r[i]); 261 SetPower(c, i, ObjByExponents(c,e)); 262 263 SetRelativeOrder(c, n+i, r[i]); 264 e := Concatenation(0*e, e); 265 SetPower(c, n+i, ObjByExponents(c,e)); 266 fi; 267 268 # conjugates 269 for j in [1..i-1] do 270 e := ExponentsByIgs(g, g[i]^g[j]); 271 SetConjugate(c, i, j, ObjByExponents(c,e)); 272 273 e := Concatenation(0*e, e); 274 SetConjugate(c, n+i, n+j, ObjByExponents(c,e)); 275 276 if r[j] = 0 then 277 e := ExponentsByIgs(g, g[i]^(g[j]^-1)); 278 SetConjugate(c, i, -j, ObjByExponents(c,e)); 279 e := Concatenation(0*e, e); 280 SetConjugate(c, n+i, -(n+j), ObjByExponents(c,e)); 281 fi; 282 283 od; 284 od; 285 286 # the relators of G^G 287 for i in [1..m] do 288 289 # relative order and power 290 if s[i] > 0 then 291 SetRelativeOrder(c, 2*n+i, s[i]); 292 e := ExponentsByPcp(d, d[i]^s[i]); 293 e := Concatenation(w, e); 294 SetPower(c, 2*n+i, ObjByExponents(c,e)); 295 fi; 296 297 # conjugates 298 for j in [1..i-1] do 299 e := ExponentsByPcp(d, d[i]^d[j]); 300 e := Concatenation(w, e); 301 SetConjugate(c, 2*n+i, 2*n+j, ObjByExponents(c,e)); 302 303 if s[j] = 0 then 304 e := ExponentsByPcp(d, d[i]^(d[j]^-1)); 305 e := Concatenation(w, e); 306 SetConjugate(c, 2*n+i, -(2*n+j), ObjByExponents(c,e)); 307 fi; 308 od; 309 od; 310 311 # the extension of G^G by GxG 312 # 313 # This is the computation of \lambda in our paper: For (g_i,g_j) we take 314 # preimages (f_i,f_j) in G* and calculate the image of (g_i,g_j) under 315 # \lambda as the commutator [f_i,f_j]. 316 for i in [1..n] do 317 for j in [1..n] do 318 e := ExponentsByPcp(d, Comm(f[j], f[i])); 319 e := Concatenation(w, e); e[n+j] := 1; 320 SetConjugate(c, n+j, i, ObjByExponents(c,e)); 321 322 if r[i] = 0 then 323 e := ExponentsByPcp(d, Comm(f[j], f[i]^-1)); 324 e := Concatenation(w, e); e[n+j] := 1; 325 SetConjugate(c, n+j, -i, ObjByExponents(c,e)); 326 fi; 327 od; 328 od; 329 330 # the action on G^G by GxG 331 for i in [1..n] do 332 333 # create action homomorphism 334 # G^G is generated by commutators of G* 335 # G acts on G^G via conjugation with preimages in G*. 336 gens := []; imgs := []; 337 for k in [1..n] do 338 for j in [1..n] do 339 Add(gens, Comm(f[k], f[j])); 340 Add(imgs, Comm(f[k]^f[i], f[j]^f[i])); 341 od; 342 od; 343 alpha := GroupHomomorphismByImagesNC(D,D,gens,imgs); 344 345 # compute conjugates 346 for j in [1..m] do 347 e := ExponentsByPcp(d, Image(alpha, d[j])); 348 e := Concatenation(w, e); 349 SetConjugate(c, 2*n+j, i, ObjByExponents(c,e)); 350 SetConjugate(c, 2*n+j, n+i, ObjByExponents(c,e)); 351 od; 352 353 if r[i] = 0 then 354 # create action homomorphism 355 gens := []; imgs := []; 356 for k in [1..n] do 357 for j in [1..n] do 358 Add(gens, Comm(f[k], f[j])); 359 Add(imgs, Comm(f[k]^(f[i]^-1), f[j]^(f[i]^-1))); 360 od; 361 od; 362 alpha := GroupHomomorphismByImagesNC(D,D,gens,imgs); 363 364 # compute conjugates 365 for j in [1..m] do 366 e := ExponentsByPcp(d, Image(alpha, d[j])); 367 e := Concatenation(w, e); 368 SetConjugate(c, 2*n+j, -i, ObjByExponents(c,e)); 369 SetConjugate(c, 2*n+j, -(n+i), ObjByExponents(c,e)); 370 od; 371 372 fi; 373 374 od; 375 376 if CHECK_SCHUR_PCP@ then 377 S := PcpGroupByCollector(c); 378 else 379 UpdatePolycyclicCollector(c); 380 S := PcpGroupByCollectorNC(c); 381 fi; 382 S!.group := G; 383 384 gens := GeneratorsOfGroup(S){[2*n+1..2*n+m]}; 385 embed := GroupHomomorphismByImagesNC( D, S, GeneratorsOfPcp(d), gens ); 386 387 return embed; 388end; 389 390NonAbelianExteriorSquarePlus := function( G ) 391 return Range( NonAbelianExteriorSquarePlusEmbedding( G ) ); 392end; 393 394############################################################################# 395## 396#A Epicentre 397## 398InstallMethod(Epicentre, "for pcp groups", [IsPcpGroup], 399function (G) 400 local epi; 401 epi := SchurExtensionEpimorphism(G); 402 return Image(epi,Centre(Source(epi))); 403end); 404