#############################################################################
##
#W obj3.gi                        XMOD Package                  Chris Wensley
##
## Installation file for functions of the XMOD package.
##
#H @(#)$Id: obj3.gi,v 2.007 2006/07/05 gap Exp $
##
#Y Copyright (C) 1999,2001 University of St. Andrews, North Haugh,
#Y St. Andrews, Fife KY16 9SS, Scotland
##
## This file contains generic methods for (pre-)crossed square and
## (pre-)cat2-groups.
##
Revision. ("xmod/gap/obj3_gi") :=
  "@(#)$Id: obj3.gi,v 2.007 2006/07/05 gap Exp $";

#############################################################################
##
#M  Is3dObject
##
InstallMethod( Is3dObject, "generic method for 2-dimensional group objects",
    true, [ IsObject ], 0,
function ( obj )
    return ( ( HasUp2dObject( obj ) and HasDown2dObject( obj )
               and HasLeft2dObject( obj ) and HasRight2dObject( obj ) )
         and ( IsPreXSq( obj ) or IsPreCat2( obj ) ) );
end );

#############################################################################
##
#M  IsPerm3dObject . . . . . . . . check whether the 4 sides are perm groups
#M  IsFp3dObject . . . . . . . . . check whether the 4 sides are fp groups
#M  IsPc3dObject . . . . . . . . . check whether the 4 sides are pc groups
##
InstallMethod( IsPerm3dObject, "generic method for 3d-group objects",
    true, [ Is3dObject ], 0,
function (obj)
    return ( IsPermGroup( Up2dObject(obj) ) and IsPermGroup( Range(obj) )
             and IsPermGroup( Left2dObject(obj) ) 
             and IsPermGroup( Right2dObject(obj) ) );
end );

InstallMethod( IsFp3dObject, "generic method for 3d-group objects",
    true, [ Is3dObject ], 0,
function (obj)
    return ( IsFpGroup( Up2dObject(obj) ) and IsFpGroup( Range(obj) )
             and IsFpGroup( Left2dObject(obj) ) 
             and IsFpGroup( Right2dObject(obj) ) );
end );

InstallMethod( IsPc3dObject, "generic method for 3d-group obj ects" ,
    true, [ Is3dObject ], 0,
function (obj)
    return ( IsPcGroup( Up2dObject(obj) ) and IsPcGroup( Range(obj) )
             and IsPcGroup( Left2dObject(obj) ) 
             and IsPcGroup( Right2dObject(obj) ) );
end );

##############################################################################
##
#M  IsXPair
##
InstallMethod( IsXPair, "generic method for mappings", true, 
    [ IsGeneralMapping ], 0,
function( map )
    return ( HasSource( map ) and HasRange( map ) 
             and HasXPairMap( map ) );
end );

##############################################################################
##
#M  XPairObj( [<src1>,<src2>],<rng>,<map> ) .. make a crossed pairing
##
InstallMethod( XPairObj, "for a general mapping", true,
    [ IsList, IsGroup, IsGeneralMapping ], 0,
function( src, rng, map )

    local  filter, fam, obj;

    fam := FamilyObj( [ src, rng, map ] );
    filter := IsXPairObj;
    obj := rec();
    ObjectifyWithAttributes( obj, NewType( fam, filter ),
        Source, src,
        Range, rng, 
        XPairMap, map,
        IsXPair, true );
    return obj;
end );

##############################################################################
##
#M  XPairByNormalSubgroups( <grp>, <grp>, <grp> ) . . . make an xpair
##
InstallMethod( XPairByNormalSubgroups, 
    "for the intersection of two normal subgroups", true,
    [ IsGroup, IsGroup, IsGroup ], 0,
function( M, N, L )

    local  map, xp;

    if not ( IsNormal( M, L ) and IsNormal( N, L ) ) then 
        Error( "L not normal in M and N" );
    fi;
    map := Mapping2ArgumentsByFunction( [M,N], L, 
               function(c) return Comm( c[1], c[2] ); end );
    xp := XPairObj( [M,N], L, map );
    return xp;
end );

##############################################################################
##
#M  XPairByDerivations( <xmod> ) . . .  make an actor crossed pairing
##
InstallMethod( XPairByDerivations, "for a crossed module", true,
    [ IsXMod ], 0,
function( X0 )

    local  SX, RX, WX, reg, imlist, map;

    SX := Source( X0 );
    RX := Range( X0 );
    WX := WhiteheadPermGroup( X0 );
    reg := RegularDerivations( X0 );
    imlist := ImagesList( reg );
    map := Mapping2ArgumentsByFunction( [RX,WX], SX, 
               function(t) 
               local  r, p, pos, chi;
               r := t[1];  p := t[2];
               pos := Position( Elements( WX ), p );
               chi := DerivationByImages( X0, imlist[pos] ); 
               return DerivationImage( chi, r ); 
               end );
    return XPairObj( [RX,WX], SX, map );
end );

