#############################################################################
##
#W  util.gi                        XMOD Package                  Chris Wensley
#W                                                                 & Murat Alp
##
##  Installation file for functions of the XMOD package.
##
#H  @(#)$Id: util.gi,v 2.004 2004/04/14 gap Exp $
##
#Y  Copyright (C) 1999,2001 University of St. Andrews, North Haugh,
#Y                          St. Andrews, Fife KY16 9SS, Scotland
##
Revision.("xmod/gap/util_gi") := 
   "@(#)$Id: util.gi,v 2.004 2004/04/14 gap Exp $";

##############################################################################
##
#M  IdentitySubgroup . . . . . . . . . . . . . . . . . . . . . . .  of a group
##
InstallMethod( IdentitySubgroup, "of a group", true, [ IsGroup ], 0,
function( G )

    local  S;

    S := Subgroup( G, [ One( G ) ] );
    if HasName( G ) then
        SetName( S, Concatenation( "id(", Name( G ), ")" ) );
    fi;
    return S;
end );

#############################################################################
##
#M  InclusionMappingGroups( <G>, <H> )
##
InstallMethod( InclusionMappingGroups, "generic method for subgroup",
               IsIdenticalObj, [ IsGroup, IsGroup ], 0,
function( G, H )

    local  genH, inc, ok;
    if not IsSubgroup( G, H ) then
        Error( "usage: InclusionMappingGroups( G, H );  with  H <= G" );
    fi;
    genH := GeneratorsOfGroup( H );
    inc := GroupHomomorphismByImages( H, G, genH, genH );
    ok := IsInjective( inc );
    return inc;
end );

#############################################################################
##
#M  MappingToOne( <G>, <H> )
##
InstallMethod( MappingToOne, "generic method for groups",
    true, [ IsGroup, IsGroup ], 0,
function( G, H )

    local  genG, oneH, ones;
    genG := GeneratorsOfGroup( G );
    oneH := One( H );
    ones := List( genG, g -> oneH );
    return GroupHomomorphismByImages( G, H, genG, ones );
end );

#############################################################################
##
#M  RestrictionMappingGroups( <hom>, <src>, <rng> )
##
InstallMethod( RestrictionMappingGroups, "generic method for group hom",
    true, [ IsGroupHomomorphism, IsGroup, IsGroup ], 0,
function( hom, src, rng )

    local  res, gens, ims, r;

    if not IsSubgroup( Source( hom ), src ) then
        return fail;
    fi;
    if not IsSubgroup( Range( hom ), rng ) then
        return fail;
    fi;
    res := RestrictedMapping( hom, src );
    gens := GeneratorsOfGroup( src );
    ims := List( gens, g -> Image( res, g ) );
    for r in ims do
        if not (r in rng ) then
            return fail;
        fi;
    od;
    return GroupHomomorphismByImages( src, rng, gens, ims );
end );

#############################################################################
##
#M  Display( <list> )
##
InstallMethod( Display, "generic method for lists", true, [ IsList ], 0,
function( L )

    local  len, i;

    len := Length( L );
    if ( len < 2 ) then
        Print( L, "\n" );
    else
        Print( "[ " );
        for i in [1..len-1] do
            if IsBound( L[i] ) then
                Print( L[i], ",\n  " );
            else
                Print( "," );
            fi;
        od;
        Print( L[len], "\n  ]\n" );
    fi;
end );

## 08/01/04  replace by the library function IsEndoMapping ??
#############################################################################
##
#M  IsEndomorphism( <f> )
#M  IsAutomorphism( <f> )
##
## (10/04/02) changed to subgroup test, rather than equality
##
##InstallMethod( IsEndomorphism,
##    "generic method for homomorphisms", true, [ IsGroupHomomorphism ], 0,
##function( f )
##    return IsSubgroup( Source( f ), Range( f ) ); 
##end );
##
##InstallMethod( IsAutomorphism,
##    "generic method for homomorphisms", true, [ IsGroupHomomorphism ], 0,
##function( f )
##    return ( ( Source( f ) = Range( f ) ) and IsBijective( f ) ); 
##end );

#############################################################################
##
#M  IsGroupOfAutomorphisms
##
InstallOtherMethod( IsGroupOfAutomorphisms,
               "generic method for groups and groups",
               true, [ IsGroup, IsGroup ], 0,
function( A, S )

    local  a;

    if not IsGroupOfAutomorphisms( A ) then
        return false;
    fi;
    for a in GeneratorsOfGroup( a ) do
        if not ( ( Source( a ) = S ) and ( Range( a )  = S ) ) then
            return false;
        fi;
    od;
    return true;
end );

#############################################################################
##
#M  AbelianModuleObject( <abgrp>, <act> )
##
InstallMethod( AbelianModuleObject, "for abelian group and group action",
    true, [ IsGroup, IsGroupHomomorphism ], 0,
function( ab, act )

    local  filter, fam, obj;

    if not IsCommutative( ab ) then
        Error( "AbelianModuleObject requires a commutative group" );
    fi;
    fam := FamilyObj( [ ab, act ] );
    filter := IsAbelianModuleObj;
    obj := Objectify( NewType( fam, filter ), rec() );
    SetAbelianModuleGroup( obj, ab );
    SetAbelianModuleAction( obj, act );
    SetIsAbelianModule( obj, true );
    return obj;
end );

#############################################################################
##
#M  TrivialAction                                                  for groups
##
InstallMethod( TrivialAction, "for groups", true,
              [ IsGroup, IsGroup ], 0,
function( G, H )

    local  triv;

    triv := Group( IdentityMapping( G ) );
    return MappingToOne( H, triv );
end );

