8
$\begingroup$

As you can see below, FindCurvePath returns only a part of the list, resulting in a partial interpolation. I would like to interpolate all the points.

enter image description here

Complete code:

pts = {{1.93423, 0.641189}, {1.9358, 0.630954}, {1.9371, 
    0.650986}, {1.93919, 0.621439}, {1.94365, 0.61225}, {1.94597, 
    0.655907}, {1.94882, 0.603438}, {1.95455, 0.594968}, {1.95606, 
    0.656171}, {1.96069, 0.586872}, {1.96595, 0.654537}, {1.96714, 
    0.579184}, {1.97424, 0.571486}, {1.97578, 0.651937}, {1.98145, 
    0.564318}, {1.98531, 0.648845}, {1.98881, 0.557548}, {1.9948, 
    0.645393}, {1.99647, 0.551004}, {2.00419, 0.641735}, {2.00463, 
    0.544488}, {2.01275, 0.538373}, {2.01363, 0.637894}, {2.02088, 
    0.532551}, {2.02306, 0.633956}, {2.02915, 0.526872}, {2.0323, 
    0.630046}, {2.03751, 0.521304}, {2.04156, 0.62611}, {2.04595, 
    0.515815}, {2.05077, 0.622207}, {2.0544, 0.510398}, {2.05999, 
    0.618333}, {2.06294, 0.504962}, {2.06934, 0.614459}, {2.07145, 
    0.499549}, {2.07862, 0.610677}, {2.07994, 0.494119}, {2.08831, 
    0.606811}, {2.0884, 0.488658}, {2.09683, 0.483151}, {2.09804, 
    0.603014}, {2.1052, 0.477593}, {2.10739, 0.599448}, {2.11352, 
    0.471977}, {2.11717, 0.59581}, {2.12178, 0.466298}, {2.12666, 
    0.592359}, {2.12999, 0.460556}, {2.13608, 0.589006}, {2.13813, 
    0.454749}, {2.14553, 0.585711}, {2.14629, 0.448827}, {2.15441, 
    0.44282}, {2.155, 0.582465}, {2.16246, 0.436763}, {2.1645, 
    0.579252}, {2.174, 0.576075}, {2.1835, 0.572919}, {2.19313, 
    0.569731}, {2.2027, 0.56656}, {2.21246, 0.563307}, {2.2221, 
    0.560059}, {2.23174, 0.556768}, {2.24124, 0.553468}, {2.2507, 
    0.550113}, {2.26013, 0.546683}, {2.26966, 0.543124}, {2.27906, 
    0.539506}, {2.28836, 0.535809}, {2.29765, 0.531988}, {2.30703, 
    0.527995}, {2.31622, 0.523934}, {2.32532, 0.519765}, {2.33437, 
    0.515457}, {2.34337, 0.511008}, {2.35234, 0.506407}, {2.36121, 
    0.501682}, {2.36999, 0.496834}};
