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.


1 Answer 1


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


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.