#############################################################################
##
#W  algfp.gi                   GAP library                   Alexander Hulpke
##
#H  @(#)$Id: algfp.gi,v 4.25 2002/04/15 10:04:24 sal Exp $
##
#Y  Copyright (C)  1997,  Lehrstuhl D fuer Mathematik,  RWTH Aachen,  Germany
#Y  (C) 1998 School Math and Comp. Sci., University of St.  Andrews, Scotland
#Y  Copyright (C) 2002 The GAP Group
##
##  This file contains the methods for finitely presented algebras.
##  So far, there are not many.
##
Revision.algfp_gi :=
    "@(#)$Id: algfp.gi,v 4.25 2002/04/15 10:04:24 sal Exp $";


#############################################################################
##
#M  ElementOfFpAlgebra( <Fam>, <elm> )  . . . .  for family of f.p. alg.elms.
##
InstallMethod(ElementOfFpAlgebra,
    "for family of fp. alg. elements and ring element",
    true,
    [ IsElementOfFpAlgebraFamily, IsRingElement ], 0,
    function( fam, elm )
    return Objectify( fam!.defaultType, [ Immutable( elm ) ] );
    end );


#############################################################################
##
#M  ElementOfFpAlgebra( <Fam>, <elm> )  . .  for family with nice normal form
##
InstallMethod( ElementOfFpAlgebra,
    "for fp. alg. elms. family with normal form, and ring element",
    true,
    [ IsElementOfFpAlgebraFamily and HasNiceNormalFormByExtRepFunction,
      IsRingElement ], 0,
    function( Fam, elm )
    return NiceNormalFormByExtRepFunction( Fam )( Fam, ExtRepOfObj( elm ) );
    end );


#############################################################################
##
#M  ExtRepOfObj( <elm> )  . . . . . . . . . . . . .  for f.p. algebra element
##
##  The external representation of elements in an f.p. algebra is defined as
##  a list of length 2, the first entry being the zero coefficient,
##  the second being a zipped list containing the external representations
##  of the monomials and their coefficients.
##
InstallMethod( ExtRepOfObj,
    "for f.p. algebra element",
    true,
    [ IsElementOfFpAlgebra and IsPackedElementDefaultRep ], 0,
    elm -> ExtRepOfObj( elm![1] ) );


#############################################################################
##
#M  ObjByExtRep( <Fam>, <descr> ) . for f.p. alg. elms. fam. with normal form
##
InstallMethod( ObjByExtRep,
    "for family of f.p. algebra elements with normal form",
    true,
    [ IsElementOfFpAlgebraFamily and HasNiceNormalFormByExtRepFunction,
      IsList ], 0,
    function( Fam, descr )
    return NiceNormalFormByExtRepFunction( Fam )( Fam, descr );
    end );


############################################################################
##
#M  MappedExpression( <expr>, <gens1>, <gens2> )
##
BindGlobal( "MappedExpressionForElementOfFreeAssociativeAlgebra",
    function( expr, gens1, gens2 )

    local mapped,      # the mapped expression, result
          gen,         # one in `gens1'
          one,         # 1 of the coefficients field
          MappedWord,  # local function to map words
          i,           # loop over summands
          pos;         # position in a list

    expr:= ExtRepOfObj( expr )[2];
    if IsEmpty( expr ) then
      return Zero( gens2[1] );
    fi;

    # Get the numbers corresponding to the generators.
    gens1:= List( gens1, x -> ExtRepOfObj( x )[2] );
    for i in [ 1 .. Length( gens1 ) ] do
      gen:= gens1[i];
      if Length( gen ) = 2 and IsOne( gen[2] ) then
        gen:= gen[1];
        if Length( gen ) = 0 then
          gens1[i]:= 0;
        elif Length( gen ) = 2 and gen[2] = 1 then
          gens1[i]:= gen[1];
        else
          Error( "<gens1> must be list of generators or identity" );
        fi;
      else
        Error( "<gens1> must be list of generators or identity" );
      fi;
    od;
#T This was quite expensive.
#T Better introduce `MappedExpressions' to do this work not so often?

    one:= One( expr[2] );

    MappedWord:= function( word )
    local mapped, i;
    mapped:= gens2[ Position( gens1, word[1], 0 ) ] ^ word[2];
    for i in [ 4, 6 .. Length( word ) ] do
      if word[i] = 1 then
        mapped:= mapped * gens2[ Position( gens1, word[i-1], 0 ) ];
      else
        mapped:= mapped * gens2[ Position( gens1, word[i-1], 0 ) ] ^ word[i];
      fi;
    od;
    return mapped;
    end;

    # The empty word can be at most at the first position.
    if IsEmpty( expr[1] ) then
      pos:= Position( gens1, 0, 0 );
      if pos <> fail then
        mapped:= gens2[ pos ];
      else
        mapped:= One( gens2[1] );
      fi;
    else
      mapped:= MappedWord( expr[1] );
    fi;

    # Avoid to multiply explicitly with 1 in order to avoid deep trees.
    if expr[2] <> one then
      mapped:= expr[2] * mapped;
    fi;

    for i in [ 4, 6 .. Length( expr ) ] do
      if expr[i] = one then
        mapped:= mapped + MappedWord( expr[ i-1 ] );
      else
        mapped:= mapped + expr[i] * MappedWord( expr[ i-1 ] );
      fi;
    od;

    return mapped;
end );
#T special method for expression trees! (see GAP 3.5)

