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