Find path through a set of Coordinates

Question

I have a set of coordinates that I need a robot to draw, thus it must take the shortest path along these coordinates. Plotting them looks like this:

Graphics[Point[maskCoordinates]]

EDIT: maskCoordinates is derived from the following code, which runs EdgeDetect and ComponentMeasurements on any given image, and for this example works with the first mask:

intWidth = 100;
imgCar = Import["https://2hire.io/wp-content/uploads/2016/12/car.png"];
imgCar = ColorConvert[imgCar, "Grayscale"];
imgCar = ImageResize[imgCar, intWidth];

edges = Thinning@EdgeDetect@imgCar;
masks = ComponentMeasurements[edges, "Mask"];
maskCoordinates = PixelValuePositions[Image@masks[[1, 2]], 1];

I have tried using FindShortestTour, but that only works for "complete" shapes/masks that I'm working with, like a circle. So applying this to the given mask, I get:

Graphics[Line[maskCoordinates[[Last[FindShortestTour[maskCoordinates]]]]]]

Which is close, but not exactly what I want. I thought that FindShortestPath would get the job done, but haven't had any succes with that yet.

Answer 1

Graphics @ Line @ FindHamiltonianPath @ NearestNeighborGraph[maskCoordinates, 2]

Answer 2

ListCurvePathPlot is pretty close:

ListCurvePathPlot[maskCoordinates]

FindShortestTour

You can get your FindShortestTour method to work if you give FindShortestTour a good starting and ending point. For instance, we can find the left-most and right-most points using Ordering:

left = First @ Ordering[maskCoordinates, 1]
right = First @ Ordering[maskCoordinates, -1]

110

115

Feed these to FindShortestTour:

tour = FindShortestTour[maskCoordinates, left, right][[2]];

Plot the tour:

Graphics[{Line[maskCoordinates[[tour]]]}]

Update to add comparisons I think the NearestNeighborGraph and FindCurvePath approaches won't work well when the path has a near intersection that is smaller than the distance between points on the path. To show this, here is a comparison of the three current answers on such a set of points:

pts = Join[{
    {.2,-.998027},{.4,-.998026}},
    N @ CirclePoints[{0,0},1,50],
    {{-.2,-.998027}, {-.4,-.998027}
}];
Graphics @ Point @ pts

Here is the result using FindShortestTour (starting and ending points are needed for this approach):

Graphics[{
    Line @ pts[[Last @ FindShortestTour[pts, 2, 54]]],
    Point @ pts
}]

Here is the result using NearestNeighborGraph:

Graphics[{
    Line @ FindHamiltonianPath @ NearestNeighborGraph[pts, 2],
    Point[pts]
}]

The approach using FindCurvePath suggested by @AlexeyPopkov didn't work for this set of points.

Answer 3

Using a "fix" for FindCurvePath by Michael E2 from here (please read the original answer):

segments = FindCurvePath@maskCoordinates;
edges = Partition[#, 2, 1] & /@ segments;
edges = Join @@ edges;

g = Graph@edges;
path = FindShortestPath[g, ##] & @@ 
  Flatten[Position[VertexDegree[g], 1]];

Graphics[Line[maskCoordinates[[path]]]]

Looks good at first sight, but some points aren't included:

maskCoordinates // Length
path // Length
ListPlot[maskCoordinates[[#]] & /@ segments]

149
142

---

Some other techniques can be found in answers to the following questions:

• How to group and join points

• Finding a function that fits the shape of an image

• Parametric Interpolation of 2D data

• How to connect discrete points and make them become continuous curve?

• How to create a new "person curve"?

• How can I combine a list of Line[]'s into one continuous Line?

• Can I get the curvature at any point of a random curve?

... and in the following answers:

• https://mathematica.stackexchange.com/a/102633/280

• https://mathematica.stackexchange.com/a/639/280