##############################################################################
##
#M  InnerAutomorphismsByNormalSubgroup       for a group and a normal subgroup
##
InstallMethod( InnerAutomorphismsByNormalSubgroup,
    "for a group and a normal subgroup", true, [ IsGroup, IsGroup ], 0,
function( G, N )

    local  nargs, id, genG, genN, autG, genA, A, g, conj, name;

    if not IsNormal( G, N ) then
        Error( "Second parameter must be normal subgroup of the first\n" );
    fi;
    if ( ( G = N ) and HasAutomorphismGroup( G ) ) then
        autG := AutomorphismGroup( G );
        return InnerAutomorphismsAutomorphismGroup( autG );
    fi;
    genG := GeneratorsOfGroup( G );
    genN := GeneratorsOfGroup( N );
    id := InclusionMappingGroups( N, N );
    genA := [ ];
    for g in genG do
        conj := InnerAutomorphism( N, g );
        Add( genA, conj );
    od;
    A := Group( genA, id );
    SetIsGroupOfAutomorphisms( A, true );
    return A;
end );

##  this code commented out 08/01/04, it colflicts with package grpconst   ##
#############################################################################
##
##  #F  InnerAutomorphismGroup( <G> ) 
##  #F  InnerAutomorphismGroup( <G>, <N> )
##
##InstallGlobalFunction( InnerAutomorphismGroup, function( arg )
##
##      local  nargs, G, N;
##  
##    nargs := Length( arg );
##    # N not specified
##    if ( ( nargs = 1 ) and IsGroup( arg[1] ) ) then
##        G := arg[1];
##        N := G;
##    elif ( ( nargs = 2 ) and IsGroup( G ) and IsGroup( N ) ) then
##        G := arg[1];
##        N := arg[2];
##    else
##        Print( "usage: InnerAutomorphismGroup( G );\n" ); 
##        Print( "   or: InnerAutomorphismGroup( G, N );\n" );
##        return fail;
##    fi;
##    return InnerAutomorphismsByNormalSubgroup( G, N );
##end );

##############################################################################
##
#M  IsomorphismPermGroup                           for groups of automorphisms
##
InstallMethod( IsomorphismPermGroup, "for group of group automorphisms",
    true, [ IsGroupOfAutomorphisms ], 0,
function( A )

    local  G, a, genA, genG, eG1, eG2, new, num1, num2, ima, P, genP, a2p;

    a := One( A );
    genA := GeneratorsOfGroup( A );
    G := Source( a );
    genG := GeneratorsOfGroup( G );
    # determine the closure of genG under A
    eG2 := genG;
    num1 := 0;
    num2 := Length( genG );
    new := genG;
    while ( num1 <> num2 ) do
        num1 := num2;
        eG1 := eG2;
        for a in genA do
            ima := List( new, g -> Image( a, g ) );
            eG2 := Union( eG2, ima );
        od;
        new := Difference( eG2, eG1 );
        num2 := Length( eG2 );
    od;
    # construct perm group P using action of A on this closure
    P := Action( A, eG2 );
    genP := GeneratorsOfGroup( P );
    if HasName( G ) then
        if not HasName( A ) then
            if ( HasAutomorphismGroup( G ) 
                 and ( A = AutomorphismGroup( G ) ) ) then
                SetName( A, Concatenation( "Aut(", Name( G ), ")" ) );
            else
                SetName( A, Concatenation( "SubAut(", Name( G ), ")" ) );
            fi;
        fi;
        SetName( P, Concatenation( "Perm", Name( A ) ) );
    fi;
    a2p := ActionHomomorphism( A, P );
    return a2p;
end );

##############################################################################
##
#M  Embedding                              for permutation semidirect products
##
InstallMethod( Embedding, "generic method for perm semidirect products",
    true, [ IsPermGroup and HasSemidirectProductInfo, IsPosInt ], 0,
function( D, i )
    local  info, G, genG, imgs, hom;

    info := SemidirectProductInfo( D );
    if IsBound( info.embeddings[i] ) then
        return info.embeddings[i];
    fi;
    G := info.groups[i];
    genG := GeneratorsOfGroup( G );
    imgs := GeneratorsOfGroup( D ){[info.lenlist[i]+1 .. info.lenlist[i+1]]};
    hom := GroupHomomorphismByImages( G, D, genG, imgs );
    SetIsInjective( hom, true );
    info.embeddings[i] := hom;
    return hom;
end );

##############################################################################
##
#M  Projection                             for permutation semidirect products
##
InstallOtherMethod( Projection, "generic method for perm semidirect products",
    true, [ IsPermGroup and HasSemidirectProductInfo ], 0,
function( D )
    local  info, genD, G, genG, imgs, hom, ker, list;

    info := SemidirectProductInfo( D );
    if not IsBool( info.projections ) then
        return info.projections;
    fi;
    G := info.groups[1];
    genG := GeneratorsOfGroup( G );
    genD := GeneratorsOfGroup( D );
    list := [ info.lenlist[2]+1 .. info.lenlist[3] ];
    imgs := Concatenation( genG, List( list, j -> () ) );
    hom := GroupHomomorphismByImagesNC( D, G, genD, imgs );
    SetIsSurjective( hom, true );
    ker := Subgroup( D, genD{ list } );
    SetKernelOfMultiplicativeGeneralMapping( hom, ker );
    info.projections := hom;
    return hom;
end );

##############################################################################
##
#M  EndomorphismClassObj( <nat>, <iso>, <aut>, <conj> ) . . . . . make a class
##
InstallMethod( EndomorphismClassObj,
  "generic method for an endomorphism class", true,
  [ IsGroupHomomorphism, IsGroupHomomorphism, IsGroupOfAutomorphisms, IsList ],
  0,
function( nat, iso, aut, conj )

    local  filter, fam, class;

    fam := FamilyObj( [ nat, iso, aut, conj ] );
    filter := IsEndomorphismClassObj;
    class := Objectify( NewType( fam, filter ), rec() );
    SetIsEndomorphismClass( class, true );
    SetEndoClassNaturalHom( class, nat );
    SetEndoClassIsomorphism( class, iso );
    SetAutoGroup( class, aut );
    SetEndoClassConjugators( class, conj );
    return class;
end );

