Quellcodebibliothek Statistik Leitseite products/Sources/formale Sprachen/GAP/pkg/groupoids/lib/   (Algebra von RWTH Aachen Version 4.15.1©)  Datei vom 11.8.2025 mit Größe 24 kB image not shown  

Quelle  double.gi   Sprache: unbekannt

 
############################################################################# 
## 
#W  double.gi                 GAP4 package `groupoids'          Chris Wensley 
##  
##  This file contains the implementations for basic double groupoids 
##  

#####################  MULT SQUARE WITH OBJECTS  ########################### 

############################################################################ 
## 
#M  SquareOfArrows( <dmwo>, <elt>, <down>, <left>, <up>, <right> ) 
#M  SquareOfArrowsNC( <dmwo>, <elt>, <down>, <left>, <up>, <right> ) 
##
InstallMethod( SquareOfArrowsNC, 
    "for double groupoid, element, up, left, right and down", true,  
    [ IsDoubleGroupoid, IsMultiplicativeElement, 
      IsObject, IsObject, IsObject, IsObject ], 0, 
function( dg, m, u, l, r, d ) 

    local elt, fam;

    fam := IsGroupoidElementFamily; 
    elt := Objectify( IsDoubleGroupoidElementType, [ dg, m, u, l, r, d ] );
    return elt; 
end ); 

InstallMethod( SquareOfArrows, 
    "for double groupoid with objects, element, up, left, right and down", 
    true, [ IsBasicDoubleGroupoid, IsMultiplicativeElement, 
            IsObject, IsObject, IsObject, IsObject ], 0, 
function( dmwo, e, u, l, r, d ) 

    local  gpd, ok, piece, loop, sq; 

    gpd := dmwo!.groupoid;     
    ok := ForAll( [u,l,r,d], x -> x in gpd ) 
             and ( TailOfArrow( u ) = TailOfArrow( l ) ) 
             and ( HeadOfArrow( u ) = TailOfArrow( r ) ) 
             and ( HeadOfArrow( l ) = TailOfArrow( d ) ) 
             and ( HeadOfArrow( r ) = HeadOfArrow( d ) ); 
    if not ok then 
        Info( InfoGroupoids, 1, "the four arrows do not form a square" );
        return fail; 
    else 
        if IsSinglePiece( gpd ) then 
            piece := dmwo; 
        else 
            piece := PieceOfObject( gpd, TailOfArrow( d ) ); 
        fi; 
        loop := d^-1 * l^-1 * u * r; 
        ok := ( e = loop![2] ); 
        if not ok then 
            Info( InfoGroupoids, 2, "here" ); 
            Info( InfoGroupoids, 1, "element ", e, 
                               " <> boundary element ", loop![2] ); 
            return fail; 
        fi; 
        sq := SquareOfArrowsNC( dmwo, e, u, l, r, d ); 
        return sq; 
    fi; 
end );

InstallOtherMethod( SquareOfArrows, 
    "for double groupoid with objects, up, left, right and down", 
    true, [ IsDoubleGroupoid, IsObject, IsObject, IsObject, IsObject ], 0, 
function( dmwo, u, l, r, d )

    local  gpd, ok, piece, loop, m, sq; 

    gpd := dmwo!.groupoid;     
    ok := ForAll( [u,l,r,d], x -> x in gpd ) 
             and ( TailOfArrow( u ) = TailOfArrow( l ) ) 
             and ( HeadOfArrow( u ) = TailOfArrow( r ) ) 
             and ( HeadOfArrow( l ) = TailOfArrow( d ) ) 
             and ( HeadOfArrow( r ) = HeadOfArrow( d ) ); 
    if not ok then 
        Info( InfoGroupoids, 1, "the four arrows do not form a square" );
        return fail; 
    else 
        if IsSinglePiece( gpd ) then 
            piece := dmwo; 
        else 
            piece := PieceOfObject( gpd, TailOfArrow( d ) ); 
        fi;
        m := ( d^-1 * l^-1 * u * r )![2];
        sq := SquareOfArrowsNC( dmwo, m, u, l, r, d ); 
        return sq; 
    fi; 
end );

