1##############################################################################
2##
3#W  gp2act.gi                  GAP4 package `XMod'               Chris Wensley
4#W                                                                 & Murat Alp
5##
6##  This file implements methods for actor crossed squares of crossed modules.
7##
8#Y  Copyright (C) 2001-2018, Chris Wensley et al,
9#Y  School of Computer Science, Bangor University, U.K.
10
11#############################################################################
12##
13#M  AutomorphismPermGroup( <XM> )  subgroup of Aut(Source(XM))xAut(Range(XM))
14##
15InstallMethod( AutomorphismPermGroup, "automorphism perm group of xmod",
16    true, [ IsXMod ], 0,
17function( XM )
18
19    local S, genS, ngS, R, genR, ngR, bdy, act, ker, imbdy,
20          AS, genAS, a2pS, PAS, genPAS, p2aS,
21          AR, genAR, a2pR, PAR, genPAR, p2aR,
22          D, genD, emS, emR, emgenPAS, emgenPAR, emAS, emAR, infoD,
23          P, num, autogens, as, eas, ar, ear, mor, ispre, ismor,
24          genP, imsrc, imrng, projDS, projDR, projPS, projPR, ePAS, ePAR;
25
26    Info( InfoXMod, 1, "using standard AutomorphismPermGroup method" );
27    S := Source( XM );
28    genS := GeneratorsOfGroup( S );
29    ngS := Length( genS );
30    R := Range( XM );
31    genR := GeneratorsOfGroup( R );
32    ngR := Length( genR );
33    bdy := Boundary( XM );
34    act := XModAction( XM );
35    ker := Kernel( bdy );
36    AS := AutomorphismGroup( S );
37    genAS := GeneratorsOfGroup( AS );
38    a2pS := IsomorphismPermGroup( AS );    ### check if smaller possible
39    PAS := Image( a2pS );
40    genPAS := List( genAS, a -> ImageElm( a2pS, a ) );
41    p2aS := GroupHomomorphismByImages( PAS, AS, genPAS, genAS );
42    if ( p2aS = fail ) then
43        Error( "p2aS = fail" );
44    else
45        SetAutoGroupIsomorphism( PAS, p2aS );
46    fi;
47
48    imbdy := Image( bdy );
49    AR := AutomorphismGroup( R );
50    genAR := GeneratorsOfGroup( AR );
51    a2pR := IsomorphismPermGroup( AR );    ### ditto
52    PAR := Image( a2pR );
53    genPAR := List( genAR, a -> ImageElm( a2pR, a ) );
54    p2aR := GroupHomomorphismByImages( PAR, AR, genPAR, genAR );
55    if ( p2aR = fail ) then
56        Error( "p2aR = fail" );
57    else
58        SetAutoGroupIsomorphism( PAR, p2aR );
59    fi;
60    D := DirectProduct( PAS, PAR );
61    genD := GeneratorsOfGroup( D );
62    if ( HasName( PAS ) and HasName( PAR ) ) then
63        SetName( D, Concatenation( Name(PAS), "x", Name(PAR) ) );
64    fi;
65    emS := Embedding( D, 1 );
66    emR := Embedding( D, 2 );
67    emgenPAS := List( genPAS, a -> ImageElm( emS, a ) );
68    emgenPAR := List( genPAR, a -> ImageElm( emR, a ) );
69    emAS := GroupHomomorphismByImages( AS, D, genAS, emgenPAS );
70    emAR := GroupHomomorphismByImages( AR, D, genAR, emgenPAR );
71    infoD := DirectProductInfo( D );
72    P := Subgroup( D, [ ] );
73    num := 0;
74    autogens := [ ];
75    for as in AS do
76        eas := ImageElm( emAS, as );
77        for ar in AR do
78            ear := ImageElm( emAR, ar );
79            if not ( eas*ear in P ) then
80                mor := Make2DimensionalGroupMorphism( [ XM, XM, as, ar ] );
81                ispre := ( not( mor = fail ) and IsPreXModMorphism( mor ) );
82                if ispre then
83                    ismor := IsXModMorphism( mor );
84                    if ismor then
85                        num := num + 1;
86                        Add( autogens, mor );
87                        P := ClosureGroup( P, eas*ear );
88                        Info( InfoXMod, 2, "size of P now ", Size(P) );
89                    fi;
90                fi;
91            fi;
92        od;
93    od;
94    genP := GeneratorsOfGroup( P );
95    projDS := Projection( D, 1 );
96    projDR := Projection( D, 2 );
97    imsrc := List( genP, g -> ImageElm( projDS, g ) );
98    imrng := List( genP, g -> ImageElm( projDR, g ) );
99    projPS := GroupHomomorphismByImages( P, PAS, genP, imsrc );
100    projPR := GroupHomomorphismByImages( P, PAR, genP, imrng );
101    SetGeneratingAutomorphisms( XM, autogens );
102    SetIsAutomorphismPermGroupOfXMod( P, true );
103    ### 22/06/06, revised 30/07/18 ###
104    ### these two functions could be changed as follows:  AS -> P
105    ### imePAS := List( genAS, a -> ImageElm( emS, ImageElm( a2pS, a ) ) );
106    ### ePAS := GroupHomomorphismByImages( AS, D, genAS, imePAS );
107    ### imePAR := List( genAR, a -> ImageElm( emR, ImageElm( a2pR, a ) ) );
108    ### ePAR := GroupHomomorphismByImages( AR, D, genAR, imePAR );
109    ePAS := GroupHomomorphismByImages( PAS, D, genPAS, emgenPAS );
110    ePAR := GroupHomomorphismByImages( PAR, D, genPAR, emgenPAR );
111    SetEmbedSourceAutos( P, ePAS );
112    SetEmbedRangeAutos( P, ePAR );
113    SetSourceProjection( P, projPS );
114    SetRangeProjection( P, projPR );
115    SetAutomorphismDomain( P, XM );
116    return P;
117end );
118
119InstallMethod( AutomorphismPermGroup, "automorphism perm group of xmod",
120    true, [ IsXMod and IsNormalSubgroup2DimensionalGroup ], 0,
121function( XM )
122
123    local S, genS, R, genR, autR, autS, AR, genAR, ngAR, AS, genAS,
124          ar, as, a2pR, PAR, genPAR, p2aR, a2pS, PAS, genPAS, p2aS,
125          restrict, D, genD, emS, emR, emgenPAS, emgenPAR, emAS, emAR,
126          infoD, P, genP, autogens, j, p2, p2i, newS, newR, oldS, oldR,
127          imsrc, imrng, projS, projR, filtS, ePAS, egenR, ePAR;
128
129    Info( InfoXMod, 1, "using special AutomorphismPermGroup method" );
130    S := Source( XM );
131    genS := GeneratorsOfGroup( S );
132    R := Range( XM );
133    genR := GeneratorsOfGroup( R );
134
135    autR := AutomorphismGroup( R );
136    autS := AutomorphismGroup( S );
137    genAR := [ ];
138    genAS := [ ];
139    AR := Subgroup( autR, [ IdentityMapping( R ) ] );
140    AS := Subgroup( autS, [ IdentityMapping( S ) ] );
141    for ar in autR do
142        as := GeneralRestrictedMapping( ar, S, S );
143        if not ( fail in MappingGeneratorsImages(as)[2] ) then
144            if not ( ar in AR ) then
145                Add( genAR, ar );
146                Add( genAS, as );
147                AR := ClosureGroup( AR, ar );
148                AS := ClosureGroup( AS, as );
149            fi;
150        fi;
151    od;
152    Info( InfoXMod, 2, " genAR = ", genAR );
153    Info( InfoXMod, 2, " genAS = ", genAS );
154    ngAR := Length( genAR );
155    a2pR := IsomorphismPermGroup( AR );
156    PAR := Image( a2pR );
157    a2pR := a2pR * SmallerDegreePermutationRepresentation( PAR );
158    PAR := ImagesSource( a2pR );
159    genPAR := List( genAR, a -> ImageElm( a2pR, a ) );
160    Info( InfoXMod, 2, "genPAR = ", genPAR );
161    p2aR := GroupHomomorphismByImages( PAR, AR, genPAR, genAR );
162    if ( p2aR = fail ) then
163        Error( "p2aR = fail" );
164    else
165        SetAutoGroupIsomorphism( PAR, p2aR );
166    fi;
167    a2pS := IsomorphismPermGroup( AS );
168    PAS := Image( a2pS );
169    a2pS := a2pS * SmallerDegreePermutationRepresentation( PAS );
170    PAS := ImagesSource( a2pS );
171    genPAS := List( genAS, a -> ImageElm( a2pS, a ) );
172    Info( InfoXMod, 2, "genPAS = ", genPAS );
173    p2aS := GroupHomomorphismByImages( PAS, AS, genPAS, genAS );
174    if ( p2aS = fail ) then
175        Error( "p2aS = fail" );
176    else
177        SetAutoGroupIsomorphism( PAS, p2aS );
178    fi;
179    restrict := GroupHomomorphismByImages( PAR, PAS, genPAR, genPAS );
180
181    D := DirectProduct( PAS, PAR );
182    genD := GeneratorsOfGroup( D );
183    if ( HasName( PAS ) and HasName( PAR ) ) then
184        SetName( D, Concatenation( Name(PAS), "x", Name(PAR) ) );
185    fi;
186    emS := Embedding( D, 1 );
187    emR := Embedding( D, 2 );
188    ## this looks odd, but ngAR=ngAS
189    filtS := Filtered( [1..ngAR], i -> not IsOne( genPAS[i] ) );
190    Info( InfoXMod, 2,  "filtS = ", filtS );
191    emgenPAS := List( genPAS, a -> ImageElm( emS, a ) );
192    emgenPAR := List( genPAR, a -> ImageElm( emR, a ) );
193    ##  (05/03/07)  allowed for the case that AS is trivial
194    emAS := GroupHomomorphismByImages( AS,D,genAS{filtS},emgenPAS{filtS} );
195    emAR := GroupHomomorphismByImages( AR,D,genAR,       emgenPAR );
196    infoD := DirectProductInfo( D );
197
198    genP := ListWithIdenticalEntries( ngAR, 0 );
199    autogens := ListWithIdenticalEntries( ngAR, 0 );
200    for j in [1..ngAR] do
201        genP[j] := ImageElm( emAS, genAS[j] ) * ImageElm( emAR, genAR[j] );
202        autogens[j] := XModMorphism( XM, XM, genAS[j], genAR[j] );
203    od;
204    P := Subgroup( D, genP );
205
206    p2 := infoD.perms[2];
207    p2i := p2^(-1);
208    newS := infoD.news[1];  oldS := infoD.olds[1];
209    newR := infoD.news[2];  oldR := infoD.olds[2];
210    imsrc := List( genP, g ->
211                   MappingPermListList( oldS, List( newS, x->(x^g) ) ) );
212    imrng := List( genP, g ->
213                   MappingPermListList( oldR, List( newR, x->(x^g)^p2i ) ) );
214    projS := GroupHomomorphismByImages( P, PAS, genP, imsrc );
215    projR := GroupHomomorphismByImages( P, PAR, genP, imrng );
216    ePAS := GroupHomomorphismByImages( PAS,D,genPAS{filtS},genPAS{filtS} );
217    egenR := List( genPAR, p -> p^p2 );
218    ePAR := GroupHomomorphismByImages( PAR,D,genPAR,       egenR );
219    SetGeneratingAutomorphisms( XM, autogens );
220    SetIsAutomorphismPermGroupOfXMod( P, true );
221    SetEmbedSourceAutos( P, ePAS );
222    SetEmbedRangeAutos( P, ePAR );
223    SetSourceProjection( P, projS );
224    SetRangeProjection( P, projR );
225    SetAutomorphismDomain( P, XM );
226    return P;
227end );
228
229#############################################################################
230##
231#M  PermAutomorphismAsXModMorphism( <xmod>, <permaut> )
232##
233InstallMethod( PermAutomorphismAsXModMorphism,
234    "xmod morphism coresponding to an element of the AutomorphismPermGroup",
235    true, [ IsXMod, IsPerm ], 0,
236function( XM, a )
237
238    local APXM, sp, rp, sa, ra, si, ri, smor, rmor, mor;
239
240    APXM := AutomorphismPermGroup( XM );
241    sp := SourceProjection( APXM );
242    sa := ImageElm( sp, a );
243    si := AutoGroupIsomorphism( Range( sp ) );
244    smor := ImageElm( si, sa );
245    rp := RangeProjection( APXM );
246    ra := ImageElm( rp, a );
247    ri := AutoGroupIsomorphism( Range( rp ) );
248    rmor := ImageElm( ri, ra );
249    mor := XModMorphism( XM, XM, smor, rmor );
250    return mor;
251end );
252
253#############################################################################
254##
255#M  ImageAutomorphismDerivation( <mor>, <chi> )
256##
257InstallMethod( ImageAutomorphismDerivation, "image of derivation under action",
258    true, [ IsXModMorphism, IsDerivation ], 0,
259function( mor, chi )
260
261    local XM, R, stgR, imj, rho, imrho, sigma, invrho, rngR, k, r, rr, crr, chj;
262
263    XM := Source( mor );
264    sigma := SourceHom( mor );
265    rho := RangeHom( mor );
266    R := Range( XM );
267    stgR := StrongGeneratorsStabChain( StabChain( R ) );
268    rngR := [ 1..Length( stgR ) ];
269    imrho := List( stgR, r -> ImageElm( rho, r ) );
270    invrho := GroupHomomorphismByImages( R, R, imrho, stgR );
271    imj := 0 * rngR;
272    for k in rngR do
273        r := stgR[k];
274        rr := ImageElm( invrho, r );
275        crr := DerivationImage( chi, rr );
276        imj[k] := ImageElm( sigma, crr );
277    od;
278    chj := DerivationByImages( XM, imj );
279    return chj;
280end );
281
282#############################################################################
283##
284#M  WhiteheadXMod( <XM> )     (InnerSourceHom : Range(XM) -> Whitehead Group)
285##
286InstallMethod( WhiteheadXMod, "Whitehead crossed module", true,
287    [ IsXMod ], 0,
288function( XM )
289    local S, genS, reg, imreg, W, WT, posW, nposW, genW, imiota,
290          s, chi, poschi, iota, autS, genchi, j, sigma, ima, a,
291          imact, act, WX, name;
292
293    S := Source( XM );
294    genS := GeneratorsOfGroup( S );
295    reg := RegularDerivations( XM );
296    imreg := ImagesList( reg );
297    W := WhiteheadPermGroup( XM );
298    WT := WhiteheadGroupTable( XM );
299    posW := WhiteheadGroupGeneratorPositions( XM );
300    nposW := Length( posW );
301    genW := GeneratorsOfGroup( W );
302    # determine the boundary map iota = PrincipalSourceHom
303    imiota := [ ];
304    for s in genS do
305        chi := PrincipalDerivation( XM, s );
306        poschi := Position( imreg, UpGeneratorImages( chi ) );
307        Add( imiota, PermList( WT[poschi] ) );
308    od;
309    iota := GroupHomomorphismByImages( S, W, genS, imiota );
310    ##  ????? should this be a general mapping ????????????????????
311    if not IsGroupHomomorphism( iota ) then
312        Error( "Whitehead boundary fails to be a homomorphism" );
313    fi;
314    # now calculate the action homomorphism
315    autS := AutomorphismGroup( S );
316    genchi := WhiteheadGroupGeneratingDerivations( XM );
317    ##  (05/03/07)  allow for the case that W is trivial
318    if ( genchi = [ ] ) then
319        imact := [ One( autS ) ];
320    else
321        imact := [ 1..nposW ];
322        for j in [1..nposW] do
323            chi := genchi[j];
324            sigma := SourceEndomorphism( chi );
325            ima := List( genS, s -> ImageElm( sigma, s ) );
326            a := GroupHomomorphismByImages( S, S, genS, ima );
327            imact[j] := a;
328        od;
329    fi;
330    act := GroupHomomorphismByImages( W, autS, genW, imact );
331    WX := XMod( iota, act );
332    name := Name( XM );
333    SetName( WX, Concatenation( "Whitehead", name ) );
334    ## SetIsWhiteheadXMod( WX, true );
335    return WX;
336end );
337
338#############################################################################
339##
340#M  NorrieXMod( <XM> )
341##
342InstallMethod( NorrieXMod, "Norrie crossed module", true,
343    [ IsXMod ], 0,
344function( XM )
345
346    local S, R, genR, P, DX, genP, Prng,
347          AS, AR, a2pS, PAS, p2aS, a2pR, PAR, p2aR,
348          im, r, autr, psrc, emsrc, conjr, prng, emrng, bdy, ok,
349          imact, p, projp, proja, ima, a, act, i, f, NX, name;
350
351    Info( InfoXMod, 2, "now in NorrieXMod" );
352    S := Source( XM );
353    R := Range( XM );
354    genR := GeneratorsOfGroup( R );
355    P := AutomorphismPermGroup( XM );
356    DX := Parent( P );
357    genP := GeneratorsOfGroup( P );
358    Prng := [ 1..Length( genP ) ];
359    ########## 23/06/06 revision ########
360    PAR := Image( RangeProjection( P ) );
361    if HasAutoGroupIsomorphism( PAR ) then
362        p2aR := AutoGroupIsomorphism( PAR );
363    elif ( HasParent( PAR ) and HasAutoGroupIsomorphism( Parent(PAR) ) ) then
364        p2aR := AutoGroupIsomorphism( Parent( PAR ) );
365    else
366        Error( "AutoGroupIsomorphism unavailable for PAR" );
367    fi;
368    AR := Image( p2aR );
369    a2pR := InverseGeneralMapping( p2aR );
370    PAS := Image( SourceProjection( P ) );
371    if HasAutoGroupIsomorphism( PAS ) then
372        p2aS := AutoGroupIsomorphism( PAS );
373    elif ( HasParent( PAS ) and HasAutoGroupIsomorphism( Parent(PAS) ) ) then
374        p2aS := AutoGroupIsomorphism( Parent( PAS ) );
375    else
376        Error( "AutoGroupIsomorphism unavailable for PAS" );
377    fi;
378    AS := Image( p2aS );
379    a2pS := InverseGeneralMapping( p2aS );
380    ######################################
381    # determine the boundary map
382    im := [ ];
383    for r in genR do
384        autr := ImageElm( XModAction( XM ), r );
385        psrc := ImageElm( a2pS, autr );
386        emsrc := ImageElm( EmbedSourceAutos( P ), psrc );
387        conjr := InnerAutomorphism( R, r );
388        prng := ImageElm( a2pR, conjr );
389        emrng := ImageElm( EmbedRangeAutos( P ), prng );
390        Add( im, emrng * emsrc );  ### assumes direct product ###
391    od;
392    bdy := GroupHomomorphismByImages( R, P, genR, im );
393    # determine the action
394    imact := 0 * Prng;
395    for i in Prng do
396        p := genP[i];
397        projp := ImageElm( RangeProjection( P ), p );
398        proja := ImageElm( p2aR, projp );
399        ima := List( genR, r -> ImageElm( proja, r ) );
400        a := GroupHomomorphismByImages( R, R, genR, ima );
401        imact[i] := a;
402    od;
403    act := GroupHomomorphismByImages( P, AR, genP, imact );
404    for f in MappingGeneratorsImages( act )[2] do
405        if ( f = IdentityMapping( R ) ) then
406            f := InclusionMappingGroups( R, R );
407        fi;
408    od;
409    ## create the crossed module
410    NX := XMod( bdy, act );
411    name := Name( XM );
412    SetName( NX, Concatenation( "Norrie", name ) );
413    return NX;
414end );
415
416#############################################################################
417##
418#M  LueXMod( <XM> )
419##
420InstallMethod( LueXMod, "Lue crossed module", true,
421    [ IsXMod ], 0,
422function( XM )
423
424    local NX, Nbdy, Xbdy, Lbdy, P, genP, Prng, S, genS, AS, a2pS, PAS,
425          p2aS, imact, i, p, projp, proja, ima, a, act, f, LX, name;
426
427    NX := NorrieXMod( XM );
428    Nbdy := Boundary( NX );
429    Xbdy := Boundary( XM );
430    Lbdy := Xbdy * Nbdy;
431    P := AutomorphismPermGroup( XM );
432    genP := GeneratorsOfGroup( P );
433    Prng := [ 1..Length( genP ) ];
434    S := Source( XM );
435    genS := GeneratorsOfGroup( S );
436    ########## 23/06/06 revision ##########
437    PAS := Image( SourceProjection( P ) );
438    if HasAutoGroupIsomorphism( PAS ) then
439        p2aS := AutoGroupIsomorphism( PAS );
440    elif ( HasParent( PAS ) and HasAutoGroupIsomorphism( Parent(PAS) ) ) then
441        p2aS := AutoGroupIsomorphism( Parent( PAS ) );
442    else
443        Error( "AutoGroupIsomorphism unavailable for PAS" );
444    fi;
445    AS := Image( p2aS );
446    a2pS := InverseGeneralMapping( p2aS );
447    ######################################
448    imact := 0 * Prng;
449    for i in Prng  do
450        p := genP[i];
451        projp := ImageElm( SourceProjection( P ), p );
452        proja := ImageElm( p2aS, projp );
453        ima := List( genS, s -> ImageElm( proja, s ) );
454        a := GroupHomomorphismByImages( S, S, genS, ima );
455        imact[i] := a;
456    od;
457    act := GroupHomomorphismByImages( P, AS, genP, imact );
458    for f in MappingGeneratorsImages( act )[2] do
459        if ( f = IdentityMapping( S ) ) then
460            f := InclusionMappingGroups( S, S );
461        fi;
462    od;
463    LX := XMod( Lbdy, act );
464    name := Name( XM );
465    SetName( LX, Concatenation( "Lue", name ) );
466    return LX;
467end );
468
469
470#############################################################################
471##
472#M  ActorXMod( <XM> )
473##
474InstallMethod( ActorXMod, "actor crossed module", true, [ IsXMod ], 0,
475function( XM )
476
477    local D, L, W, eW, P, genP, genpos, ngW, genW, invW, imdelta,
478          S, R, AS, AR, PAS, p2aS, a2pS, PAR, p2aR, a2pR, emsrc, emrng,
479          i, j, k, mor, imsrc, imrng, delta, GA, nGA, imact, rho, invrho,
480          impos, chi, chj, imgen, phi, id, aut, act, ActX, name;
481
482    if not IsPermXMod( XM ) then
483        Error( "ActorXMod only implemented for permutation xmods" );
484    fi;
485    D := RegularDerivations( XM );
486    L := ImagesList( D );
487    W := WhiteheadPermGroup( XM );
488    eW := Elements( W );
489    P := AutomorphismPermGroup( XM );
490    genP := GeneratorsOfGroup( P );
491    genpos := WhiteheadGroupGeneratorPositions( XM );
492    ngW := Length( genpos );
493    # determine the boundary map
494    genW := List( genpos, i -> eW[i] );
495    invW := List( genW, g -> g^-1 );
496    imdelta := ListWithIdenticalEntries( ngW, 0 );
497    S := Source( XM );
498    R := Range( XM );
499    ########## 23/06/06 revision ##########
500    PAR := Image( RangeProjection( P ) );
501    if HasAutoGroupIsomorphism( PAR ) then
502        p2aR := AutoGroupIsomorphism( PAR );
503    elif ( HasParent( PAR ) and HasAutoGroupIsomorphism( Parent(PAR) ) ) then
504        p2aR := AutoGroupIsomorphism( Parent( PAR ) );
505    else
506        Error( "AutoGroupIsomorphism unavailable for PAR" );
507    fi;
508    AR := Image( p2aR );
509    a2pR := InverseGeneralMapping( p2aR );
510    PAS := Image( SourceProjection( P ) );
511    if HasAutoGroupIsomorphism( PAS ) then
512        p2aS := AutoGroupIsomorphism( PAS );
513    elif ( HasParent( PAS ) and HasAutoGroupIsomorphism( Parent(PAS) ) ) then
514        p2aS := AutoGroupIsomorphism( Parent( PAS ) );
515    else
516        Error( "AutoGroupIsomorphism unavailable for PAS" );
517    fi;
518    AS := Image( p2aS );
519    a2pS := InverseGeneralMapping( p2aS );
520    ######################################
521    emsrc := EmbedSourceAutos( P );
522    emrng := EmbedRangeAutos( P );
523    for i in [1..ngW] do
524        j := genpos[i];
525        chj := DerivationByImages( XM, L[j] );
526        mor := Object2dEndomorphism( chj );
527        imsrc := ImageElm( emsrc, ImageElm( a2pS, SourceHom( mor ) ) );
528        imrng := ImageElm( emrng, ImageElm( a2pR, RangeHom( mor ) ) );
529        imdelta[i] := imsrc * imrng;
530    od;
531    delta := GroupHomomorphismByImages( W, P, genW, imdelta );
532    Info( InfoXMod, 3, "delta: ", MappingGeneratorsImages( delta ) );
533
534    # determine the action
535    GA := GeneratingAutomorphisms( XM );
536    nGA := Length( GA );
537    imact := ListWithIdenticalEntries( nGA, 0 );
538    for k in [1..nGA] do
539        mor := GA[k];
540        rho := RangeHom( mor );
541        invrho := rho^(-1);
542        impos := ListWithIdenticalEntries( ngW, 0);
543        for i in [1..ngW] do
544            j := genpos[i];
545            chi := DerivationByImages( XM, L[j] );
546            chj := ImageAutomorphismDerivation( mor, chi );
547            impos[i] := Position( L, UpGeneratorImages( chj ) );
548        od;
549        imgen := List( impos, i -> eW[i] );
550        phi := GroupHomomorphismByImages( W, W, genW, imgen );
551        imact[k] := phi;
552    od;
553    id := InclusionMappingGroups( W, W );
554    aut := Group( imact, id );
555    SetName( aut, "Aut(W)" );
556    act := GroupHomomorphismByImages( P, aut, genP, imact );
557    ActX := XMod( delta, act );
558    name := Name( XM );
559    SetName( ActX, Concatenation( "Actor", name ) );
560    return ActX;
561end );
562
563#############################################################################
564##
565#M  ActorCat1Group( <C> )
566##
567InstallMethod( ActorCat1Group, "actor cat1-group", true, [ IsCat1Group ], 0,
568function( C )
569    return 0;
570end );
571
572#############################################################################
573##
574#M  InnerMorphism( <XM> )
575##
576InstallMethod( InnerMorphism, "inner morphism of xmod", true,
577    [ IsPermXMod ], 0,
578function( XM )
579
580    local WX, NX, ActX, mor;
581
582    WX := WhiteheadXMod( XM );
583    NX := NorrieXMod( XM );
584    ActX := ActorXMod( XM );
585    mor := XModMorphismByGroupHomomorphisms(XM,ActX,Boundary(WX),Boundary(NX));
586    return mor;
587end );
588
589#############################################################################
590##
591#M  XModCentre( <XM> )
592##
593#?  InstallOtherMethod( Centre, "centre of an xmod", true, [ IsPermXMod ], 0,
594##
595InstallMethod( XModCentre, "centre of an xmod", true, [ IsXMod ], 0,
596function( XM )
597    return Kernel( InnerMorphism( XM ) );
598end );
599
600#############################################################################
601##
602#M  InnerActorXMod( <XM> )
603##
604InstallMethod( InnerActorXMod, "inner actor crossed module", true,
605    [ IsPermXMod ], 0,
606function( XM )
607
608    local InnX, mor, name, ActX;
609
610    ActX := ActorXMod( XM );
611    mor := InnerMorphism( XM );
612    InnX := ImagesSource( mor );
613    if ( InnX = ActX ) then
614        InnX := ActX;
615    else
616        name := Name( XM );
617        SetName( InnX, Concatenation( "InnerActor", name ) );
618    fi;
619    return InnX;
620end );
621