#############################################################################
##
#M  ImageElmXPair( <map>, <elm> )  . . . . . . . for crossed pairing
##
InstallMethod( ImageElmXPair, "for crossed pairing", true, 
    [ IsXPair, IsList ], 0,
    function ( xp, elm ) 
        return ImageElm( XPairMap( xp ), elm );
    end );

#############################################################################
##
#M  IsPreXSq . . . . . . . . . . . . . . . . .  check that the square commutes
##
InstallMethod( IsPreXSq, "generic method for a pre-crossed square",
    true, [ Is3dObject ], 0,
function( P )

    local  u, d, l, r, ul, dl, ur, dr, bu, bd, bl, br, blbd, bubr,
           autu, autl, act, diag, ok, morud, morlr;

    if not ( IsPreXSqObj ( P ) and HasDiagonalAction( P ) 
             and HasXPair( P ) ) then
        return false;
    fi;
    u := Up2dObject( P );
    l := Left2dObject( P );
    d := Down2dObject( P );
    r := Right2dObject( P );
    act := DiagonalAction( P );
    ul := Source( u );
    ur := Range( u );
    dl := Source( d );
    dr := Range( d );
    if not ( ( ul = Source(l) ) and ( dl = Range(l) ) and
             ( ur = Source(r) ) and ( dr = Range(r) ) ) then
        Info( InfoXMod, 2, "Incompatible source/range" );
        return false;
    fi;
    ## construct the boundary of the diagonal
    bl := Boundary( l );
    bd := Boundary( d );
    blbd := bl * bd;
    bu := Boundary( u );
    br := Boundary( r );
    bubr := bu * br;
    if not ( blbd = bubr ) then
        Info( InfoXMod, 2, "Boundaries in square do not commute" );
        return false;
    fi;
    ## check the action of the diagonal
    autu := AutoGroup( u );
    autl := AutoGroup( l );
    if not ( autu = autl ) then
        Info( InfoXMod, 1, "Allow the case autu <> autl ?" );
        return false;
    fi;
    diag := PreXModByBoundaryAndAction( blbd, act );
    ok := IsPreXMod( diag );
    if not ok then
        Info( InfoXMod, 2, "diagonal not a pre-crossed module" );
        return false;
    fi;
    ## compatible actions to be checked?
    morud := PreXModMorphism( u, d, bl, br );
    morlr := PreXModMorphism( l, r, bu, bd );
    if not ( IsPreXModMorphism( morud ) and IsPreXModMorphism( morlr ) ) then
        Info( InfoXMod, 2, "morud and/or modlr not prexmod morphisms" );
        return false;
    fi;
    return true;
end );

##############################################################################
##
#M  PreXSqObj ( <up>, <down>, <left>, <right>, <act>, <pair> ) . .make a PreXSq
##
InstallMethod( PreXSqObj, "for prexmods, action and pairing", true,
    [ IsPreXMod, IsPreXMod, IsPreXMod, IsPreXMod, IsObject, IsObject ], 0,
function( u, l, d, r, a, p )

    local  filter, fam, PS, ok, src, rng, aut, narne;

    fam := FamilyObj( [ u, d, l, r, a, p ] );
    filter := IsPreXSqObj;
    ## test commutativity here?
    PS := rec();
    ObjectifyWithAttributes( PS, NewType( fam, filter), 
      Up2dObject, u, 
      Left2dObject, l,
      Down2dObject, d,
      Right2dObject, r,
      XPair, p,
      DiagonalAction, a,
      Is3dObject, true );
    if not IsPreXSq( PS ) then
        Info( InfoXMod, 1, "Warning: not a pre-crossed square." );
    fi;
    # ok := IsXSq( PS );
    # name:= Name( PS );
    return PS;
end );