#############################################################################
## 
#M  ElementOfSquare
#M  DownArrow
#M  LeftArrow 
#M  UpArrow 
#M  DownArrow
#M  BoundaryOfSquare 
##
InstallMethod( DoubleGroupoidOfSquare, "generic method for double gpd element", 
    true, [ IsDoubleGroupoidElement ], 0, s -> s![1] ); 

InstallMethod( ElementOfSquare, "generic method for double groupoid element", 
    true, [ IsDoubleGroupoidElement ], 0, s -> s![2] ); 

InstallMethod( UpArrow, "generic method for double groupoid element", 
    true, [ IsDoubleGroupoidElement ], 0, s -> s![3] ); 

InstallMethod( LeftArrow, "generic method for double groupoid element", 
    true, [ IsDoubleGroupoidElement ], 0, e -> e![4] ); 

InstallMethod( RightArrow, "generic method for double groupoid element", 
    true, [ IsDoubleGroupoidElement ], 0, s -> s![5] ); 

InstallMethod( DownArrow, "generic method for double groupoid element", 
    true, [ IsDoubleGroupoidElement ], 0, s -> s![6] ); 

InstallMethod( BoundaryOfSquare, "generic method for double groupoid element", 
    true, [ IsDoubleGroupoidElement ], 0,
    s -> s![6]^(-1) * s![4]^(-1) * s![3] * s![5] );

#############################################################################
##
#M  String, ViewString, PrintString, ViewObj, PrintObj 
##  . . . . . . . . . . . . . . . . . . for elements in a double groupoid  
##
InstallMethod( String, "for a square in a double groupoid", true, 
    [ IsMultiplicativeElementWithObjects ], 0, 
function( e ) 
    return( STRINGIFY( "[", String( e![2] ), " : ", String( e![3] ), 
                       " -> ", String( e![4] ), "]" ) ); 
end );

InstallMethod( ViewString, "for a square in a double groupoid", true, 
    [ IsDoubleGroupoidElement ], 0, String ); 

InstallMethod( PrintString, "for a square in a double groupoid", true, 
    [ IsDoubleGroupoidElement ], 0, String ); 

InstallMethod( ViewObj, "for a square in a double groupoid", true, 
    [ IsDoubleGroupoidElement ], 0, PrintObj ); 

InstallMethod( PrintObj, "for a square in a double groupoid",
    [ IsDoubleGroupoidElement ],
function ( sq ) 
    local up, lt, rt, dn, es, spaces, dashes,
          upstr, ltstr, rtstr, dnstr, uplen, ltlen, rtlen, dnlen, esstr, eslen,
          toplen, midlen, botlen, maxlen, topgap, midgap, botgap; 
    up := UpArrow( sq );
    lt := LeftArrow( sq ); 
    rt := RightArrow( sq ); 
    dn := DownArrow( sq );
    es := ElementOfSquare( sq );
    spaces := "                                                  ";
    dashes := "--------------------------------------------------";
    upstr := [ String( up![2] ), String( up![3] ), String( up![4] ) ];
    uplen := List( upstr, s -> Length(s) );
    ltstr := [ String( lt![2] ), String( lt![3] ), String( lt![4] ) ];
    ltlen := List( ltstr, s -> Length(s) );
    rtstr := [ String( rt![2] ), String( rt![3] ), String( rt![4] ) ];
    rtlen := List( rtstr, s -> Length(s) );
    dnstr := [ String( dn![2] ), String( dn![3] ), String( dn![4] ) ];
    dnlen := List( dnstr, s -> Length(s) );
    esstr := String( es );
    eslen := Length( esstr );
    toplen := uplen[2]+2 + 6 + uplen[1] + 6 + uplen[3]+2;
    midlen := ltlen[1] + 6 + eslen + 6 + rtlen[1];
    botlen := dnlen[2]+2 + 6 + dnlen[1] + 6 + dnlen[3]+2;
    maxlen := Maximum( [ toplen, midlen, botlen ] );
    topgap := 4;
    midgap := 8;
    botgap := 4;
    if ( maxlen = midlen ) then
        topgap := 4 + Int( (maxlen - toplen)/2 );
        botgap := 4 + Int( (maxlen - botlen)/2 );
    elif ( maxlen = botlen ) then
        topgap := topgap + Int( (botlen-toplen)/2 );
        midgap := midgap - 2 + Int( (botlen-midlen)/2 );
    elif ( maxlen = toplen ) then
        botgap := botgap + Int( (toplen-botlen)/2 );
        midgap := midgap - 2 + Int( (toplen-midlen)/2 );
    fi;
    Print( "[", up![3], "] ", dashes{[1..topgap]}, " ", up![2],
           " ", dashes{[1..topgap-1]}, "> [", up![4], "]\n" );
    Print( "  |  ", spaces{[1..maxlen-11]}, "   |\n" );
    Print( lt![2], spaces{[1..midgap]}, es, spaces{[1..midgap]}, rt![2], "\n" ); 
    Print( "  V  ", spaces{[1..maxlen-11]}, "   V\n" ); 
    Print( "[", dn![3], "] ", dashes{[1..botgap]}, " ", dn![2],
           " ", dashes{[1..botgap-1]}, "> [", dn![4], "]" );
end );