InstallMethod( MappedExpression,
    "for element of f.p. algebra, and two lists of generators",
    IsElmsCollsX,
    [ IsElementOfFpAlgebra, IsHomogeneousList, IsHomogeneousList ], 0,
#T install same method for free ass. algebra elements!
    MappedExpressionForElementOfFreeAssociativeAlgebra );


#############################################################################
##
#M  \=( <x>, <y> )  . . . . . . . .  for two normalized f.p. algebra elements
##
InstallMethod( \=,
    "for two normalized f.p. algebra elements",
    IsIdenticalObj,
    [ IsElementOfFpAlgebra and IsNormalForm,
      IsElementOfFpAlgebra and IsNormalForm ], 0,
    function( x, y )
    return ExtRepOfObj( x ) = ExtRepOfObj( y );
    end );

#T missing: \= method to look for normal form in the family


#############################################################################
##
#M  \=( <x>, <y> )  . . . . . . . . . . . . . . for two f.p. algebra elements
##
InstallMethod( \=,
    "for two f.p. algebra elements (try nice monomorphism)",
    IsIdenticalObj,
    [ IsElementOfFpAlgebra,
      IsElementOfFpAlgebra ], 0,
    function( x, y )
    local hom;
    hom:= NiceAlgebraMonomorphism( FamilyObj( x )!.wholeAlgebra );
    if hom = fail then
      TryNextMethod();
    fi;
    return ImagesRepresentative( hom, x ) = ImagesRepresentative( hom, y );
    end );


#############################################################################
##
#M  \<( <x>, <y> )  . . . . . . . .  for two normalized f.p. algebra elements
##
##  The ordering is defined as follows.
##  Expressions with less summands are shorter,
##  and for expressions with the same number of summands,
##  the words in algebra generators and the coefficients are compared
##  according to the ordering in the external representation.
##
InstallMethod( \<,
    "for two normalized f.p. algebra elements",
    IsIdenticalObj,
    [ IsElementOfFpAlgebra and IsNormalForm,
      IsElementOfFpAlgebra and IsNormalForm ], 0,
    function( x, y )
    local lenx, leny, i;

    x:= ExtRepOfObj( x )[2];
    y:= ExtRepOfObj( y )[2];
    lenx:= Length( x );
    leny:= Length( y );

    # Compare the lengths.
    if lenx < leny then
      return true;
    elif leny < lenx then
      return false;
    fi;

    # For expressions of same length, compare the summands.
    for i in [ 1 .. lenx ] do
      if x[i] < y[i] then
        return true;
      elif y[i] < x[i] then
        return false;
      fi;
    od;

    # The operands are equal.
    return false;
    end );


#############################################################################
##
#M  \<( <x>, <y> )  . . . . . . . . . . . . . . for two f.p. algebra elements
##
InstallMethod( \<,
    "for two f.p. algebra elements (try nice monomorphism)",
    IsIdenticalObj,
    [ IsElementOfFpAlgebra,
      IsElementOfFpAlgebra ], 0,
    function( x, y )
    local hom;
    hom:= NiceAlgebraMonomorphism( FamilyObj( x )!.wholeAlgebra );
    if hom = fail then
      TryNextMethod();
    fi;
    return ImagesRepresentative( hom, x ) < ImagesRepresentative( hom, y );
    end );


