# Rebuild a polygon so it doesn't self intersect [duplicate]

If you consider the following Polygon:

coor = {{6, 0}, {6, 1}, {4, 0}, {5, 2}};
(* and coor = {{7, 2}, {7, 1}, {5, 2}, {6, 1}} *)
pol = Polygon@coor;
Graphics@pol I would like to know if there is any way to rebuild it automatically in order to remove the self intersection.

Self intersection can be check thanks to J.M.'s comment by:

interPolQ = Not@GraphicsMeshSimplePolygonQ[#]&;
interPolQ@pol


True

Knowing that GraphicsMeshSimplePolygonQ[] is undocumented I'm wondering if there is a hidden built-in function for that purpose as well.

The output should look like the following and have for coordinates desiredcoor:

coor = {{6, 0}, {6, 1}, {4, 0}, {5, 2}};
desiredcoor = {{4, 0}, {6, 0}, {6, 1}, {5, 2}};
Graphics[{EdgeForm[Dashed], FaceForm@Opacity@.2, Polygon@{coor, desiredcoor}}] • I guess you're not after the convex hull, but for clarity you could show an example showing the before and after and also showing that the result isn't the convex hull May 18, 2014 at 23:09
• The result should fill the white spaces as well. I'm going to edit it.
– Öskå
May 18, 2014 at 23:11
• @belisarius I might need ConvexHull indeed.. :) That's uber perfect. I still don't know what a convex hull is but at least I know what it does.
– Öskå
May 18, 2014 at 23:23
• Be careful. The convex hull may "eat up" some of your vertices. For example, if you add one more vertex inside your grayed area, it won't show up in the convex hull. May 18, 2014 at 23:29
• Previously: @ybeltukov's "deintersection" algorithm.
– user484
May 19, 2014 at 7:32

The question is a little underspecified, so I'll discuss two options.

SeedRandom;
coords = RandomReal[1, {6, 2}];
drawPolygon[coords_, color_] := {PointSize[Large], color, Point@coords,
FaceForm[Opacity[0.2]], EdgeForm[Directive[Thick, color]], Polygon@coords}
Graphics[drawPolygon[coords, Red]] As suggested by @belisarius, the convex hull does not self-intersect, but can drop points:

Needs["ComputationalGeometry"];
chCoords = coords[[ConvexHull[coords]]];
Graphics[drawPolygon[chCoords, Darker@Green]] If you want to preserve all the points but remove self-intersections, you can try using the travelling salesman tour:

stCoords = coords[[Last@FindShortestTour[coords]]];
Graphics[drawPolygon[stCoords, Blue]] This approach solves a strictly harder problem than just finding an intersection-free polygon, though, so maybe a simpler solution is possible.

Caveat: For large datasets, Mathematica finds a suboptimal tour, and it's possible that the tour self-intersects.

coords = RandomReal[{0, 1}, {200, 2}];
stCoords = coords[[Last@FindShortestTour[coords]]];
Graphics[drawPolygon[stCoords, Blue]] To remove those intersections, we can use @ybeltukov's "deintersection" algorithm on the computed tour.

SignedArea[p1_, p2_, p3_] :=
0.5 (#1[] #2[] - #1[] #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;
Deintersect[p_] :=
Append[p,
p[]] //. {s1___, p1_, p2_, s2___, p3_, p4_, s3___} /;
IntersectionQ[p1, p2, p3, p4] :> ({s1, p1, p3,
Sequence @@ Reverse@{s2}, p2, p4, s3}) // Most;
dstCoords = Deintersect[stCoords];
Graphics[drawPolygon[dstCoords, Purple]] One might ask, why not simply apply Deintersect on the original coordinates? Well, one can, but it takes an extremely long time.

dCoords = Deintersect[coords];
Graphics[drawPolygon[dCoords, Orange]] • It would be interesting to see where ShortestTour draws the line in terms of an optimal solution (since it claims to find these for "small" numbers of vertices). May 19, 2014 at 9:38
• It's weird that FindShortestTour doesn't remove intersections as a post-processing step. IIRC, finding&removing intersections is a O(n*log(n)) operation if done right, and it's guaranteed to make the tour shorter. May 19, 2014 at 9:48
• These are both good points that I don't know the answer to! =)
– user484
May 19, 2014 at 9:51
• The problem is that nikie's answer doesn't seem to work with my test case. See here.
– Öskå
May 19, 2014 at 18:03
• @Öskå: You're right, I forgot that SortBy treats exact values and machine-precision values differently. Try using N@ArcTan[... or N[pts] instead, then SortBy should sort them properly. May 19, 2014 at 18:19

One simple way to get an intersection-free tour would be to

• choose a center point (e.g. arithmetic mean of the vertices)
• sort the other points clockwise around that center

then the polygon should be the graph of a positive function in a polar plot, so it shouldn't intersect.

I've tested it with some random point sets:

pts = RandomReal[{0, 1}, {200, 2}];
ListLinePlot[Append[pts, pts[]], AspectRatio -> Automatic] (* get the center point *)
center = Mean[pts];

(* sort by angle *)
pts = SortBy[pts, N[ArcTan @@ (# - center)] &];

(* display result *)
ListLinePlot[Append[pts, pts[]], Epilog -> {Red, Point[center]},
AspectRatio -> Automatic] I think if two points get the same angle from the starting point, this should still work, but if there's a chance that three or more points lie on a straight line through the starting point, you should sort by {angle, radius} instead.

• "…you should sort by {angle, radius} instead." - that is, SortBy[pts, {N[ArcTan @@ (# - center)] &, N[EuclideanDistance[center, #]] &}]` Jul 3, 2015 at 2:58