35
$\begingroup$

A planar graph is a graph that can be drawn in the plane such that no two edges cross.

For example, the graph Graph[{{1, 2}, {2, 3}, {3, 1}, {1, 4}, {3, 4}, {2, 4}}] is planar, and can be shown in both of these ways:

enter image description here

The layout in the left doesn't have crossing edges and it's immediately obvious that the graph is planar. The layout on the right is what Mathematica gives me by default.

Question: How can a planar graph be shown without any crossing edges in Mathematica?

I expect Combinatorica` might have this feature as it has a PlanarQ function, but unfortunately the documentation is not included with Mathematica and I have not been able to find out how to do this.

Testing whether a Graph is planar is possible like this:

<< GraphUtilities`
PlanarQ@ToCombinatoricaGraph[someGraph]

Note: The above way of testing planarity is for version 8 or earlier. The PlanarGraphQ built-in function was introduced in version 9.

Here's a random set of planar graph of different sizes to test on:

<< ComputationalGeometry`
graphs = DeleteDuplicates[
   Flatten@Table[
     Graph@
      Union[Sort /@ 
        Join @@ (Thread /@ 
           DelaunayTriangulation@RandomReal[1, {j, 2}])],
     {10}, {j, 4, 10}
     ], IsomorphicGraphQ];

To avoid confusion, I'd like to note that the ComputationalGeometry`PlanarGraphPlot[] function does not do what I need. It does not lay out a graph. One needs to provide an explicit list of vertex coordinates to it. I have a graph as the input, I know that it's planar, and need a layout algorithm that will draw the graph without intersecting edges.

Improve this question
$\endgroup$
11
  • $\begingroup$ What do you mean: the documentation is not included with Mathematica? $\endgroup$
    – Mr.Wizard
    Commented Feb 15, 2012 at 14:35
  • 4
    $\begingroup$ @Mr.Wizard The full documentation of Combinatorica` is not included. It has to be bought separately. $\endgroup$
    – Szabolcs
    Commented Feb 15, 2012 at 14:47
  • $\begingroup$ Did you try selecting RadialDrawing in the right-click context menu under Graph Layout. For this example it gives the graph on the left. $\endgroup$
    – kglr
    Commented Feb 15, 2012 at 14:48
  • $\begingroup$ On the other hand, GraphData["TetrahedralGraph"] is drawn such that it is obviously planar... $\endgroup$
    – J. M.'s missing motivation ♦
    Commented Feb 15, 2012 at 14:53
  • 3
    $\begingroup$ This paper, posted by @halirutan in chat, seems to suggest this is not a trivial thing to do: math.uni-hamburg.de/home/schacht/2011/untangle.pdf $\endgroup$
    – Szabolcs
    Commented Feb 15, 2012 at 15:37

3 Answers 3

Reset to default
19
$\begingroup$

You can plot it using the GraphLayout option, which has, since v9, "PlanarEmbedding" as a possible value:

Graph[Rule @@@ {{1, 2}, {2, 3}, {3, 1}, {1, 4}, {3, 4}, {2, 4}}, GraphLayout -> "PlanarEmbedding"]

Mathematica graphics.

(BTW: This is the standard Mathematica Graph, not the Combinatorica Graph function)

Another one:

truncatedCube =
  {{0, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1}, {1, 0, 1, 0, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1}, 
   {1, 1, 0, 1, 1, 0, 0, 0, 1, 1, 0, 0, 1, 1}, {1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0}, 
   {0, 1, 1, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0}, {1, 1, 0, 1, 1, 0, 1, 1, 0, 0, 1, 1, 0, 0}, 
   {0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0}, 
   {0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, 
   {0, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0}, {1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0}, 
   {0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}};

AdjacencyGraph[truncatedCube, 
  GraphLayout -> "PlanarEmbedding", 
  VertexLabels -> Array[# -> # &, Length @ truncatedCube], 
  PlotRangePadding -> 0.5]

Mathematica graphics

Without GraphLayout -> "PlanarEmbedding":

Mathematica graphics

Improve this answer
$\endgroup$
8
  • 1
    $\begingroup$ Excellent! I do wonder if this (new in version 9) method is guaranteed to find a planar embedding if one exists. $\endgroup$
    – Szabolcs
    Commented Jan 28, 2013 at 0:08
  • 1
    $\begingroup$ @Szabolcs since v9 there's also PlanarGraphQ. I suppose that mma will try to find the solution if it knows it exists. Anyway, the documentation says nothing about this but I tried quite a few cases. $\endgroup$
    – Sjoerd C. de Vries
    Commented Jan 28, 2013 at 6:19
  • 3
    $\begingroup$ I wrote support and they confirmed (in less than 24 hrs!!) that if the graph is planar, this method should always find a planar embedding (i.e. it's not a heuristic method). I'll mention PlanarGraphQ in the question in case people read it. $\endgroup$
    – Szabolcs
    Commented Jan 28, 2013 at 16:32
  • $\begingroup$ @Szabolcs Great! $\endgroup$
    – Sjoerd C. de Vries
    Commented Jan 28, 2013 at 21:47
  • $\begingroup$ Is it possible to do this given a graph taken from GraphData? $\endgroup$
    – Juan
    Commented Jan 26, 2016 at 20:13
17
$\begingroup$

I wouldn't know how to do this automatically but you could untangle the graphs manually using Manipulate:

untangle[gr_] :=
 DynamicModule[{edges, vv, plrnge, gap},
  gap = .15;
  edges = EdgeList[gr];
  vv = VertexList[gr];
  plrnge = 
   Through[{Min, Max}[#]] & /@ 
    Transpose[
     OptionValue[AbsoluteOptions[gr, VertexCoordinates], 
      VertexCoordinates]];
  Manipulate[
   pt = Round[pt, .15];
   Graph[vv, edges, VertexCoordinates -> pt,
    EdgeStyle -> {{Darker[Gray], Thickness[Large]}},
    VertexSize -> 0,
    GridLines -> (Range[Floor[#1 - 1, gap], #2 + 1, gap] & @@@ plrnge),
    GridLinesStyle -> Opacity[.3],
    PlotRange -> plrnge + {{-1, 1}, {-1, 1}},
    Epilog -> {EdgeForm[Black], FaceForm[Red], 
      Disk[#, .03] & /@ pt}],
   {{pt, OptionValue[AbsoluteOptions[gr, VertexCoordinates],
      VertexCoordinates]}, Locator, Appearance -> None},
   Button["Paste graph", Print[Graph[vv, edges, VertexCoordinates -> pt]]]]]

Example

For some arbitrary test graph this looks like

<< ComputationalGeometry`
graph = Graph@
   Union[Sort /@ 
     Join @@ (Thread /@ DelaunayTriangulation@RandomReal[1, {20, 2}])];