#############################################################################
##
#M  Display . . . . . . . . . . . . . . . . . . . . . for endomorphism classes
##
InstallMethod( Display, "generic method for endomorphism classes",
    true, [ IsEndomorphismClassObj ], 0,
function( class )
    Print( "class of group endomorphisms with\n" );
    Print( "natural hom: " );
    ViewObj( EndoClassNaturalHom( class ) );
    Print( "\n" );
    Print( "isomorphism: " );
    ViewObj( EndoClassIsomorphism( class ) );
    Print( "\n" );
    Print( "autogp gens: ", GeneratorsOfGroup( AutoGroup( class ) ), "\n" );
    Print( "conjugators: ", EndoClassConjugators( class ), "\n" );
end );

#############################################################################
##
#M  ZeroEndomorphismClass( <G> )
##
InstallMethod( ZeroEndomorphismClass, "generic method for a group",
    true, [ IsGroup ], 0, 
function( G )

    local  Q, nat, iso, aut, conj, idgp;

    Q := Group( One( G ) );
    nat := MappingToOne( G, Q );
    iso := IdentityMapping( Q );
    aut := Group( iso );
    SetIsAutomorphismGroup( aut, true );
    conj := [ One( G ) ];
    return EndomorphismClassObj( nat, iso, aut, conj );
end );

#############################################################################
##
#M  AutomorphismClass( <G> )
##
InstallMethod( AutomorphismClass, "generic method for a group", true,
    [ IsGroup ], 0, 
function( G )

    local  iso, aut, conj;

    aut := AutomorphismGroup( G );
    iso := InclusionMappingGroups( G, G );
    conj := [ One( G ) ];
    return EndomorphismClassObj( iso, iso, aut, conj );
end );

#############################################################################
##
#M  NontrivialEndomorphismClasses( <G> )
##
InstallMethod( NontrivialEndomorphismClasses, "generic method for a group",
    true, [ IsGroup ], 0, 
function( G )

    local  nargs, valid, case, switch, oldcase, normG, rcosG, N, nnum,
           natG, quotG, genG, oneG, Qnum, ccs, reps, cnum, Q, R, iso, L, im,
           phi, nat, proj, comp, normal, cosets, conj, Cnum, g, gim, zero,
           i, j, k, l, Lnum, aut, idgp, Ecl, Enum, classes, class, name, ok;

    genG := GeneratorsOfGroup( G );
    oneG := One( G );
    idgp := Subgroup( G, [ One(G) ] );
    # determine non-monomorphic endomorphisms by kernel
    normG := NormalSubgroups( G );
    nnum := Length( normG );
    ccs := ConjugacyClassesSubgroups( G );
    cnum :=Length( ccs );
    reps := List( ccs, c -> Representative( c ) );
    rcosG := List( normG, N -> RightCosets( G, N ) );
    natG := List( normG, N -> NaturalHomomorphismByNormalSubgroup( G, N ) );
    quotG := List( natG, n -> Image( n ) );
    normal := List( reps, R -> ( Normalizer( G, R ) = G ) );
    classes := [ ];
    for i in [2..(nnum-1)] do
        N := normG[i];
        Q := quotG[i];
        proj := natG[i];
        aut := AutomorphismGroup( Q );
        for j in [2..(cnum-1)] do
            R := reps[j];
            ok := ( Intersection( N, R ) = idgp );
            iso := IsomorphismGroups( Q, R );
            if not ( iso = fail ) then
                # (unnecessary?) check that this gives a homomorphism
                comp := CompositionMapping( iso, proj );
                im := List( genG, x -> Image( comp, x ) );
                phi := GroupHomomorphismByImages( G, R, genG, im );
                if not IsGroupHomomorphism( phi ) then
                    Error( "phi not a homomorphism" );
                fi;
                if not normal[j] then
                    cosets := RightCosets( G, Normalizer( G, R ) );
                    conj := List( cosets, c -> Representative( c ) );
                else
                    conj := [ oneG ];
                fi;
                class := EndomorphismClassObj( proj, iso, aut, conj );
                Add( classes, class );
            fi;
        od;
    od;
    return classes;
end );

#############################################################################
##
#M  NonIntersectingEndomorphismClasses( <G> )
##
InstallMethod( NonIntersectingEndomorphismClasses,
    "generic method for a group", true, [ IsGroup ], 0, 
function( G )

    local  nargs, valid, case, switch, oldcase, normG, rcosG, N, nnum,
           natG, quotG, genG, oneG, Qnum, ccs, reps, cnum, Q, R, iso, L, im,
           phi, nat, proj, comp, normal, cosets, conj, Cnum, g, gim, zero,
           i, j, k, l, Lnum, aut, idgp, Ecl, Enum, classes, class, name, ok;

    genG := GeneratorsOfGroup( G );
    oneG := One( G );
    idgp := Subgroup( G, [ One(G) ] );
    # determine non-monomorphic endomorphisms by kernel
    normG := NormalSubgroups( G );
    nnum := Length( normG );
    ccs := ConjugacyClassesSubgroups( G );
    cnum :=Length( ccs );
    reps := List( ccs, c -> Representative( c ) );
    rcosG := List( normG, N -> RightCosets( G, N ) );
    natG := List( normG, N -> NaturalHomomorphismByNormalSubgroup( G, N ) );
    quotG := List( natG, n -> Image( n ) );
    normal := List( reps, R -> ( Normalizer( G, R ) = G ) );

    classes := [ ];
    for i in [2..(nnum-1)] do
        N := normG[i];
        Q := quotG[i];
        proj := natG[i];
        aut := AutomorphismGroup( Q );
        for j in [2..(cnum-1)] do
            R := reps[j];
            ok := ( Intersection( N, R ) = idgp );
            if ok then
                iso := IsomorphismGroups( Q, R );
            fi;
            if ( ok and not ( iso = fail ) ) then
                # (unnecessary?) check that this gives a homomorphism
                comp := CompositionMapping( iso, proj );
                im := List( genG, x -> Image( comp, x ) );
                phi := GroupHomomorphismByImages( G, R, genG, im );
                if not IsGroupHomomorphism( phi ) then
                    Error( "phi not a homomorphism" );
                fi;
                if not normal[j] then
                    cosets := RightCosets( G, Normalizer( G, R ) );
                    conj := List( cosets, c -> Representative( c ) );
                else
                    conj := [ oneG ];
                fi;
                class := EndomorphismClassObj( proj, iso, aut, conj );
                Add( classes, class );
            fi;
        od;
    od;
    return classes;
end );

