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 smoothed some data with a BSpline $B[t] = (x[t],y[t])$. I would like to extract certain points from this spline by their x-Values, $x_0$. The easiest way I came up with was to minimize $B[t][[1]]-x_0$ for $t \in [0,1]$. So for finding the parameter t at which the x value is 13.46 if have the following code:

data = {{9.93114`, 379022.8`}, {11.71875`, 321705.7`}, {13.46983`, 
280830.8`}, {15.625`, 243949.8`}, {18.60119`, 206915}, {21.70139`,
 179663.2`}, {24.93351`, 158942.4`}, {29.29688`, 
138396.2`}, {33.48214`, 123873.8`}};

spline = BSplineFunction[data, SplineDegree -> 3];
tstfc[t_] := spline[t][[1]]

FindMinimum[Abs[tstfc[x] - 13.46] , {x, 0}]

It seems like the Spline is not getting evaluated. How can I solve this? And is there a standard way to extract points from a spline? Thanks!

share|improve this question

4 Answers 4

up vote 3 down vote accepted
data = {{9.93114`, 379022.8`}, {11.71875`, 321705.7`}, {13.46983`, 
280830.8`}, {15.625`, 243949.8`}, {18.60119`, 206915}, {21.70139`, 
179663.2`}, {24.93351`, 158942.4`}, {29.29688`, 138396.2`}, {33.48214`, 
123873.8`}};

spline = BSplineFunction[data, SplineDegree -> 3];

Clear[tstfc];

You need to restrict the definition of tstfc to numeric arguments. Using the symbolic result causes your problem.

tstfc[t_?NumericQ] := spline[t][[1]]

The function being minimized clearly has a local minimum:

Plot[Abs[tstfc[x] - 13.46], {x, 0, 1}]

Plot of function being minimized

Plot[Abs[tstfc[x] - 13.46], {x, 0.17, .173}]

Close-up off minimum

You should also constrain x.Even so, FindMinimum has some difficulty.

FindMinimum[{Abs[tstfc[x] - 13.46], 0 <= x <= 1}, {x, .2}]

FindMinimum::eit: The algorithm does not converge to the tolerance of 4.806217383937354`*^-6 in 500 iterations. The best estimated solution, with feasibility residual, KKT residual, or complementary residual of {2.00154,0.757541,1.00077}, is returned. >>

{0.000010463696439089176, {x -> 0.17147137220615655}}

NMinimize works better.

NMinimize[{Abs[tstfc[x] - 13.46], 0 <= x <= 1}, x]

{1.0658141036401503*^-13, {x -> 0.17147210562361115}}

share|improve this answer
    
@BobHanion - sorry for the vote-down. but your answer is mathematically wrong and ignores the other answers given. –  eldo Jun 4 at 21:24
    
The other answers agree with my result: x -> 0.171472 –  Bob Hanlon Jun 4 at 21:33
    
The other answers agree with my result: x -> 0.171472 as the value of the spline's parameter. The comments about a local minimum not existing are incorrect since the function being minimized is not the data or its spline but rather Abs[tstfc[x] - 13.46] which does have a local minimum. None of the plots plotted this argument of the FindMinimum which would show the local minimum. –  Bob Hanlon Jun 4 at 21:41
    
Hanion - First of all, I beg your pardon for the downvote. I tried to reverse it to no avail: You must edit at least 5 characters of your answer before I can do that. A short graphical demonstration of your answer would most probably overcome my ignorance. –  eldo Jun 4 at 21:52
    
I added plots of function being minimized to highlight local minimum –  Bob Hanlon Jun 4 at 22:08

If your aim is to find the parameter value t that maps to {13.46, _} in the B spline you could use:

data = {{9.93114`, 379022.8`}, {11.71875`, 321705.7`}, {13.46983`, 
    280830.8`}, {15.625`, 243949.8`}, {18.60119`, 206915}, {21.70139`,
     179663.2`}, {24.93351`, 158942.4`}, {29.29688`, 
    138396.2`}, {33.48214`, 123873.8`}};
bf = BSplineFunction[data, SplineDegree -> 3];
d = Table[{bf[t][[1]], t}, {t, 0, 1, 0.01}];
ifn = Interpolation[d];

