lcz

1029 Reputation

11 Badges

5 years, 297 days
changsha, China

MaplePrimes Activity


These are answers submitted by lcz

See https://de.maplesoft.com/support/help/maple/view.aspx?path=GraphTheory/MakeWeighted.

with(GraphTheory): 
G := Graph({{1, 2}, {1, 3}, {2, 3}});
H1 := MakeWeighted(G);
WeightMatrix(H1);

@Scott03 See the link: https ://www.mapleprimes.com/questions/235430-Find-All-Minimal-Edge-Cuts-Of-A-Graph

But I think they are different issues.  You want to find all the minimal edge cuts of two specific vertices. 

  • IGFindMinimalCuts[g, s, t] finds all unweighted minimal edge cuts that disconnect vertex t from vertex s

 IGraph/M, a Mathematica backpack, can do that.(But how maple implements it, I don't know yet) 

Your example:

g = Graph[{1 <-> 2, 1 <-> 3, 2 <-> 3, 2 <-> 4, 3 <-> 4}, 
  VertexLabels -> Automatic]
HighlightGraph[g, Join[#, {1, 4}], GraphHighlightStyle -> "Dashed", 
   VertexSize -> Medium] & /@ 
 SortBy[Length]@IGFindMinimalCuts[g, 1, 4]

 

# another example
g = GridGraph[{2, 4}]
HighlightGraph[g, Join[#, {1, 4}], GraphHighlightStyle -> "Dashed", 
   VertexSize -> Medium] & /@ 
 SortBy[Length]@IGFindMinimalCuts[g, 1, 4]

We can use stylesheet = [padding =20,color=COLORS [i]]in HighlightVertex.

with(GraphTheory):
G := Graph(undirected, {{1, 2}, {1, 4}, {2, 3}, {3, 4},{3,5}});
COLORS := [red, yellow, cyan, green, coral, blue, magenta, navy, orange, pink, plum, khaki, turquoise];
cn := ChromaticNumber(G, 'col');
for i to cn do
    HighlightVertex(G, col[i], stylesheet = [padding =20,color=COLORS [i]]);
end do;
DrawGraph(G,  showlabels = false);

 

I'm interested in why you need to draw a graph with so many vertices (528). 

  • You say "Some kind of patterned way to set vertex positions for least crossings". 

          In geometric graph theory, this is known as the crossing number of a graph. Calculating the crossing number of a  given graph is NP-hard. But it may be possible to find some heuristic algorithm to find a drawing with the smallest possible number of crossings.

If only to make it easier to see the graph, I prefer to go with gephi that is the leading visualization and exploration software for all kinds of graphs and networks. 

Let's take the two matrices you uploaded, F[0] and F[1], as an example.

with(GraphTheory);
with(SpecialGraphs);
F[0] := Matrix([
 [0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],
 [1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],
 [1, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],
 [1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0], 
 [0, 0, 0, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0], 
 [0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0],
 [0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],
 [0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0], 
 [0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0], 
 [0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0], 
 [0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0], 
 [0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0], 
 [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0], 
 [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0], 
 [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0], 
 [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0], 
 [0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0], 
 [0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0], 
 [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1], 
 [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1], 
 [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1], 
 [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0]]);
F[1] := Matrix([
 [0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0],
 [0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0], 
 [1, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0], 
 [1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0], 
 [0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1], 
 [0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1], 
 [0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0], 
 [0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0], 
 [0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0], 
 [0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0], 
 [0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0], 
 [0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0], 
 [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0], 
 [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0], 
 [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0], 
 [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0], 
 [0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0], 
 [0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0], 
 [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1, 0, 0], 
 [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0], 
 [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 0], 
 [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0], 
 [1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1], 
 [0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0]])

The graphs represented by the two matrices to make a Cartesian product.  We stored it in gml format.

g:=CartesianProduct(Graph(F[0]), Graph(F[1]));
ExportGraph(g, "D://g.graphml",graphml)

We import it with gephi and choose some layouts. You can see that the drawings  of the graph g in the pdf files I uploaded are indeed much better.

f_0f_1.pdf

f0f1_2.pdf

 

 

As Thomas Richard  said, this is not realistic. It turns out that doing code translation is more or less our own work. I think a pragmatic strategy is  to learn to find the resources you need on Github. They will make up for the temporary absence of function  in  the Graph theory backpack. At the same time, it is necessary to constantly learn  skills of python or other program  languages and more knowledge of data structures and graph algorithms to adapt to more demands.

I could easily find some code for the specific problem you mentioned. (Correctness is not checked!)

I made some changes to the code for the first link because of the python2 to Python3 migration.

import sys

x = sys.maxsize

G = [[  0, 11,  x,  9],
     [ 14,  0, 35,  2],
     [  x, 21,  0, 15],
     [  2,  x,  5,  0]]

def printGraph(G):
    for row in G:
        print(row)

def BadAPSP(G, show=0):
    assert len(G) == len(G[0])
    M = G
    n = len(M[0])
    for l in range(n-1):
        if show:
            print ('l=%d' % (l))
            printGraph(M)
            print ('-'*10)
        for i in range(n):
            for j in range(n):
                for k in range(n):
                    M[i][j] = min([M[i][j], M[i][k]+M[k][j]])
    print ("APSP:")
    printGraph(M)
    return M

def FloydWarshall(G, show=0):
    assert len(G) == len(G[0])
    M = G
    n = len(M[0])
    for k in range(n):
        if show:
            print('k=%d' % (k-1))
            printGraph(M)
            print ('-'*10)
        for i in range(n):
            for j in range(n):
                M[i][j] = min([M[i][j], M[i][k]+M[k][j]])
    print ("APSP (k=%d):" % k)
    printGraph(M)
    return M

#BadAPSP(G, 1)
FloydWarshall(G, 1)

The graph involved in the above code:

k=-1
[0, 11, 9223372036854775807, 9]
[14, 0, 35, 2]
[9223372036854775807, 21, 0, 15]
[2, 9223372036854775807, 5, 0]
----------
k=0
[0, 11, 9223372036854775807, 9]
[14, 0, 35, 2]
[9223372036854775807, 21, 0, 15]
[2, 13, 5, 0]
----------
k=1
[0, 11, 46, 9]
[14, 0, 35, 2]
[35, 21, 0, 15]
[2, 13, 5, 0]
----------
k=2
[0, 11, 46, 9]
[14, 0, 35, 2]
[35, 21, 0, 15]
[2, 13, 5, 0]
----------
APSP (k=3):
[0, 11, 14, 9]
[4, 0, 7, 2]
[17, 21, 0, 15]
[2, 13, 5, 0]

 

 

 

Ps:Maple's print function can see framework of some built-in function. But I don't see anything useful about AllPairsDistance.

proc(G::GRAPHLN, {output::identical(Matrix, DataFrame) := ':-Matrix'}, $)
    AllPairsDistanceImpl(G, 1, output, _rest);
end proc

But the help documentation of AllPairsDistance explains its method:an implementation of the Floyd-Warshall all-pairs shortest path algorithm. But how to improve, when there's no information left.

My advice is to look at the source codes of MathChem and write them yourself. I saw the introduction of package MathChem you mentioned.  MathChem is a python package for calculating topological Indices. This is actually a similar question I've asked before, but I talked about the igraph package.

Another similar discussion is as below.

I tried to install this package in python3, but unfortunately the run always failed. So I looked at the source codes, and it seemed to be based on Python 2.  I looked at  some functions in MathChem , and most of them could have been rewritten in Maple or made use of the Maple built-in functions.  

For example,  the spectral radius of adjacency matrix of a graph is what we talked about a while ago.  Carl Love,  dharr and acer  have an equally brilliant analysis of the problem.

SR := proc(G::Graph)
  local M := GraphTheory:-AdjacencyMatrix(G);
  max(abs~(LinearAlgebra:-Eigenvalues(
    rtable(`if`([rtable_indfns(M)]=[':-symmetric'],
           ':-symmetric',NULL), M,
           'datatype'=':-hfloat','storage'=':-rectangular',
           'order'=':-Fortran_order'))));
end proc:

  See more details in https://www.mapleprimes.com/questions/233883-How-To-Quickly-Find--The-Spectral-Radius-Of-A-Matrix-.

Another example, we can calculate the first Zagreb index and  second Zagreb index of a graph by maple.

with(GraphTheory):with(SpecialGraphs):
G:=PetersenGraph()
Zagrebindex_1:=g-> add((GraphTheory:-DegreeSequence(g))^~(2));
Zagrebindex_2:=proc(g)
local d,i;
d:=Edges(g);
add([seq(Degree(g,d[i][1])*Degree(g,d[i][2]), i=1..NumberOfEdges(g))])
end proc:
Zagrebindex_1(G),Zagrebindex_2(G)

90, 135

In MathChem, their codes are written in a similar way.

def zagreb_m1_index(self):
        """ Zagreb M1 Index """    
        return sum(map(lambda d: d**2, self.degrees()))
def zagreb_m2_index(self):
        """ Zagreb M2 Index 
        
        The molecular graph must contain at least one edge, otherwise the function Return False
        Zagreb M2 Index is a special case of Connectivity Index with power = 1"""
        return sum( map(lambda (e1, e2): self.degrees()[e1]*self.degrees()[e2] , self.edges()) )            
    
   

During my master's period, I once did research on chemical graph theory. Generally speaking, it is not too difficult to write codes for chemical index of graph. The difficulty is  calculating some parameters of graphs themselves.  For example, whether a graph is Hamiltonian, or to calculate  the crossing number  of a graph, and so on.  (They are NP hard. )  Even for linear time algorithms, such as testing whether a graph is planar, it is difficult to write code without specialized knowledge, but fortunately it is often readily available.

The unweighted  version was previously provided in https://www.mapleprimes.com/questions/233695-Solve-The-Resistor-Grid-Of-1-Ohm-. Here, for the first question, we provide a  weighted graph version. Relevant theories can be referred to this paper.

  • Bapat R B. Resistance matrix of a weighted graph[J]. MATCH Commun. Math. Comput. Chem, 2004, 50(02).

As for whether the author discovered it for the first time, I haven't checked it carefully.

We just need to change the  laplacian matrix of  unweighted graph to the laplacian matrix of the weighted graph. So we improved the codes from last time as follows.

Laplaceweightmatrix:=proc(g::Graph)
local M,M1,M2;
M:=GraphTheory:-WeightMatrix(g):
M1:=Matrix(upperbound(M), (i,j)-> `if`(M(i,j)<>0, -1/M(i,j), 0)):
M2:=M1+LinearAlgebra:-DiagonalMatrix(-MTM:-sum(M1,1));
end proc:
ResistanceMatrix:= (g::Graph)-> 
    (M-> Matrix(
            upperbound(M), (i,j)-> M[i,i]+M[j,j], 'shape' = 'symmetric'
         ) - 2*M
    )(LinearAlgebra:-MatrixInverse(Laplaceweightmatrix(g)
          , 'method'= 'pseudo'
     ))
:
with(GraphTheory):
G:=Graph({[{"000","400"},4],[{"400","450"},5],[{"450","050"},4],[{"050","000"},5],
          [{"003","403"},4],[{"403","453"},5],[{"453","053"},4],[{"053","003"},5],
          [{"000","003"},3],[{"400","403"},3],[{"450","453"},3],[{"050","053"},3]}):
S:=ResistanceMatrix(G):
S[1,8] #156/47

 

PS: Here I have not studied the corresponding relationship between graph vertex index and adjacency matrix index thoroughly.

However,  it seems that Rows and columns of the adjacency matrix follow the order given by Vertices:

Vertices(G);

["000", "003", "050", "053", "400", "403", "450", "453"]

In graph theory, the resistance distance between two vertices of a simple connected graph, G, is equal to the resistance between two equivalent points on an electrical network, constructed so as to correspond to G, with each edge being replaced by a 1 ohm resistance

SEE https://en.wikipedia.org/wiki/Resistance_distance

PS: I remember that even though each edge is not set to a unit resistance, there is a corresponding theoretical calculation formula. 

So we can write the following function:

ResistanceMatrix:=proc(g::Graph)
   local L,ML,n, i, j, R;
     n:=GraphTheory:-NumberOfVertices(g);
     L:=GraphTheory:-LaplacianMatrix(g):
     ML:=LinearAlgebra:-MatrixInverse(L, method = pseudo):
         for i from 1 to n do
            for j from i to n do
               R:=Matrix(n,n,(i,j)->ML[i,i]+ML[j,j]-2*ML[i,j],shape = symmetric);
            od:
         od:
     R;
end proc:
with(SpecialGraphs):
S := SoccerBallGraph():
R:=ResistanceMatrix(S):
R[1,31];
R[1,2];

17/11;
16273/25080

Note that finding the  pseudo inverse of the matrix is ​​not efficient, so this method seems to be limited to cases with fewer vertices or only has theoretical value. Is there a faster solution? I don't know yet.

See some talks in https://www.mapleprimes.com/maplesoftblog/208427-Google-Maps-And-Geocoding-For-Maple 

First you have to install this extra package, but even so, it looks like this function is not easy to use now.

Page 1 of 1