#############################################################################
##
#M  FactorFreeAlgebraByRelators( <F>, <rels> )  . . .  factor of free algebra
##
InstallGlobalFunction( FactorFreeAlgebraByRelators, function( F, rels )
    local A, fam;

    # Create a new family.
    fam := NewFamily( "FamilyElementsFpAlgebra", IsElementOfFpAlgebra );

    # Create the default type for the elements.
    fam!.defaultType := NewType( fam,
                       IsElementOfFpAlgebra and IsPackedElementDefaultRep );

    fam!.freeAlgebra := F;
    fam!.relators := Immutable( rels );
    fam!.familyRing := FamilyObj(LeftActingDomain(F));

    # Set the characteristic.
    if HasCharacteristic( F ) or HasCharacteristic( FamilyObj( F ) ) then
      SetCharacteristic( fam, Characteristic( F ) );
    fi;

    # Create the algebra.
    if IsAlgebraWithOne( F ) then

      A := Objectify(
          NewType( CollectionsFamily( fam ),
                       IsSubalgebraFpAlgebra
                   and IsAlgebraWithOne
                   and IsWholeFamily
                   and IsAttributeStoringRep ),
          rec() );

      SetLeftActingDomain( A, LeftActingDomain( F ) );
      SetGeneratorsOfAlgebraWithOne( A,
          List( GeneratorsOfAlgebraWithOne( F ),
                i -> ElementOfFpAlgebra( fam, i ) ) );

    else

      A := Objectify(
          NewType( CollectionsFamily( fam ),
                       IsSubalgebraFpAlgebra
                   and IsWholeFamily
                   and IsAttributeStoringRep ),
          rec() );

      SetLeftActingDomain( A, LeftActingDomain( F ) );
      SetGeneratorsOfAlgebra( A,
          List( GeneratorsOfAlgebra( F ),
                i -> ElementOfFpAlgebra( fam, i ) ) );

    fi;

    SetZero( fam, ElementOfFpAlgebra( fam, Zero( F ) ) );
    UseFactorRelation( F, rels, A );
    SetIsFullFpAlgebra( A, true );
    fam!.wholeAlgebra:= A;

    return A;
end );


#############################################################################
##
#M  FreeGeneratorsOfFpAlgebra( <A> )
##
InstallMethod( FreeGeneratorsOfFpAlgebra,
    "for a full f.p. algebra",
    true,
    [ IsSubalgebraFpAlgebra and IsFullFpAlgebra ], 0,
    function( A )
    A:= ElementsFamily( FamilyObj( A ) )!.freeAlgebra;
    if IsMagmaWithOne( A ) then
      return GeneratorsOfAlgebraWithOne( A );
    else
      return GeneratorsOfAlgebra( A );
    fi;
    end );


############################################################################
##
#M  RelatorsOfFpAlgebra( <A> )
##
InstallMethod( RelatorsOfFpAlgebra,
    "for a full f.p. algebra",
    true,
    [ IsSubalgebraFpAlgebra and IsFullFpAlgebra ], 0,
    A -> ElementsFamily( FamilyObj( A ) )!.relators );


#############################################################################
##
#A  FreeAlgebraOfFpAlgebra( <A> )
##
InstallMethod( FreeAlgebraOfFpAlgebra,
    "for a full f.p. algebra",
    true,
    [ IsSubalgebraFpAlgebra and IsFullFpAlgebra ], 0,
    A -> ElementsFamily( FamilyObj( A ) )!.freeAlgebra );


#############################################################################
##
#M  IsFullFpAlgebra( <A> )
##
InstallOtherMethod( IsFullFpAlgebra,
    "for f. p. algebra",
    true,
    [ IsAlgebra and IsSubalgebraFpAlgebra ], 0,
    function( A )
    local Fam;
    Fam:= ElementsFamily( FamilyObj( A ) );
    return IsSubset( A, List( GeneratorsOfAlgebra( Fam!.freeAlgebra ),
                              a -> ElementOfFpAlgebra( Fam, a ) ) );
    end );


