Mathematica Stack Exchange is a question and answer site for users of Mathematica. Join them; it only takes a minute:

Sign up
Here's how it works:
  1. Anybody can ask a question
  2. Anybody can answer
  3. The best answers are voted up and rise to the top

How to programmatically create and plot regular planar graphs with $k = 3, 4$ or $6$ (not hypercubes) and regular nonplanar graphs of $k = 8$ (see figure)? Note that what matters is the average connectivity, as nodes at edges and corners have smaller $k$ values. Is there any easy method to do this, or one has to write its own VertexCoordinates function and the method to generate the appropriate graph?

planar and nonplanar graphs

Also, how to create and plot random planar graphs, where only the average connectivity is given and nodes possibly have varying connectivity. Note that the Computational Geometry Package has some means to deal with planar graphs, but e.g. PlanarGraphPlot can only give the Delaunay triangulation of the given dataset. Thus edges cannot be specified for e.g. top-right and bottom-left graphs in figure.

share|improve this question
up vote 29 down vote accepted

My friend C.P and I worked out these solutions. The 1st is C.P.s' Here we go. First things to know:

1) New Graph[] and related functionality in v8.0.4 is powerful in the sense that it does not only create an image but also stores all the information, including vertex coordinates, in that Graph[] object.

2) There is a GridGraph[...] function that makes exactly what it is named for

Now starting from GridGraph[...] you can simply add or remove edges to it to get your diagrams.

g[m_, n_] := 
 GridGraph[{m, n}, VertexSize -> 0.3, VertexStyle -> White, 
  EdgeStyle -> Black]

edges[m_, n_] := 
   If[Mod[j, m] != 0 && (j + m + 1 <= n*m), 
    UndirectedEdge[j + m + 1, j], {}], {j, 1, n*m}]]

altg[m_, n_] := EdgeAdd[g[m, n], edges[m, n]]

altg[7, 5]

enter image description here

The rest of your diagrams can follow in the same manner. Another way would be to figure out the formula for construction of adjacency matrix for your diagrams. Then just use AdjacencyGraph[...].

But probably the easiest way to solve this (not necessarily efficient) is to understand the visual connection between your vertices. Then connect elements of an array exactly in this way and flatten the array. You should get creative with vertex coordinates though.

mat[m_, n_] := Flatten@Table[{
    If[i < m, a[i, j] \[UndirectedEdge] a[i + 1, j], {}],
    If[j < n, a[i, j] \[UndirectedEdge] a[i, j + 1], {}],
    If[i < m && j < n, a[i, j] \[UndirectedEdge] a[i + 1, j + 1], {}]
    }, {i, m}, {j, n}]

g[m_, n_] := 
 Graph[mat[m, n], 
  VertexCoordinates -> 
   Thread[Sort[VertexList[Graph[mat[m, n]]]] -> 
     Flatten[Table[{i, j}, {i, m}, {j, n}], 1]], VertexSize -> 0.4, 
  VertexStyle -> White]

g[7, 5]

enter image description here

=================== UPDATE ===================

I just realized that we have some beautiful built in data for this type of things.

SetProperty[GraphData[{"KingsTour", {10, 10}}], {VertexSize -> 0.4, 
VertexStyle -> White, EdgeStyle -> Black}]

enter image description here

SetProperty[GraphData[{"KnightsTour", {10, 10}}], {VertexSize -> 0.4, 
VertexStyle -> White, EdgeStyle -> Black}]

enter image description here

share|improve this answer

Your Answer


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.