9
$\begingroup$

Writing:

pts = {{1, 0}, {2, 0}, {2, 3}, {3, 3}, {3, 4}, {0, 4}, {0, 3}, {1, 3}, {1, 0}};
Graphics[{Red, Point[pts], Blue, Line[pts]}]

we get:

enter image description here

and all of this works fine.

On the other hand, if the points weren't listed exactly in counterclockwise (or similarly clockwise) order it would not work.

So, if those points were awarded non-ordering, would there be any way to sort them?


I add a case that just came to my mind:

pts = {{1, 0}, {2, 2.5}, {3, 0}, {2.5, 3.5}, {4, 5}, {2.5, 4.5}, 
       {2, 7}, {1.5, 4.5}, {0, 5}, {1.5, 3.5}, {1, 0}};
Graphics[{Red, Point[pts], Blue, Line[pts]}]

enter image description here

$\endgroup$
7
  • 2
    $\begingroup$ Polygon[pts[[Last[FindShortestTour[pts]]]]] will get you a different ordering with shorter polygon perimeter. It really depends on what your ordering criteria are. If you want it angle wise - then you need to pick a point on the inside (in the middle of the top part of the T) and sort by angle from that point. $\endgroup$ – flinty May 13 at 16:24
  • 2
    $\begingroup$ Graphics[{Line @ pts[[Last @ FindShortestTour[pts, DistanceFunction -> ManhattanDistance]]], Red, Point@pts}]? $\endgroup$ – kglr May 13 at 20:05
  • 1
    $\begingroup$ Rolex, the method works only when the boundary lines are vertical and horizontal. $\endgroup$ – kglr May 13 at 21:03
  • 1
    $\begingroup$ Given an arbitrary set of points, there are usually multiple polygons that have the points as vertices. Each of many of the polygons would seem a reasonable solution to a different person. I don't see how to write a program that would always return one person's preference. $\endgroup$ – Michael E2 May 14 at 4:00
  • 1
    $\begingroup$ @Michael E2: Thanks everyone, every intervention is precious to me. Naively, after having learned to determine the convex hull of a set of points, I thought you could also find the concave one, but now I have understood that there are infinite ones, each with its own characteristics. Therefore, I deduce that to triangulate a region of the plane it is necessary to request the ORDERED border points, it is not possible to order them later. $\endgroup$ – Rolex May 14 at 6:56
15
$\begingroup$

One way to solve the case provided is to apply a DistanceFunction to FindShortestTour. Here, I apply a stiff penalty to the next point that does not share an X or Y value with the current point.

pts = {{1, 0}, {2, 0}, {2, 3}, {3, 3}, {3, 4}, {0, 4}, {0, 3}, {1, 
    3}, {1, 0}};
(*randomize points*)
pts = (#[[RandomSample[Range[Length@#], Length@#]]]) &[Most[pts]]
{len, tour} = 
  FindShortestTour[pts, 
   DistanceFunction -> ((If[(#1[[1]] == #2[[1]]) || (#1[[2]] == \
#2[[2]]), EuclideanDistance[#1, #2], 100000]) &)];
Graphics[{Red, Point[pts[[tour]]], Blue, Line[pts[[tour]]]}]

enter image description here

Update for the second case

You may need to come up with an approach for each shape class as I do not think there is a general approach for every conceivable set of points.

Sort by planar angle

Here is an approach that will work for the star-shaped set of points given in the update.

pts = {{1, 0}, {2, 2.5}, {3, 0}, {2.5, 3.5}, {4, 5}, {2.5, 4.5}, {2, 
    7}, {1.5, 4.5}, {0, 5}, {1.5, 3.5}, {1, 0}};
pts = (#[[RandomSample[Range[Length@#], Length@#]]]) &[Most[pts]];
mean = Mean[pts];
angles = PlanarAngle[mean -> {mean + {1, 0}, #}, 
     "Counterclockwise"] & /@ pts;
npts = Join[#, {First@#}] &@pts[[Ordering[angles]]];
Graphics[{Line[npts], PointSize[Medium], Red, Point[npts], Green, 
  Point[mean]}]

Star-shaped

Using FindShortestTour

Here, we will make use of the fact that the points alternate between short and long distances from the center. We can create a disk that encloses short points and use the sign of SignedRegionDistance to determine whether the points are within the disk. We generate a large penalty if the points are the same sign.

pts = {{1, 0}, {2, 2.5}, {3, 0}, {2.5, 3.5}, {4, 5}, {2.5, 4.5}, {2, 
    7}, {1.5, 4.5}, {0, 5}, {1.5, 3.5}, {1, 0}};
pts = (#[[RandomSample[Range[Length@#], Length@#]]]) &[Most[pts]];
mean = Mean[pts];
sdf = SignedRegionDistance[Disk[mean, 1.1]];
{len, tour} = 
  FindShortestTour[pts, 
   DistanceFunction -> ((If[Sign@sdf[#1] == Sign@sdf[#2], 100000, 
        EuclideanDistance[#1, #2]]) &)];
Graphics[{Blue, Line[pts[[tour]]], PointSize[Medium], Red, 
  Point[pts[[tour]]], Green, Point[mean]}]

Star-shaped version number two

$\endgroup$
4
  • $\begingroup$ Thanks so much for the invaluable help! Does this technique also apply to the case I added? Thank you! $\endgroup$ – Rolex May 13 at 20:20
  • 1
    $\begingroup$ @Rolex I updated the answer for the star-shaped case. The standard distance functions did not seem to find the desired star-shaped pattern. There still might be a custom distance function that will work. For me, it was easier to just do a sort by planar angle. $\endgroup$ – Tim Laska May 13 at 23:13
  • $\begingroup$ I really learned so much from your answer, thank you for taking the time! $\endgroup$ – Rolex May 14 at 6:52
  • 1
    $\begingroup$ @Rolex Thank you very much! Enjoy your explorations with Mathematica! $\endgroup$ – Tim Laska May 14 at 15:37

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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