# How to create all possible graphs that connect all vertices?

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. 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 • 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.
– hana
Nov 8, 2022 at 17:59
• Please try allConnected, it will return all those graphs. Nov 8, 2022 at 18:01
• I see, thank you.
– hana
Nov 8, 2022 at 18:04
• Better practice is to accept the answer if it answers what you asked instead of writing "thank you". Nov 8, 2022 at 21:35
• 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. Nov 8, 2022 at 21:52

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:=
n = 5; (* no of vertices *)
k = n (n - 1)/2; (* max number of edges *)

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

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

In:= graphs = Select[
ConnectedGraphQ
];

In:= Length[graphs]
Out= 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.

• 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.
– hana
Nov 9, 2022 at 4:20
– hana
Nov 9, 2022 at 8:03
• 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. Nov 9, 2022 at 13:30

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]  And just a small portion of all 768 graphs for n=5 (for n=6 there is already 27449 graphs): 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]

• Maybe I misunderstood the requirements. I took it as any vertex must be connected somewhere, not that all vertices have to me connected together. Nov 8, 2022 at 20:25
• Sorry for the confusion, I actually meant to say all vertices connected together.
– hana
Nov 8, 2022 at 21:04