##############################################################################
##
#F  EndomorphismClasses                        finds all homomorphisms  G -> G
##
InstallGlobalFunction( EndomorphismClasses, 
function( arg )
    
    local  nargs, valid, G, case, classes, auts, ends, zero, disj;

    nargs := Length( arg );
    G := arg[1];
    valid := ( IsGroup( G ) and ( nargs = 2 ) and ( arg[2] in [0..3] ) );
    if not valid then
         Print( "\nUsage:  EndomorphismClasses( G [, case] );\n" );
         Print( " choose  case = 1  to include automorphisms & zero,\n" );
         Print( "default  case = 2  to exclude automorphisms & zero,\n" );
         Print( "         case = 3  when  N meet H  trivial,\n" );
         return fail;
    fi;
    if ( Length( arg ) = 1 ) then
        case := 2;
    else
        case := arg[2];
    fi;
    ends := NontrivialEndomorphismClasses( G );
    if ( case = 1 ) then
        zero := ZeroEndomorphismClass( G );
        auts := AutomorphismClass( G );
    fi;
    if ( case = 2 ) then
        classes := ends;
    elif ( case = 1 ) then
        classes := Concatenation( [auts], ends, [zero] );
    else
        classes := NonIntersectingEndomorphismClasses( G );
    fi;
    return classes;
end );

###############################################################################
##
#M  EndomorphismImages           finds all homomorphisms  G -> G  by converting
##                                 EndomorphismClasses into a list of genimages
##
InstallMethod( EndomorphismImages,
    "generic method for a list of endomorphism classes", true, [ IsList ], 0,
function( classes )

    local  clnum, G, genG, Q, autos, rho, psi, phi, L, Lnum, LR, k, l,
           im, g, gim, i, c, nat, iso, aut, conj, cjnum, comp, R;

    if ( ( classes = [] ) or not IsEndomorphismClass( classes[1] ) ) then
        Error( "usage: EndomorphismImages( <list of endo classes> );" );
    fi;
    c := classes[1];
    nat := EndoClassNaturalHom( c );
    G := Source( nat );
    genG := GeneratorsOfGroup( G );
    clnum := Length( classes );
    L := [ ];
    for i in [1..clnum] do
        c := classes[i];
        nat := EndoClassNaturalHom( c );
        iso := EndoClassIsomorphism( c );
        aut := AutoGroup( c );
        conj := EndoClassConjugators( c );
        comp := CompositionMapping( iso, nat );
        R := Image( comp );
        cjnum := Length( conj );
        Q := Image( nat );
        autos := Elements( aut );
        LR := [ ];
        for k in [ 1..Length( autos ) ] do
            rho := autos[k];
            psi := nat * rho * iso;
            im := List( genG, x -> Image( psi, x ) );
            Add( LR, im );
        od;
        Lnum := Length( LR );
        for k in [2..cjnum] do
            g := conj[k];
            for l in [1..Lnum] do
                im := LR[l];
                gim := List( im, x -> x^g );
                Add( LR, gim );
            od;
        od;
        L := Concatenation( L, LR ); 
    od;
    return L;
end );

###############################################################################
##
#M  IdempotentImages          finds all homomorphisms  h : G -> G  with h^2 = h
##                   by converting EndomorphismClasses into a list of genimages
##
InstallMethod( IdempotentImages,
    "generic method for a list of endomorphism classes", true, [ IsList ], 0,
function( classes )

    local  clnum, G, genG, Q, autos, rho, psi, phi, L, Lnum, LR, LR2, k, l,
           im, im2, psi2, g, gim, i, c, nat, iso, aut, conj, cjnum, comp, R;

    if ( ( classes = [] ) or not IsEndomorphismClass( classes[1] ) ) then
        Error( "usage: EndomorphismImages( <list of endo classes> );" );
    fi;
    c := classes[1];
    nat := EndoClassNaturalHom( c );
    G := Source( nat );
    genG := GeneratorsOfGroup( G );
    clnum := Length( classes );
    L := [ ];
    for i in [1..clnum] do
        c := classes[i];
        nat := EndoClassNaturalHom( c );
        iso := EndoClassIsomorphism( c );
        aut := AutoGroup( c );
        conj := EndoClassConjugators( c );
        comp := CompositionMapping( iso, nat );
        R := Image( comp );
        cjnum := Length( conj );
        Q := Image( nat );
        autos := Elements( aut );
        LR := [ ];
        for k in [ 1..Length( autos ) ] do
            rho := autos[k];
            psi := nat * rho * iso;
            im := List( genG, x -> Image( psi, x ) );
            Add( LR, im );
        od;
        LR2 := [ ];
        Lnum := Length( LR );
        for k in [1..cjnum] do
            g := conj[k];
            for l in [1..Lnum] do
                im := LR[l];
                gim := List( im, x -> x^g );
                psi2 := GroupHomomorphismByImages( G, G, genG, gim );
                im2 := List( gim, x -> Image( psi2, x ) );
                if ( gim = im2 ) then
                    Add( LR2, gim );
                fi;
            od;
        od;
        L := Concatenation( L, LR2 ); 
    od;
    return L;
end );

