Quellcodebibliothek Statistik Leitseite products/Sources/formale Sprachen/GAP/pkg/numericalsgps/gap/   (Algebra von RWTH Aachen Version 4.15.1©)  Datei vom 30.7.2024 mit Größe 14 kB image not shown  

Quelle  obsolet.gi   Sprache: unbekannt

 
#############################################################################
# This file contains obsolet functions which are to be kept during a while for
# compatibility
# WARNING: the manual must be updated before removing the functions
#############################################################################
##
#F  GeneratorsOfNumericalSemigroupNC(S)
##
##  Returns a set of generators of the numerical
##  semigroup S.
##
#############################################################################
# InstallGlobalFunction( GeneratorsOfNumericalSemigroupNC, function(S)
#     if not IsNumericalSemigroup(S) then
#         Error("The argument must be a numerical semigroup");
#     fi;
#     if HasGenerators(S) then
#         return(Generators(S));
#     fi;
#     return(MinimalGeneratingSystemOfNumericalSemigroup(S));
# end);
#############################################################################
##
#F  ReducedSetOfGeneratorsOfNumericalSemigroup(arg)
##
##  Returns a set with possibly fewer generators than those recorded in <C>S!.generators</C>. It changes <C>S!.generators</C> to the set returned.
##The function has 1 to 3 arguments. One of them a numerical semigroup. Then an argument is a boolean (<E>true</E> means that all the elements not belonging to the Apery set with respect to the multiplicity are removed; the default is "false") and another argument is a positive integer <M>n</M> (meaning that generators that can be written as the sum of <n> or less generators are removed; the default is "2"). The boolean or the integer may not be present. If a minimal generating set for <M>S</M> is known or no generating set is known, then the minimal generating system is returned.
##
# InstallGlobalFunction( ReducedSetOfGeneratorsOfNumericalSemigroup, function(arg)
#     local   sumNS,  S,  apery,  n,  generators,  m,  aux,  i,  g,  gen,  ss;

#     #####################################################
#     # Computes the sum of subsets of numerical semigroups
#     # WARNING: the arguments have to be non empty sets, not just lists
#     sumNS := function(S,T)
#         local mm, s, t, R;
#         R := [];
#         mm := Maximum(Maximum(S),Maximum(T));
#         for s in S do
#             for t in T do
#                 if s+t > mm then
#                     break;
#                 else
#                     AddSet(R,s+t);
#                 fi;
#             od;
#         od;
#         return R;
#     end;
#     ##
#     S := First(arg, s -> IsNumericalSemigroup(s));
#     if S = fail then
#         Error("Please check the arguments of ReducedSetOfGeneratorsOfNumericalSemigroup");
#     fi;
#     apery := First(arg, s -> IsBool(s));
#     if apery = fail then
#         apery := false;
#     fi;
#     n := First(arg, s -> IsInt(s));
#     if n = fail then
#         n := 2;
#     fi;

#     if not IsBound(S!.generators) then
#         S!.generators := MinimalGeneratingSystemOfNumericalSemigroup(S);
#         return S!.generators;
#     else
#         if IsBound(S!.minimalgenerators) then
#             #S!.generators := MinimalGeneratingSystemOfNumericalSemigroup(S);
#             return S!.minimalgenerators;
#         fi;
#         generators := S!.generators;
#         m := Minimum(generators); # the multiplicity
#         if m = 1 then
#             S!.generators := [1];
#             return S!.generators;
#         elif m = 2 then
#             S!.generators := [2,First(generators, g -> g mod 2 = 1)];
#             return S!.generators;
#         fi;
#         if apery then
#             aux := [m];
#             for i in [1..m-1] do
#                 g := First(generators, g -> g mod m = i);
#                 if g <> fail then
#                     Append(aux,[g]);
#                 fi;
#             od;
#             gen := Set(aux);
#         else
#             gen := ShallowCopy(generators);
#         fi;
#         ss := sumNS(gen,gen);
#         i := 1;
#         while i < n and ss <> [] do
#             gen :=  Difference(gen,ss);
#             ss := sumNS(gen,ss);
#             i := i+1;
#         od;
#     fi;

#     S!.generators := gen;
#     return S!.generators;
# end);

##
#############################################################################