#############################################################################
##
#M  NaturalHomomorphismByIdeal( <F>, <I> )  . . . . . for free alg. and ideal
##
InstallMethod( NaturalHomomorphismByIdeal,
    "for free algebra and ideal",
    IsIdenticalObj,
    [ IsMagmaRingModuloRelations, IsFLMLOR ], 0,
    function( F, I )

    local image, hom;

    image:= FactorFreeAlgebraByRelators( F, GeneratorsOfIdeal( I ) );

    if IsMagmaWithOne( F ) then
      hom:= AlgebraWithOneHomomorphismByImagesNC( F, image,
                GeneratorsOfAlgebraWithOne( F ),
                GeneratorsOfAlgebraWithOne( image ) );
    else
      hom:= AlgebraHomomorphismByImagesNC( F, image,
                GeneratorsOfAlgebra( F ),
                GeneratorsOfAlgebra( image ) );
    fi;

    SetIsSurjective( hom, true );

    return hom;
    end );


#############################################################################
##
#M  Print(<fp alg elm>)
##
InstallMethod(PrintObj,
    "fp algebra elements",
    true,
    [ IsElementOfFpAlgebra and IsPackedElementDefaultRep ], 0,
    function( e )
    Print( "[", e![1], "]" );
    end );


#############################################################################
##
#M  \+( <fp alg elm>, <fp alg elm> )
##
InstallMethod( \+,
    "fp algebra elements",
    IsIdenticalObj,
    [ IsElementOfFpAlgebra and IsPackedElementDefaultRep,
      IsElementOfFpAlgebra and IsPackedElementDefaultRep ], 0,
    function( a, b )
    return ElementOfFpAlgebra( FamilyObj( a ), a![1] + b![1] );
    end );


#############################################################################
##
#M  \-( <fp alg elm>, <fp alg elm> )
##
InstallMethod( \-,
    "fp algebra elements",
    IsIdenticalObj,
    [ IsElementOfFpAlgebra and IsPackedElementDefaultRep,
      IsElementOfFpAlgebra and IsPackedElementDefaultRep ], 0,
    function( a, b )
    return ElementOfFpAlgebra( FamilyObj( a ), a![1] - b![1] );
    end );


#############################################################################
##
#M  AdditiveInverseOp( <fp alg elm> )
##
InstallMethod( AdditiveInverseOp,
    "fp algebra element",
    true,
    [ IsElementOfFpAlgebra and IsPackedElementDefaultRep ], 0,
    function( a )
    return ElementOfFpAlgebra( FamilyObj( a ), AdditiveInverse( a![1] ) );
    end );


#############################################################################
##
#M  OneOp( <fp alg elm> )
##
InstallOtherMethod( OneOp,
    "for an f.p. algebra element",
    true,
    [ IsElementOfFpAlgebra and IsPackedElementDefaultRep ], 0,
    function( elm )
    local one;
    one:= One( elm![1] );
    if one <> fail then
      one:= ElementOfFpAlgebra( FamilyObj( elm ), one );
    fi;
    return one;
    end );


#############################################################################
##
#M  ZeroOp( <fp alg elm>)
##
InstallMethod( ZeroOp,
    "for an f.p. algebra element",
    true,
    [ IsElementOfFpAlgebra and IsPackedElementDefaultRep ], 0,
    elm -> ElementOfFpAlgebra( FamilyObj( elm ), Zero( elm![1] ) ) );


#############################################################################
##
#M  \*( <fp alg elm>, <fp alg elm> )
##
InstallMethod( \*,
    "fp algebra elements",
    IsIdenticalObj,
    [ IsElementOfFpAlgebra and IsPackedElementDefaultRep,
      IsElementOfFpAlgebra and IsPackedElementDefaultRep ], 0,
    function( a, b )
    return ElementOfFpAlgebra( FamilyObj( a ), a![1] * b![1] );
    end);


#############################################################################
##
#M  \*( <ring el>, <fp alg elm> )
##
InstallMethod( \*,"ring el *fp algebra el",IsRingsMagmaRings,
    [ IsRingElement, IsElementOfFpAlgebra and IsPackedElementDefaultRep ], 0,
    function( a, b )
    return ElementOfFpAlgebra( FamilyObj( b ), a * b![1] );
    end);


