notebook.community

Edit and run

Numerical semigroups with francy

Load francy Package





In [2]:



    


LoadPackage("francy");
LoadPackage("num");



    


















    
Out[2]:








true










    
Out[2]:








true

Drawing Apéry sets

This example draws the Apéry set of a numerical semigrup with respect to its multiplicity. By passing over a node with the mouse, the set of factorizations with respect to the minimal generating system of the numerical semigroup is displayed. Clicking a node produces a message with the same information.





In [3]:



    


apery:=function(arg)
    local ap,c,hasse, s, n, r, graphHasse, aps, es, canvas, i, order, showfacts, message;
    # rel is a list of lists with two elements representin a binary relation
    # hasse(rel) removes from rel the pairs [x,y] such that there exists
    # z with [x,z],[z,y] in rel
    hasse:=function(rel)
      local dom, out;
      dom:=Flat(rel);
      out:=Filtered(rel, p-> ForAny(dom, x->([p[1],x] in rel) and ([x,p[2]] in rel)));
      return Difference(rel,out);
    end;

    order:=function(x)
        return Maximum(LengthsOfFactorizationsElementWRTNumericalSemigroup(x,s));
    end;

    showfacts:=function(x)
        message := FrancyMessage(Concatenation(String(x), " factors as "), 
                    String(FactorizationsElementWRTNumericalSemigroup(x,s)));
        SetFrancyId(message, Concatenation("message-for-", String(x)));
        Add(canvas, message);
        return Draw(canvas);
    end;
    if Length(arg)=1 then
        s:=arg[1];
        n:=MultiplicityOfNumericalSemigroup(s);
    fi;
    if Length(arg)=2 then
        s:=arg[1];
        n:=arg[2];
    fi;
    if Length(arg)>2 then
        Error("The number of arguments must be one or two");
    fi;
  
    graphHasse := Graph(GraphType.UNDIRECTED);
    #SetSimulation(graphHasse,true);
    #SetDrag(graphHasse,true);
    ap:=AperyList(s,n);
    c:=Cartesian([1..n],[1..n]);
    c:=Filtered(c, p-> ap[p[2]]<>ap[p[1]]);
    c:=Filtered(c, p-> ap[p[1]]-ap[p[2]] in s);
    c:=hasse(c);
    aps:=[];
    for i in [1..n] do
        aps[i]:=Shape(ShapeType!.CIRCLE, String(ap[i]));
        SetLayer(aps[i],-order(ap[i]));
        Add(aps[i],Callback(showfacts,[ap[i]]));
        Add(aps[i],FrancyMessage(Concatenation("{",
            JoinStringsWithSeparator(List(FactorizationsElementWRTNumericalSemigroup(ap[i],s), 
            f->Concatenation("(",JoinStringsWithSeparator(f,","),")")),","),")")));
        Add(graphHasse,aps[i]);
    od;
    for r in c do
        Add(graphHasse,Link(aps[r[1]],aps[r[2]]));
    od;
    canvas:=Canvas("Apery");
    Add(canvas,graphHasse);
    return Draw(canvas);    
end;



    


















    
Out[3]:








function( arg... ) ... end

















In [4]:



    


apery(NumericalSemigroup(10,51,27,31));



    


















    
Out[4]:

Drawing sons of numerical semigroups

This example shows how to draw the sons of a numerical semigroup in the tree of numerical semigroups. If we click on a node, then the sets of sons of that node are added to the canvas, and if the node is a leaf, a warning message is displayed.

Passing the mouse over a node shows the set of minimal generators of the node.





In [5]:



    