untangle[graph]

Before:

Mathematica graphics

And after manually untangling the vertices:

Mathematica graphics

The pasted untangled graph looks like:

Mathematica graphics

Improve this answer
$\endgroup$
8
  • 3
    $\begingroup$ It's not that easy to do the untangling even manually though. $\endgroup$
    – Szabolcs
    Commented Mar 2, 2012 at 14:48
  • 8
    $\begingroup$ No, I know. Maybe you could turn it into a puzzle and let other people do the untangling :-) $\endgroup$
    – Heike
    Commented Mar 2, 2012 at 14:56
  • 4
    $\begingroup$ I could make a web based game, and feed all my graphs to the visitors :D $\endgroup$
    – Szabolcs
    Commented Mar 2, 2012 at 14:59
  • 7
    $\begingroup$ That's how I am usually suckered into solving other people's problems. $\endgroup$
    – Heike
    Commented Mar 2, 2012 at 15:05
  • 4
    $\begingroup$ SE is a big game, isn't it? :D $\endgroup$
    – Szabolcs
    Commented Mar 2, 2012 at 15:06
4
$\begingroup$

There are the built-in "PlanarEmbedding" and "TutteEmbedding" GraphLayouts.

IGraph/M brings additional planar graph visualization functions, IGLayoutPlanar and IGLayoutTutte. IGLayoutPlanar implements a different algorithm than "PlanarEmbedding" and IGLayoutTutte allows specifying the outer face, and considers edge weights (the builtin one can do neither). In addition to IGraph/M's documentation, there are some demos in this post.

Improve this answer
$\endgroup$

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.