# Check if two graph have same shape(?)

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}]

• for same "shape", see IsomorphicGraphQ. E.g. Graph[{1 -> 2, 2 -> 3, 3 -> 1}]~IsomorphicGraphQ~ Graph[{1 -> 3, 3 -> 2, 2 -> 1}] gives True. – kglr Nov 26 '17 at 2:54
• 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). – ZisIsNotZis Nov 26 '17 at 15:26
• 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? – ZisIsNotZis Nov 26 '17 at 15:39
• ZisIsNotZ, The two arguments of IsomorphicGraphQ should be graphs: IsomorphicGraphQ[Graph@{1 -> 2}, Graph@{1 -> 2}] gives True. – kglr Nov 26 '17 at 15:43

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).

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]]


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,

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

Check the documentation for more examples.

Here's a copyable snippet:

IGHomeomorphicQ[CycleGraph[3], CycleGraph[4]]
(* True *)