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

Quelle  moduleprojres.gi   Sprache: unbekannt

 
Spracherkennung für: .gi vermutete Sprache: Unknown {[0] [0] [0]} [Methode: Schwerpunktbildung, einfache Gewichte, sechs Dimensionen]

# GAP Implementation
# This file was generated from
# $Id: projres.gi,v 1.7 2012/09/27 08:55:07 sunnyquiver Exp $
#

#########################################################################
##
#O  ProjectiveResolutionFpPathAlgebraModule( <A>, <I>, <presentation_map>, <n> )
##
##  Given a finite dimension quotient  A=KQ/I  of a path algebra KQ and an ideal  I, 
##  this function computes the fn's and fnprime's in the GSZ-resolution for the module
##  over  A  given by projective presentation over A via the matrix  <presentation_map>.
## 
InstallMethod( ProjectiveResolutionFpPathAlgebraModule,
    "for algebras",
    true,
    [ IsAlgebra, IsRing and HasGroebnerBasisOfIdeal, IsRingElementTable, IsPosInt ], 0,
    function(A,I,presentation_map, termint)
    
    local Res, gen, len, verts, gVerts, rverts, paverts, lverts, RelementsFam, el, el2,
          f, fprime, fprev, fprevprime, i, j, k, m, tmp, L, P, N, M, R, X1, Y1, G, rtG, rtGBofN, maps,
          II, rtGBofII, XSet, perm, mapstmp, finf0, fprimeinf0, temp, temp2;
    #
    # Initializing variables
    #
    P := [];       # R-projectives:
    L := [];       # R/I-projectives:
    finf0 := [];
    fprimeinf0 := [];
    maps := [];    # resolution maps:
    #
    # Checking input
    #
    if not (IsPathAlgebra(A) or IsQuotientOfPathAlgebra(A)) then
        TryNextMethod();
    fi;

    # Make sure generators are not empty
    if IsEmpty(presentation_map) then
        Error("Usage: ProjectiveResolutionFpPathAlgebraModule( <A>, <I>, <presentation_map>, <n> )",
              " <presentation_map> must be nonempty.");
    fi;

    # Make sure all entries are left uniform
    for gen in presentation_map do
        if not ForAll(gen, IsLeftUniform) then
            Error("Usage: ProjectiveResolutionFpPathAlgebraModule( <A>, <I>, <presentation_map>, <n> )",
              " entries in <presentation_map> must be left uniform.");
        fi;
    od;

    # Get the starting vertex of each element in first row:
    #  (These vertices will allow us to form L^0, the first right projective
    #   module in the projective resolution).
    verts := List(presentation_map[1], x -> SourceVertex(LeadingMonomial(x)));


    # Verify we really have proper presentation:
    for gen in presentation_map do 
        gVerts := List(gen, x -> SourceVertex(LeadingMonomial(x)));
        for i in [1..Length(verts)] do
            if IsZeroPath(verts[i]) and not IsZeroPath(gVerts[i]) then
                verts[i] := gVerts[i];
            elif verts[i] <> gVerts[i] and not IsZeroPath(gVerts[i]) then
                Error("Usage: ProjectiveResolutionFpPathAlgebraModule( <A>, <I>, <presentation_map>, <n> )",
                " <presentation_map> contains mismatched starting vertices.");
            fi;     
        od;
    od;
    
    # Check columns are non-zero:
    if not ForAll(verts, x -> not IsZeroPath(x)) then
        Error("Usage: ProjectiveResolutionFpPathAlgebraModule( <A>, <I>, <presentation_map>, <n> )",
            " <presentation_map> contains all zeroes in some column.");
    fi;

    # Get the parent ring R for ideal I (where above A = R/I):
    R := LeftActingRingOfIdeal(I);

    # Get right groebner basis for ideal:
    rtG := RightGroebnerBasis(I);

    # Get family for ring:
    RelementsFam := ElementsFamily(FamilyObj(R));

    # Create vertex set (all in the path algebra) from 'verts':
    paverts := List(verts, x -> x*One(A));

    # Create vertex set (all in the ring) from 'verts':
    rverts := List(verts, x -> x*One(R));

    # Ok, everything is good, construct the module L^0 from vertices in first row:
    L[1] := RightProjectiveModule( A, paverts );
    P[1] := RightProjectiveModule( R, rverts );
    finf0[1] := GeneratorsOfAlgebraModule(P[1]); # f0's
    fprimeinf0[1] := [];  # f0prime's

    # Convert elements in map from elements in R/I to elements in R:
    X1 := [];
    i := 1;
    for i in [1..Length(presentation_map)] do
        X1[i] := List(presentation_map[i], x -> ObjByExtRep(RelementsFam,ExtRepOfObj(x)));
    od;

    # first map:
    maps[1] := ShallowCopy(X1);

    X1 := List( X1, x -> Vectorize(P[1], x) );

    # Create set Y1 to union with X1 for the lift:
    Y1 := [];
    for i in [1..Length(rverts)] do
        for el in rtG!.relations do
            if not IsZero(rverts[i]*el) then
                tmp := List([1..Length(rverts)], x->Zero(R));
                tmp[i] := rverts[i]*el;
                Add(Y1,tmp);
            fi;
        od;
    od;   

    Y1 := List( Y1, x -> Vectorize(P[1], x) );

    # Determine the submodule of the algebra module P[1] generated by the elements
    #  of X1 union Y1 (which are the rows of the presentation_map).
    N := SubAlgebraModule(P[1], Concatenation(X1,Y1));
    II := SubAlgebraModule(P[1], Y1);
    rtGBofN := RightGroebnerBasisOfModule(N);
    rtGBofII := RightGroebnerBasisOfModule(II);

    # Determine f1's and f1primes:
    finf0[2] := []; # f1's
    fprimeinf0[2] := []; # f1prime's
    i := 1;
    j := 1;
    for el in BasisVectors(rtGBofN) do
        tmp := CompletelyReduce(rtGBofII,el);
        if IsZero(tmp) then
            fprimeinf0[2][i] := el;
            i := i + 1;
        else
            finf0[2][j] := el;
            j := j + 1;
        fi;
    od;
    # Sort the f1's and the f1prime's, largest Tip first:
    Sort(finf0[2],\<);
    Sort(fprimeinf0[2],\<);
    finf0[2] := Reversed(finf0[2]);
    fprimeinf0[2] := Reversed(fprimeinf0[2]);
   
#Print( "finf0[2]: ", finf0[2], "\n");
#Print( "fprimeinf0[2]: ", fprimeinf0[2], "\n");

    # Since all f1's should be right uniform, get the vertices for the vertex projective P[2]:
    lverts := [];
    for el in finf0[2] do
        if IsRightUniform(el![1]) then
            Add(lverts,TargetVertex(el![1]));
        else
            Error("The f1's are not right uniform. \n");
        fi;
    od;

    # Convert vertex set from 'lverts', create P^2 and L^2:
    rverts := List(lverts, x -> x*One(R));
    P[2] := RightProjectiveModule( R, rverts );
    lverts := List(lverts, x -> x*One(A));
    L[2] := RightProjectiveModule( A, lverts );

## form f2's if necessary:  NEED TO CHECK FOR NONEMPTY SET

    # create f2's:
    finf0[3] := [];
    fprimeinf0[3] := [];
    maps[2] := [];
    i := 1;

    # Determine the OSet and NSet for our f2's:
    for el in finf0[2] do
        XSet := XSetOfPathAlgebraVector(finf0[1],fprimeinf0[1], I, el![1]);
        for el2 in XSet[1] do
            tmp := finf0[1][el2[2]]^(el2[3]*el2[4]);
            maps[2][i] := FirstPart(finf0[2],fprimeinf0[2],tmp![1]);
            temp := ShallowCopy(Zero(P[1]));
            for j in [1..Length(finf0[2])] do
                temp := temp + finf0[2][j]^maps[2][i][j];
            od;
            finf0[3][i] := ShallowCopy(temp);
            i := i + 1;
        od;
        for el2 in XSet[2] do
            Add(fprimeinf0[3],(el^el2[2])^el2[3]);
        od;
    od;
    # Since all f2's should be right uniform, get the vertices for the vertex projective P[3]:
    lverts := [];
    for el in finf0[3] do
        if IsRightUniform(el![1]) then
            Add(lverts,TargetVertex(el![1]));
        else
            Error("The f2's are not right uniform. \n");
        fi;
    od;

    # Convert vertex set from 'lverts', create P^3:
    rverts := List(lverts, x -> x*One(R));
    P[3] := RightProjectiveModule( R, rverts );

    lverts := List(lverts, x -> x*One(A));
    L[3] := RightProjectiveModule( A, lverts );


## START REPEATING HERE
    
    for k in [3..termint] do
        finf0[k+1] := [];
        fprimeinf0[k+1] := [];
        maps[k] := [];
        i := 1;

      ###  NEED to Vectorize elements in maps[k-1]:
        
        for el in finf0[k] do
            XSet := XSetOfPathAlgebraVector(finf0[k-1],fprimeinf0[k-1], I, el![1]);            
            for el2 in XSet[1] do
                tmp := finf0[k - 1][el2[2]]^(el2[3]*el2[4]);
                if not IsZero(tmp) then
                    maps[k][i] := FirstPart(finf0[k],fprimeinf0[k],tmp![1]);
                    temp := Zero(P[1]);
                    for j in [1..Length(maps[k][i])] do
                        temp := temp + finf0[k][j]^maps[k][i][j];
                    od;
                    finf0[k + 1][i] := temp;
                    i := i + 1;
                fi;
            od;
            for el2 in XSet[2] do
                Add(fprimeinf0[k + 1],(el^el2[2])^el2[3]);                
            od;
        od;

        if Length(maps[k]) < 1 then
            Print("finite at projective: ",k,"\n");
            break;
        else
        # create vertex projectives

        # Since all fk's should be right uniform, get the vertices for the vertex projective P[3]:
            lverts := [];
            for el in finf0[k + 1] do
                if IsRightUniform(el![1]) then
                    Add(lverts,TargetVertex(el![1]));
                else
                    Error("The f",k,"'s are not right uniform. \n");
                fi;
            od;
        
            # Convert vertex set from 'lverts', create P^(k+1):
            rverts := List(lverts, x -> x*One(R));
            P[k+1] := RightProjectiveModule( R, rverts );
            lverts := List(lverts, x -> x*One(A));
            L[k+1] := RightProjectiveModule( A, lverts );
        fi;
    od;

#   Create the (initial) resolution:

    Res := Objectify(NewType(ProjectiveResolutionFpPathAlgebraModuleFamily,
                             IsProjectiveResolutionFpPathAlgebraModuleDefaultRep),
                             rec());
    SetName(Res,"ProjectiveResolutionFpPathAlgebraModule");
    SetParentAlgebra(Res,A);
##    SetModule(Res,M);
    SetProjectives(Res,L);
    SetRProjectives(Res,P);
    SetMaps(Res,maps);
    SetProjectivesFList(Res,[finf0,fprimeinf0]);
    SetRingIdeal(Res,I);

    return Res;
end     
);   

