8

Let a partition of a planar polygon into colored polygons be given, i.e. something similar to enter image description here

We know the coordinates of the vertices and the color of each part, e. g. in such a way

Graphics[{EdgeForm[Black], Red,  Polygon[{{0, 0}, {0, 2}, {2, 2}, {2, 1}, 
    {3, 1}, {3, 2}, {4, 2}, {4, 0}}], 
 EdgeForm[Black], Green,    Polygon[{{0, 2}, {0, 6}, {3, 6}, {3, 4}, {2, 4}, 
    {2, 5}, {1, 5}, {1, 3}, {2, 3}, {2, 2}}], 
 EdgeForm[Black], Blue, Polygon[{{1, 3}, {1, 5}, {2, 5}, {2, 3}}], 
 EdgeForm[Black], Red, Polygon[{{3, 2}, {3, 6}, {5, 6}, {5, 2}}],
 EdgeForm[Black], Green, Polygon[{{2, 1}, {2, 4}, {3, 4}, {3, 1}}], 
 EdgeForm[Black], Green, Polygon[{{4, 0}, {4, 2}, {5, 2}, {5, 0}}]}]

enter image description here

How to write a Mathematica program which unites the polygons having a joint edge and the same color into a single polygon with the simply-connected interior, not a polygonial figure (see Encyclopedia of Mathematics and Wiki)? For the above partition we have to obtain two green polygons, one red polygon, one yellow polygon, one blue polygon, and one violet polygon.

Addition. The following result in green is not a polygon so is not allowed:

enter image description here

kglr
  • 394,356
  • 18
  • 477
  • 896
user64494
  • 26,149
  • 4
  • 27
  • 56
  • can you post the code that produced the picture? – kglr Dec 04 '20 at 09:37
  • @kglr: Here is an example Graphics[{EdgeForm[Black], Red, Polygon[{{0, 0}, {0, 2}, {2, 2}, {2, 1}, {3, 1}, {3, 2}, {4, 2}, {4, 0}}], EdgeForm[Black], Green, Polygon[{{0, 2}, {0, 6}, {3, 6}, {3, 4}, {2, 4}, {2, 5}, {1, 5}, {1, 3}, {2, 3}, {2, 2}}], EdgeForm[Black], Blue, Polygon[{{1, 3}, {1, 5}, {2, 5}, {2, 3}}], EdgeForm[Black], Red, Polygon[{{3, 2}, {3, 6}, {5, 6}, {5, 2}}], EdgeForm[Black], Green, Polygon[{{2, 1}, {2, 4}, {3, 4}, {3, 1}}], EdgeForm[Black], Green, Polygon[{{4, 0}, {4, 2}, {5, 2}, {5, 0}}]}]. – user64494 Dec 04 '20 at 11:22
  • user64494, i suggest you add the example in your comment in your post. Maybe also clarify how you want to treat the cases where a subset of polygons with a common color form a polygon with a hole. – kglr Dec 04 '20 at 14:36
  • 1
    @kglr: I listened to you and added the example and the definition. I will be absent at the page during several hours. – user64494 Dec 04 '20 at 14:48
  • 1
    Perhaps a RelationGraph with the criterion that two polygons are connected if their colours are the same AND their RegionUnion is a SimplePolygonQ, then take connected components of that graph. Unfortunately I cannot explore this idea in Mathematica because RegionUnion is too buggy and sometimes crashes the kernel for certain polygon arrangements. – flinty Dec 04 '20 at 17:01

1 Answers1

5

Input examples

First a slightly modified form of the example input from OP:

