# Dual graph of an arbitrary (planar) graph

Every planar graph has a dual. How can I obtain it with Mathematica?

I know that GraphData provides the DualGraph property for its named graphs, but I have found no method for computing the dual of an arbitrary (non-named) graph. Even Combinatorica seems to lack it.

Update: obviously incorrect statements are removed.

I think WM doesn't include DualGraph-function because it is usually multigraph and non unique.

As far as I have read in Wikipedia a dual graph $G^*$ depends on planar embedding of $G$. If you ask for a some dual graph for a given graph, then here is my brute force heuristic algorithm. It is based on algorithm (given below) which yields the faces (and I do not guarantee that it is correct):

The pseudo-code is as follows:

1. pseudofaces={}
2. graph0 = spanning tree of graph
3. edges0 = all edges of graph which are not in graph0
4. While edges0 is non empty
1. find edge from edges0 such that its vertices have shortest path in graph0
2. Append path to pseudofaces
3. Remove edge from edges0
4. Add edge to graph0
5. return pseudofaces

Here is Mathematica implementation.

(* simple Kruskal's algorithm without sorting *)
SpanningTree[graph_] := Module[{label, edges = EdgeList[graph]},
Pick[edges, Table[If[UnsameQ[#1, #2], #2 = #1; True, False] & @@ Sort[label /@ edge], {edge, edges}]]]


It yields a spanning tree:

graph = GridGraph[{5, 9}];
HighlightGraph[graph, SpanningTree[graph]] makeEges[list_] := Sort /@ UndirectedEdge @@@ Partition[list, 2, 1]

(* FindFace : finds the smallest cycle. This cycle is a pseudo-face. *)
FindFace[graph_, edges_] := MapAt[makeEges,
First@SortBy[Transpose[{FindShortestPath[graph, Sequence @@ #] & /@ edges, edges}],
Composition[Length, First]], 1]

(* Append analyzed edge to a graph *)
appendEge[graph_, edge_] := Graph@Append[EdgeList[graph], edge]

iteration[graph_, {}] := $faces; iteration[graph_, edges_] := iteration[AppendTo[$faces, Flatten[#]]; appendEge[graph, Last@#],
DeleteCases[edges, Last@#]] &[FindFace[graph, edges]]

(* Faces : returns all pseudo-faces of a graph *)
Faces[graph_] := Block[{\$faces = {}, tree = SpanningTree[graph]},
iteration[Graph[tree], Complement[EdgeList[graph], tree]]]


It works as follows:

faces = Faces[graph];
Manipulate[HighlightGraph[graph, faces[[n]]], {n, 1, Length@faces, 1}] The last step is to construct the dual graph from the faces:

 shareQ[set1_, set2_] := Length@Intersection[set1, set2] > 0;

(* connecting all faces *)
innerDualEdges[faces_] := Join @@ Table[
Table[If[shareQ @@ faces[[{i, j}]], UndirectedEdge[i, j], Unevaluated@Sequence[]],
{j, i + 1, Length[faces]}], {i, 1, Length[faces] - 1}]

(* next two functions find the faces on the boundary *)
boundaryEdges[faces_] :=
Module[{edges = Join @@ faces}, Select[Union[edges], (Count[edges, #] == 1) &]]
boundaryFaces[faces_, outerEdges_] :=
Select[Range@Length@faces, shareQ[faces[[#]], outerEdges] &];

(* altogether *)
DualGraph[faces_] := Graph[DeleteDuplicates@Join[innerDualEdges[faces],


That's all.

 DualGraph[faces] If you do not consider the outer space as a face, then you can ask:

 Graph[innerDualEdges[faces]] You can also compare it with Mathematica internals:

 IsomorphicGraphQ[GraphData["IcosahedralGraph", "DualGraph"],
DualGraph[Faces[GraphData["IcosahedralGraph"]]]]
(* True *)


Full notebook is available here.

• +1 ... by the by in M10 there will be multigraph, here's some evidence reference.wolfram.com/language/ref/MultigraphQ.html – Charlie Joey Hadley Jul 5 '14 at 11:57
• Grisha Kirilin's method doesn't seem to work for some (even very small) examples. Eg. IsomorphicGraphQ outputs False both times here: name = "SelfDualGraph1"; IsomorphicGraphQ[GraphData[name,"DualGraph"],DualGraph[Faces[GraphData[name]]]] name = {"JohnsonSkeleton", 26}; IsomorphicGraphQ[GraphData[name, "DualGraph"],DualGraph[Faces[GraphData[name]]]] Can this method be fixed or is there a more reliable way to get a dual graph? In particular I want to find the dual graphs of the JohnsonSkeletons which GraphData doesn't have complete information for. – nasosev Jan 20 '16 at 5:09

IGraph/M now includes functionality to find the faces of a planar graph, or to find the dual graph.

Demo:

g = IGTriangularLattice[3, VertexShapeFunction -> "Name"] IGFaces[g]
(* {{1, 2, 3}, {1, 3, 6, 5, 4, 2}, {2, 4, 5}, {2, 5, 3}, {3, 5, 6}} *)

IGDualGraph[g] The vertices of the dual are in the same order as the result of IGFaces.