8
$\begingroup$

The version of my Mathematica is 10. I generate a connected graph with 9 vertices, but find that it is not included in Mathematica.

adjm = {{0, 1, 0, 0, 1, 0, 0, 0, 1}, {1, 0, 1, 0, 0, 0, 0, 1, 0}, {0, 1, 0, 
  1, 0, 0, 0, 1, 0}, {0, 0, 1, 0, 1, 1, 0, 0, 0}, {1, 0, 0, 1, 0, 1, 
  0, 0, 0}, {0, 0, 0, 1, 1, 0, 1, 0, 0}, {0, 0, 0, 0, 0, 1, 0, 1, 
  1}, {0, 1, 1, 0, 0, 0, 1, 0, 0}, {1, 0, 0, 0, 0, 0, 1, 0, 0}};
g1 = AdjacencyGraph[adjm];
(*generate the graph g1*)
ori2 = GraphData[9];
set2 = GraphData[#] & /@ ori2;
set3 = Select[set2, ConnectedGraphQ[#] == True &];
IsomorphicGraphQ[g1, #] & /@ (set3)
(*generate all the graphs with 9 vertices, select the connected ones and check if g1 is there*)

The output is a list of False.

If I have missed something. Then the question is how to get the database of all connected graphs with 9 vertices?

Improve this question
$\endgroup$
12
  • $\begingroup$ Very important for all such questions: what precise version of Mathematica are you using, on what operating system? $\endgroup$
    – Szabolcs
    Sep 26, 2014 at 12:50
  • $\begingroup$ OK, I looked at your code. I cannot run it because at the moment I do not have access to a fast enough internet connection to be able to download all the graph data ... However, you seem to be assuming that GraphData[9] will return all possible graphs on 9 vertices. I do not see why this should be so. It is just a non-exhaustive graph database, don't assume it contains everything. $\endgroup$
    – Szabolcs
    Sep 26, 2014 at 12:54
  • $\begingroup$ Actually there seem to be no less than 274668 unlabelled graphs on 9 vertices ... which is much more than what the database can be expected to contain. Voting to close since this question is due to a simple misunderstanding. $\endgroup$
    – Szabolcs
    Sep 26, 2014 at 12:56
  • $\begingroup$ @Szabolcs Thanks! I update the question. $\endgroup$
    – Eden Harder
    Sep 26, 2014 at 13:21
  • $\begingroup$ There is no such database built into Mathematica, so for a pre-made database you'd have to look elsewhere. Generating all unlabelled graphs on 9 vertices and making sure there are no duplicates in the list is going to be hard and definitely impossible using a naive approach of simply using IsomorphicGraphQ to filter duplicates. Not to say it's impossible with smarter methods (it probably is), but how to do it seems hard enough that I'd say it's a math question first, and a Mathematica question only once you have a strategy in mind ... $\endgroup$
    – Szabolcs
    Sep 26, 2014 at 13:32

3 Answers 3

Reset to default
10
$\begingroup$

Here is a recursive way to get them all: (slow due to the use of IsomorphicGraphQ inside DeleteDuplicates, if anybody knows how to do it faster, please comment). Much faster now thanks to @MarkMcClure's clever improvement.

Edit

Improved again by 40% prefiltering the added rows using the automorphisms of the n-1 graph:

<< Combinatorica`
filtPerms[skel_, rows_] := Module[{perms, gathered},
  perms = FindPermutation /@ (Automorphisms@FromAdjacencyMatrix@skel);
  gathered = GatherBy[rows, Tr@# &];
  Flatten[ DeleteDuplicates[#, MemberQ[System`Permute[#1, PermutationGroup[perms]], #2] &] & /@
                                                                                    gathered, 1]
  ]
getConnG[2] = {{{0, 1}, {1, 0}}};
getConnG[n_] := getConnG[n] = 
  Module[{skels, rows, adjk, gathered}, 
   skels = ArrayPad[#, {{1, 0}, {1, 0}}] & /@ getConnG[n - 1];
   rows = Rest@Tuples[Join[{{0}}, Array[{0, 1} &, n - 1]]];
   adjk = (Unitize@(# + Transpose@#) & /@ 
      Flatten[Flatten[Outer[ReplacePart[#1, 1->#2]&, {#}, filtPerms[#,rows],  1], 1] & /@ skels, 1]);
   gathered = GatherBy[adjk, Total[Flatten[#]] &];
   Flatten[DeleteDuplicates[#, IsomorphicGraphQ[AdjacencyGraph@#1, AdjacencyGraph@#2] &] & /@ 
     gathered, 1]]

GraphicsGrid@Partition[Framed /@ AdjacencyGraph /@ getConnG@6, 8]

Mathematica graphics

Improve this answer
$\endgroup$
6
  • 2
    $\begingroup$ I modified your code slightly so that getConnG[6] runs in 5 seconds as opposed to 30 seconds on my machine. The major point is that DeleteDuplicates has quadratic time complexity when using a user defined comparison function. Thus, breaking the list of graphs in smaller parts using the total number of edges helps a lot. Of course, DeleteDuplicates can run like $n\log(n)$, when the data is linearly ordered, but that's not generally possible with a user defined comparison function. $\endgroup$
    – Mark McClure
    Sep 27, 2014 at 12:38
  • $\begingroup$ getConnG[7] in about 6 minutes. $\endgroup$
    – Mark McClure
    Sep 27, 2014 at 12:55
  • $\begingroup$ @MarkMcClure Thanks! Sound good, very clever. I'm trying to filter the rows to use on each getConnF[n-1] based on the Automorphisms[] of the getConnF[n-1] and its permutation group to produce much less isomorphic results to be discarded later. $\endgroup$
    – Dr. belisarius
    Sep 27, 2014 at 18:38
  • 1
    $\begingroup$ @MarkMcClure I've done it. Resulted in a 40% time gain. $\endgroup$
    – Dr. belisarius
    Sep 27, 2014 at 21:56
  • $\begingroup$ Should be faster if you use FindIsomorphism[g,g,All] on a Graph object. On my iPhone right now so I can't try it just now. $\endgroup$
    – Mark McClure
    Sep 27, 2014 at 22:21
7
$\begingroup$

The geng tool of the nauty suite can generate all non-isomorphic connected graphs on a specified number of vertices. The format used by nauty is directly supported by Mathematica, making it easy to use these tools.

I installed nauty using MacPorts (sudo port install nauty), but it's generally easy to compile on Unix-like systems. Once you have the geng binary, simply use the command below (adjusting the path to geng appropriately).

cg = Import["!/opt/local/bin/geng -c 9", "Graph6"];

Length[cg]    
(* 261080 *)

(This takes a minute or so.)

As you can see, there are 261,080 connected non-isomorphic graphs on 9 vertices.

If you want even larger graphs, it will be useful to read them one-by-one. You can do it like so:

geng = StartProcess[{"/opt/local/bin/geng", "-c", "9"}]
Import[geng, {"Graph6", "GraphList", 123}] (* read 123th graph from the output *)

Original answer:

The website http://cs.anu.edu.au/~bdm/data/graphs.html contains a list of all unlabelled graphs, with up to 10 vertices.

Update: As @paw says in a comment, the format used on this website can be read directly by Mathematica, so the conversion I described below is not necessary: Graph6.

It uses a special format, which can be converted to an adjacency matrix using the showg program, downloadable (as C source code) from here.

Once converted to an adjacency matrix, Mathematica can read it.

I compiled showg on a Unix-like system with the command

cc -O2 showg.c -o showg

then imported e.g. the graph H???C@w to Mathematica using

First@ImportString[#, "Table"] & /@ Rest@Import["!echo H???C@w | ~/test/showg -A", "Lines"]

(I'm sure this can be done better...)

Improve this answer
$\endgroup$
1
  • 3
    $\begingroup$ Yes this can be done better. Mathematica supports .g6 natively and you can import the list of graphs with n vertices with gSet[n_] := Import["http://cs.anu.edu.au/~bdm/data/graph" <> ToString@n <> ".g6"]; $\endgroup$
    – paw
    Sep 26, 2014 at 13:54
3
$\begingroup$

You can generate a connected random graph with the same number of vertices and edges as g1.

adjm = {{0, 1, 0, 0, 1, 0, 0, 0, 1}, {1, 0, 1, 0, 0, 0, 0, 1, 0}, {0, 1, 0, 1,
     0, 0, 0, 1, 0}, {0, 0, 1, 0, 1, 1, 0, 0, 0}, {1, 0, 0, 1, 0, 1, 0, 0, 
    0}, {0, 0, 0, 1, 1, 0, 1, 0, 0}, {0, 0, 0, 0, 0, 1, 0, 1, 1}, {0, 1, 1, 0,
     0, 0, 1, 0, 0}, {1, 0, 0, 0, 0, 0, 1, 0, 0}};

g1 = AdjacencyGraph[adjm];
vc = VertexCount[g1];
ec = EdgeCount[g1];

rg := RandomGraph[{vc, ec}];

gr = rg; While[! ConnectedGraphQ[gr], gr = rg]; gr

enter image description here

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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