11
$\begingroup$

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]

enter image description here

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

enter image description here

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

enter image description here

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?

$\endgroup$
  • 3
    $\begingroup$ I'd consider the opposite route: start with a mesh on random points extracted from a region with the rough shape you want (see RandomPoint), and carry out enough rounds of Lloyd relaxation on the resulting mesh to get it "regular enough". Should you go this route, you can find excellent code ready to go in Lloyd relaxation on VoronoiMesh. You should then be able to use your own code to remove the "borders". $\endgroup$ – MarcoB Jan 9 at 18:23
  • 1
    $\begingroup$ This might be helpful to extract the interior cells. $\endgroup$ – Henrik Schumacher Jan 9 at 18:49
17
$\begingroup$

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

relaxed quasi-hexagonal lattice

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

new mesh comprising only the interior cells from the previous Mesh


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

Graphics output for the same selection

| improve this answer | |
$\endgroup$
  • $\begingroup$ Just one question. Would it be possible to specify the number of interior cells to display? I'm finding it difficult since it will depend on the number of boundary cells, which can vary in each simulation. Any idea how to solve this? $\endgroup$ – sam wolfe Jan 13 at 14:28
  • $\begingroup$ Also, is it possible to avoid Graphics? That is, can I select the interior cells using the MeshPrimitives and still get a mesh-type object? I ask this because I intend to use SetProperty later, and I can't do that to a Graphics-type object. $\endgroup$ – sam wolfe Jan 13 at 15:09
  • $\begingroup$ @Sam For your first question (how many cells to display), I don't see a way to force that, since the number of interior cells depends on the shape of the mesh; perhaps starting from a non-random mesh could do. Let me think about that. $\endgroup$ – MarcoB Jan 13 at 15:35
  • 1
    $\begingroup$ @Sam for your second question, I added an approach that returns a Mesh. $\endgroup$ – MarcoB Jan 13 at 15:47
  • $\begingroup$ That's awesome. Thank you! $\endgroup$ – sam wolfe Jan 13 at 15:48
12
$\begingroup$

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

perturbed hexagonal grid

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.

enter image description here

| improve this answer | |
$\endgroup$
  • $\begingroup$ Exactly what I needed today. I don't even have to look any further $\endgroup$ – LCarvalho Jun 10 at 18:49
  • 1
    $\begingroup$ You actually 3d printed it ? That's real commitment right there. $\endgroup$ – flinty Jun 10 at 22:21
  • $\begingroup$ Yes. I really printed in 3D. This is my hand holding a piece made from the code above. I exported to the SVG extension, worked on the file in the InkScape software, exported again to the DXF extension and worked on the Blender software to finally generate the STL file ... $\endgroup$ – LCarvalho Jun 11 at 14:42
  • $\begingroup$ This is my channel on YouTube: youtube.com/channel/UCnBvTLPG9M1dbqA-sxN3UmA $\endgroup$ – LCarvalho Jun 11 at 14:44
10
$\begingroup$
mesh = VoronoiMesh[pts]; 
hexagons = Select[Length[#[[1]]] == 6 &] @ MeshPrimitives[mesh, {2, "Interior"}]; 

DiscretizeGraphics @ Graphics @ hexagons

enter image description here

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

enter image description here

| improve this answer | |
$\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.