gr1 = Graphics[SequenceReplace[#, p : {_RGBColor, _Polygon} :> p] & @
   {EdgeForm[ Black], Red, Polygon[{{0, 0}, {0, 2}, {2, 2}, {2, 1}, {3, 1}, {3, 2}, 
       {4, 2}, {4, 0}}], 
  EdgeForm[Black], Green, Polygon[{{0, 2}, {0, 6}, {3, 6}, {3, 4}, {2, 4}, {2, 5}, 
       {1, 5}, {1, 3}, {2, 3}, {2, 2}}], 
  EdgeForm[Black], Blue, Polygon[{{1, 3}, {1, 5}, {2, 5}, {2, 3}}],
  EdgeForm[Black], Red,  Polygon[{{3, 2}, {3, 6}, {5, 6}, {5, 2}}], 
  EdgeForm[Black], Green, Polygon[{{2, 1}, {2, 4}, {3, 4}, {3, 1}}]}];

Additional examples where the combined regions have no holes (gr2) , a single hole (gr3) and multiple holes (gr4):

SeedRandom[1]
polygons = MeshPrimitives[VoronoiMesh[RandomReal[{-1, 1}, {20, 2}]], {2, "Interior"}];

{gr2, gr3} = Graphics[{EdgeForm[{Thick, Gray}], MapIndexed[Function[{x, y}, Table[{ColorData[{"Rainbow", {1, Length@#}}]@y[[1]], polygons[[i]]}, {i, x}]], #]}] & /@ {{{2, 5, 10}, {3, 6}, {4, 8}, {1, 7}, {9}}, {{5, 10, 9, 7, 3}, {6}, {4, 8}, {2, 1}}};

SeedRandom[77] gr4 = Graphics[{EdgeForm[Gray], {RandomChoice[{2, 1} -> {Red, Blue}], #}} & /@ MeshPrimitives[MengerMesh[2], 2]];

Grid[{Style[#, 24] & /@ {"gr1", "gr2", "gr3", "gr4"}, Show[#, ImageSize -> 250] & /@ {gr1, gr2, gr3, gr4}}, Dividers -> All]

enter image description here

Combined polygons allowed to have holes:

We group polygons by color and take the RegionUnion of each group of polygons and RegionPlot it with the color associated with the group:

ClearAll[bdR, combinePolygonsByColorHolesAllowed]

bdR = BoundaryDiscretizeRegion[RegionUnion @@ #, MeshCellStyle -> {2 -> #2, 1 -> Directive[Thick, Gray]}] &;

combinePolygonsByColorHolesAllowed = Show[Values[ GroupBy[Cases[#[[1]], {_RGBColor, _Polygon}, All], First, Module[{color = #[[1, 1]], polys = #[[All, 2]]}, bdR[polys, color]] &]], PlotRange -> All, Frame -> False, AspectRatio -> Automatic] &;

Grid[{Style[#, 24] & /@ {"gr1", "gr2", "gr3", "gr4"}, Show[#, ImageSize -> 250] & /@ #, Show[#, ImageSize -> 250] & /@ combinePolygonsByColorHolesAllowed /@ #}, Dividers -> All] &@{gr1, gr2, gr3, gr4}

enter image description here

Combined polygons cannot have holes:

If holes are not allowed, we need to identify the holes in the region formed by the group of polygons. For this purpose, we BoundaryDiscretizeRegion the RegionUnion of the polygon group and use the (undocumented) function Region`Mesh`FindMeshRegionHoles which returns None if the mesh region does not have any holes and, if it does, a point for each of the holes. For each hole h, we find the polygons that lie on the line from a point in h to nearest point on the outer boundary (obtained using ConnectedMeshComponents) and BoundaryDiscretizeRegion the RegionUnion of resulting partition of the polygon group.

ClearAll[findHoles, combinePolygonsByColorNoHoles]

findHoles = RegionMeshFindMeshRegionHoles[ BoundaryDiscretizeRegion[RegionUnion @@ #]] &;

combinePolygonsByColorNoHoles = Show[Values[ GroupBy[Cases[#[[1]], {_RGBColor, _Polygon}, All], First, Module[{color = #[[1, 1]], polys = #[[All, 2]], bdr = BoundaryDiscretizeRegion[RegionUnion @@ #[[All, 2]]], outerboundary, lines, partition}, If[findHoles[polys] === None, bdR[polys, color], outerboundary = First@ConnectedMeshComponents[ DiscretizeGraphics[MeshPrimitives[bdr, {1, "Boundary"}]]]; lines = Rationalize[Line[{#, RegionNearest[outerboundary, #]}] & /@ findHoles[polys], 10^-4]; partition = {Complement[polys, ##], ##} & @@ Table[Select[Rationalize[polys, 10^-4], Head[RegionIntersection[#, ln]] === Line &], {ln , lines}]; Show[bdR[First @ partition, color], bdR[#, Lighter @ Lighter @ color] & /@ Rest[partition], PlotRange -> All]]] &]], PlotRange -> All, Frame -> False, AspectRatio -> Automatic] &;

Showing input graphics (first row), outputs from combinePolygonsByColorHolesAllowed (second row) and outputs from combinePolygonsByColorNoHoles (third row):

Grid[{Style[#, 24] & /@ {"gr1", "gr2", "gr3", "gr4"}, 
    Show[#, ImageSize -> 250] & /@ #, 
    Show[#, ImageSize -> 250] & /@ combinePolygonsByColorHolesAllowed /@ #, 
    Show[#, ImageSize -> 250] & /@ combinePolygonsByColorNoHoles /@ #}, 
 Dividers -> All] & @ {gr1, gr2, gr3, gr4}

enter image description here

Focusing on the red polygons in gr4:

gr4a = Graphics[{EdgeForm[Gray], Cases[gr4[[1]], {Red, _}, All]}, 
   ImageSize -> Medium];
gr4b = Replace[combinePolygonsByColorHolesAllowed[gr4], 
  {Directive[{___, Blue, ___}], _} -> {}, All];
gr4c = Replace[combinePolygonsByColorNoHoles[gr4],
  {Directive[{___, Blue | Lighter[Lighter@Blue], ___}], _} -> {}, All];

Row[Show[#, ImageSize -> 250] & /@ {gr4, gr4a, gr4b, gr4c}]

enter image description here

Note: We can also use RegionPlot instead of BoundaryDiscretizeRegion above; that is, we can replace the function rdF above with rP:

rP = RegionPlot[RegionUnion @@ #, PlotPoints -> 90, 
    MaxRecursion -> 5, PlotStyle -> #2, BoundaryStyle -> Thick] &;

The 2D primitives produced by the functions above are FilledCurves if we use rdF; they are Polygons if we use rP.

kglr
  • 394,356
  • 18
  • 477
  • 896
  • +1. Thank you for your interest to the question and your work. The results of gr1 and gr4 are not final and can be extended. – user64494 Dec 05 '20 at 06:07
  • 1
    @user64494, thanks for the upvote. I was about to delete this answer because removing multiple holes requires a more complicated approach. Good question btw. I will post an update if I find a clean way to handle multiple holes. – kglr Dec 05 '20 at 06:24
  • The result of gr1 in "Combined polygons cannot have holes" is not final yet: two green polygons can be combined. – user64494 Dec 05 '20 at 11:17
  • @user64494, if you combine the two green pieces the resulting shape will have a hole, no? – kglr Dec 05 '20 at 11:48
  • No, think of the horizontal jont edge. Removing it, one obtains a polygon without holes and with the simply-connected interior. Of course, that polygon is not simple. – user64494 Dec 05 '20 at 11:56
  • @user64494, oh i (mis)interpreted "unite polygons" and "hole". – kglr Dec 05 '20 at 12:08
  • @kglr, wow, cool stuff. How would you go about merging 3d polygons, like, say, two 3d triagles with common edge? tr1 = MeshRegion[{{0, 0, 0}, {1, 1, 0}, {1, 3, 0}},Triangle[{1, 2, 3}]]; tr2 = MeshRegion[{{2, 0, 0}, {1, 1, 0}, {1, 3, 0}},Triangle[{1, 2, 3}]]; – Anton Jul 04 '22 at 13:13