##############################################################################
##
#M  XSqByNormalSubgroups          create a crossed square from normal M,N in P
##
InstallMethod( XSqByNormalSubgroups, "conjugation crossed square",
    true, [ IsGroup, IsGroup, IsGroup, IsGroup ], 0,
function( P, N, M, L )

    local  XS, u, d, l, r, a, xp, diag;

    if not ( IsNormal( P, M ) and IsNormal( P, N ) 
             and IsNormal( M, L ) and IsNormal( N, L ) ) then
        return fail;
    fi;
    if not ( L = Intersection( M, N ) ) then 
        Print( "Warning: expecting L = Intersection( M, N )\n" );
    fi;
    if ( not HasName(L) and HasName(M) and HasName(N) ) then
        SetName( L, Concatenation ( "(", Name(M), "^", Name(N), ")" ) );
    fi;
    u := XModByNormalSubgroup( N, L );
    l := XModByNormalSubgroup( M, L );
    d := XModByNormalSubgroup( P, M );
    r := XModByNormalSubgroup( P, N );
    diag := XModByNormalSubgroup( P, L );
    a := XModAction( diag );
    ##  define the pairing as a commutator
    xp := XPairByNormalSubgroups( M, N, L );
    XS := PreXSqObj( u, l, d, r, a, xp );
    SetIsXSq( XS, true );
    return XS;
end );

InstallOtherMethod( XSqByNormalSubgroups, "conjugation crossed square",
    true, [ IsGroup, IsGroup, IsGroup ], 0,
function( P, M, N )

    local  XS, genP, genM, genN, L, genL, u, d, l, r, a, p, diag;

    if not ( IsNormal( P, M ) and IsNormal( P, N ) ) then
        return fail;
    fi;
    L := Intersection( M, N );
    return XSqByNormalSubgroups( P, M, N, L );;
end );

##############################################################################
##
#M  ActorXSq                create a crossed square from an xmod and its actor
##
InstallMethod( ActorXSq, "actor crossed square", true, [ IsXMod ], 0,
function( X0 )

    local  XS, WX, LX, NX, AX, xp, da;

    AX := ActorXMod( X0 );
    WX := WhiteheadXMod( X0 );
    NX := NorrieXMod( X0 );
    LX := LueXMod( X0 );
    da := XModAction( LX );
    ##  define the pairing as evaluation of a derivation
    xp := XPairByDerivations( X0 );
    XS := PreXSqObj( WX, X0, NX, AX, da, xp );
    SetIsXSq( XS, true );
    return XS;
end );

##############################################################################
##
#M  Transpose3dObject                        the transpose of a crossed square
##
InstallMethod( Transpose3dObject, "transposed crossed square", true, 
    [ IsXSq ], 0,
function( XS )

    local  xpS, NM, L, map, xpT, XT;

    xpS := XPair( XS );
    NM := Reversed( Source( xpS ) );
    L := Range( xpS );
    map := Mapping2ArgumentsByFunction( NM, L, 
             function(c) return ImageElmXPair( xpS, Reversed(c) )^(-1); end );
    xpT := XPairObj( NM, L, map );
    XT := PreXSqObj( Left2dObject(XS), Up2dObject(XS), Right2dObject(XS), 
                     Down2dObject(XS), DiagonalAction(XS), xpT );
    SetIsXSq( XT, true );
    return XT;
end );    

#############################################################################
##
#M  Name . . . . . . . . . . . . . . . . . . . . . . for a pre-crossed square
##
InstallMethod( Name, "method for a pre-crossed square", true, [ IsPreXSq ], 0,
function( PS )

    local  nul, nur, ndl, ndr, name, mor;

    if HasName( Source( Up2dObject( PS ) ) ) then
        nul := Name( Source( Up2dObject( PS ) ) );
    else
        nul := "..";
    fi;
    if HasName( Range( Up2dObject( PS ) ) ) then
        nur := Name( Range( Up2dObject( PS ) ) );
    else
        nur := "..";
    fi;
    if HasName( Source( Down2dObject( PS ) ) ) then
        ndl := Name( Source( Down2dObject( PS ) ) );
    else
        ndl := "..";
    fi;
    if HasName( Range( Down2dObject( PS ) ) ) then
        ndr := Name( Range( Down2dObject( PS ) ) );
    else
        ndr := "..";
    fi;
    name := Concatenation( "[", nul, "->", nur, ",", ndl, "->", ndr, "]" );
    SetName( PS, name );
    return name;
end );

