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

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

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

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?

Answer 1

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

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

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

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

i.e., a polygon and a line.

Answer 2

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

Answer 3

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.

Answer 4

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.

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:

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

Answer 5

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

Answer 6

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