Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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.

share|improve this question

1 Answer 1

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]] 

enter image description here

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}]

enter image description here

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],
      Thread@UndirectedEdge[0, boundaryFaces[faces, boundaryEdges[faces]]]]]

That's all.

 DualGraph[faces]

enter image description here

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

 Graph[innerDualEdges[faces]]

enter image description here

You can also compare it with Mathematica internals:

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

Full notebook is available here.

share|improve this answer
1  
+1 ...Very nice! –  belisarius Jul 4 at 21:20
    
+1 ... by the by in M10 there will be multigraph, here's some evidence reference.wolfram.com/language/ref/MultigraphQ.html –  Martin John Hadley Jul 5 at 11:57

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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