#########################################################################
##
#O  ProjectiveResolutionOfPathAlgebraModule( <M>, <n> )
##
##  Given a finite dimension quotient of a path algebra and a module  M  over 
##  it this function computes the f^i's and f^iprime's in the GSZ-resolution 
##  for the module  M out to step  <n>.
## 
InstallMethod( ProjectiveResolutionOfPathAlgebraModule,
    "for a PathAlgebraMatModule and a positive integer",
    true,
    [ IsPathAlgebraMatModule, IsPosInt ], 0,
    function( M, termint )
    
    local A, fam, I, Res, gen, len, verts, gVerts, ProjPres, rverts, paverts, lverts, RelementsFam, el, el2,
          f, fprime, fprev, fprevprime, i, j, k, m, tmp, L, P, N, R, X1, Y1, G, rtG, rtGBofN, maps,
          II, rtGBofII, XSet, perm, mapstmp, finf0, fprimeinf0, temp, temp2, fones;
    #
    # Initializing variables
    #
    P := [];       # R-projectives:
    finf0 := [];
    fprimeinf0 :=[];
    maps := [];    # resolution maps:

    A := RightActingAlgebra(M);    
    #
    # Checking input
    #
    if not (IsPathAlgebra(A) or IsQuotientOfPathAlgebra(A)) then
        TryNextMethod();
    fi;

    fam := ElementsFamily(FamilyObj(A));
    I := fam!.ideal;
    R := OriginalPathAlgebra(A);
    rtG := RightGroebnerBasis(I);  # Get right groebner basis for ideal:
    RelementsFam := ElementsFamily(FamilyObj(R));  # Get family for ring:
    
    ProjPres := ProjectivePathAlgebraPresentation(M);        
    finf0[1] := ProjPres[3];
    P[1] := ProjPres[1];
    finf0[1] := ProjPres[3]; # f0's    
    fprimeinf0[1] := [];  # f0prime's    
    
    # Create set P^0I, store generators in Y1
    Y1 := [];
    for m in finf0[1] do
        for el in rtG!.relations do
            tmp := m^el;
            if not IsZero(tmp) then
                Add(Y1,tmp);
            fi;
        od;
    od;   

    N := SubAlgebraModule(P[1], ProjPres[4]);
    rtGBofN := Flat(RightGroebnerBasisOfModule(N)!.gbasisElems);
    fones := List(rtGBofN, x -> Vectorize(P[1], x![1]));
    II := SubAlgebraModule(P[1], Y1);
    rtGBofII := RightGroebnerBasisOfModule(II);

    # Determine f1's and f1primes:
    finf0[2] := []; # f1's
    fprimeinf0[2] :=[]; # f1prime's
    i := 1;
    j := 1;
    for el in fones do
        tmp := CompletelyReduce(rtGBofII,el);
        if IsZero(tmp) then
            fprimeinf0[2][i] := el;
            i := i + 1;
        else
            finf0[2][j] := el;
            j := j + 1;
        fi;
    od;
    # Sort the f1's and the f1prime's, largest Tip first:
    Sort(finf0[2],\<);
    Sort(fprimeinf0[2],\<);
    finf0[2] := Reversed(finf0[2]);
    fprimeinf0[2] := Reversed(fprimeinf0[2]);
    maps[1] := ProjPres[5]; # the first map
    
    # Since all f1's should be right uniform, get the vertices for the vertex projective P[2]:
    lverts := [];
    for el in finf0[2] do
        if IsRightUniform(el![1]) then
            Add(lverts,TargetVertex(el![1]));
        else
            Error("The f1's are not right uniform. \n");
        fi;
    od;

    # Convert vertex set from 'lverts', create P^2 and L^2:
    rverts := List(lverts, x -> x*One(R));
    P[2] := RightProjectiveModule( R, rverts );

## START REPEATING HERE
    
    for k in [2..termint] do
        Print("Computing f",k,"'s ...\n");
        finf0[k+1] := [];
        fprimeinf0[k+1] := [];
        maps[k] := [];
        i := 1;

        for el in finf0[k] do
            XSet := XSetOfPathAlgebraVector(finf0[k-1],fprimeinf0[k-1], I, el![1]);            
            for el2 in XSet[1] do
                tmp := finf0[k - 1][el2[2]]^(el2[3]*el2[4]);
                if not IsZero(tmp) then
                    maps[k][i] := FirstPart(finf0[k],fprimeinf0[k],tmp![1]);
                    temp := Zero(P[1]);
                    for j in [1..Length(maps[k][i])] do
                        temp := temp + finf0[k][j]^maps[k][i][j];
                    od;
                    finf0[k + 1][i] := temp;
                    i := i + 1;
                fi;
            od;
            for el2 in XSet[2] do
                Add(fprimeinf0[k + 1],(el^el2[2])^el2[3]);
            od;
        od;

        if Length(maps[k]) < 1 then
            Print("finite at projective: ",k,"\n");
            break;
        else
        # create vertex projectives

        # Since all fk's should be right uniform, get the vertices for the vertex projective P[3]:
            lverts := [];
            for el in finf0[k + 1] do
                if IsRightUniform(el![1]) then
                    Add(lverts,TargetVertex(el![1]));
                else
                    Error("The f",k,"'s are not right uniform. \n");
                fi;
            od;
        
            # Convert vertex set from 'lverts', create P^(k+1):
            rverts := List(lverts, x -> x*One(R));
            P[k+1] := RightProjectiveModule( R, rverts );
        fi;
    od;

#   Create the (initial) resolution:

    Res := Objectify(NewType(ProjectiveResolutionFpPathAlgebraModuleFamily,
                             IsProjectiveResolutionFpPathAlgebraModuleDefaultRep),
                             rec());
    SetName(Res,"ProjectiveResolutionOfPathAlgebraModule");
    SetParentAlgebra(Res,A);
    SetRProjectives(Res,P);
    SetMaps(Res,maps);
    SetProjectivesFList(Res,[finf0,fprimeinf0]);
    SetRingIdeal(Res,I);

    return Res;
end     
);   