sons:=function(s)
    local gens, frb, desc, graphHasse, d, shpr, shp, canvas, sonsf, i, gn, lbl;
    
    
    sonsf:=function(s,n)
        local gens, frb, desc, d, shp, i, lbl, gn;

        frb:=FrobeniusNumber(s);
        gens:=Filtered(MinimalGenerators(s), x-> x>frb);
        desc:=List(gens, g->RemoveMinimalGeneratorFromNumericalSemigroup(g,s));
        gn:=Genus(s);
        i:=0;
        for d in desc do
            i:=i+1;
        lbl:=Concatenation("$\\langle",JoinStringsWithSeparator(MinimalGenerators(d),","),"\\rangle$");
            shp:=Shape(ShapeType!.CIRCLE, lbl);
            SetFrancyId(shp,lbl);
            SetLayer(shp,Genus(d));
            SetSize(shp,1);
            Add(shp,Callback(sonsf,[d,shp]));
            Add(shp,FrancyMessage(String(MinimalGenerators(d))));
            Add(graphHasse,shp);
            Add(graphHasse,Link(n,shp));
        od;
        if desc<>[] then 
            return Draw(canvas);
        fi;
        Add(canvas, FrancyMessage(FrancyMessageType.WARNING, "This semigroup is a leaf"));
        return Draw(canvas);
    end;
    
    frb:=FrobeniusNumber(s);
    gens:=Filtered(MinimalGenerators(s), x-> x>frb);
    desc:=List(gens, g->RemoveMinimalGeneratorFromNumericalSemigroup(g,s));
    gn:=Genus(s);

    graphHasse := Graph(GraphType.UNDIRECTED);
    lbl:=Concatenation("$\\langle",JoinStringsWithSeparator(MinimalGenerators(s),","),"\\rangle$");
    shpr:=Shape(ShapeType!.CIRCLE, lbl);
    SetSize(shpr,1);
    SetFrancyId(shpr,lbl);
    Add(shpr,FrancyMessage(String(MinimalGenerators(s))));
    SetLayer(shpr,Genus(s));
    Add(graphHasse,shpr);
    i:=0;
    for d in desc do
        i:=i+1;
        lbl:=Concatenation("$\\langle",JoinStringsWithSeparator(MinimalGenerators(d),","),"\\rangle$");
        shp:=Shape(ShapeType!.CIRCLE, lbl);
        SetFrancyId(shp,lbl);
        SetLayer(shp,Genus(d));
        SetSize(shp,1);
        Add(shp,Callback(sonsf,[d,shp]));
        Add(shp,FrancyMessage(String(MinimalGenerators(d))));
        Add(graphHasse,shp);
        Add(graphHasse,Link(shpr,shp));
    od;
    canvas:=Canvas("Sons of a numerical semigroup");
    SetTexTypesetting(canvas, true);
    Add(canvas,graphHasse);
    return Draw(canvas);    
end;



    


















    
Out[5]:








function( s ) ... end

















In [6]:



    


sons(NumericalSemigroup(3,5,7));



    


















    
Out[6]:

Tree of numerical semigroups

Now we draw the sons of a numerical semigroup s in the tree of numerical semigroups up to level l.





In [7]:



    


sonstree:=function(s,l,generators)
    local gens, frb, desc, graphTreee, d, shpr, shp, canvas, sonsf, lbl;


    sonsf:=function(s,n,lv)
        local gens, frb, desc, d, shp;
        if lv=0 then
            return ;
        fi;
        frb:=FrobeniusNumber(s);
        gens:=Filtered(generators(s), x-> x>frb);
        desc:=List(gens, g->RemoveMinimalGeneratorFromNumericalSemigroup(g,s));
        for d in desc do
            lbl:=Concatenation("$\\{",JoinStringsWithSeparator(generators(d),","),"\\}$");
            shp:=Shape(ShapeType!.CIRCLE, lbl);
            SetSize(shp,5);
            Add(graphTreee,shp);
            SetParentShape(shp,n);
            sonsf(d,shp,lv-1);
        od;
        if desc<>[] then
            return ;
        fi;
        #Add(canvas, FrancyMessage(FrancyMessageType.WARNING, "This semigroup is a leaf"));
        return ;
    end;

    frb:=FrobeniusNumber(s);
    gens:=Filtered(generators(s), x-> x>frb);
    desc:=List(gens, g->RemoveMinimalGeneratorFromNumericalSemigroup(g,s));

    graphTreee := Graph(GraphType.TREE);
    SetCollapsed(graphTreee,false);
    shpr:=Shape(ShapeType!.CIRCLE, "S");
    SetSize(shpr,5);
    Add(shpr,FrancyMessage(String(generators(s))));
    Add(graphTreee,shpr);
    canvas:=Canvas("Sons of a numerical semigroup");
    SetTexTypesetting(canvas, true);
    Add(canvas,graphTreee);
    sonsf(s,shpr,l);
    return Draw(canvas);
end;



    


















    
Out[7]:








function( s, l, generators ) ... end

