# How to plot planar graphs as such?

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:

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 /@
DelaunayTriangulation@RandomReal[1, {j, 2}])],
{10}, {j, 4, 10}
], IsomorphicGraphQ];

To avoid confusion, I'd like to note that the ComputationalGeometryPlanarGraphPlot[] 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.

-
What do you mean: the documentation is not included with Mathematica? – Mr.Wizard Feb 15 '12 at 14:35
@Mr.Wizard The full documentation of Combinatorica is not included. It has to be bought separately. – Szabolcs Feb 15 '12 at 14:47
Did you try selecting RadialDrawing in the right-click context menu under Graph Layout. For this example it gives the graph on the left. – kglr Feb 15 '12 at 14:48
On the other hand, GraphData["TetrahedralGraph"] is drawn such that it is obviously planar... – J. M. Feb 15 '12 at 14:53
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 – Szabolcs Feb 15 '12 at 15:37

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

.

(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}};

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

Without GraphLayout -> "PlanarEmbedding":

-
Excellent! I do wonder if this (new in version 9) method is guaranteed to find a planar embedding if one exists. – Szabolcs Jan 28 '13 at 0:08
@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. – Sjoerd C. de Vries Jan 28 '13 at 6:19
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. – Szabolcs Jan 28 '13 at 16:32
@Szabolcs Great! – Sjoerd C. de Vries Jan 28 '13 at 21:47
Is it possible to do this given a graph taken from GraphData? – Juan Jan 26 at 20:13

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:

And after manually untangling the vertices:

The pasted untangled graph looks like:

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