#########################################################################
##
#O  XSetOfPathAlebraVector( <fn>, <fnprime>, <I>, <v> )
## 
##  For a set of  f^n's and f^nprime  for a projective GSZ-resolution of a 
##  module, the function returns two lists: list 1 is the OSet and list 2 
##  is the NSet. The definition of the OSet and the NSet are given in the 
##  paper Green-Solberg-Zacharia.
## 
InstallMethod( XSetOfPathAlgebraVector,
    "for path algebra vectors",
    true, 
    [ IsHomogeneousList, IsHomogeneousList,
    IsRing and HasGroebnerBasisOfIdeal, 
    IsPathAlgebraVector ],
    0,
    function( finf0, fprimeinf0, I, fn )
    
    local rightgb, rightgbtips, i, divides, j, tippath, tipcoeff, coeffs, position, redtippath,
          redtippathlength, testset, fam, gb, walkoftipsgb, OSet, NSet, XSet, t, rightgbtip, 
          rightgbtipcoeff, rightgbtipwalk, qlength, found, gindex, glength, zwalk, zpath, qprimewalk, 
          qprimepath, positions, coeffstips, maxtip;
    
    rightgb := RightGroebnerBasis(I)!.relations;
    rightgbtips := [];
    for i in [1..Length(rightgb)] do
        rightgbtips[i] := [TipMonomial(rightgb[i]), i];
    od;
    divides := List([1..Length(rightgb)], x -> false);
    for i in [1..Length(rightgb)] do
        for j in [1..Length(rightgb)] do
            if ( i <> j ) and ( divides[j] = false ) then 
                if PositionSublist(WalkOfPath(rightgbtips[j][1]),WalkOfPath(rightgbtips[i][1])) = 1 then 
                    divides[j] := true;
                fi;
            fi;
        od;
    od;
    rightgbtips := Filtered(rightgbtips, x -> divides[Position(rightgbtips,x)] = false);
    tippath := TipMonomial(fn![1][fn![2]]);
    tipcoeff := TipCoefficient(fn![1][fn![2]]);
    # write fn in terms of f^(n-1)'s
    coeffs := FirstPart(finf0,fprimeinf0,fn);
    positions := Filtered([1..Length(finf0)], x -> PositionSublist(WalkOfPath(tippath),WalkOfPath(TipMonomial(finf0[x]![1]![1][finf0[x]![1]![2]]))) = 1);    
    positions := Filtered(positions, x -> not IsZeroPath(TipMonomial(coeffs[x])));
    coeffstips := List(positions, x -> TipMonomial(coeffs[x]));
    maxtip := Maximum(coeffstips);
    position := positions[Position(coeffstips,maxtip)];
    redtippath := TipMonomial(coeffs[position]);
    redtippathlength := LengthOfPath(redtippath);
    testset := Filtered(rightgbtips, x -> PositionSublist(WalkOfPath(x[1]),WalkOfPath(redtippath))=1);
    fam := FamilyObj(rightgb[1]);
    gb := GroebnerBasisOfIdeal(I);
    walkoftipsgb := List(gb!.relations, x -> Reversed(WalkOfPath(TipMonomial(x))));
    
    # Initialize our N and O sets:
    OSet := [];
    NSet := [];
    for t in testset do
        rightgbtip := TipMonomial(rightgb[t[2]]);
        rightgbtipcoeff := TipCoefficient(rightgb[t[2]]);
        rightgbtipwalk := WalkOfPath(rightgbtip);
        qlength := Length(rightgbtipwalk); 
        found := false;
        gindex := 1;
        while not found do
            if PositionSublist(Reversed(rightgbtipwalk),walkoftipsgb[gindex]) = 1 then
                found := true;
            else
                gindex := gindex + 1;
            fi;
        od;
        glength := Length(walkoftipsgb[gindex]);

        # Determine if OSet element or NSet:
        if ( redtippathlength <= qlength - glength ) then
            if ( redtippathlength = qlength - glength ) then
                zpath := One(rightgb[1]);
            else
                zwalk := ExtRepOfObj(rightgbtip*One(rightgb[1]));
                zwalk := [zwalk[1], [zwalk[2][1]{[(redtippathlength + 1)..(qlength - glength)]}, zwalk[2][2]]];
                zpath := ObjByExtRep(fam,zwalk);
            fi;
            Add(NSet, [t[1], zpath, gb!.relations[gindex]]);
        else
            if qlength = glength then 
                qprimepath := (tipcoeff/TipCoefficient(gb!.relations[gindex]))*One(rightgb[1]);
            else 
                qprimewalk := ExtRepOfObj(rightgbtip*One(rightgb[1]));
                qprimewalk := [qprimewalk[1], [ qprimewalk[2][1]{[1..(qlength - glength)]}, qprimewalk[2][2]]];
                qprimepath := (tipcoeff/TipCoefficient(gb!.relations[gindex]))*ObjByExtRep(fam,qprimewalk);
            fi;
            Add(OSet, [t[1], position, qprimepath, gb!.relations[gindex]]);
        fi;
    od;
    
    return [OSet,NSet];
end
);