InstallMethod( ViewObj, "for an element in a magma with objects",
    [ IsMultiplicativeElementWithObjects ], PrintObj );

#############################################################################
##
#M  IsCommutingSquare
##
InstallMethod( IsCommutingSquare, "for a square in a double groupoid", true,
    [ IsDoubleGroupoidElement ], 0,
function( sq )
    return sq![4] * sq![6] = sq![3] * sq![5];
end );

############################################################################# 
## 
#M  HorizontalProduct( s1, s2 ) 
##      . . . . horizantal composition of squares in a basic double groupoid 
## 
InstallMethod( HorizontalProduct, 
    "for two squares in a basic double groupoid", true, 
    [ IsDoubleGroupoidElement, IsDoubleGroupoidElement ], 0, 
function( s1, s2 ) 

    local m; 

    ## elements are composable? 
    if not ( s1![5] = s2![4] ) then 
        Info( InfoGroupoids, 1, "right arrow of s1 <> left arrow of s2" ); 
        return fail; 
    fi; 
    if not ( s1![1] = s2![1] ) then 
        Info( InfoGroupoids, 1, "s1 and s2 are in different double groupoids" ); 
        return fail; 
    fi; 
    m := s1![2]^s2![6]![2] * s2![2];
    return SquareOfArrowsNC( s1![1], m, s1![3]*s2![3], s1![4], 
                                        s2![5], s1![6]*s2![6] ); 
end );

############################################################################# 
## 
#M  VerticalProduct( s1, s2 ) 
##  . . . . . . . vertical composition of squares in a basic double groupoid 
## 
InstallMethod( VerticalProduct, "for two squares in a basic double groupoid", 
    true, [ IsDoubleGroupoidElement, IsDoubleGroupoidElement ], 0, 
function( s1, s2 ) 

    local m; 

    ## elements are composable? 
    if not ( s1![6] = s2![3] ) then 
        Info( InfoGroupoids, 1, "down arrow of s1 <> up arrow of s2" ); 
        return fail; 
    fi; 
    if not ( s1![1] = s2![1] ) then 
        Info( InfoGroupoids, 1, "s1 and s2 are in different double groupoids" ); 
        return fail; 
    fi; 
    m := s2![2] * s1![2]^s2![5]![2]; 
    return SquareOfArrowsNC( s1![1], m, s1![3], s1![4]*s2![4], 
                                        s1![5]*s2![5], s2![6] ); 
end );

############################################################################# 
## 
#M  HorizontalIdentities( s ) 
## 
InstallMethod( HorizontalIdentities, "for a square in a basic double groupoid", 
    true, [ IsDoubleGroupoidElement ], 0, 
function( s ) 

    local b, c, gpd, u, v, w, x, one, ui, vi, wi, xi, lti, rti; 

    b := LeftArrow( s );
    c := RightArrow( s );
    gpd := (s![1])!.groupoid;
    u := b![3];  w := b![4];  v := c![3];  x := c![4];
    one := One( b![2] );
    ui := Arrow( gpd, one, u, u );
    vi := Arrow( gpd, one, v, v );
    wi := Arrow( gpd, one, w, w );
    xi := Arrow( gpd, one, x, x );
    lti := SquareOfArrowsNC( s![1], one, ui, b, b, wi );
    rti := SquareOfArrowsNC( s![1], one, vi, c, c, xi );
    return [ lti, rti ];
end );