#############################################################################
##
#M  \*( <fp alg elm>, <ring el> )
##
InstallMethod( \*,"fp algebra el*ring el",IsMagmaRingsRings,
    [ IsElementOfFpAlgebra and IsPackedElementDefaultRep, IsRingElement ], 0,
    function( a, b )
    return ElementOfFpAlgebra( FamilyObj( a ), a![1] * b );
    end);

#AH  Embedding can only be defined reasonably if a `One' different from
#AH  the zero is present
#AH  (The factor may collaps).
#T The `One' of the factor may be equal to the `Zero',
#T so the ``embedding'' can be defined as a mapping from the ring
#T to the algebra,
#T but it is injective only if the `One' is not the `Zero'.


#############################################################################
##
#M  IsomorphismMatrixFLMLOR( <A> )  . . . . . . . . . . . . for a f.p. FLMLOR
##
InstallMethod( IsomorphismMatrixFLMLOR,
    "for a f.p. FLMLOR",
    true,
    [ IsFLMLOR and IsSubalgebraFpAlgebra ], 0,
    A -> Error( "sorry, no method to compute a matrix algebra\n",
                "for a (not nec. associative) f.p. algebra" ) );


#############################################################################
##
#M  IsomorphismMatrixFLMLOR( <A> )  . . . . . . for a full f.p. assoc. FLMLOR
##
##  We compute the operation homomorphism for <A> acting on itself from the
##  right.
##
InstallMethod( IsomorphismMatrixFLMLOR,
    "for a full f.p. associative FLMLOR",
    true,
    [ IsFLMLORWithOne and IsSubalgebraFpAlgebra and IsAssociative
      and IsFullFpAlgebra ], 0,
    A  -> OperationAlgebraHomomorphism( A, [ [ Zero( A ) ] ], OnRight ) );
#T change this: second argument should be the <A>-module itself!


#############################################################################
##
#M  OperationAlgebraHomomorphism( <A>, <C>, <opr> )
##
InstallOtherMethod( OperationAlgebraHomomorphism,
    "for a full f.p. associative FLMLOR, a collection, and a function",
    true,
    [ IsFLMLORWithOne and IsSubalgebraFpAlgebra and IsAssociative
      and IsFullFpAlgebra, IsCollection, IsFunction ], 0,
    function( A, C, opr )
    Error( "this case will eventually be handled by the Vector Enumerator\n",
           "which is not available yet" );
    end );


#############################################################################
##
#M  NiceAlgebraMonomorphism( <A> )  . . . . . . for a full f.p. assoc. FLMLOR
##
##  We delegate to `IsomorphismMatrixFLMLOR'.
##
InstallMethod( NiceAlgebraMonomorphism,
    "for a full f.p. associative FLMLOR (call `IsomorphismMatrixFLMLOR')",
    true,
    [ IsFLMLORWithOne and IsSubalgebraFpAlgebra and IsAssociative
      and IsFullFpAlgebra ], 0,
    IsomorphismMatrixFLMLOR );


#############################################################################
##
#M  IsFiniteDimensional( <A> )
#M  Dimension( <A> )
##
#M  NiceVector( <A>, <a> )
#M  UglyVector( <A>, <r> )
##
##  Provided the f.~p. algebra <A> knows its `NiceAlgebraMonomorphism' value,
##  it is handled via nice bases.
##  So we have to treat the case that this value is not (yet) known.
##  Note that `Dimension' may ask whether <A> is finite dimensional,
##  so we must provide a (partial) method for it.
##
##  The family of elements of <A> stores its whole algebra,
##  so it is reasonable to look whether this algebra knows already a
##  nice monomorphism.
##
InstallMethod( IsFiniteDimensional,
    "for f.p. algebra",
    true,
    [ IsSubalgebraFpAlgebra ], 0,
    function( A )
    local iso;
    if HasNiceAlgebraMonomorphism(
           ElementsFamily( FamilyObj( A ) )!.wholeAlgebra ) then
      iso:= NiceAlgebraMonomorphism(
                ElementsFamily( FamilyObj( A ) )!.wholeAlgebra );
    else
      iso:= IsomorphismMatrixFLMLOR( A );
    fi;
    if iso <> fail then
      if IsAlgebraHomomorphismFromFpRep( iso ) then
        SetNiceAlgebraMonomorphism( A, iso );
      fi;
      return true;
    fi;
    TryNextMethod();
    end );