## ???? replace by ElementsInGenerators ???? ##

##############################################################################
##
#M  GenerationOrder         elements of G generated as words in the generators
##
InstallMethod( GenerationOrder, "method for a group", true, [ IsGroup ], 0,
function( G )

    local  oG, eG, ord, ngG, genG, g, i, j, k, P, pos, n, x, y;

#    genG := GeneratorsOfGroup( G );
    genG := StrongGeneratorsStabChain( StabChain( G ) );
    ngG := Length( genG );
    oG := Size( G );
    eG := Elements( G );
    ord := 0 * [1..oG];
    ord[1] := 1;
    P := 0 * [1..oG];
    P[1] := [ 1, 0 ];
    for n in [1..ngG] do
        g := genG[n];
        pos := Position( eG, g );
        P[pos] := [ 1, n ];
        ord[ n+1 ] := pos;
    od;
    n := ngG + 1;
    k := 2;
    while ( k < oG ) do
        i := ord[k];
        x := eG[i];
        for j in [1..ngG] do
            g := genG[j];
            y := x * g;
            pos := Position( eG, y );
            if ( P[pos] = 0 ) then
                P[pos] := [ i, j ];
                n := n+1;
                ord[n] := pos;
            fi;
        od;
        k := k+1;
    od;
    SetGenerationPairs( G, P );
    return ord;
end );

##############################################################################
##
#M  CheckGenerationPairs             G.generationPairs, G.generationOrder ok ?
##
InstallMethod( CheckGenerationPairs, "method for a ", true, [ IsGroup ], 0,
function( G )

    local  eG, oG, genG, P, i, g, x;

    genG := StrongGeneratorsStabChain( StabChain( G ) );
    oG := Size( G );
    eG := Elements( G );
    P := GenerationPairs( G );
    if ( P[1] <> [1,0] ) then
        return false;
    fi;
    for i in [2..oG] do
        x := eG[ P[i][1] ];
        g := genG[ P[i][2] ];
        if ( x*g <> eG[i] ) then
            Info( InfoXMod, 2, x, " * ", g, " <> ", eG[i] );
            return false;
        fi;
    od;
    return true;
end );

############################### items added May 2002 ########################

##############################################################################
##
#M  DistinctRepresentatives( <L> )
##
InstallMethod( DistinctRepresentatives, "for a list of sets", true,
    [ IsList ], 0,
function( L )

    local  n, rep, U, len, i, j, k, used, found, S, T, M, P, x, y, z;

    if not  ( IsList( L ) and
              ( ForAll( L, IsList ) or ForAll( L, IsSet ) ) ) then
        Error( "argument should be a list of sets" );
    fi;
    n := Length( L );
    U := [1..n];
    len := 0 * U;
    for i in U do
        S := L[i];
        if IsList( S ) then
            S := Set( S );
        fi;
        len[i] := Length( S );
        if ( len[i] = 0 ) then
            Error( "subsets must be non-empty" );
        fi;
        if not ForAll( S, j -> ( j in U ) ) then
            Error( "each set must be a subset of [1..n]" );
        fi;
    od;
    rep := 0 * U;
    used := 0 * U;
    rep[1] := L[1][1];
    used[ rep[1] ] := 1;
    for i in [2..n] do
        found := false;
        S := L[i];
        j := 0;
        while ( ( j < len[i] ) and not found ) do 
            j := j+1;
            x := S[j];
            if ( used[x] = 0 ) then
                rep[i] := x;
                used[x] := i;
                found := true;
            fi;
        od;
        # construct the graph component
        T := ShallowCopy( S );
        M := List( T );
        P := 0 * U;
        for x in M do
            P[x] := i;
        od;
        j := 0;
        while not found do
            j := j+1;
            x := M[j];
            k := used[x];
            if ( k = 0 ) then
                # reassign representatives
                y := P[x];
                while ( y <> i ) do
                    z := rep[y];
                    rep[y] := x;
                    used[x] := y;
                    x := z;
                    y := P[x];
                od;
                rep[i] := x;
                used[x] := i;
                found := true;
            else
                for y in L[k] do
                    if not ( y in T ) then
                        Add( M, y );
                        P[y] := k;
                        T := Union( T, [y] );
                    fi;
                od;
            fi;
            if ( ( not found ) and ( j = Length( M ) ) ) then
                Print( "Hall condition not satisfied!\n" );
                return false;
            fi;
        od;
    od;
    return rep;
end );

##############################################################################
##
#M  CommonRepresentatives( <J>, <K> )
##
InstallMethod( CommonRepresentatives, "for a pair of lists/sets", true,
    [ IsList, IsList ], 0,
function( J, K )

    local  U, i, j, k, m, n, lenJ, lenK, S, L, I, rep, perm, common;

    if not ( ForAll( J, IsList ) or ForAll( J, IsSet ) ) then
        Error( "first argument should be a list of sets" );
    fi;
    m := Length( J );
    if not ( ForAll( K, IsList ) or ForAll( K, IsSet ) ) then
        Error( "second argument should be a list of sets" );
    fi;
    n := Length( K );
    if not ( m = n ) then
        Error( "lists <J> and <K> have unequal length" );
    fi;
    U := [1..n];
    lenJ := 0 * U;
    lenK := 0 * U;
    for i in U do
        S := J[i];
        if IsList( S ) then
            S := Set( S );
        fi;
        lenJ[i] := Length( S );
        if ( lenJ[i] = 0 ) then
            Error( "sets must be non-empty" );
        fi;
        S := K[i];
        if IsList( S ) then
            S := Set( S );
        fi;
        lenK[i] := Length( S );
        if ( lenK[i] = 0 ) then
            Error( "sets must be non-empty" );
        fi;
    od;
    L := List( U, x -> [ ] );
    for i in U do
        S := J[i];
        for j in U do
            I := Intersection( S, K[j] );
            if ( Length( I ) > 0 ) then
                Add( L[i], j );
            fi;
        od;
    od;
    rep := DistinctRepresentatives( L );
    perm := PermList( rep );
    K := Permuted( K, perm^-1 );
    common := 0 * U;
    for i in U do
        I := Intersection( J[i], K[i] );
        common[i] := I[1];
    od;
    return [ common, rep ];
end );