############################################################################# 
## 
#M  VerticalIdentities( s ) 
## 
InstallMethod( VerticalIdentities, "for a square in a basic double groupoid", 
    true, [ IsDoubleGroupoidElement ], 0, 
function( s ) 

    local a, d, gpd, u, v, w, x, one, ui, vi, wi, xi, upi, dni; 

    a := UpArrow( s );
    d := DownArrow( s );
    gpd := (s![1])!.groupoid;
    u := a![3];  v := a![4];  w := d![3];  x := d![4];
    one := One( a![2] );
    ui := Arrow( gpd, one, u, u );
    vi := Arrow( gpd, one, v, v );
    wi := Arrow( gpd, one, w, w );
    xi := Arrow( gpd, one, x, x );
    upi := SquareOfArrowsNC( s![1], one, a, ui, vi, a );
    dni := SquareOfArrowsNC( s![1], one, d, wi, xi, d );
    return [ upi, dni ];
end );

############################################################################# 
## 
#M  HorizontalInverse( s ) 
## 
InstallMethod( HorizontalInverse, "for a square in a basic double groupoid", 
    true, [ IsDoubleGroupoidElement ], 0, 
function( s ) 

    local a, b, c, d, gpd, bdy;

    a := UpArrow( s );
    b := LeftArrow( s );
    c := RightArrow( s );
    d := DownArrow( s );
    gpd := (s![1])!.groupoid;
    bdy := d * c^-1 * a^-1 * b;
    return SquareOfArrowsNC( s![1], bdy![2], a^-1, c, b, d^-1 );
end );

############################################################################# 
## 
#M  VerticalInverse( s ) 
## 
InstallMethod( VerticalInverse, "for a square in a basic double groupoid", 
    true, [ IsDoubleGroupoidElement ], 0, 
function( s ) 

    local a, b, c, d, gpd, bdy;

    a := UpArrow( s );
    b := LeftArrow( s );
    c := RightArrow( s );
    d := DownArrow( s );
    gpd := (s![1])!.groupoid;
    bdy := a^-1 * b * d * c^-1;
    return SquareOfArrowsNC( s![1], bdy![2], d, b^-1, c^-1, a );
end );

############################################################################# 
## 
#M  TransposedSquare( sq ) 
##
InstallMethod( TransposedSquare, "for a square in a double groupoid", true, 
    [ IsDoubleGroupoidElement ], 0,
function( sq )
    local dg, a, b, c, d, m, tsq; 

    dg := DoubleGroupoidOfSquare( sq );
    a := UpArrow( sq );
    b := LeftArrow( sq );
    c := RightArrow( sq );
    d := DownArrow( sq );
    m := BoundaryOfSquare( sq )![2];
    return SquareOfArrowsNC( dg, m^-1, b, a, d, c ); 
end );

InstallMethod( IsClosedUnderTransposition, "for a square in a double groupoid",
    true, [ IsDoubleGroupoidElement ], 0,
function( sq )
    local tsq; 

    tsq := TransposedSquare( sq );
    return sq = tsq;
end );

#############################################################################
##
#M  \in( <sq>, <dg> ) . . . . . . . test if a square is in a double groupoid 
##

InstallMethod( \in, "for a square in a standard double groupoid", true, 
    [ IsDoubleGroupoidElement, IsDoubleGroupoid and IsSinglePiece ], 0,
function( sq, dg ) 
    return ( sq![1] = dg );
end ); 

InstallMethod( \in, "for a square in a double groupoid with pieces", true, 
    [ IsDoubleGroupoidElement, IsDoubleGroupoid and HasPieces ], 0,
function( sq, dg )
    local u, p; 

    u := sq![3]![3];
    p := PieceOfObject( dg, u );
    if p = fail then 
        return false; 
    else 
        return sq in p; 
    fi;
end );

#############################################################################
##
#M  \=( <dg1>, <dg2> ) . . . . . . . . . . test equality of double groupoids 
##

