Creating a Hexagonal Lattice with VoronoiMesh

Question

I want to create a hexagonal lattice using VoronoiMesh. One can achieve that with the following code, where L=5,

pts = Flatten[
   Table[{3/2 i, Sqrt[3] j + Mod[i, 2] Sqrt[3]/2}, {i, L}, {j, L}], 1];
mesh = VoronoiMesh[pts]

Changing the code slightly, I can delete the overly sized cells in the following manner

pts = Flatten[
   Table[{3/2 i, Sqrt[3] j + Mod[i, 2] Sqrt[3]/2}, {i, L + 2}, {j, 
     L + 2}], 1];
mesh = VoronoiMesh[pts];
MeshRegion[MeshCoordinates[mesh], 
 With[{a = PropertyValue[{mesh, 2}, MeshCellMeasure]}, 
  With[{m = 3}, Pick[MeshCells[mesh, 2], UnitStep[a - m], 0]]]]

to get

Now, I want to add a bit of "realism" to the mesh, by including a noise term in each coordinate of the cell centroids.

rt = 0.5;
pts = Flatten[
   Table[{3/2 i + RandomReal[rt], 
     Sqrt[3] j + Mod[i, 2] Sqrt[3]/2 + RandomReal[rt]}, {i, 
     L + 2}, {j, L + 2}], 1];
mesh = VoronoiMesh[pts];
MeshRegion[MeshCoordinates[mesh], 
 With[{a = PropertyValue[{mesh, 2}, MeshCellMeasure]}, 
  With[{m = 3}, Pick[MeshCells[mesh, 2], UnitStep[a - m], 0]]]]

As one can see, the MeshCellMeasure threshold fails in this case, and I get either holes in the mesh or those "pointy" cells that I have previously excluded. How do I solve this?

I thought about tracking the specific boundary cells and delete them from the Voronoi mesh. Is this viable? How could I do that?

Answer 1

Here is what I was suggesting in comments:

SeedRandom[]

relaxed = Nest[
   PropertyValue[{VoronoiMesh[#, {{-1, 1}, {-1, 1}}], {2, All}}, MeshCellCentroid] &,
   RandomReal[{-1, 1}, {45, 2}],
   500
];
mesh = VoronoiMesh[relaxed, {{-1, 1}, {-1, 1}}, MeshCellStyle -> {1 -> White}];

Then extract the cell primitives corresponding to the interior cells and generate a new Mesh object:

interiorMesh = MeshRegion[
   MeshCoordinates[mesh],
   MeshCells[mesh, {2, "Interior"}],
   MeshCellStyle -> {1 -> White}
 ]

---

Depending on whether the application focuses on visualization or further computation, one could prefer having the output as simple Graphics objects instead, which are far easier to style than mesh components, at least for me:

Graphics[{
  Darker@Green, EdgeForm[{Thick, White}], 
  MeshPrimitives[mesh, {2, "Interior"}]
}]

Answer 2

If you are not completely attached to Voronoi, you might consider tiling with hexagons and then perturbing their coordinates. GraphicsComplex makes it work.

Define a hexagon.

HexTile[s_] := Polygon[s*{{Sqrt[3], 1}/2, {0, 1}, {-Sqrt[3], 1}/2,
                          {-Sqrt[3], -1}/2, {0, -1}, {Sqrt[3], -1}/2}]

Allow for translation.

TranslateObject[p_, {x_, y_}] := Map[{x, y} + # &, p, {2}]

Make a grid of hexagons.

HexGrid[s_, h_, v_] :=
   Flatten[Table[
      TranslateObject[HexTile[s], s {i*Sqrt[3] + Mod[j, 2]*Sqrt[3]/2, 3 j/2}],
      {i, 0, h}, {j, 0, v}], 1]

Make a perturbed grid of hexagons.

HexGridPerturbed[s_, h_, v_, r_] := 
   Block[{poly = Map[Round[#, 10.^-10] &, HexGrid[N[s], h, v], {2}], p, m, rules},
      p = DeleteDuplicates[Flatten[poly[[All, 1]], 1]];
      m = Length[p];
      rules = Dispatch[Thread[p -> Range[m]]];
      GraphicsComplex[
         p + RandomReal[{-r, r}, {m, 2}],
         poly /. rules]
   ]

Manipulate

Manipulate[
   Graphics[{
      EdgeForm[{Thick, White}],
      HexGridPerturbed[s, h, v, r]}],
   {{s, 1, "Hexagon Size"}, 0.1, 3., Appearance -> "Labeled"},
   {{h, 5, "Horizontal Count"}, 1, 10, 1, Appearance -> "Labeled"},
   {{v, 3, "Vertical Count"}, 1, 10, 1, Appearance -> "Labeled"},
   {{r, 0., "Random Noise"}, 0., 1., Appearance -> "Labeled"}
]

Comment:

With this code, I was able to make a 3D impression saving the result of the code in a file with the extension STL.

Answer 3

mesh = VoronoiMesh[pts]; 
hexagons = Select[Length[#[[1]]] == 6 &] @ MeshPrimitives[mesh, {2, "Interior"}]; 

DiscretizeGraphics @ Graphics @ hexagons

SeedRandom[1]
rt = 0.5;
pts = Flatten[Table[{3/2 i + RandomReal[rt], 
  Sqrt[3] j + Mod[i, 2] Sqrt[3]/2 + RandomReal[rt]}, {i, L + 2}, {j, L + 2}], 1];
mesh = VoronoiMesh[pts];

hexagons = Select[Length[#[[1]]] == 6 &] @ MeshPrimitives[mesh, {2, "Interior"}]; 
DiscretizeGraphics @ Graphics @ hexagons