1
$\begingroup$

How can I check if two graphs have same shape or not? By shape I mean the two graphs are equivalent under a set of "name" replacements, like:

Graph[{1->2,2->3,3->1}] == Graph[{1->3,3->2,2->1}]
Graph[{1->2,2->3,3->1}] != Graph[{1->2,2->3,3->4,4->1}]

And by the way how can I check if they have same topological(?) shape, which means

Graph[{1->2,2->3,3->1}] == Graph[{1->2,2->3,3->4,4->1}]
Graph[{1->2,2->3,3->1}] != Graph[{1->2,2->3,3->4,4->1,1->5,5->2,2->1}]
$\endgroup$
  • 2
    $\begingroup$ for same "shape", see IsomorphicGraphQ. E.g. Graph[{1 -> 2, 2 -> 3, 3 -> 1}]~IsomorphicGraphQ~ Graph[{1 -> 3, 3 -> 2, 2 -> 1}] gives True. $\endgroup$ – kglr Nov 26 '17 at 2:54
  • $\begingroup$ In Mathematica 11.2 on my mechine, it turns out IsomorphicGraphQ[Graph[...],Graph[...]] will not evaluate, while IsomorphicGraphQ[{a[1, 1, 3, 1] -> a[1, 1, 3, 1]}, {a[1, 1, 1, 3] -> a[1, 1, 1, 3]}] will return false (incorrectly?). I use this kind of "a-tuple" as vertexes since they are generated by NestGraph while it will not work correctly if I return list of list (it will be considered matrix). $\endgroup$ – ZisIsNotZis Nov 26 '17 at 15:26
  • $\begingroup$ Fix above: It turns out that IsomorphicGraphQ of anything beside Graph[...] will always return false, even for IsomorphicGraphQ[{1 -> 2}, {1 -> 2}], while IsomorphicGraphQ of Graph[...] do not evaluate (it will return the same thing as input). Is that a bug on my mechine or bug of 11.2? $\endgroup$ – ZisIsNotZis Nov 26 '17 at 15:39
  • $\begingroup$ ZisIsNotZ, The two arguments of IsomorphicGraphQ should be graphs: IsomorphicGraphQ[Graph@{1 -> 2}, Graph@{1 -> 2}] gives True. $\endgroup$ – kglr Nov 26 '17 at 15:43
3
$\begingroup$

The first equivalence you mention is called isomorphism. Use IsomorphicGraphQ.

The second is not entirely clear to me, but you probably mean homeomorphism.

It seems reasonable (but I have not proven it!) that two directed graphs would be homeomorphic if we obtain isomorphic graphs after repeatedly removing vertices that have one incoming and one outgoing edge, like vertex 2 below, and replacing them with a single edge (would be 1 -> 3 below).

enter image description here

To avoid obtaining multigraphs or self loops, the removal should only be done if vertices 1 and 3 are distinct and there is no edge 1 -> 3 already.

Here's an implementation of this for directed graphs (since that is what you have in your example):

out[g_, v_] := First@DeleteCases[VertexOutComponent[g, v], v]
in[g_, v_] := First@DeleteCases[VertexInComponent[g, v], v]

smooth[graph_?DirectedGraphQ]:=
    Module[{g=graph,candidates,v},
        While[True,
            candidates=Pick[VertexList[g],Transpose[{VertexOutDegree[g],VertexInDegree[g]}],{1,1}];
            candidates=Select[candidates, With[{i=in[g,#1],o=out[g,#1]},!EdgeQ[g,i\[DirectedEdge]o]&&i=!=o]&];
            If[candidates==={},Break[]];
            v=First[candidates];
            g=VertexContract[g,{v,out[g,v]}]
        ];
        g
    ]

homeomorphicQ[g1_?DirectedGraphQ, g2_?DirectedGraphQ] := 
 IsomorphicGraphQ[smooth[g1], smooth[g2]]
$\endgroup$
1
$\begingroup$

To check that two undirected graphs have the same topological shape, now you can use IGHomeomorphicQ from IGraph/M 0.3.99 or later.

For example,

enter image description here

The IGSmoothen function will smooth out degree-2 vertices like this:

enter image description here

Check the documentation for more examples.

Here's a copyable snippet:

IGHomeomorphicQ[CycleGraph[3], CycleGraph[4]]
(* True *)
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.