Mathematica Stack Exchange is a question and answer site for users of Mathematica. Join them; it only takes a minute:

Sign up
Here's how it works:
  1. Anybody can ask a question
  2. Anybody can answer
  3. The best answers are voted up and rise to the top

This question already has an answer here:

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;

Mathematica graphics

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@Graphics`Mesh`SimplePolygonQ[#]&;


Knowing that Graphics`Mesh`SimplePolygonQ[] 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}}]

Mathematica graphics

share|improve this question

marked as duplicate by Rahul, Sjoerd C. de Vries, ciao, Jens, Kuba Apr 18 '15 at 8:25

This question has been asked before and already has an answer. If those answers do not fully address your question, please ask a new question.

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 – Dr. belisarius May 18 '14 at 23:09
The result should fill the white spaces as well. I'm going to edit it. – Öskå May 18 '14 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 '14 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. – Dr. belisarius May 18 '14 at 23:29
Previously: @ybeltukov's "deintersection" algorithm. – Rahul May 19 '14 at 7:32
up vote 14 down vote accepted

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

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

enter image description here

As suggested by @belisarius, the convex hull does not self-intersect, but can drop points:

chCoords = coords[[ConvexHull[coords]]];
Graphics[drawPolygon[chCoords, Darker@Green]]

enter image description here

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

enter image description here

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

enter image description here

To remove those intersections, we can use @ybeltukov's "deintersection" algorithm on the computed tour.

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;
Deintersect[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;
dstCoords = Deintersect[stCoords];
Graphics[drawPolygon[dstCoords, Purple]]

enter image description here

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

enter image description here

share|improve this answer
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). – Yves Klett May 19 '14 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. – nikie May 19 '14 at 9:48
These are both good points that I don't know the answer to! =) – Rahul May 19 '14 at 9:51
The problem is that nikie's answer doesn't seem to work with my test case. See here. – Öskå May 19 '14 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. – nikie May 19 '14 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[[1]]], AspectRatio -> Automatic]

enter image description here

(* get the center point *)
center = Mean[pts];

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

(* display result *)
ListLinePlot[Append[pts, pts[[1]]], Epilog -> {Red, Point[center]}, 
 AspectRatio -> Automatic]

enter image description here

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.

share|improve this answer
"…you should sort by {angle, radius} instead." - that is, SortBy[pts, {N[ArcTan @@ (# - center)] &, N[EuclideanDistance[center, #]] &}] – J. M. Jul 3 '15 at 2:58

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