8
$\begingroup$

There is a function GridGraph that generates a finite square lattice graph. Is there a way to make a generalized solution (e.g. with hexagons, or triangles instead of squares)?

To put it in more strict form, I need a subgraph of a finite lattice where each vertex have exactly n neighbors, except a set of "boudary vertices" B. Vertices from B can will have less than n adjacent edges. One can think of boundary vertices as a periphery of the graph.

As you can see from my explanation, I have some difficulties with strict mathematical description of my problem, and I think this is why I am struggling so much trying to solve it. Here is what I've tried so far:

  • NestList, where on each step I am taking one of the boundary vertices bv and adding a few vertices, so that bv is not in the periphery anymore, and new vertices are taking its place. I've realized that it this approach is dependent in a way I am selecting vertices from the periphery and extremely sensitive to a starting graph.

  • Generating coordinates for a vertices in $R^2$, and then building a Unit Disk Graph. This was an interesting experiment by itself, however, I wasn't able to provide an algo for putting points in the right places.

  • Randomly connecting vertices in a graph with no edges while their power is less than n. Obviously, I've got crazy graphs that were not even close to a regular lattice.

There is a solution for hex grid, that could be used together with a unit disk graph method described above.

$\endgroup$
  • $\begingroup$ Do you mean to do this for general $n$, not just for those $n$ for which it is possible to embed a regular lattice in a plane? $\endgroup$ – Szabolcs Jul 9 '15 at 7:25
  • 1
    $\begingroup$ For $n=3$ you can also use KaryTree[31, 2] except with the root node branching out into 3 instead of 2. Each node has 3 neighbours, except the leaves (the boundary). Is this an acceptable solution? If not, why not? $\endgroup$ – Szabolcs Jul 9 '15 at 8:11
  • 1
    $\begingroup$ Maybe it would be better to ask for help at Math.SE with formulating the question precisely. Interesting question BTW! I do wonder what graphs are possible that satisfy your requirement and are also symmetric in the sense that the neighbourhood of any vertex looks the same. (That's also true for the tree: the neighbourhood of any of them looks the same.) Unfortunately I have no time to think about it right now, maybe tomorrow. $\endgroup$ – Szabolcs Jul 9 '15 at 10:45
  • 1
    $\begingroup$ By the way, calling boundary vertices a periphery of the graph is a bit misleading. Mathematica has a GraphPeriphery function, which by definition doesn't actually return the intuitive boundary under consideration, for example in the case of a GridGraph in general. But what the intuitive "boundary" of such regular planar graphs should be actually called? $\endgroup$ – kirma Jul 10 '15 at 9:36
  • 1
    $\begingroup$ @kirma, yes, graph periphery is just a vertices with highest eccentricity. It could be the same as an 'intuitive periphery' IP (like in wheel graph). I would define an IP as a cycle where all vertices have power less than some n. In the context of the problem, there should be no more than one IP. $\endgroup$ – Alexander Jul 10 '15 at 15:39
6
$\begingroup$

Admittedly the implementation below is not as simple or efficient as I wished. Some of the visualizations are a bit messy, but I think it works correctly.

Basically it tracks the planar graph boundary and tries to add new edges in regularity-admitting locations. Regular planar tilings are trivially present, but this code also generates Platonic graphs corresponding to regular Platonic polyhedra (these close on themselves, and don't have a "boundary"), and graphs corresponding to tilings in hyperbolic geometry.

Module[{regularGraphBoundary, takeClosestVertexGroup, 
  selectAdmissableArcs, addNewEdges, tryAddPolygon},
 regularGraphBoundary[g_Graph, nvertices_Integer] :=
  Graph[First /@
    Select[Tally[Sort /@ Flatten@FindCycle[g, {nvertices}, All]], 
     Last@# == 1 &]];

 takeClosestVertexGroup[g_Graph, groups_List] :=
  First@TakeSmallestBy[
    groups, Min[GraphDistance[g, 1, #] & /@ #] &, 1];

 selectAdmissableArcs[g_Graph, candidates_List, nvertices_Integer, 
   targetdegree_Integer] :=
  Select[
   candidates,
   VertexDegree[g, First@#] < targetdegree &&
     And @@ (VertexDegree[g, #] == targetdegree & /@ #[[2 ;; -2]]) && 
     VertexDegree[g, Last@#] < targetdegree &];

 addNewEdges[g_Graph, oldvertices_List, nvertices_Integer] :=
  GraphUnion[g,
   Graph[UndirectedEdge @@@
     Partition[{First@oldvertices,
       Sequence @@ (Unique[] & /@ 
          Range[nvertices - Length@oldvertices]),
       Last@oldvertices},
      2, 1]]];

 tryAddPolygon[g_Graph, vertices_Integer, targetdegree_Integer] :=
  Module[{graphboundary, admissablearcgroups},
   graphboundary = regularGraphBoundary[g, vertices];

   If[EmptyGraphQ@graphboundary,
    g,

    admissablearcgroups =
     Flatten[
      Table[
       selectAdmissableArcs[g, 
        Partition[First /@ First@FindCycle@graphboundary, n, 1, 1],
        vertices, targetdegree],
       {n, vertices, 2, -1}],
      1];

    addNewEdges[
     g, takeClosestVertexGroup[g, admissablearcgroups], vertices]]];

 Grid[Table[
   HighlightGraph[#, regularGraphBoundary[#, v]] &@
    Nest[tryAddPolygon[#, v, d] &, CycleGraph[v], 150], {v, 3, 7}, {d, 
    3, 7}], Frame -> All]]

enter image description here

$\endgroup$
  • 2
    $\begingroup$ That's cool. I have a feeling that it could be optimised somewhere. BTW, for those who like me don't have TakeSmallestBy you can copy-paste it here: TakeSmallestBy[l_,f_,n_Integer]:=Take[SortBy[l,f],Min[n,Length[l]]]; TakeSmallestBy[f_,n_Integer]:=TakeSmallestBy[#,f,n]&; $\endgroup$ – Alexander Jul 10 '15 at 15:44
  • $\begingroup$ @Alexander I'm quite convinced the primary source of inefficiency in my code consists of use of FindCycle[..., All] in regularGraphBoundary. This function clearly has nasty run-time complexity; if a more efficient method (probably based on progress of boundary augmentation) would be used, this code would be much more scalable. I usually aim for intelligibility instead of efficiency; In this case, finding those steps actually creating valid graphs wasn't that clear (at least to me). $\endgroup$ – kirma Jul 11 '15 at 4:32
2
$\begingroup$

IGraph/M now has some new lattice graph generation features that might be useful (though not every graph of the type you describe can be generated through these functions).

Here's a demo through a few examples:

IGTriangularLattice[5]

Mathematica graphics

IGTriangularLattice[{4, 5}]

Mathematica graphics

IGBetheLattice[5]

Mathematica graphics

There is IGLatticeMesh which uses (a post-processed version of) Mathematica's built-in periodic tiling data to generate various meshes. These can be converted to graphs using IGMeshGraph, or to face-face adjacency graphs (i.e. the dual) using IGMeshCellAdjacencyGraph[mesh, 2, VertexCoordinates -> Automatic].

IGLatticeMesh["Hexagonal"]

Mathematica graphics

IGLatticeMesh["Hexagonal", {3, 2}]

Mathematica graphics

IGLatticeMesh["Hexagonal", Polygon@CirclePoints[4, 6]]

Mathematica graphics

IGLatticeMesh["Trihexagonal"]

Mathematica graphics

Convert to graphs:

IGMeshGraph[%]

Mathematica graphics

IGMeshCellAdjacencyGraph[%%, 2, VertexCoordinates -> Automatic]

Mathematica graphics

In this last graph, not all non-boundary vertices have the same number of neighbours. I included it as an illustration of how to extract the dual lattice, which may be useful for some other tilings.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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