How to ensure that Polygon[list] plots a simple polygon?

Question

Consider the following code which plots a triangle.

 p = {{0, 0}, {.2, 0}, {0, .2}};
 {Cyan, Polygon[Dynamic[p]]} // Graphics

Mathematica graphics

Then adding (for example) {.1, -.1} yields a non-simple polygon with intersecting lines.

AppendTo[p, {.1, -.1}]

Mathematica graphics

Question: Given a list of 2D points that are plotted as a polygon by Graphics. Is there a way to re-order the points such that Graphics plots a simple polygon after a point which has been added that resulted in plotting a non-simple polygon?

to understand better what you want, suppose I had p = {{-1, 1}, {1, 1}, {-1, -1}, {1, -1}, {0, 0}}; what polygon should be plotted? — acl, Aug 14 '12 at 08:55
p1 = {-1, 1}; p2 = {1, 1}; p3 = {-1, -1}; p4 = {1, -1}; p5 = {0, 0}; p = {p1, p2, p4, p3, p5} would pass. — nilo de roock, Aug 14 '12 at 09:05
That one is not convex by the way. I have been using the wrong words I realized. I don't want the ones which look like connected via a single point. Does that makes sense? — nilo de roock, Aug 14 '12 at 09:08
Sort of, but I think it is ambiguous. Would the convex hull work? It might not include all the points — acl, Aug 14 '12 at 09:24
Thanks, @acl. Yes, it is ambiguous, I know. Think of a polygon and clicking 'somewhere' adds a point to the polygon with the ability to move it to the spot where you want it. Now, sometimes Polygon plots unexpected polygons from a list of points. That's what I am trying to ' fix '. — nilo de roock, Aug 14 '12 at 09:51
@ndroock1: I'm not sure what you want. Do you want to minimize self-intersections? Would FindShortestTour work? — Niki Estner, Aug 14 '12 at 09:53
so, is this a correct way to express what you want: given a list of points, arrange them so that Polygon does not produce a polygon which can be cut in two by removing a single point — acl, Aug 14 '12 at 12:20
@ndroock1 Polygon doesn't plot unexpected polygons, it plots exactly what you tell it to plot. The order of the points matters however as you have learned. There isn't one particular "correct" order of traversing a number of points to form a polygon, so while you can find a different order which doesn't contain intersecting lines it may not be the one you where actually expecting. I suggest posting your full problem, since I suspect you could avoid this problem completely by always inserting a new point ordered in between the two nearest already present points, rather then prepending. — jVincent, Aug 14 '12 at 13:23
Also, now that you know that "convex" polygon is wrong terminology, you should update your question so that others aren't misled by your incorrect question. — rm -rf, Aug 14 '12 at 16:46
Some more possible solutions are given in the duplicate question Rebuild a polygon so it doesn't self intersect. — , Apr 17 '15 at 20:25

score 11 · Accepted Answer · answered Aug 14 '12 at 21:12

The function you may be looking for is FindCurvePath. Its task is to find reasonable curves through disorganized point sets. It is not guaranteed to find the solution that you find most pleasing but if often gets close. You may also end up with several disconnected lines instead of a single one.