InstallMethod( \=, "for two double groupoids", true, 
    [ IsDoubleGroupoid, IsDoubleGroupoid ], 0,
function( dg1, dg2 ) 

    local p1, p2, i;

    if ( IsSinglePiece( dg1 ) and IsSinglePiece( dg2 ) ) then 
        return ( ( dg1!.objects = dg2!.objects ) 
             and ( dg1!.groupoid = dg2!.groupoid ) ); 
    elif ( IsSinglePiece( dg1 ) or IsSinglePiece( dg2 ) ) then 
        return false; 
    else 
        p1 := Pieces( dg1 ); 
        p2 := Pieces( dg2 ); 
        if not ( Length( p1 ) = Length( p2 ) ) then 
            return false; 
        else 
            for i in [1..Length( p1 )] do 
                if ( p1[i] <> p2[i] ) then 
                    return false; 
                fi; 
            od; 
            return true; 
        fi; 
    fi;
end ); 

#############################################################################
##
#M  Size 
##
InstallOtherMethod( Size, "generic method for a double groupoid", true,
    [ IsDoubleGroupoid ], 0,
function( dg )

    local gpd, gp, obs, p, s;

    gpd := dg!.groupoid;
    gp := gpd!.magma;
    obs := dg!.objects;
    if IsBasicDoubleGroupoid( dg ) then 
        return Size( gp )^4 * Length( obs )^4; 
    else 
        TryNextMethod();  
    fi;
end );

#############################################################################
##
#M  String, ViewString, PrintString, ViewObj, PrintObj 
##  . . . . . . . . . . . . . . . . . . . . . . . . . . for a double groupoid 
##
InstallMethod( String, "for a double groupoid", true, [ IsDoubleGroupoid ], 0, 
function( mwo ) 
    return( STRINGIFY( "groupoid" ) ); 
end );

InstallMethod( ViewString, "for a double groupoid", true, 
    [ IsDoubleGroupoid ], 0, String ); 

InstallMethod( PrintString, "for a double groupoid", true, 
    [ IsDoubleGroupoid ], 0, String ); 

InstallMethod( ViewObj, "for a double groupoid", true, 
    [ IsDoubleGroupoid ], 0, PrintObj ); 

InstallMethod( ViewObj, "for a double groupoid", true, 
    [ IsDoubleGroupoid and IsSinglePiece ], 0,   
function( dgpd )
    Print( "single piece double groupoid with:\n" );
    Print( " groupoid = ", dgpd!.groupoid, "\n" ); 
    Print( "    group = ", dgpd!.groupoid!.magma, "\n" ); 
    Print( "  objects = ", dgpd!.objects ); 
end );

InstallMethod( PrintObj, "for a double groupoid", true, 
    [ IsDoubleGroupoid and IsSinglePiece ], 0, 
function( dgpd )
    Print( "single piece double groupoid with:\n" );
    Print( " groupoid = ", dgpd!.groupoid, "\n" ); 
    Print( "    group = ", dgpd!.groupoid!.magma, "\n" ); 
    Print( "  objects = ", dgpd!.objects, "\n" ); 
end );

InstallMethod( ViewObj, "for more than one piece", true, 
    [ IsDoubleGroupoid and IsPiecesRep ], 10,   
function( ddwo )

    local i, pieces, np; 

    pieces := Pieces( ddwo ); 
    np := Length( pieces ); 
    Print( "double groupoid having ", np, " pieces :-\n" ); 
    for i in [1..np] do 
        Print( i, ": ", pieces[i] ); 
        if HasName( pieces[i] ) then 
            Print( "\n" ); 
        fi; 
    od; 
end ); 

InstallMethod( PrintObj, "for more than one piece", true, 
    [ IsDoubleGroupoid and IsPiecesRep ], 0,   
function( dg )

    local i, pieces, np; 

    pieces := Pieces( dg ); 
    np := Length( pieces ); 
    Print( "domain with objects having ", np, " pieces :-\n" ); 
    for i in [1..np] do 
        Print( pieces[i] ); 
        if HasName( pieces[i] ) then 
            Print( "\n" ); 
        fi; 
    od; 
end ); 