#############################################################################
##
#M ViewObj( <PM> ) . . . . . . . . . . . . . . . view a (pre-)crossed square
##
InstallMethod( ViewObj, "method for a pre-crossed square", true,
    [ IsPreXSq ], 0,
function( PS )

    local  L, M, N, P, lenL, lenM, lenN, lenP, len1, len2, j, q1, q2, ok;

    if HasName( PS ) then
        Print( Name( PS ), "\n" );
    else
        L := Source( Up2dObject( PS ) );
        M := Source( Down2dObject( PS ) );
        N := Range( Up2dObject( PS ) );
        P := Range( Down2dObject( PS ) );
        ok := HasName(L) and HasName(M) and HasName(N) and HasName(P);
        if ok then
            lenL := Length( Name( L ) );
            lenM := Length( Name( M ) );
            lenN := Length( Name( N ) );
            lenP := Length( Name( P ) );
            len1 := Maximum( lenL, lenM );
            len2 := Maximum( lenN, lenP );
            q1 := QuoInt( len1, 2 );
            q2 := QuoInt( len2, 2 );
            Print( "[ " );
            for j in [1..lenM-lenL] do Print(" "); od;
            Print( Name(L), " -> ", Name(N) );
            for j in [1..lenP-lenN] do Print(" "); od;
            Print( " ]\n[ " );
            for j in [1..q1] do Print(" "); od;
            Print( "|" );
            for j in [1..q1+RemInt(len1,2)+2+q2+RemInt(len2,2)] do 
                Print(" "); 
            od;
            Print( "|" );
            for j in [1..q2] do Print(" "); od;
            Print( " ]\n" );
            Print( "[ " );
            for j in [1..lenL-lenM] do Print(" "); od;
            Print( Name(M), " -> ", Name(P) );
            for j in [1..lenN-lenP] do Print(" "); od;
            Print( " ]\n" );
        else
            if ( HasIsXSq( PS ) and IsXSq( PS ) ) then
                Print( "crossed square with:\n" );
            else
                Print( "pre-crossed square with:\n" );
            fi;
            Print( "      up = ",   Up2dObject(PS), "\n" );
            Print( "    left = ", Left2dObject(PS), "\n" );
            Print( "    down = ", Down2dObject(PS), "\n" );
            Print( "   right = ",Right2dObject(PS), "\n" );
        fi;
    fi;
end );

#############################################################################
##
#M PrintObj( <PS> . . . . . . . . . . . . . . . . view a (pre-)crossed square
##
InstallMethod( PrintObj, "method for a pre-crossed square", true,
    [ IsPreXSq ], 0,
function( PS )

    local  L, M, N, P, lenL, lenM, lenN, lenP, len1, len2, j, q1, q2, ok;

    if HasName( PS ) then
        Print( Name( PS ), "\n" );
    else
        L := Source( Up2dObject( PS ) );
        M := Source( Down2dObject( PS ) );
        N := Range( Up2dObject( PS ) );
        P := Range( Down2dObject( PS ) );
        ok := HasName(L) and HasName(M) and HasName(N) and HasName(P);
        if ok then
            lenL := Length( Name( L ) );
            lenM := Length( Name( M ) );
            lenN := Length( Name( N ) );
            lenP := Length( Name( P ) );
            len1 := Maximum( lenL, lenM );
            len2 := Maximum( lenN, lenP );
            q1 := QuoInt( len1, 2 );
            q2 := QuoInt( len2, 2 );
            Print( "[ " );
            for j in [1..lenM-lenL] do Print(" "); od;
            Print( Name(L), " -> ", Name(N) );
            for j in [1..lenP-lenN] do Print(" "); od;
            Print( " ]\n[ " );
            for j in [1..q1] do Print(" "); od;
            Print( "|" );
            for j in [1..q1+RemInt(len1,2)+2+q2+RemInt(len2,2)] do 
                Print(" "); 
            od;
            Print( "|" );
            for j in [1..q2] do Print(" "); od;
            Print( " ]\n" );
            Print( "[ " );
            for j in [1..lenL-lenM] do Print(" "); od;
            Print( Name(M), " -> ", Name(P) );
            for j in [1..lenN-lenP] do Print(" "); od;
            Print( " ]\n" );
        else
            Print( "(pre-)crossed square with:\n" );
            Print( "      up = ",   Up2dObject(PS), "\n" );
            Print( "    left = ", Left2dObject(PS), "\n" );
            Print( "    down = ", Down2dObject(PS), "\n" );
            Print( "   right = ",Right2dObject(PS), "\n" );
        fi;
    fi;
end );

#############################################################################
##
#M Display( <PS> . . . . . . . . . . . . . . . display a (pre-)crossed square
##
InstallMethod( Display, "method for a pre-crossed square", true,
    [ IsPreXSq ], 0,
function( PS )
    Print( "Display not yet implemented for crossed squares\n" );
end );

#############################################################################
##
#E obj3.gi . . . . . . . . . . . . . . . . . . . . . . . . . . . .  ends here