#######################################################################
##
#O  TipReduce( <M> )
##
##  This function tip reduces a set of elements  <M>  for a path algebra
##  module. 
##
InstallMethod( TipReduce,
    "tip reduce set of elements from path algebra module",
    true, 
    [IsHomogeneousList], 0,
    function( M )
    
    local i, j, H, Hlen, reducible, redset;

    if ( not IsRightAlgebraModuleElementCollection(M) ) then
        TryNextMethod();
    fi;

    H := List(M, ExtRepOfObj );

    # Tip reduce H to create a Right Groebner Basis:
    reducible := true;
    while reducible do
        # remove zeros:
        H := Filtered(H, x -> not IsZero(x));
        reducible := false;
        Hlen := Length(H);
        for i in [1..Hlen] do
            redset := Difference([1..Hlen],[i]);
            for j in redset do
            # if H[j] divides H[i]:
                if IsLeftDivisible(H[i], H[j]) then
                    H[i] := ReduceRightModuleElement( H[i], H[j] );
                    reducible := true;
                    break;
                fi;
            od;
            if reducible then
                break;
            fi;
        od;
    od;

    return H;
end
);

#######################################################################
##
#O  TipReduce( <H>, <el> )
##
##  Given an element  <el>  in a path algebra module, this function 
##  tip reduces the element modulo the set of path algebra vectors
##  <H>. 
##
InstallMethod( TipReduce,
    "tip reduce path algebra vector by set of path algebra vectors",
    true, 
    [IsHomogeneousList, IsPathAlgebraVector], 0,
    function( H, el )
    
    local i, reducible, rlen, redset;

    # Tip reduce el to by set redset:
    reducible := true;

    # Convert reducing set to pathalgebavectors
    redset := List(H, ExtRepOfObj );
 
    while reducible and (not IsZero(el)) do
        reducible := false;
        i := 1;
        rlen := Length(redset);
        while i <= rlen do
            if IsLeftDivisible(el, redset[i]) then
                el := ReduceRightModuleElement( el, redset[i] );
                reducible := true;
                break;
            else
                i := i + 1;    
            fi;
        od;
    od;

    return el;
end
);