##############################################################################
##
#M  CommonTransversal
##
InstallMethod( CommonTransversal, "for a group and a subgroup", true,
    [ IsGroup, IsGroup ], 0,
function( G, H )

    local  R, ER, EL, T;

    if not IsSubgroup( G, H ) then
        Error( "<H> must be a subgroup of <G>" );
    fi;
    R := RightCosets( G, H );
    ER := List( R, x -> Elements( x ) );
    EL := List( ER, C -> List( C, x -> x^(-1) ) );
    Info( InfoXMod, 3, "right cosets: ", ER );
    Info( InfoXMod, 3, " left cosets: ", EL );
    T := CommonRepresentatives( EL, ER );
    return T[1];
end );

##############################################################################
##
#M  IsCommonTransversal
##
InstallMethod( IsCommonTransversal, "for group, subgroup, list", true,
    [ IsGroup, IsGroup, IsList ], 0,
function( G, H, T )

    local  eG, eH, oG, oH, g, h, t, pos, ind, found;

    if not IsSubgroup( G, H ) then
        Print( "second group must be subgroup of first\n" );
        return fail;
    fi;
    oG := Size( G );
    oH := Size( H );
    eG := Elements( G );
    eH := Elements( H );
    ind := oG/oH;
    found := 0 * [1..oG];
    for t in T do
        if not ( t in eG ) then
            Print( "element of T not in G\n" );
            return false;
        fi;
        for h in eH do
            g := t*h;
            pos := Position( eG, g );
            found[pos] := found[pos] +1;
            g := h*t;
            pos := Position( eG, g );
            found[pos] := found[pos] + 1;
        od;
    od;  
    for t in [1..oG] do
        if not ( found[t] = 2 ) then
            Print( eG[t], " found ", found[t], " times\n" );
            return false;
        fi;
    od;
    return true;
end );

##############################################################################
##
#M  TzCommutatorPair( <tietze>, <rel> )
##
InstallGlobalFunction( TzCommutatorPair, function( T, rel )

    local  tietze, numgens, invs, numinvs, 
           x, ax, ix, px, y, ay, iy, py, pair;

    TzCheckRecord( T );
    tietze := T!.tietze;
    invs := tietze[TZ_INVERSES];
    numgens := tietze[TZ_NUMGENS];
    numinvs := 1 + 2 * numgens;
    if not ( IsList( rel ) and ( Length( rel ) = 4 ) ) then
        Print( "Second parameter must be a relator of length 4.\n" );
        return [ 0, 0 ];
    fi;
    x := rel[1];
    y := rel[2];
    ax := AbsInt( x );            
    ay := AbsInt( y );
    px := Position( invs, x );
    ix := invs[numinvs + 1 - px];
    py := Position( invs, y );
    iy := invs[numinvs + 1 - py];
    if ( ( rel[3] = ix ) and ( rel[4] = iy ) ) then
        pair := Set( [ ax, ay ] );
    else
        pair := [ 0, 0 ];
    fi;
    return pair;    
end );