#############################################################################
##
#M  Display( <dg> ) . . . . . . . . . . . . . display a magma with objects
##
InstallMethod( Display, "for a double groupoid", true, [ IsDoubleGroupoid ], 0, 
function( dg )
    
    local comp, c, i, m, len;

    if IsSinglePiece( dg ) then 
        if IsDirectProductWithCompleteDigraph( dg ) then 
            Print( "Single constituent magma with objects: " );
            if HasName( dg ) then
                Print( dg );
            fi;
            Print( "\n" ); 
            Print( "  objects: ", dg!.objects, "\n" );
            m := dg!.magma;
            Print( "    magma: " );
            if HasName( m ) then
                Print( m, " = <", GeneratorsOfMagma( m ), ">\n" );
            else
                Print( m, "\n" );
            fi;
        else
            TryNextMethod(); 
        fi; 
    else
        comp := Pieces( dg );
        len := Length( comp );
        Print( "Magma with objects with ", len, " pieces:\n" );
        for i in [1..len] do
            c := comp[i];
            if IsDirectProductWithCompleteDigraph( c ) then 
                Print( "< objects: ", c!.objects, "\n" );
                m := c!.magma;
                Print( "    magma: " );
                if HasName( m ) then
                    Print( m, " = <", GeneratorsOfMagma( m ), "> >\n" );
                else
                    Print( m, " >\n" );
                fi;
            else 
                TryNextMethod(); 
            fi; 
        od;
    fi;
end );

###################  DOUBLE DOMAIN WITH OBJECTS   ########################## 

#############################################################################
##
#F  DoubleGroupoid( <pieces> )          double groupoid as list of pieces 
#F  DoubleGroupoid( <gpd> )             basic single piece double groupoid 
#F  DoubleGroupoid( <gpd> )             when the groupoid has pieces
#O  DoubleGroupoidWithTrivialGroup( <obs> )
##
InstallGlobalFunction( DoubleGroupoid, function( arg )

    local nargs, gpd, pieces, len, L, dg;

    nargs := Length( arg ); 
    # list of pieces
    if ( ( nargs = 1 ) and IsList( arg[1] ) ) then
        if ForAll( arg[1], IsDoubleGroupoid ) then
            Info( InfoGroupoids, 2, "ByUnion" );
            return UnionOfPieces( arg[1] );
        elif ForAll( arg[1], IsGroupoid ) then
            pieces := arg[1];
            len := Length( pieces );
            if ( len = 1 ) then
                Info( InfoGroupoids, 2, "SinglePieceBasicDoubleGroupoid" );
                return SinglePieceBasicDoubleGroupoid( gpd );
            else
                L := List( pieces, p -> SinglePieceBasicDoubleGroupoid( p ) );
                dg := UnionOfPieces( L );
                return dg;
            fi;
        fi;
    #  groupoid
    elif ( ( nargs = 1 ) and IsGroupoid( arg[1] ) ) then
        gpd := arg[1];
        pieces := Pieces( gpd );
        len := Length( pieces );
        if ( len = 1 ) then
            Info( InfoGroupoids, 2, "SinglePieceBasicDoubleGroupoid" );
            return SinglePieceBasicDoubleGroupoid( gpd );
        else
            L := List( pieces, p -> SinglePieceBasicDoubleGroupoid( p ) );
            dg := UnionOfPieces( L );
            return dg;
        fi;
    else
        return fail;
    fi;
end );

InstallMethod( SinglePieceBasicDoubleGroupoid, "for a groupoid", true, 
    [ IsGroupoid ], 0, 
function( gpd ) 

    local dgpd; 

    dgpd := rec( groupoid := gpd, objects := ObjectList( gpd ) ); 
    ObjectifyWithAttributes( dgpd, IsDoubleGroupoidType, 
        IsSinglePiece, true, 
        IsAssociative, true, 
        IsCommutative, IsCommutative( gpd!.magma ), 
        IsBasicDoubleGroupoid, true, 
        GroupoidOfDoubleGroupoid, gpd );
    return dgpd; 
end ); 

InstallMethod( DoubleGroupoidWithTrivialGroup, "for a list of objects",
    true, [ IsList ], 0, 
function( obs ) 

    local gp, gpd, dg; 

    gp := Group( () );
    gpd := SinglePieceGroupoid( gp, obs );
    dg := SinglePieceBasicDoubleGroupoid( gpd );
    return dg; 
end ); 