#############################################################################
##
#M  NiceFreeLeftModuleInfo( <V> )
#M  NiceVector( <V>, <v> )
#M  UglyVector( <V>, <r> )
##
InstallHandlingByNiceBasis( "IsFpAlgebraElementsSpace", rec(
    detect := function( F, gens, V, zero )
      return IsElementOfFpAlgebraCollection( V ) and IsFreeLeftModule( V );
      end,

    NiceFreeLeftModuleInfo := ReturnTrue,

    NiceVector := function( A, a )
      local hom;
      hom:= NiceAlgebraMonomorphism( FamilyObj( a )!.wholeAlgebra );
      if hom = fail then
        TryNextMethod();
      fi;
      return ImagesRepresentative( hom, a );
      end,

    UglyVector := function( A, r )
      local hom;
      hom:= NiceAlgebraMonomorphism(
                ElementsFamily( FamilyObj( A ) )!.wholeAlgebra );
      if hom = fail then
        TryNextMethod();
      fi;
      return PreImagesRepresentative( hom, r );
      end ) );


#############################################################################
##
#F  FpAlgebraByGeneralizedCartanMatrix( <F>, <A> )
##
InstallGlobalFunction( FpAlgebraByGeneralizedCartanMatrix, function( F, A )

    local n,            # dimension of the matrix `A'
          i, j, k,      # loop variables
          gensstrings,  # names of algebra generators
          a,            # algebra, result
          gens,         # algebra generators
          e, h, f,      # different portions of generators
          LieBracket,   # function that computes the commutator
          rels,         # list of relators
          rel;          # one relator

    if not IsField( F ) then
      Error( "<F> must be a field" );
    elif not IsGeneralizedCartanMatrix( A ) then
      Error( "<A> must be a generalized Cartan matrix" );
    fi;

    n:= Length( A );
    gensstrings:= [];
    for i in [ 1 .. n ] do
      gensstrings[       i ]:= Concatenation( "e", String(i) );
    od;
    for i in [ 1 .. n ] do
      gensstrings[   n + i ]:= Concatenation( "h", String(i) );
    od;
    for i in [ 1 .. n ] do
      gensstrings[ 2*n + i ]:= Concatenation( "f", String(i) );
    od;
    a:= FreeAssociativeAlgebraWithOne( F, gensstrings );
    gens:= GeneratorsOfAlgebraWithOne( a );
    e:= gens{ [       1 ..   n ] };
    h:= gens{ [   n + 1 .. 2*n ] };
    f:= gens{ [ 2*n + 1 .. 3*n ] };

    LieBracket:= function( A, B )
      return A*B - B*A;
    end;

    rels:= [];
    for i in [ 1 .. n ] do
      for j in [ i+1 .. n ] do
        Add( rels, LieBracket( h[i], h[j] ) );
      od;
    od;

    for i in [ 1 .. n ] do
      for j in [ 1 .. n ] do
        if i = j then
          Add( rels, LieBracket( e[i], f[i] ) - h[i] );
        else
          Add( rels, LieBracket( e[i], f[j] ) );
        fi;
      od;
    od;

    for i in [ 1 .. n ] do
      for j in [ 1 .. n ] do
        Add( rels, LieBracket( h[i], e[j] ) - A[i][j] * e[j] );
        Add( rels, LieBracket( h[i], f[j] ) + A[i][j] * f[j] );
      od;
    od;

    for i in [ 1 .. n ] do
      for j in [ i+1 .. n ] do
        if A[i][j] = 0 then
          Add( rels, LieBracket( e[i], e[j] ) );
          Add( rels, LieBracket( f[i], f[j] ) );
        fi;
      od;
    od;

    for i in [ 1 .. n ] do
      for j in [ 1 .. n ] do
        if i <> j then
          rel:= e[j];
          for k in [ 1 .. 1 - A[i][j] ] do
            rel:= LieBracket( e[i], rel );
          od;
          Add( rels, rel );
          rel:= f[j];
          for k in [ 1 .. 1 - A[i][j] ] do
            rel:= LieBracket( f[i], rel );
          od;
          Add( rels, rel );
        fi;
      od;
    od;

    # Return the algebra.
    return a / rels;
end );


#############################################################################
##
#E