##############################################################################
##
#M  TzPartition( <tietze> ) partition generators into commuting subsets
##
InstallGlobalFunction( TzPartition, function( T )

    local  tietze, numgens, gens, partition, count, bipartite,
           invs, allgens, others, rels, numrels, lengths, numpart, numold,
           numinvs, i, j, k, x, ax, y, ay, z, r, lr, s, ok,
           commpairs, c, d, pair, commutators, comm1, comm2,
           left, right, rest, powerof, powers, freq, fnum, L, S;

    TzCheckRecord( T );
    tietze := T!.tietze;
    invs := tietze[TZ_INVERSES];
    rels := tietze[TZ_RELATORS];
    lengths := tietze[TZ_LENGTHS];
    numrels := tietze[TZ_NUMRELS];
    numgens := tietze[TZ_NUMGENS];
    numinvs := 1 + 2 * numgens;
    allgens := [1..numgens];
    left := allgens;
    partition := [ Set( allgens ) ];

    # phase1: find explicit commutators
    commpairs := [ ];
    for j in [1..numgens] do
        Add( commpairs, [ ] );
    od;
    commutators := 0 * [1..numrels];
    comm1 := 0;
    comm2 := 0;
    for j in [1..numrels] do
        if ( lengths[j] <> 4 ) then
            commutators[j] := false;
        else
            r := rels[j];
            pair := TzCommutatorPair( T, r );
            if ( pair <> [ 0, 0 ] ) then
                commutators[j] := true;
                comm2 := comm2 + 1;
                ax := pair[1];
                ay := pair[2];
                if ( ( ax in allgens ) and ( ay in allgens ) ) then
                    Add( commpairs[ax], ay );
                    Add( commpairs[ay], ax );
                fi;
            else
                commutators[j] := false;
            fi;
        fi;
    od;
    commpairs := List( commpairs, L -> Set( L ) );
    if ( ( TzOptions(T).printLevel > 1 ) and ( comm2 > 0 ) ) then
        Print( "There were ", comm2, " commutators found in phase 1\n" );
    fi;

    # phase2: find implicit commutators
    while ( comm1 < comm2 ) do
        comm1 := comm2;
        for j in [1..numrels] do 
            r := rels[j];
            lr := Length( r );
            if ( lr > 1 ) then
                freq := Collected( List( r, x -> AbsInt( x ) ) );
                fnum := Length( freq );
                for x in [1..fnum] do
                    L := freq[x];
                    if ( L[2] = 1 ) then
                        S := allgens;
                        for y in [1..fnum] do
                            if ( x <> y ) then
                                z := freq[y][1];
                                S := Intersection( S, commpairs[z] );
                            fi;
                        od;
                        y := L[1];
                        commpairs[y] := Union( commpairs[y], S );
                        for z in S do
                            commpairs[z] := Union( commpairs[z], [y] );
                        od;
                    fi;
                od;
            fi;
        od;
    comm2 := Sum( List( commpairs, L -> Length( L ) ) )/2;
    if ( ( TzOptions(T).printLevel > 1 ) and ( comm2 > comm1 ) ) then
        Print( "There were ", comm2 - comm1 );
        Print( " commutators found in phase 2\n" );
    fi;
    od;

    # phase3: separate into parts
    numpart := 1;
    numold := 0;
    while ( ( numold <> numpart ) and ( Length( partition[1] ) > 1 ) ) do
        if ( numpart > 1 ) then
            commpairs := List( commpairs, 
                                  L -> Difference( L, partition[2] ) );
        fi;
        gens := partition[1];
        others := Difference( allgens, gens );
        rest := partition{[ 2..Length(partition) ]};
        bipartite := false;
        left := commpairs[ gens[1] ];
        if ( left <> [ ] ) then
            right := Difference( gens, left );
            bipartite := true;
            for c in commpairs do
                d := Difference( c, left );
                if not ( c = [ ] ) then
                    if not ( ( c = left ) or ( d = right ) ) then
                        bipartite := false;
                    fi;
                fi;
            od;
        fi;
        if bipartite then
            # reorder the letters in each relator (but not the commutators)
            partition := Concatenation( [ left ], [ right ], rest );
            for j in [1..numrels] do
                if not commutators[j] then
                    r := rels[j];
                    s := [ ];
                    for x in r do
                        ax := AbsInt( x );
                        if ( ax in left ) then
                            Add( s, x );
                        fi;
                    od;
                    for y in r do
                        ay := AbsInt( y );
                        if ( ay in right ) then
                            Add( s, y );
                        fi;
                    od;
                    for x in r do
                        ax := AbsInt( x );
                        if ( ax in others ) then
                            Add( s, x );
                        fi;
                    od;
                    if ( r <> s ) then
                        rels[j] := s;
                        tietze[TZ_MODIFIED] := true;
                    fi;
                fi;
            od;
            if ( TzOptions(T).printLevel > 1 ) then
                Print( "#I factoring ", gens, " into " );
                Print( left, ", ", right, "\n" );
            fi;
        else
            left := [ ];
        fi;
    numold := numpart;
    numpart := Length( partition );
    od;
    T!.partition := partition;
    ## return partition;
end );

##############################################################################
##
#M  FactorsPresentation( <tietze> ) 
##
InstallGlobalFunction( FactorsPresentation, function( arg )

    local  T, printlevel, tietze, gens, rels, numrels, numgens, invs, numinvs,
           lengths, flags, partition, part, numpart, i, j, k, rel, diff, F,
           commutator, fx, fy, pair, factor, fac, len, chosen, posn,
           subrels, subnumi, subtot, sublen, subflags, subtriv, subT;

    T := arg[1];
    TzCheckRecord( T );
    # check that the second argument is an integer
    printlevel := 1;
    if ( Length( arg ) = 2 ) then
        printlevel := arg[2];
    fi;
    if not IsInt( printlevel ) then
        Error( "second argument must be an integer" );
    fi;

    TzPartition( T );
    partition := T!.partition;
    if ( Length( partition ) = 1 ) then
        return [ T ];
    fi;
    tietze := T!.tietze;
    invs := tietze[TZ_INVERSES];
    numgens := tietze[TZ_NUMGENS];
    numinvs := 1 + 2 * numgens;
    gens := T!.generators;         ## ??????
    rels := tietze[TZ_RELATORS];
    lengths := tietze[TZ_LENGTHS];
    flags := tietze[TZ_FLAGS];
    numrels := tietze[TZ_NUMRELS];
    numpart := Length( partition );
    factor := 0 * [1..numgens ];
    for i in [1..numpart] do
        part := partition[i];
        for j in [1..Length(part)] do
            factor[ part[j] ] := i;
        od;
    od;
    chosen := List( [1..numpart], i -> [ ] );
    for j in [1..numrels] do
        rel := rels[j];
        len := lengths[j];
        commutator := false;
        if ( len = 4 ) then
            pair := TzCommutatorPair( T, rel );
            if ( pair <> [ 0, 0 ] ) then
                fx := factor[ pair[1] ];
                fy := factor[ pair[2] ];
                commutator := ( fx <> fy );
            fi;
        fi;
        if not commutator then
            fac := List( rel, i -> factor[ AbsInt( i ) ] );
            # check that fac is increasing
            for i in [2..len] do
                if ( fac[i] < fac[i-1] ) then
                    Print( "relator = ", rel, "\n" );
                    Error( "factors mixed in relator" );
                fi;
            od;
            for i in Set( fac ) do
                Add( chosen[i], j );
            od;           
        fi;
    od;
    # construct Tietze records for each factor
    subflags := 0 * [1..numpart];
    F := List( [1..numpart], i -> ShallowCopy( T ) );
    for i in [1..numpart] do
        subrels := [ ];
        for j in chosen[i] do
            rel := rels[j];
            len := lengths[j];
            fac := List( rel, k -> factor[ AbsInt( k ) ] );
            posn := Filtered( [1..len], k -> fac[k]=i );
            Add( subrels, rel{posn} );
        od;
        sublen := List( subrels, L -> Length( L ) );
        subflags := List( chosen[i], k -> flags[k] );
        F[i].printLevel := printlevel;
        subT := F[i].tietze;
        diff := Difference( [1..numgens], partition[i] );
        subtriv := List( diff, x -> [x] );
        subrels := Concatenation( subtriv, subrels );
        sublen := Concatenation( List( subtriv, x -> 1 ), sublen );
        subflags := Concatenation( List( subtriv, x -> 0 ), subflags );
        subnumi := Length( subrels );
        subtot := 0;
        for j in [1..subnumi] do
            subtot := subtot + sublen[j];
        od;
        subT[TZ_TOTAL] := subtot;
        subT[TZ_RELATORS] := subrels;
        subT[TZ_NUMRELS] := subnumi;
        subT[TZ_LENGTHS] := sublen;
        subT[TZ_FLAGS] := subflags;
        subT[TZ_STATUS] := [ subT[1], subT[2], subT[3] ];
    od;
    return F;
end );