(* some points randomly drawn on a sine shape *)
pts = {#, Sin[#]} & /@ RandomReal[{0, 2 \[Pi]}, 30];

Graphics@Line@pts

Mathematica graphics

(* now with FindCurvePath *)
Graphics@GraphicsComplex[pts, Line@FindCurvePath@pts]

Mathematica graphics

In the case of your point set it finds the following:

Graphics@GraphicsComplex[p, {EdgeForm[Black], Polygon@FindCurvePath@p}]

Mathematica graphics

i.e., a polygon and a line.

score 6 · Answer 2 · edited Aug 15 '12 at 00:40

6

Do you mean a convex hull? This is always a convex polygon, but in general, not every point in the list will be a vertex of the convex hull.

Needs["ComputationalGeometry`"]
Graphics[Polygon[p[[ConvexHull[p]]]]]

edited Aug 15 '12 at 00:40

Brett Champion

20,779
2
64
121

answered Aug 14 '12 at 08:57

Niki Estner

36,101
3
92
152

Convex is not the right word, I just found out. Sorry. – nilo de roock Aug 14 '12 at 09:08

score 6 · Answer 3 · edited Nov 21 '12 at 12:52

I'm assuming from your explanation that you aren't actually just interested in the convex hull, but simply inserting points into a polygon without creating self-intersecting lines. In this case, you can simply find the closest point and insert either before or after this, depending on which of the neighboring points are closest to the new point.

 insertIntoClosestEdge[line_, p_] := 
 Module[{closest, neighbors, nearclosest},
 closest = Nearest[line -> Automatic, p][[1]];
 neighbors = closest // Mod[# + {1, -1}, Length@line, 1] &;
 nearclosest = Nearest[line[[neighbors]] -> neighbors, {.1, -.1}][[1]];
 Insert[line, p, {Mod[closest - If[nearclosest < closest, 0, -1], Length@line]}]
 ]

It may need extending to work in all cases, but it shows the gist of the suggested solution.

score 4 · Answer 4 · answered Dec 02 '21 at 16:28

The original algorithm is given here. I post the slightly revised version since it perfectly fits the question.

The "deintersection" algorithm

Let us start from some random polygon with $n$ randomly placed vertices. Initially, it has a lot of self-intersections

SeedRandom[0];
n = 10;
p = RandomReal[1.0, {n, 2}];
Graphics[{Lighter@Red, EdgeForm@Thickness[0.01], EdgeForm@Red, 
  Polygon[p]}]

We want to change the order of these points to get rid of the intersections.

Line segments $(p_1,p_2)$ and $(p_3,p_4)$ intersect if and only if the signs of areas of triangles $p_1p_2p_3$ and $p_1p_2p_4$ are different and the signs of areas of triangles $p_3p_4p_1$ and $p_3p_4p_1$ are also different.

enter image description here

Corresponding function

SignedArea[p1_, p2_, p3_] := 
  0.5 (#1[[2]] #2[[1]] - #1[[1]] #2[[2]]) &[p2 - p1, p3 - p1];
IntersectionQ[p1_, p2_, p3_, p4_] := 
  SignedArea[p1, p2, p3] SignedArea[p1, p2, p4] < 0 && 
   SignedArea[p3, p4, p1] SignedArea[p3, p4, p2] < 0;

The main step:

enter image description here

Patterns in Mathematica are very convenient for searching and removing intersections.

Deintersect[p_] := 
  Append[p, p[[1]]] //. 
    {s1___, p1_, p2_, s2___, p3_, p4_, s3___} /; IntersectionQ[p1, p2, p3, p4] :> 
       ({s1, p1, p3, Sequence @@ Reverse@{s2}, p2, p4, s3}) // Most;

To add the segment between the last and the first point I use Append and Most.

As a result we obtain the polygon without intersections

p2 = Deintersect[p];
Graphics[{Lighter@Red, EdgeForm@Thickness[0.01], EdgeForm@Red, 
  Polygon[p2]}]

score 3 · Answer 5 · answered Dec 02 '21 at 17:14

3

As of V12 we can use SimplePolygonQ:

SeedRandom[0];
n = 10;
p = RandomReal[1.0, {n, 2}];
Graphics[{Lighter@Red, EdgeForm@Thickness[0.01], EdgeForm@Red, Polygon[p]}]

SimplePolygonQ[Polygon[p]]

False

answered Dec 02 '21 at 17:14

Greg Hurst

35,921
1
90
136

Unfortunately SimplePolygonQ is flawed as of version 13.0.1, see here. – Alexey Popkov Apr 07 '22 at 06:38

score 0 · Answer 6 · answered Sep 11 '23 at 09:14

Based on 195229, the points can be sorted to create a convex polygon. As a demonstration and comparison with ConvexHullMesh:

SeedRandom[0];
n = 10;
pts = RandomReal[1.0, {n, 2}];
m = Mean@pts;
poly = Polygon[SortBy[pts, ArcTan @@ (# - m) &]];
chm = ConvexHullMesh[pts];
GraphicsRow[{
  Graphics[{
    {poly}
    , {Red, AbsolutePointSize[6], Point@m}
    , {Blue, AbsolutePointSize[8], Point@pts}
    , {Yellow, Dotted, Thin, Line[{m, #}] & /@ pts}
    , {Red, Dashed, MeshPrimitives[chm, 1]}
    , {Text[
      Rotate[#, 12 Degree] &@Style["Convex hull boundary", 14], {0.5, 
       0.9}]}
    , {Text[
      Rotate[#, 46 Degree] &@Style["convex\npolygon", 14], {0.84, 
       0.77}]}
}

, Axes -> False
   ]
  , Graphics[{
    {FaceForm[Red], EdgeForm[White], Polygon@pts}
    , {Red, Dashed, MeshPrimitives[chm, 1]}
    }
   ]
  }]

How to ensure that Polygon[list] plots a simple polygon?

6 Answers6

The "deintersection" algorithm

Linked

Related