15
$\begingroup$

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?

$\endgroup$
11
  • $\begingroup$ 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? $\endgroup$
    – acl
    Aug 14, 2012 at 8:55
  • $\begingroup$ p1 = {-1, 1}; p2 = {1, 1}; p3 = {-1, -1}; p4 = {1, -1}; p5 = {0, 0}; p = {p1, p2, p4, p3, p5} would pass. $\endgroup$ Aug 14, 2012 at 9:05
  • $\begingroup$ 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? $\endgroup$ Aug 14, 2012 at 9:08
  • 2
    $\begingroup$ @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. $\endgroup$
    – jVincent
    Aug 14, 2012 at 13:23
  • 1
    $\begingroup$ 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. $\endgroup$
    – rm -rf
    Aug 14, 2012 at 16:46

6 Answers 6

11
$\begingroup$

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.

$\endgroup$
6
$\begingroup$

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]]]]]
$\endgroup$
1
  • $\begingroup$ Convex is not the right word, I just found out. Sorry. $\endgroup$ Aug 14, 2012 at 9:08
6
$\begingroup$

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.

$\endgroup$
4
$\begingroup$

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]}]
$\endgroup$
3
$\begingroup$

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
$\endgroup$
1
  • $\begingroup$ Unfortunately SimplePolygonQ is flawed as of version 13.0.1, see here. $\endgroup$ Apr 7, 2022 at 6:38
0
$\begingroup$

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

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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