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.

I want to create an interpolation through the following 2dim data points:

data = {{22.78, 0.2431}, {22.06, 0.262}, {21.51, 0.2774}, {21.07, 
   0.2905}, {20.7, 0.302}, {20.38, 0.3121}, {20.1, 0.3213}, {19.86, 
   0.3296}, {19.28, 0.3499}, {5.41, 0.363}, {5.88, 0.364}, {18.71, 
   0.3709}, {5.14, 0.3715}, {5.11, 0.3734}, {6.3, 0.3772}, {6.4, 
   0.3824}, {4.96, 0.3882}, {18.15, 0.3925}, {4.9, 0.4036}, {4.89, 
   0.4083}, {6.69, 0.4141}, {17.6, 0.4147}, {4.91, 0.4372}, {17.06, 
   0.4374}, {6.61, 0.4414}, {6.43, 0.4493}, {4.98, 0.459}, {16.52, 
   0.4603}, {5.07, 0.4791}, {15.99, 0.4835}, {5.19, 0.4995}, {15.47, 
   0.5067}, {5.33, 0.5204}, {14.96, 0.5297}, {5.5, 0.5415}, {14.45, 
   0.5524}, {5.69, 0.5626}, {13.95, 0.5745}, {5.9, 0.5834}, {13.46, 
   0.5957}, {6.13, 0.6035}, {12.98, 0.6158}, {6.38, 0.6227}, {12.5, 
   0.6346}, {6.65, 0.6407}, {12.03, 0.6518}, {6.94, 0.6571}, {11.57, 
   0.6672}, {7.25, 0.6717}, {11.12, 0.6805}, {7.57, 0.6842}, {10.68, 
   0.6915}, {7.91, 0.6944}, {10.25, 0.7}, {8.27, 0.7021}, {9.83, 
   0.7059}, {8.64, 0.7072}, {9.42, 0.7091}, {9.02, 0.7095}};

With the common interpolation the plot looks like this:

dataInt = Interpolation @ data;
Show[{
  ListPlot[data, 
    PlotRange -> {{0, 25}, {0, 1}}, ImageSize -> 800], 
  Plot[dataInt[r], {r, 5, 25}, 
    PlotStyle -> RGBColor[0, 0, 1, .5]]}]

Listplot with interpolation

I already tried to obtain a better interpolation using Nearest or try to interpolate the two components seperatly but I was not able to get it the way I want it to be: It just does not connect the right points together. I already tried the solution presented here Parametric differentiable interpolation of a 2D data set using parametrizeCurve[] but it does not create an adequate interpolation either:

tvals = parametrizeCurve[data];
int = Interpolation[Transpose[{tvals, data}]]
Show[{
  ListPlot[data, PlotRange -> {{0, 25}, {0, 1}}, ImageSize -> 800], 
  ParametricPlot[int[t], {t, 0, 1}]}]

Interpolation with using parametrizeCurve

I must admit, that I dont understand the method behind parametrizeCurve, but it seems to be working with the wrong dimension of my data. I would be very happy to get a solution to my problem.

share|improve this question
1  
This looks like a job for FindCurvePath. –  Rahul May 5 at 18:57
    
Strongly related J. M.'s answer: "How to make BSplineFunction pass each data point and naturally smooth?" –  Alexey Popkov May 5 at 22:21

3 Answers 3

up vote 12 down vote accepted

Edit

Applying @Kuba's y-rescaling trick works here as well, just pass the rescaling through the DistanceFunction option

tour2 = FindShortestTour[data, 
   DistanceFunction -> (EuclideanDistance[#1 {1, 30},  #2 {1, 30}] &)];
ListLinePlot[data[[tour2[[2]]]], 
 Epilog -> {PointSize@0.01, Red, Point /@ data}]

Mathematica graphics


Here's as close as I can come with your set of data. I found a reasonable solution with FindShortestTour

tour = FindShortestTour[data]
ListLinePlot[data[[tour[[2]]]], 
 Epilog -> {PointSize@0.01, Red, Point /@ data}]

Mathematica graphics

We can now make an interpolating (parametric) dataset

Table[{i, data[[tour[[2, i]]]]}, {i, Length@data}];
points = Interpolation[%]
ParametricPlot[points[t], {t, 1, 59}, AspectRatio -> 1]

Mathematica graphics

share|improve this answer
    
Hey! The distance trick is nice! I wonder if we can set up a local distance (using some density measurement on each axis) so that the thing could be automated and put to work in almost any situation. –  belisarius May 5 at 22:58
    
I used the solution using FindShortestTour[data], which worked fine for me. I avoided those little artifacts at the left end of the curve by putting in more data, which I could gernate quite easily. The parametric interpolating of data using tour is exacly what I needed. –  Martin May 6 at 14:00

After reading the above answers, I see the the whole thing can be reduced to just three lines of code.

path = First @ FindCurvePath @ Standardize @ data
curve = Interpolation @ MapIndexed[{#2[[1]], #1} &, data[[path]]];
ParametricPlot[curve[t], {t, 1, 59}, AspectRatio -> 3/4]

plot

Nice work guys!

share|improve this answer

As Rahul Narain has pointed, FindCurvePath is the way to go. However, we need to give it some feedback. The problem is that points x-y scales are different about 20x. With quick fix, it is working.

I'm multiplying each pair with {1, 10} but a neat solution is to use Standardize@data as Simon Woods has noticed.

ord = FindCurvePath[# {1, 10} & /@ data]

Graphics[Line@data[[ord[[1]]]], AspectRatio -> 1]

enter image description here


The following works because points are quite dense:

dat = # {1, 10} & /@ SortBy[data, -#[[1]] &];
a = First@dat;
b = Rest@dat;
path = {1, .1} # & /@ First@Last@Reap@Do[
       b = DeleteCases[b, a = Sow@Nearest[b, a][[1]], 1];,
       {Length@b}];

Graphics[Line@path, AspectRatio -> 1, Frame -> True]

enter image description here

share|improve this answer
    
Of cours since you have the correct order you can Interpolate it :) –  Kuba May 5 at 20:32
    
+1 That's the problem with FindCurvePath[]. Nice find- –  belisarius May 5 at 20:35
    
@belisarius thanks, I had to use it for my Nearest solution and then I realized it should help FindCurvePath[] too ;) –  Kuba May 5 at 20:38
1  
+1. Well spotted. Standardize@data also works. –  Simon Woods May 5 at 20:42

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.