# How many graphs are there on 4 nodes with degrees 1, 1, 2, 2?

I know just the basic operations on graphs using Mathematica. But I want to know how to write a code that prints all the possible combinations of a graph with a specified number of edges.
Take for example:
How many graphs are there on 4 nodes with degrees 1, 1, 2, 2?
I know the answer mathematically is 12, but I want Mathematica to print these combinations. \Please help me and explain to me how can I write the code.

• Hint: Since you only have four nodes, could you imagine building a table where each entry is a list of whether or not each node is connected to each other node for every possible graph? Could you check that table has the correct number of entries? And then could you think of a way of discarding entries in that table that do not have the appropriate degrees? Is the number of entries that remain what you want to know? And is that number equal to 12? Does this hint make the programming problem more concrete so you can make some progress on doing this? – Bill Mar 6 at 6:36

am = Tuples[{0, 1}, {4, 4}];


4X4 adjacency matrices with no self-loops:

simpleam = DeleteDuplicates[(1 - IdentityMatrix[4]) # & /@ am];


Adjacency matrices for undirected graphs on 4 nodes:

undirectedam = Select[# == Transpose@# &]@simpleam;


Adjacency matrices for graphs with vertex degree sequence {1,1,2,2}:

vdegree1122am = Select[Sort[Total[#]] == {1, 1, 2, 2} &]@undirectedam;


Counts:

Length /@ {am, simpleam, undirectedam, vdegree1122am}

 {65536, 4096, 64, 12}


Associated graphs:

AdjacencyGraph[#, VertexLabels -> "Name"] & /@ vdegree1122am // Column


We can get the 12 graphs more directly, by noting that two periphery nodes (nodes with vertex degree 1) can be selected in 6 ways:

peripherynodes = Subsets[Range[4], {2}]

 {{1, 2}, {1, 3}, {1, 4}, {2, 3}, {2, 4}, {3, 4}}


For each pair in peripherynodes the remaining two nodes can be ordered in 2 ways:

interiornodes = Permutations[Complement[Range[4], #]] & /@ peripherynodes;


We combine peripherynodes with associated interiornodes to get the edgelists of 12 graphs:

edgelists = BlockMap[UndirectedEdge @@ # &, #, 2, 1] & /@ (Join @@
{peripherynodes, interiornodes}])


Graph[#, VertexLabels -> "Name"] & /@ edgelists // Column


• Thank you for the solution. The second method of obtaining the graphs is exactly what I did to obtain them mathematically, I considered (4C2) then (2C1) to obtain the final result, and I wanted to know how to implement this idea in Mathematica. So thanks! – Mubarak Alsaeedi Mar 6 at 20:17

I had an old program lying around that will generate all realizations of a degree sequence. The first vertex will have degree equal to the first element in the input list, the 2nd degree equal to the 2nd element, and so on.

The program requires my IGraph/M package for graphicality testing.

For details on how it works, see http://bolyai.cs.elte.hu/egres/tr/egres-11-11.pdf

The answer here is trivial: there are only two realizations, which are isomorphic. They have an automorphism group size of 2 (they are symmetric to reflection, see also IGBlissAutomorphismCount). Thus not all 4! = 24 permutations of vertices create distinct labelled graphs, only 4! / 2 = 12.

What if the degree sequence is a bit more complicated?

degSeqGraphList[{3, 3, 2, 2, 1, 1}] // DeleteDuplicatesBy[CanonicalGraph]


There are now 5 non-isomorphic realizations:

There have different automorphism group sizes:

In[]:= IGBlissAutomorphismCount /@ %
Out[]= {8, 1, 4, 2, 4}


There are 6! permutations of vertices, but many of these generate the same labelled graph. We can compute the total number of graphs like this:

In[]:= 6!/%
Out[]= {90, 720, 180, 360, 180}

In[]:= Total[%]
Out[]= 1530


The code for generating all labelled realizations of a degree sequence:

Needs["IGraphM"]

removeZeros[list_] := TakeWhile[list, # != 0 &]

iter[ds_, vert_] :=
With[{pos = Position[ds, 0]}, {Delete[ds, pos], Delete[vert, pos]}]

ClearAll[exactGen, list]; (* list is an inert head *)

exactGen[{}, edges_, _] := edges
exactGen[degseq : {d_, rest__}, edges_, vertices_] /; IGGraphicalQ[degseq] :=

Module[{ds = {rest}, temp, newDs, newVertices},
Function[subs,
temp = ds;
temp[[subs]] -= 1;
If[IGGraphicalQ[temp],
{newDs, newVertices} = iter[temp, Rest[vertices]];
exactGen[newDs,
Join[edges, list @@ Thread[First[vertices] <-> Rest[vertices][[subs]]]],
newVertices],
{}
]
] /@ Subsets[Range@Length[ds], {d}]
]

degSeqGraphList[degseq_?IGGraphicalQ] :=

With[{verts = Range@Length[degseq]},
Graph[verts, #, VertexLabels -> Automatic] & /@ List @@@ Cases[
exactGen[degseq, list[], verts],
_list,
Infinity
]
]

• Thanks. I appreciate your solution and your generalization. – Mubarak Alsaeedi Mar 6 at 20:21

A one-liner:

Length@Select[Graph /@ Subsets[EdgeList[CompleteGraph[4]]],
Sort@VertexDegree[#] == {1, 1, 2, 2} &]


EdgeList[CompleteGraph[4]] will give us all the possible edges on four vertices, Subsets will give us all the possible subsets of those edges, and Graph will turn those into graphs. (When a vertex is isolated, it will not be included in the graph, but that's not a problem for us.)

VertexDegree gives the degrees of all vertices of a graph, so Sort@VertexDegree[#] == {1, 1, 2, 2} checks if a graph has the degree sequence you want.

We Select all graphs with that degree sequence, and then find the Length` of that list.

(Like the accepted answer, this would be inefficient for large graphs, in which case Szabolcs's answer is the way to go.)

• Yes, I can see that. But when I tried to solve it mathematically, I used the approach of Kglr in his second solution, where he used the idea of peripherynodes and interiornodes. Is this an efficient approach? – Mubarak Alsaeedi Mar 6 at 20:25
• It's situational: it doesn't give a general algorithm for an arbitrary degree sequence. So it's hard to say how efficient this is, given that for this specific problem, all of these solutions work instantly. – Misha Lavrov Mar 6 at 20:37