Darker dots correspond either to leaves or to elements with highest genus. Blue nodes can be collapsed by clicking.





In [8]:



    


sonstree(NumericalSemigroup(1),4,MinimalGenerators);



    


















    
Out[8]:

And we can get also the tree of Arf numerical semigroups





In [9]:



    


sonstree(NumericalSemigroup(1),8,ArfCharactersOfArfNumericalSemigroup);



    


















    
Out[9]:

Oversemigroups





In [10]:



    


oversemigroups:=function(s)
    local ov, graphHasse, canvas,c,i,r,ovs,n,hasse,lbl;
    
    hasse:=function(rel)
      local dom, out;
      dom:=Flat(rel);
      out:=Filtered(rel, p-> ForAny(dom, x->([p[1],x] in rel) and ([x,p[2]] in rel)));
      return Difference(rel,out);
    end;

    ov:=OverSemigroupsNumericalSemigroup(s);
    n:=Length(ov);
    graphHasse := Graph(GraphType.UNDIRECTED);
    #SetSimulation(graphHasse,true);
    #SetDrag(graphHasse,true);
    c:=Cartesian([1..n],[1..n]);
    c:=Filtered(c, p-> p[2]<>p[1]);
    c:=Filtered(c, p-> IsSubset(ov[p[1]],ov[p[2]]));
    c:=hasse(c);
    ovs:=[];
    for i in [1..n] do
    lbl:=Concatenation("$\\langle",JoinStringsWithSeparator(MinimalGenerators(ov[i]),","),"\\rangle$");


        if IsIrreducible(ov[i]) then
            ovs[i]:=Shape(ShapeType!.DIAMOND, lbl);
        else
            ovs[i]:=Shape(ShapeType!.CIRCLE, lbl);
        fi;
        SetLayer(ovs[i],Genus(ov[i]));
    SetSize(ovs[i],2);
    Add(graphHasse,ovs[i]);
    od;
    for r in c do
        Add(graphHasse,Link(ovs[r[1]],ovs[r[2]]));
    od;
    canvas:=Canvas("Oversemigroups");
    SetTexTypesetting(canvas, true);
    Add(canvas,graphHasse);
    return Draw(canvas);    
end;



    


















    
Out[10]:








function( s ) ... end

A Hasse diagram of the set of oversemigroups of the given numerical semigroup is displayed. Irreducible numerical semigroups are drawn as diamonds.





In [11]:



    


oversemigroups(NumericalSemigroup(6,7,9,11));



    


















    
Out[11]:

Graphs associated to elements

The Eliahou graph of an element in a numerical semigroup is a graph whose vertices are the factorizations of the element, and to vertices are joined with an edge if they have common support.





In [12]:



    


DrawEliahouGraph:=function(n,s)
    local graph, canvas, f, fs, c, nf, i, p;
    
    f:=FactorizationsElementWRTNumericalSemigroup(n,s);
    graph:=Graph(GraphType.UNDIRECTED);
    #SetShowNeighbours(graph,true);
    #SetSimulation(graph,true);
    #SetDrag(graph,true);
    nf:=Length(f);
    fs:=[];
    for i in [1..nf] do 
        fs[i]:=Shape(ShapeType!.CIRCLE, Concatenation("(",JoinStringsWithSeparator(f[i],","),")"));
        SetLayer(fs[i],Sum(f[i]));
        SetSize(fs[i],1);
        Add(graph,fs[i]);
    od;
    c:=Cartesian([1..nf],[1..nf]);
    c:=Filtered(c,p->p[1]<p[2] and f[p[1]]*f[p[2]]<>0);
    for p in c do 
        Add(graph,Link(fs[p[1]],fs[p[2]]));
    od;
    canvas:=Canvas("Eliahou graph");
    Add(canvas,graph);
    return Draw(canvas);
end;



    


















    
Out[12]:








function( n, s ) ... end

















In [13]:



    


s:=NumericalSemigroup(5,7,9);



    


















    
Out[13]:








Numerical semigroup with 3 generators

















In [14]:



    


DrawEliahouGraph(49,s);



    


















    
Out[14]:



















In [15]:



    


BettiElements(s);



    


















    
Out[15]:








[ 14, 25, 27 ]

















In [16]:



    


DrawEliahouGraph(55,s);



    


















    
Out[16]:



















In [17]:



    