InstallMethod( DoubleGroupoidWithSingleObject, "for a group and an object",
    true, [ IsGroup, IsObject ], 0, 
function( gp, obj ) 

    local gpd, dg; 

    gpd := MagmaWithSingleObject( gp, obj );
    dg := SinglePieceBasicDoubleGroupoid( gpd );
    return dg; 
end ); 

############################################################################
##
#M  GroupoidOfDoubleGroupoid( <src> <rng> <hom> ) 
##
InstallMethod( GroupoidOfDoubleGroupoid, "for a double groupoid", true,
    [ IsDoubleGroupoid ], 0,
function( dg )
    local pieces, gpds;
    if ( HasIsSinglePiece( dg ) and IsSinglePiece( dg ) ) then
        return dg!.groupoid;
    else
        pieces := Pieces( dg );
        gpds := List( pieces, p -> p!.groupoid );
        return UnionOfPieces( gpds );
    fi;
end );


############################################################################
##
#M  DoubleGroupoidHomomorphism( <src> <rng> <hom> ) . . from a groupoid hom
##
InstallMethod( DoubleGroupoidHomomorphism, "for a groupoid homomorphism",
    true, [ IsDoubleGroupoid, IsDoubleGroupoid, IsGroupoidHomomorphism ], 0,
function( src, rng, hom )

    local sgpd, rgpd, map;

    sgpd := src!.groupoid;
    rgpd := rng!.groupoid;
    if not ( sgpd = Source( hom ) ) and ( rgpd = Range( hom ) ) then 
        Error( "hom not a map between the underlying groupoids" );
    fi;
    map := rec(); 
    ObjectifyWithAttributes( map, DoubleGroupoidHomomorphismType, 
        Source, src, 
        Range, rng, 
        UnderlyingGroupoidHomomorphism, hom, 
        IsGeneralMappingWithObjects, true, 
        IsGroupWithObjectsHomomorphism, true, 
        RespectsMultiplication, true ); 
    return map; 
end );

InstallMethod( PrintObj, "for a double groupoid homomorphism", true,
    [ IsDoubleGroupoidHomomorphism ], 0, 
function ( hom ) 

    local h; 

    if HasPiecesOfMapping( hom ) then 
        Print( "double groupoid homomorphism from several pieces : \n" );
        for h in PiecesOfMapping( hom ) do 
            Print( h, "\n" ); 
        od; 
    else 
        Print( "double groupoid homomorphism : " );
        if ( HasName( Source(hom) ) and HasName( Range(hom) ) ) then 
            Print( Source(hom), " -> ", Range(hom), "\n" ); 
        else 
            Print( "based on ", UnderlyingGroupoidHomomorphism( hom ), "\n" ); 
        fi; 
    fi;
end ); 

############################################################################
##
#M  Display
##
InstallMethod( Display, "for double groupoid homomorphism", true,
    [ IsDoubleGroupoidHomomorphism ], 0,
function ( map ) 
    Print( "double groupoid homomorphism: " ); 
    Print( "[ ", Source(map), " ] -> [ ", Range(map), " ]\n" ); 
    Print( "with underlying groupoid homomorphism:\n" ); 
    Display( UnderlyingGroupoidHomomorphism( map ) );
end );

############################################################################
##
#M  ImageElm
##
InstallOtherMethod( ImageElm, "for a double groupoid homomorphism and a square", 
    true, [ IsDoubleGroupoidHomomorphism, IsDoubleGroupoidElement ], 0,
function ( hom, sq )

    local mor, up, lt, rt, dn, e, isq;

    if not ( sq in Source( hom ) ) then 
        Error( "the square sq is not in the source of hom" ); 
    fi; 
    mor := UnderlyingGroupoidHomomorphism( hom );
    up := ImageElm( mor, UpArrow( sq ) );
    lt := ImageElm( mor, LeftArrow( sq ) );
    rt := ImageElm( mor, RightArrow( sq ) );
    dn := ImageElm( mor, DownArrow( sq ) );
    e := dn![2]^-1 * lt![2]^-1 * up![2] * rt![2];
    isq := SquareOfArrowsNC( Range( hom ), e, up, lt, rt, dn );
    return isq;
end ); 

############################################################################
##
#E double.gi . . . . . . . . . . . . . . . . . . . . . . . . . . . ends here
##  

[ Dauer der Verarbeitung: 0.33 Sekunden  (vorverarbeitet)  ]