##############################################################################
##
#M  IsomorphismFpInfo( <G> ) . . . . . . . . . . . . isomorphic fp-group for G
##
InstallOtherMethod( IsomorphismFpInfo, "for a group", true, [ IsGroup ], 0,
function( grp )

    local  iso, inv, fp, mgi;
    iso := IsomorphismFpGroup( grp );
    fp := ImagesSource( iso );
    mgi := MappingGeneratorsImages( iso );
    inv := GroupHomomorphismByImages( fp, grp, mgi[2], mgi[1] );
    if IsPermGroup( grp ) then
        SetIsomorphismPermInfo( fp,
            rec( perm := grp, g2perm := inv, perm2g := iso ) );
    fi;
    SetIsomorphismFpInfo( grp, 
        rec( fp := fp, g2fp := iso, fp2g := inv ) );
    return rec( fp := fp, g2fp := iso, fp2g := inv );
end );

##############################################################################
##
#M  IsomorphismPermInfo( <G> ) . . . . . . . . . . isomorphic perm group for G
##
InstallOtherMethod( IsomorphismPermInfo, "for a group", true, [ IsGroup ], 0,
function( grp )

    local  iso, inv, perm, mgi;
    iso := IsomorphismPermGroup( grp );
    perm := ImagesSource( iso );
    mgi := MappingGeneratorsImages( iso );
    inv := GroupHomomorphismByImages( perm, grp, mgi[2], mgi[1] );
    if IsFpGroup( grp ) then
        SetIsomorphismFpInfo( perm,
            rec( fp := grp, g2fp := inv, fp2g := iso ) );
    fi;
    SetIsomorphismPermInfo( grp,
        rec( perm := perm, g2perm := iso, perm2g := inv ) );
    return rec( perm := perm, g2perm := iso, perm2g := inv );
end );

##############################################################################
##
#M  IsomorphismPermObject( <obj> ) 
#M  IsomorphismFpObject( <obj> ) 
#M  IsomorphismPcObject( <obj> ) 
##
InstallGlobalFunction( IsomorphismPermObject, function( obj )
    if IsGroup( obj ) then
        return IsomorphismPermGroup( obj );
    elif IsPreXMod( obj ) then
        return IsomorphismPermPreXMod( obj );
    elif IsPreCat1( obj ) then
        return IsomorphismPermPreCat1( obj );
    else
        return fail;
    fi;
end );

InstallGlobalFunction( IsomorphismFpObject, function( obj )
    if IsGroup( obj ) then
        return IsomorphismFpGroup( obj );
    elif IsPreXMod( obj ) then
        return IsomorphismFpPreXMod( obj );
    elif IsPreCat1( obj ) then
        return IsomorphismFpPreCat1( obj );
    else
        return fail;
    fi;
end );

InstallGlobalFunction( IsomorphismPcObject, function( obj )
    if IsGroup( obj ) then
        return IsomorphismPcGroup( obj );
    elif IsPreXMod( obj ) then
        return IsomorphismPcPreXMod( obj );
    elif IsPreCat1( obj ) then
        return IsomorphismPcPreCat1( obj );
    else
        return fail;
    fi;
end );

##############################################################################
##
#M  MetacyclicGroup
##
InstallMethod( MetacyclicGroup, "for three positive integers", true,
    [ IsPosInt, IsPosInt, IsPosInt ], 0,
function( m, n, l )

    local  f, x, y, rels, fp, iso;
    if not ( RemInt( l^m, n ) = 1 ) then
        return fail;
    fi;
    f := FreeGroup( 2 );
    x := GeneratorsOfGroup( f )[1];
    y := GeneratorsOfGroup( f )[2];
    rels := [ x^m, y^n, x^(-1)*y*x*y^(-l) ];
    fp := f/rels;
    iso := IsomorphismPermGroup( fp );
    return Image( iso );
end );

## added 08/04/01, using SmallerDegreePermutationRepresentation
##############################################################################
##
#M  IsomorphismSmallPermGroup
##
InstallMethod( IsomorphismSmallPermGroup, "for a group", true,
    [ IsGroup ], 0,
function( G )

    local  G2P, P, nP, P2S, nS, S, iso;

    G2P := IsomorphismPermGroup( G );
    P := Image( G2P );
    nP := NrMovedPoints( P );
    P2S := SmallerDegreePermutationRepresentation( P );
    if ( P2S = fail ) then
        iso := G2P;
    else
        S := Image( P2S );
        nS := NrMovedPoints( S );
        if ( nP = nS ) then
            iso := G2P;
        else
            iso := G2P * P2S;
        fi;
    fi;
    if ( HasName( G ) and not HasName( Range( iso ) ) ) then
        SetName( Range( iso ), Concatenation( "P", Name( G ) ) );
    fi;
    return iso;
end );

#############################################################################
##
#E  util.gi . . . . . . . . . . . . . . . . . . . . . . . . . . . . ends here
