Mathematica Stack Exchange is a question and answer site for users of Mathematica. Join them; it only takes a minute:

Sign up
Here's how it works:
  1. Anybody can ask a question
  2. Anybody can answer
  3. The best answers are voted up and rise to the top

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

enter image description here

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}])
share|improve this question
up vote 7 down vote accepted

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

enter image description here

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

enter image description here

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

enter image description here

share|improve this answer
    
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 at 16:11
    
I was almost there when you messaged :-D – JasonB Mar 16 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). – physicien Mar 16 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 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. – JasonB Mar 16 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

just feels like its missing

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

share|improve this answer
    
Another nice solution ... thanks a lot J.M. – mrz Mar 16 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]]]
  ]

Mathematica graphics


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]

Mathematica graphics

Or

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

Mathematica graphics

share|improve this answer
    
This ist absolutely more than great ... I can only vote for one :-( – mrz Mar 16 at 17:58

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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