#############################################################################
##
#F  NumericalSemigroupByMinimalGenerators(arg)
##
##  Returns the numerical semigroup minimally generated by arg.
##  If the generators given are not minimal, the minimal ones
##  are computed and used.
##
#############################################################################
InstallGlobalFunction(NumericalSemigroupByMinimalGenerators, function(arg)
    local L, S, M, l,
          minimalGSNS, sumNS;


    #####################################################
    # Computes the sum of subsets of numerical semigroups
    sumNS := function(S,T)
        local mm, s, t, R;
        R := [];
        mm := Minimum(Maximum(S),Maximum(T));
        for s in S do
            for t in T do
                if s+t > mm then
                    break;
                else
                    AddSet(R,s+t);
                fi;
            od;
        od;
        return R;
    end;
    ##  End of sumNS(S,T)  --


    minimalGSNS := function(L)
        local res, gen, ss, sss, ssss, i, ngen;

        if 1 in L then
            return [1];
        fi;
        gen := ShallowCopy(L);
        # a naive reduction of the number of generators
        ss := sumNS(gen,gen);
        gen := Difference(gen,ss);
        if ss <> [] then
            sss := sumNS(ss,gen);
            gen := Difference(gen,sss);
            if sss <> [] then
                ssss := sumNS(sss,gen);
                gen := Difference(gen,ssss);
            fi;
        fi;
        if Length(gen) = 2 then
            return gen;
        fi;
        i := Length(gen);
        while i >= 2 do
            ngen := Difference(gen, [gen[i]]);
            if Gcd(ngen) = 1 and
               BelongsToNumericalSemigroup(gen[i], NumericalSemigroup(ngen)) then
                gen := ngen;
                i := i - 1;
            else

                i := i - 1;
            fi;
        od;
        return gen;
    end;
    ##  End of minimalGSNS(L)  --


    if IsList(arg[1]) then
        L := Difference(Set(arg[1]),[0]);
    else
        L := Difference(Set(arg),[0]);
    fi;
 if L=[] then
  Error("There should be at least one generator.\n");
 fi;
    if not ForAll(L, x -> IsPosInt(x)) then
        Error("The arguments should be positive integers.\n");
    fi;
    if Gcd(L) <> 1 then
        Error("The greatest common divisor is not 1");
    fi;


    l := minimalGSNS(L);
    if not Length(L) = Length(l) then
        Info(InfoWarning,1,"The list ", L, " can not be the minimal generating set. The list ", l, " will be used instead.");
        L := l;
    fi;
    M:= Objectify( NumericalSemigroupsType, rec() );
    #    Setter(GeneratorsOfNumericalSemigroup)( M, AsList( L ) );
    SetMinimalGenerators(M,L);
    SetGenerators(M,L);
    return M;

end);



#############################################################################
##
#F  NumericalSemigroupByMinimalGeneratorsNC(arg)
##
##  Returns the numerical semigroup minimally generated by arg.
##  No test is made about args' minimality.
##
#############################################################################
InstallGlobalFunction(NumericalSemigroupByMinimalGeneratorsNC, function(arg)
    local L, S, M;


    if IsList(arg[1]) then
        L := Difference(Set(arg[1]),[0]);
    else
        L := Difference(Set(arg),[0]);
    fi;
    if not ForAll(L, x -> IsPosInt(x)) then
        Error("The arguments should be positive integers");
    fi;
    if Gcd(L) <> 1 then
        Error("The greatest common divisor is not 1");
    fi;


    M:= Objectify( NumericalSemigroupsType, rec() );
    #    Setter(GeneratorsOfNumericalSemigroup)( M, AsList( L ) );
    SetMinimalGenerators(M,L);
    SetGenerators(M,L);
    return M;

end);



#############################################################################
##
#F  FortenTruncatedNCForNumericalSemigroups(l)
##
##  l contains the list of coefficients of a
##  single linear equation. fortenTruncated gives a minimal generator
##  of the affine semigroup of nonnegative solutions of this equation
##  with the first coordinate equal to one.
##
##  Used for computing minimal presentations.
##
#############################################################################
InstallGlobalFunction(FortenTruncatedNCForNumericalSemigroups, function(l)
    local   leq,  m,  solutions,  explored,  candidates,  x,  tmp;


    #  leq(v1,v2)
    #  Compares vectors (lists) v1 and v2, returning true if v1 is less than or
    #  equal than v2 with the usual partial order.
    leq := function(v1,v2)
        local v;
        #one should make sure here that the lengths are the same
        v:=v2-v1;
        return (First(v,n->n<0)=fail);
    end;
    ##  End of leq()  --

    m:=IdentityMat(Length(l));
    solutions:=[];
    explored:=[];
    candidates:=[m[1]];
    m:=m{[2..Length(m)]};
    while (not(candidates=[])) do
        x:=candidates[1];
        explored:=Union([x],explored);
        candidates:=candidates{[2..Length(candidates)]};
        if(l*x=0) then
            return x;
        else
            tmp:=List(Filtered(m,n->((l*x)*(l*n)<0)),y->y+x);
            tmp:=Difference(tmp,explored);
            tmp:=Filtered(tmp,n->(First(solutions,y->leq(y,n))=fail));
            candidates:=Union(candidates,tmp);
        fi;
    od;
    return fail;
end);

