Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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

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[#]&;
interPolQ@pol

True

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

2 Answers 2

up vote 11 down vote accepted

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

SeedRandom[0];
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:

Needs["ComputationalGeometry`"];
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_] := 
  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;
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 at 9:38
1  
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 at 9:48
    
These are both good points that I don't know the answer to! =) –  Rahul May 19 at 9:51
    
While you are both here, thanks for the good answers :) I'm having a hard time trying to find the best. I assume that the only intersection is going to be a bad point for @RahulNarain ;o) :) –  Öskå May 19 at 9:55
    
@Öskå: As I said, the problem is underspecified, so there are lots of valid solutions, and what is best depends on what you want. If you want a spiky polygon, use nikie's. If you want a wiggly polygon, use mine. :) –  Rahul May 19 at 10:00

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

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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