#######################################################################
##
#O  FirstPart( <f>, <fprime, v )
##
##  Given an element  <v>  in a module which is spanned by  <f>  and 
##  <fprime>, this function computes the coefficients used to write 
##  <v>  in terms of  <f>  and  <fprime>  and returns the coefficients
##  for  <f>. 
##
InstallMethod( FirstPart,
    "writes a module element as a finite sum of given module elements",
    true, 
    [IsHomogeneousList, IsHomogeneousList, IsPathAlgebraVector], 0,
    function( f, fprime, v )
    local fUfprime, i, retvec, fam, flen, tmp, div, newretvec;
    
    fUfprime := Concatenation(f,fprime); 
    fUfprime := List(fUfprime, x -> x![1]);
    flen := Length(fUfprime);
    
    fam := FamilyObj(v![1][v![2]]);
    retvec := ListWithIdenticalEntries( flen, Zero(v![1][v![2]]) );
    tmp := ShallowCopy(v);
    while not IsZero(tmp) do
        for i in [1..flen] do
            if (not IsZero(tmp)) and (not IsZero(fUfprime[i])) then
                div := LeftDivision(tmp, fUfprime[i]); 
                if ( div <> false ) then
                    retvec[i] := retvec[i] + div;
                    tmp := tmp - fUfprime[i]^div;
#                    Print("tmp after reducing: ",tmp," with factor: ",div,"\n");
                fi;
            fi;
        od;
    od;    
    
    newretvec := ListWithIdenticalEntries( flen, Zero(v![1][v![2]]) ){[1..Length(f)]};
    for i in [1..Length(f)] do
        newretvec[i] := retvec[i];
    od;
    
    return newretvec;
end
);  
  
