11
$\begingroup$

I have a list of 2D points such as in the image.

coord = {{0, 0}, {10, 0}, {20, 0}, {30, 0}, {25, 10}, {0, 10}, {0, 
5}};

enter image description here

I would like to determine the longest "edge" length in a way that if 2 segments are in same line, they would be considered as part of 1 edge. For example, segments 1-2, 2-3, 3-4 are continuous and in the same line, so we consider it as 1 edge connecting Vertex 1 and Vertex 4. In this example, the longest edge length would be the distance from vertex 1 to vertex 4. How can I determine the longest edge length in Mathematica?

$\endgroup$
14
$\begingroup$

Update: The function in the original answer does not work for arbitrary polygons. The following seems to work

ClearAll[nonCollinearHull]
nonCollinearHull = Module[{coords = #, 
 angles = ArcTan @@@ (Subtract @@@ Partition[#, 2, 1 , {1, 1}]),
 rotation, lengths},
rotation = LengthWhile[Reverse[angles], # == angles[[1]] &];
lengths = Length /@ Split[RotateRight[angles, rotation]];
TakeList[RotateRight[coords, rotation], lengths][[All, 1]]] &;

Examples:

coord = {{0, 0}, {10, 0}, {20, 0}, {30, 0}, {25, 10}, {0, 10}, {0, 5}};
lines = Line /@ Partition[nonCollinearHull[coord], 2, 1];
longest = Last@SortBy[lines, N@ArcLength[#] &];
Graphics[{EdgeForm[Gray], FaceForm[], Polygon@coord, Blue, 
  PointSize[Large], Point@coord, Opacity[.5, Green], 
  AbsolutePointSize[15], Point[nonCollinearHull[coord]], 
  Thickness[.03], CapForm["Round"], Opacity[.5], Red, longest}]

enter image description here

Using

SeedRandom[123]
coord2 = DeleteDuplicates[#[[FindShortestTour[#][[2]]]] & @
   DeleteDuplicates@RandomInteger[10, {50, 2}];

we get

enter image description here

And with

SeedRandom[123]
coord3 = DeleteDuplicates[#[[FindShortestTour[#][[2]]]] &@ 
   DeleteDuplicates@RandomInteger[20, {200, 2}]];

enter image description here

Alternatively, you can use MaximalBy to define longest:

SeedRandom[777777]
coord = MapIndexed[{#2[[1]], #} &, Accumulate[RandomInteger[{-2, 2}, 50]]];
lines = Line /@ Partition[nonCollinearHull[coord], 2, 1];
longest = MaximalBy[lines, N@ArcLength[#] &];
Graphics[{EdgeForm[Gray], FaceForm[], Line@coord, Blue, 
  PointSize[Large], Point@coord, Opacity[.5, Green], 
  AbsolutePointSize[15], Point[nonCollinearHull[coord]], 
  Thickness[.03], CapForm["Round"], Opacity[.5], Red, longest}]

enter image description here

Original answer:

Using the function noncollinearF from this answer:

ClearAll[noncollinearF]
noncollinearF[verts_] := Function[{k}, Nor @@ (RegionMember[ConvexHullMesh[#], k] & /@ 
  Subsets[Complement[verts, {k}], {2}])]

lines = Line /@ Partition[Pick[#, noncollinearF[#] /@ #], 2, 1, {1, 1}]& @ coord;
longest = Last@SortBy[lines, N@ArcLength[#] &]; 
Graphics[{EdgeForm[Gray], FaceForm[], Polygon@coord, 
  Blue, PointSize[Large], Point@coord, 
  Thickness[.03], CapForm["Round"], Opacity[.5], Red, longest}]

enter image description here

$\endgroup$
  • $\begingroup$ Why ConvexHullMesh and not just Line? $\endgroup$ – swish Jan 4 at 7:18
  • $\begingroup$ It breaks if a coordinate list starts in the middle of the longest edge. Try RotateLeft[coord, 2] for the original example. $\endgroup$ – swish Jan 4 at 7:45
  • $\begingroup$ @swish, thank you. Updated with an alternative that does not have the issue. $\endgroup$ – kglr Jan 4 at 19:47

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.