# Removing cells from Voronoi mesh if they exceed a certain area or circumference

I start with the example in Finding the perimeter, area and number of sides of a Voronoi cell with RunnyKine's answer:

pts = RandomReal[4, {20, 2}];
vor = VoronoiMesh[pts, {{0, 4}, {0, 4}}]; (* bounded Voronoi diagram *)
HighlightMesh[vor, {Style[2, White], Style[1, Thick, Red], Labeled[2, "Index"]}]


How can I remove cells which exceed a certain threshold of area or circumference?

I do not want to display such cells and also not consider them when calculation the mean area, mean circumference or when showing corresponding histograms for vortices, area, and circumference.

In the upper plot: is it possible e.g. to show how to remove from vor the smallest cell concerning area (probably number 5) and the largest concerning area (probably number 17).

RunnyKine showed in his answer how to determine the cell areas:

cells = MeshCells[vor, 2]; (* The polygons that make up the Voronoi diagram *)
cellcoord = Map[MeshCoordinates[vor][[#]] &, cells, {2}];
areas = Area /@ cellcoord;


And also he measured the perimeters:

RegionMeasure /@ (MeshPrimitives[vor, 2] /. Polygon[{x_, y__}] :> Line[{x, y, x}])


So this would create a mesh region where we've removed all the cells whose area is larger than the average area,

pts = RandomReal[4, {20, 2}];
vor = VoronoiMesh[
pts, {{0, 4}, {0,
4}}];
HighlightMesh[vor, {Style[2,
White], Style[1, Thick, Red], Labeled[2, "Index"]}]
vor2 = Show[
Graphics /@
Select[MeshPrimitives[vor, 2],
Area[#] < Mean[PropertyValue[{vor, 2}, MeshCellMeasure]] &]] //
DiscretizeGraphics;
HighlightMesh[vor2, {Style[2, White], Style[1, Thick, Red],
Labeled[2, "Index"]}]


If it is necessary that the new cells have the same index number, that would be a bit trickier I think.

For the perimeter, it's convenient to define an auxilliary function,

polygonPerimeter[Polygon[{x_, y__}]] := RegionMeasure[Line[{x, y, x}]];

vor2 = Show[
Graphics /@
Select[MeshPrimitives[vor, 2],
polygonPerimeter[#] <
Mean[polygonPerimeter /@ MeshPrimitives[vor, 2]] &]] //
DiscretizeGraphics;
HighlightMesh[vor2, {Style[2, White], Style[1, Thick, Red],
Labeled[2, "Index"]}]


You could show the different cells together, highlighting based on whether they are smaller or larger than the mean,

pts = RandomReal[4, {20, 2}];
vor = VoronoiMesh[pts, {{0, 4}, {0, 4}}];
vor12 = DiscretizeGraphics[Show[Graphics /@ #]] & /@
GatherBy[MeshPrimitives[vor, 2],
Area[#] > Mean[PropertyValue[{vor, 2}, MeshCellMeasure]] &];
Show[
HighlightMesh[vor12[[1]], {Style[2, Blue], Style[1, Thick, Black]}],
HighlightMesh[vor12[[2]], {Style[2, Red], Style[1, Thick, Black]}]
]


And finally, if you wanted to keep only the four-sided regions,

vor2 = Show[
Graphics /@
Select[MeshPrimitives[vor, 2],
Length[First[List @@ #]] == 4 &]] // DiscretizeGraphics;
HighlightMesh[vor2, {Style[2, White], Style[1, Thick, Red],
Labeled[2, "Index"]}]


• No, the index ist not important ... that is great what you did. For the circumference: could you propose how to select in this case the cells (e.g. if they are below the mean circumference). Thank you.
– mrz
Mar 16, 2016 at 16:11
• I was almost there when you messaged :-D Mar 16, 2016 at 16:13
• If you look at the input form of vor, you can notice that this is a MeshRegion (so a list of coordinates and a list of Polygon). So you can assign a value to a case and will do follow the corresponding elements (If you want to keep the same index number). Mar 16, 2016 at 16:17
• @Jason B: Great ... great ... great ... it works perfect. Very last question and then I stop: how is the corresponding code when I want to select cells with a certain number of vortices and delete them?
– mrz
Mar 16, 2016 at 16:27
• I gotta run, but basically you need to be able to formulate a True/False test to run on the individual Polygon objects. Try the function on, say, MeshPrimitives[vor, 2][[1]] to see if it works, then use the Select trick above. Mar 16, 2016 at 16:33

Maybe do something like this:

BlockRandom[SeedRandom[42]; pts = RandomReal[4, {20, 2}]] (* for reproducibility *)
vor = VoronoiMesh[pts, {{0, 4}, {0, 4}}];

plist = MapIndexed[{Text[#2[[1]], RegionCentroid[#1]], FaceForm[],
EdgeForm[Directive[Thick, Red]], #} &, MeshPrimitives[vor, 2]];

{Graphics[plist, PlotRange -> {{0, 4}, {0, 4}}],
Graphics[Select[plist,
(ArcLength[RegionBoundary[Last[#]]] < 4 && Area[Last[#]] < 0.8) &],
PlotRange -> {{0, 4}, {0, 4}}]} // GraphicsRow


where ArcLength[RegionBoundary[(* polygon *)]] directly computes the perimeter.

• Another nice solution ... thanks a lot J.M.
– mrz
Mar 16, 2016 at 20:43

I'll do something like this to build a new MeshRegion with only the smallest cells:

SeedRandom[0]
pts = RandomReal[4, {20, 2}];
vor = VoronoiMesh[pts, {{0, 4}, {0, 4}}]

vor2 = MeshRegion[
MeshCoordinates[vor],
With[{a = PropertyValue[{vor, 2}, MeshCellMeasure]},
With[{m = Mean[a]}, Pick[MeshCells[vor, 2], UnitStep[a - m], 0]]]
]


You can also define a function to filter a mesh like this

Clear[filterVoronoiMesh]
filterVoronoiMesh[mesh_MeshRegion, at : _ : Automatic,
pt : _ : Automatic, np : _ : _] :=
With[{
a = PropertyValue[{mesh, 2}, MeshCellMeasure],
p = RegionMeasure@*RegionBoundary /@ MeshPrimitives[mesh, 2],
n = Length @@@ MeshCells[mesh, 2]
},
With[{
aq = at /. Automatic -> LessEqualThan@Mean[a],
pq = pt /. Automatic -> LessEqualThan@Mean[p],
nq = MatchQ[np]
},
MeshRegion[
MeshCoordinates[mesh],
Pick[MeshCells[mesh, 2],
Boole[aq /@ a] + Boole[pq /@ p] + Boole[nq /@ n], 3]]
]]


The arguments are:

• the mesh to be filtered
• a predicate to select cells by the area (for example LessEqualThan[10]; if Automatic or missing use LessEqualThan the mean area value)
• a predicate to select cells by perimeter (for example GreaterThan[5]; if Automatic or missing use LessEqualThan the mean perimeter value)
• a pattern for the number of vertices (if missing any number pass the filter)

For example:

SeedRandom[0]
pts = RandomReal[4, {40, 2}];
vor = VoronoiMesh[pts, {{0, 4}, {0, 4}}]
filterVoronoiMesh[vor]


Or

filterVoronoiMesh[vor, Automatic, Automatic, 4 | 6]


• This ist absolutely more than great ... I can only vote for one :-(
– mrz
Mar 16, 2016 at 17:58