DrawRosalesGraph:=function(n,s)
    local graph, canvas, msg, msgs, c, nv, i, p;
    
    msg:=Filtered(MinimalGenerators(s), g->n-g in s);
    graph:=Graph(GraphType.UNDIRECTED);
    #SetSimulation(graph,true);
    #SetDrag(graph,true);
    nv:=Length(msg);
    msgs:=[];
    for i in [1..nv] do 
        msgs[i]:=Shape(ShapeType!.CIRCLE, String(msg[i]));
        SetSize(msgs[i],1);
        Add(graph,msgs[i]);
    od;
    c:=Cartesian([1..nv],[1..nv]);
    c:=Filtered(c,p->p[1]<p[2] and n-(msg[p[1]]+msg[p[2]]) in s);
    for p in c do 
        Add(graph,Link(msgs[p[1]],msgs[p[2]]));
    od;
    canvas:=Canvas("Rosales graph");
    Add(canvas,graph);
    return Draw(canvas);
end;



    


















    
Out[17]:








function( n, s ) ... end

















In [18]:



    


s:=NumericalSemigroup(5,7,9);



    


















    
Out[18]:








Numerical semigroup with 3 generators

















In [19]:



    


DrawRosalesGraph(49,s);



    


















    
Out[19]:



















In [20]:



    


DrawRosalesGraph(10,NumericalSemigroup(3,5,7));



    


















    
Out[20]:

Graphs of factorizations





In [21]:



    


DrawFactorizationGraph:=function(f)
    local graph, canvas, fs, c, nf, i, p, ln, distance, Kruskal, tv;

    Kruskal := function(V, E)
        local trees, needed, v, e, i,j, nv;

        trees := List(V, v-> [v]);
        needed := [];
        nv:=Length(V);
        for e in E do
          i:=First([1..Length(trees)], k-> e[1] in trees[k]);
          j:=First([1..Length(trees)], k-> e[2] in trees[k]);
          if i<>j then
            trees[i]:=Union(trees[i], trees[j]);
            trees[j]:=[];
            Add(needed,e);
          fi;
          if Length(needed)=nv-1 then
            break;
          fi;
        od;
        return needed;
    end;
 
    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;

    graph:=Graph(GraphType.UNDIRECTED);
# SetSimulation(graph,true);
#SetDrag(graph,true);
#SetShowNeighbours(graph,true);
    nf:=Length(f);
    fs:=[];
    for i in [1..nf] do 
        fs[i]:=Shape(ShapeType!.CIRCLE, Concatenation("(",JoinStringsWithSeparator(f[i],","),")"));
        SetLayer(fs[i],Sum(f[i]));
        SetSize(fs[i],1);
        Add(graph,fs[i]);
    od;
    c:=Cartesian([1..nf],[1..nf]);
    c:=Filtered(c,p->p[1]<p[2] and f[p[1]]*f[p[2]]<>0);
    Sort(c,function(e,ee) return distance(f[e[1]],f[e[2]])<distance(f[ee[1]],f[ee[2]]); end);
    tv:=Kruskal(f,List(c,p->[f[p[1]],f[p[2]]]));
    for p in c do 
        ln:=Link(fs[p[1]],fs[p[2]]);
        #SetWeight(ln, distance(f[p[1]],f[p[2]]));
        SetTitle(ln, String(distance(f[p[1]],f[p[2]])));
        if [f[p[1]],f[p[2]]] in tv then 
            SetColor(ln,"red");
        fi;
        Add(graph,ln);
    od;
    canvas:=Canvas("Factorizations graph");
    Add(canvas,graph);
    return Draw(canvas);
end;



    


















    
Out[21]:








function( f ) ... end

















In [22]:



    


f:=FactorizationsElementWRTNumericalSemigroup(40,NumericalSemigroup(3,5,7));



    


















    
Out[22]:








[ [ 10, 2, 0 ], [ 5, 5, 0 ], [ 0, 8, 0 ], [ 11, 0, 1 ], [ 6, 3, 1 ], [ 1, 6, 1 ], [ 7, 1, 2 ], [ 2, 4, 2 ], [ 3, 2, 3 ], [ 4, 0, 4 ], [ 0, 1, 5 ] ]

















In [ ]:

Content source: mcmartins/francy

Similar notebooks:

notebook.community | gallery | about