0
$\begingroup$

This question is a follow-up to the question I asked earlier.

Using Mathematica, we can easily determine that the following two graphs are non-isomorphic.

  G1 = Graph[
  ImportString["W|tNHEpCKoh`@@Po_WHB@CKC?WGO{G?KKCB`?OMG?_y_?Sn", 
   "Graph6"], VertexLabels -> Automatic];
  G2 = Graph[
  ImportString["W|vJJEpCKo``P`?ocKG``?ECG[GGKGCEC@@p?CMG?G]_?H^", 
   "Graph6"], VertexLabels -> Automatic];
IsomorphicGraphQ[G1, G2]
(*Flase*)

I'd like to make it easy to see that these two graphs are non-isomorphic. And I tried the method in the answer of Szabolcs, and for these two graphs, it doesn't work.

sig[g_] := Module[{dm, diam}, dm = GraphDistanceMatrix[g];
  diam = Max[dm];
  Sort[Lookup[Counts[#], Range[diam], 0] & /@ dm]]
s1[G1]
(*{{7,10,6},{7,10,6},{7,10,6},{7,10,6},{7,10,6},{7,10,6},{7,10,6},{7,\
10,6},{7,10,6},{7,10,6},{7,10,6},{7,10,6},{7,10,6},{7,10,6},{7,10,6},{\
7,10,6},{7,10,6},{7,10,6},{7,10,6},{7,10,6},{7,10,6},{7,10,6},{7,10,6}\
,{7,10,6}}*)
s2[G2]
(*{{7,10,6},{7,10,6},{7,10,6},{7,10,6},{7,10,6},{7,10,6},{7,10,6},{7,\
10,6},{7,10,6},{7,10,6},{7,10,6},{7,10,6},{7,10,6},{7,10,6},{7,10,6},{\
7,10,6},{7,10,6},{7,10,6},{7,10,6},{7,10,6},{7,10,6},{7,10,6},{7,10,6}\
,{7,10,6}}*)

So I came up with the following idea, but it could be very violent.

For two graphs $G_1$ and $G_2$, if $G_1$ has some subgraph $H$ and $G_2$ doesn't contain any subgraph isomorphic to $H$, then $G_1$ is not isomorphic to $G_2$.

Let $S$ be the set of non-isomophic subgraphs of $G$ such that $G_2$ does not contain any subgraph isomorphic to any one of $S$.

My goal is to find the graphs in $S$ such that

  • (1) have the minimum number of vertices,
  • (2) have the minimum of edges.

Note that filtered graphs prioritised to meet condition (1).

PS: choose ``the minimum` is for the sake of observation.

For example,

enter image description here

Then $S$ is the following graph set:

enter image description here

The goal graph is $g_1$ in $S$.

How can we do that with Mathematica.


Ps: One interesting thing is that these two graphs have different eigenvalues. But I prefer to look at a small subgraph $g$ in $G_1$ that $G_2$ does not contain $g$ (up to isomorphism).

Eigenvalues[AdjacencyMatrix[G1]]
(*{7, 1 + 2 Sqrt[3], 1 + 2 Sqrt[3], 1 + 2 Sqrt[3], -3, -3, -3, 
 1 - 2 Sqrt[3], 1 - 2 Sqrt[3], 
 1 - 2 Sqrt[3], -1, -1, -1, -1, -1, -1, -1, -1, -1, 1, 1, 1, 1, 1}*)
Eigenvalues[AdjacencyMatrix[G2]]
(*7, Root[25 + 50 # - 17 #^2 - 52 #^3 - 17 #^4 + 2 #^5 + #^6& , 6, 0], \
Root[25 + 50 # - 17 #^2 - 52 #^3 - 17 #^4 + 2 #^5 + #^6& , 6, 0], 1 + 
 2 Sqrt[3], Root[
25 + 50 # - 17 #^2 - 52 #^3 - 17 #^4 + 2 #^5 + #^6& , 1, 0], Root[
25 + 50 # - 17 #^2 - 52 #^3 - 17 #^4 + 2 #^5 + #^6& , 1, 0], -3, 1 - 
 2 Sqrt[3], Root[
25 + 50 # - 17 #^2 - 52 #^3 - 17 #^4 + 2 #^5 + #^6& , 2, 0], Root[
25 + 50 # - 17 #^2 - 52 #^3 - 17 #^4 + 2 #^5 + #^6& , 2, 0], Root[
25 + 50 # - 17 #^2 - 52 #^3 - 17 #^4 + 2 #^5 + #^6& , 3, 0], Root[
25 + 50 # - 17 #^2 - 52 #^3 - 17 #^4 + 2 #^5 + #^6& , 3, 0], -1, -1, \
-1, -1, -1, 1, 1, 1, Root[
25 + 50 # - 17 #^2 - 52 #^3 - 17 #^4 + 2 #^5 + #^6& , 5, 0], Root[
25 + 50 # - 17 #^2 - 52 #^3 - 17 #^4 + 2 #^5 + #^6& , 5, 0], Root[
25 + 50 # - 17 #^2 - 52 #^3 - 17 #^4 + 2 #^5 + #^6& , 4, 0], Root[
25 + 50 # - 17 #^2 - 52 #^3 - 17 #^4 + 2 #^5 + #^6& , 4, 0]*)
$\endgroup$

0

Your Answer

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

Browse other questions tagged or ask your own question.