# Minimization in single component of BSpline to extract points

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!

-

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[Abs[tstfc[x] - 13.46], {x, 0.17, .173}]

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}}

-
@BobHanion - sorry for the vote-down. but your answer is mathematically wrong and ignores the other answers given. –  eldo Jun 4 '14 at 21:24
The other answers agree with my result: x -> 0.171472 –  Bob Hanlon Jun 4 '14 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 '14 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 '14 at 21:52
I added plots of function being minimized to highlight local minimum –  Bob Hanlon Jun 4 '14 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.

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

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?

-
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 '14 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}]]}]]
`

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.

-
Again, why exactly the downvote? –  malumno Jun 5 '14 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 '14 at 12:02
impressive, thanks. just upvoted it. –  eldo Jun 5 '14 at 15:17