path = (FindCurvePath@pts)[[1]];
curve = Interpolation[#, Method -> "Spline"] &@
   MapIndexed[{#2[[1]], #1} &, pts[[path]]];
Show[ParametricPlot[curve[t], {t, 1, Length[path]}, 
  AspectRatio -> 3/4, PlotStyle -> Red], ListPlot[pts]]

If I replace [[1]] by [[2]] in path=, I get the second part:

enter image description here

How to get both curves at once?


Edit I found an example which could not be treated with Michael's solution. It appears sorting the points from one end of the curve to the other end makes it more robust. Unfortunately, I don't know how to detect the position of one end so this is not fully automatic.

This is the complete code (mostly that of Michael's answer):

(* to put an edge point in the first position *)
pts = 
 Sort[pts, #1[[1]] < #2[[1]] &]; (* replace [[1]] with [[2]] if the curve is cut horizontally *)
ptstmp = Drop[pts, {1}];
ptsOrdered = {pts[[1]]};
For[i = 1, i < Length[pts], i++,
  AppendTo[ptsOrdered, First@Nearest[ptstmp, pts[[i]]]];
  ptstmp = 
   Drop[ptstmp, Position[ptstmp, Nearest[ptstmp, pts[[i]]]]]];
ListPlot[ptsOrdered]

segments = FindCurvePath@ptsOrdered;
edges = Partition[#, 2, 1] & /@ segments;
edges = Join @@ edges;
g = Graph@edges;
path = FindShortestPath[g, ##] & @@ 
   Flatten[Position[VertexDegree[g], 1]];
curve = Interpolation[#, Method -> "Spline"] &@
   MapIndexed[{#2[[1]], #1} &, ptsOrdered[[path]]];
Show[ParametricPlot[curve[t], {t, 1, Length[path]}, 
  AspectRatio -> 3/4, PlotStyle -> Red], ListPlot[ptsOrdered]]

Output (the data is not included in the question): enter image description here

$\endgroup$
  • 1
    $\begingroup$ As of Mathematica v9, you can't. But you may build your own function. See here for a similar (but not exact) example mathematica.stackexchange.com/a/75867/193 $\endgroup$ – Dr. belisarius Sep 26 '15 at 4:54
  • 1
    $\begingroup$ @belisarius Is there a fundamental reason why FindCurvePath stops somewhere rather than somewhere else? $\endgroup$ – anderstood Sep 26 '15 at 5:06
  • $\begingroup$ @anderstood Is it possible that you provide the second data-set too? You can copy it to hastebin.com and give the link here. $\endgroup$ – halirutan Sep 29 '15 at 9:13
  • $\begingroup$ @halirutan Sure, there it is: hastebin.com/etakobosuq.mel. The procedure works for the first list of points (ptsWorks) while it fails for the second (ptsDoesnt). Yet, the two lists are very similar (they were generated from the same long list). $\endgroup$ – anderstood Sep 29 '15 at 18:27
7
$\begingroup$

FindCurvePath splits the pts into two pieces, but the segments have a common point:

segments = FindCurvePath@ pts;
segments[[All, 1]]
(*  {2, 2}  *)

Assuming that this always happens, namely that all the points are split into segments that share endpoints when in the mind of the user the points constitute a single smooth curve, one can join the lists, reversing a list when necessary. Of course, the assumption should be verified first. Further, FindCurvePath sometimes drops points and does other things automatically. The path returned may depend on the order of the points. Apparently FindCurvePath does not do a full global analysis, but proceeds locally or semi-locally. Thus writing code such as in belisarius's answer to Finding a function that fits the shape of an image is probably the most robust approach.

Taking a big-hammer approach, here is way that works in the OP's not-too-troublesome case.

segments = FindCurvePath@ pts;
edges = Partition[#, 2, 1] & /@ segments;
edges = Join @@ edges;
path = FindHamiltonianPath@ Graph@ edges;
curve = Interpolation[#, Method -> "Spline"] &@
   MapIndexed[{#2[[1]], #1} &, pts[[path]]];
Show[ParametricPlot[curve[t], {t, 1, Length[path]}, 
  AspectRatio -> 3/4, PlotStyle -> Red], ListPlot[pts]]

Mathematica graphics

This approach also works with

SeedRandom[0];
pts = RandomSample@Table[{Cos[3.2 t], Sin[2 t]}, {t, 0., 3.2, 0.02}];

FindCurvePath splits pts into four connecting segments.

V8 - V10.1 Solution

This works in V10.1 and V9.0.1 (presumably in V8) in place of FindHamiltonPath:

g = Graph@ edges;
path = FindShortestPath[g, ##] & @@ Flatten[Position[VertexDegree[g], 1]];
$\endgroup$
  • $\begingroup$ I got the error because I was not working on the same data pts. Indeed, it works for the pts of the OP. I am trying to adapt belisarius's answer to increase robustness. I've deleted my comments above as there are no longer relevant. $\endgroup$ – anderstood Sep 26 '15 at 18:32
  • $\begingroup$ @anderstood Deleted mine likewise. $\endgroup$ – Michael E2 Sep 26 '15 at 18:40
  • $\begingroup$ Sorting points from one end to the other end seems to make your procedure more robust (see edit in question). I'll see in practise if it's "robust enough" and let you know. $\endgroup$ – anderstood Sep 26 '15 at 21:12
  • $\begingroup$ A case when this method fails: mathematica.stackexchange.com/a/158320/280 $\endgroup$ – Alexey Popkov Oct 21 '17 at 15:08

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.