#========================================================================
##
#F This function is the NC version of CatenaryDegreeOfElementInNumericalSemigroup. It works
## well for numbers bigger than the Frobenius number
## DEPRECATED
##------------------------------------------------------------------------
InstallGlobalFunction(CatenaryDegreeOfElementInNumericalSemigroup_NC, function(n,s)
    local   len,  distance,  Fn,  V,  underlyinggraph,  i,  weights,
            weightedgraph,  j,  dd,  d,  w;

    #---- Local functions definitions -------------------------
    #==========================================================
    #==========================================================
    #Given two factorizations a and b of n, the distance between a
    #and b is d(a,b)=max |a-gcd(a,b)|,|b-gcd(a,b)|, where
    #gcd((a_1,...,a_n),(b_1,...,b_n))=(min(a_1,b_1),...,min(a_n,b_n)).


    #----------------------------------------------------------
    distance := function(a,b)
        local   k,  gcd,  i;

        k := Length(a);
        if k <> Length(b) then
            Error("The lengths of a and b are different.\n");
        fi;


        gcd := [];
        for i in [1..k] do
            Add(gcd, Minimum(a[i],b[i]));
        od;
        return(Maximum(Sum(a-gcd),Sum(b-gcd)));

    end;
    ## ----  End of distance()  ----

    #==========================================================
    #---- End of Local functions definitions ------------------

    #==========================================================
    #-----------      MAIN CODE       -------------------------
    #----------------------------------------------------------

    Fn := FactorizationsElementWRTNumericalSemigroup( n, s );
    #Print("Factorizations:\n",Fn,"\n");
    V := Length(Fn);
    if V = 1 then
        return 0;
    elif V = 2 then
        return distance(Fn[1],Fn[2]);
    fi;


    # compute the directed weighted graph
    underlyinggraph := [];
    for i in [2 .. V] do
        Add(underlyinggraph, [i..V]);
    od;
    Add(underlyinggraph, []);
    weights := [];
    weightedgraph := StructuralCopy(underlyinggraph);
    for i in [1..Length(weightedgraph)] do
        for j in [1..Length(weightedgraph[i])] do
            dd := distance(Fn[i],Fn[weightedgraph[i][j]]);
            Add(weights,dd);
            weightedgraph[i][j] := [weightedgraph[i][j],dd];

        od;
    od;
    weights:=Set(weights);
    d := 0;
    while IsConnectedGraphNCForNumericalSemigroups(underlyinggraph) do
        w := weights[Length(weights)-d];
        d := d+1;
        for i in weightedgraph do
            for j in i do
                if IsBound(j[2]) and j[2]= w then
                    Unbind(i[Position(i,j)]);
                fi;
            od;
        od;
        for i in [1..Length(weightedgraph)] do
            weightedgraph[i] := Compacted(weightedgraph[i]);
        od;
        underlyinggraph := [];
        for i in weightedgraph do
            if i <> [] then
                Add(underlyinggraph, TransposedMatMutable(i)[1]);
            else
                Add(underlyinggraph, []);
            fi;
        od;
    od;


    return(weights[Length(weights)-d+1]);

end);
## ----  End of CatenaryDegreeOfElementInNumericalSemigroup_NC()  ----
#========================================================================
##
#========================================================================
############################################################################
##
#F This function returns true if the graph is connected an false otherwise
##
## It is part of the NumericalSGPS package just to avoid the need of using
## other graph packages only to this effect. It is used in
## CatenaryDegreeOfElementInNumericalSemigroup
##
##
InstallGlobalFunction( IsConnectedGraphNCForNumericalSemigroups, function(G)
    local i, j, fl,
          n, # number of vertices
          uG, # undirected graph (an edge of the undirected graph may be
          #                 seen as a pair of edges of the directed graph)
          visit,
          dfs;

    fl := Flat(G);
    if fl=[] then
        n := Length(G);
    else
        n := Maximum(Length(G),Maximum(fl));
    fi;
    uG := StructuralCopy(G);
    while Length(uG) < n do
        Add(uG,[]);
    od;
    for i in [1..Length(G)] do
        for j in G[i] do
            UniteSet(uG[j],[i]);
        od;
    od;


    visit := [];          # mark the vertices an unvisited
    for i in [1..n] do
        visit[i] := 0;
    od;

    dfs := function(v) #recursive call to Depth First Search
        local w;
        visit[v] := 1;
        for w in uG[v] do
            if visit[w] = 0 then
                dfs(w);
            fi;
        od;
    end;
    dfs(1);
    if 0 in visit then
        return false;
    fi;
    return true;
end);


[ zur Elbe Produktseite wechseln0.46Quellennavigators  Analyse erneut starten  ]