Then

ans = ifn[13.46]

yields:

0.171472

and the point on spline:

bf[ans]

{13.46, 283497.}

You could adjust to desired precision.

share|improve this answer
    
Very nice, I would assume that's the real answer :) –  eldo Jun 3 at 11:06
    
Hi ubpdqn, thanks for your workaround. I would still be interested though, why my code did not work. –  malumno Jun 3 at 13:18
    
A problem with this approach is the variability of the precision, depending on dx/dt. –  malumno Jun 4 at 13:29

The documentation says in its very first sentence:

FindMinimum[f, x] searches for a local minimum in f, starting from an automatically selected point.

Not ANY minimum but a LOCAL minimum.

Google it with http://en.wikipedia.org/wiki/Maxima_and_minima

As already stated yesterday, your data doesn't contain LOCAL minima and/or maxima. Your data has one GLOBAL maximum and one GLOBAL minimum which, thanks Mathematica, can be found as follows:

{First@data, Last@data}

Aside from this, your "getPointNewton" simply doesn't work. If it works with you, could you provide an example?

share|improve this answer
    
Yes my data has just two global extrema. But I am not looking for the extrema in my data, but for the extrema in Abs[Spline[data][[1]]-x0]. This has its global minimum exactly at the point where Spline[data][[1]]=x0, as Bob Hanlon showed. By the way any global maximum is also a local maximum. –  malumno Jun 5 at 4:18

A workaround is a Newton algorithm, if the spline is used with a Modulo 1 parameter, modelling a periodic spline function. The function to be minimized is then spline[t_] := Abs[spline[t][[1]] - x0];

getPointNewton[x0_, splinein_, tstart_] := 
 Module[{d, t, dert, dt, spline},
  spline[t_] := Abs[spline[t][[1]] - x0];
  t = tstart;
  dt = 0.001;
  d = 1;
  While[d > 0.00000005,
   dert = (spline[t + dt] - spline[t - dt])/(2 dt);
   t = Mod[t - spline[t]/dert, 1];
  d = Abs[splinein[t][[1]] - x0];
   ];
  t
  ]

Edit: Works fine for this dataset, gives 0.171472 after 345 iterations, but has problems converging in more extreme data (higher derivatives/values) and close to boundaries.

The standard minimization routines in Mathematica seem to take a lot of time for convergence.

A better algorithm, which converges on the wished parameter from the left only is this one:

getPointLeft[x0_, spline_, tstart_] := 
 Module[{i, t, basestep, points}, i = 0;
  t = tstart;
 basestep = 1;
  points = {0};
  While[Abs[spline[t][[1]] - x0] > 0.000005, 
  If[spline[t + (1/2)^i basestep][[1]] > x0, i++, 
    t = t + (1/2)^i basestep;
    AppendTo[points, N[t]]]];
  points]

data = {{9.93114`, 379022.8`}, {11.71875`, 321705.7`}, {13.46983`, 
    280830.8`}, {15.625`, 243949.8`}, {18.60119`, 206915}, {21.70139`,
     179663.2`}, {24.93351`, 158942.4`}, {29.29688`, 
    138396.2`}, {33.48214`, 123873.8`}};

spline = BSplineFunction[data, SplineDegree -> 3];
points = getPointLeft[13.46, spline, 0]
Show[Plot[Abs[spline[t][[1]] - 13.46], {t, 0, 0.2}], 
 Graphics[{PointSize[Large], Red, 
   Point[Transpose[{points, 
      Abs[spline[#][[1]] - 13.46] & /@ points}]]}]]

Convergence to t[x0]

It halfs the stepsize as long as the next step would overshoot. This works well to find the next local minimum, which is fine for a case in which the dependent variable looked for is a monotonous function of the parameter t. Result:0.171472 after 33 iterations.

share|improve this answer
    
Again, why exactly the downvote? –  malumno Jun 5 at 5:40
    
I would upvote it again if you would show, with an example, that your "getPointLeft" works, yielding 0.171472 –  eldo Jun 5 at 12:02
    
impressive, thanks. just upvoted it. –  eldo Jun 5 at 15:17

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.