# operation that returns right factor if y divides x.
#######################################################################
##
#O  LeftDivision( <x>, <y> )
##
##  Given two path algebra vectors  <x>  and  <y>, this functions 
##  returns true if the tip of  <y>  left divides the tip of  <x>. 
##
InstallMethod( LeftDivision,
    "for path algebra vectors",
    true,
    [ IsPathAlgebraVector,
      IsPathAlgebraVector], 0,
    function( x, y )
    
    local xTipPos, xLeadingTerm, xCoeff, xMon, xWalk,
          yTipPos, yLeadingTerm, yCoeff, yMon, yWalk,
          fam, rightfactor, rfrep, xrep;

    if (IsZero(x) or IsZero(y)) then
        Error("don't send me zeroes, please.\n");
    else
        fam := FamilyObj(x![1][x![2]]);
        rightfactor := One(x![1][x![2]]);
        
        # Word to be divided:
        xTipPos := x![2];
        xLeadingTerm := LeadingTerm(x)![1][xTipPos];
        xMon := TipMonomial(xLeadingTerm);
        xCoeff := TipCoefficient(xLeadingTerm);
        xWalk := WalkOfPath(xMon);

        # Dividing word:
        yTipPos := y![2];
        yLeadingTerm := LeadingTerm(y)![1][yTipPos];
        yMon := TipMonomial(yLeadingTerm);
        yCoeff := TipCoefficient(yLeadingTerm);
        yWalk := WalkOfPath(yMon);

        if ((xTipPos = yTipPos) and (PositionSublist(xWalk, yWalk) = 1)) then
            # Create right factor:
            if ( Length(yWalk) <> Length(xWalk) ) then
                xrep := ExtRepOfObj(xLeadingTerm);
                # Note: creating the external rep of object here, complete with
                #       appropriate coefficient:
                #          xCoeff == (xCoeff/yCoeff)*yCoeff.
                rfrep := [xrep[1],[ xrep[2][1]{[(Length(yWalk)+1)..Length(xWalk)]}, xCoeff/yCoeff]];
                rightfactor := ObjByExtRep(fam,rfrep);
            else
                rightfactor := (xCoeff/yCoeff)*One(x![1][x![2]])*TargetVertex(xMon);
            fi;
        else
            return false;
        fi;

        return rightfactor;
    fi;
end
);

[ Dauer der Verarbeitung: 0.45 Sekunden  ]