6
$\begingroup$

How can I generate all labelled connected simple graphs on n vertices?

In the image below, I drew examples with number of vertices n = 3 and n = 4.

For n = 3, there are only 4 graphs that connect all vertices.
For n = 4, I only drew some as there are many more so did not draw all here.

I would like to create a function that if I input the number of vertices then it generates all graphs like the image below.

Any idea to do this?

The layout of graphs is not important but I want to label vertices's names with number or letters. Self-loop is not possible and there is only one edge between two vertices.

enter image description here

$\endgroup$

3 Answers 3

7
$\begingroup$

For small $n$, one can use:

allEdges[n_]:=Flatten[Table[UndirectedEdge[i,j],{i,1,n},{j,i+1,n}]];
allConnected[n_]:=Select[Map[Graph[Range[n],#,VertexLabels->Automatic]&,
                             Subsets[allEdges[n]]],ConnectedGraphQ];
allConnectedUpToIso[n_]:=DeleteDuplicates[allConnected[n],IsomorphicGraphQ];

Example:

allConnectedUpToIso[4]

enter image description here

$\endgroup$
5
  • $\begingroup$ Thanks, but that doesn't create all graphs like I mentioned above. Two graphs with same shape but vertices different are considered different in my case. $\endgroup$
    – hana
    Nov 8, 2022 at 17:59
  • 1
    $\begingroup$ Please try allConnected[4], it will return all those graphs. $\endgroup$
    – user293787
    Nov 8, 2022 at 18:01
  • $\begingroup$ I see, thank you. $\endgroup$
    – hana
    Nov 8, 2022 at 18:04
  • $\begingroup$ Better practice is to accept the answer if it answers what you asked instead of writing "thank you". $\endgroup$ Nov 8, 2022 at 21:35
  • 1
    $\begingroup$ In general, DeleteDuplicates[list, IsomorphicGraphQ] is very inefficient. The better way to do this is DeleteDuplicatesBy[list, CanonicalGraph]. However, OP was asking for labelled graphs. $\endgroup$
    – Szabolcs
    Nov 8, 2022 at 21:52
5
$\begingroup$

A hopefully efficient approach to generate all possible adjacency matrices as bit fields. In a first step, we filter those which have a sufficient number of edges to be connected. In a second step, we filter connected graphs.

In[161]:= 
n = 5; (* no of vertices *)
k = n (n - 1)/2; (* max number of edges *)

In[163]:= symmetrize = # + Transpose[#] &;

In[164]:= 
adjmats = 
  symmetrize@PadRight[TakeList[#, Range[n] - 1], {n, n}] & /@ 
   IntegerDigits[Range[2^k] - 1, 2, k];

In[165]:= graphs = Select[
   AdjacencyGraph /@ Select[adjmats, Total[#, 2]/2 >= n - 1 &],
   ConnectedGraphQ
   ];

In[166]:= Length[graphs]
Out[166]= 728

We can convince ourselves that the code is correct by comparing counts with https://oeis.org/A001187

I did not benchmark this against other solutions.

$\endgroup$
3
  • $\begingroup$ Somehow this is slower than the user293787's answer on my laptop using AbsoluteTiming. user293787's method takes 0.0930639 and this method takes 0.2760455 for 5 vertices. $\endgroup$
    – hana
    Nov 9, 2022 at 4:20
  • $\begingroup$ The link is interesting. $\endgroup$
    – hana
    Nov 9, 2022 at 8:03
  • $\begingroup$ It's interesting that this is slower. I don't have the time to look into why, but I suspect that in Mathematica building a graph from an adjacency matrix is just slower than building one from an edge list. $\endgroup$
    – Szabolcs
    Nov 9, 2022 at 13:30
4
$\begingroup$

Edit:

This is probably not what OP meant (as pointed out by @user293787) but I understood it as all vertices have to be connected somewhere instead of all vertices have to be connected together. If it was the former case my answer would be:

n = 4;
Graph[Range[n], UndirectedEdge @@@ #, VertexLabels -> Automatic, 
   VertexCoordinates -> CirclePoints[n], ImageSize -> 50] & /@ 
 Select[Subsets[Subsets[Range[n], {2}], {Floor[n/2], ∞}], 
  Length[Union[Flatten[#]]] == n &]
Clear[n]

enter image description here

enter image description here

And just a small portion of all 768 graphs for n=5 (for n=6 there is already 27449 graphs):

enter image description here

And this is for the latter case (selection by ConnectedGraphQ added to previous code):

n = 4;
Select[Graph[Range[n], UndirectedEdge @@@ #, 
    VertexLabels -> Automatic, VertexCoordinates -> CirclePoints[n], 
    ImageSize -> 50] & /@ 
  Select[Subsets[Subsets[Range[n], {2}], {Floor[n/2], \[Infinity]}], 
   Length[Union[Flatten[#]]] == n &], ConnectedGraphQ]
Clear[n]
$\endgroup$
2
  • 1
    $\begingroup$ Maybe I misunderstood the requirements. I took it as any vertex must be connected somewhere, not that all vertices have to me connected together. $\endgroup$ Nov 8, 2022 at 20:25
  • $\begingroup$ Sorry for the confusion, I actually meant to say all vertices connected together. $\endgroup$
    – hana
    Nov 8, 2022 at 21:04

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.