10

Is there a way to decompose a BSplineFunction output into two functions x[t], y[t] parametrizing the curve BSplineFunction[{{x1, y1}, {x2, y2}, ...}][t] in a form which allows easy calculation of derivatives of arbitrary order of x[t] and y[t] and of composite functions which use x[t] or y[t] like

f[t] = y''[t]/Sqrt[x'[t]^2+y'[t]^2]
f''[0.5]

etc. ?

Edit: I would also like to do this avoiding SetDelayed as much as it's possible.

Alexey Popkov
  • 61,809
  • 7
  • 149
  • 368
Alex Bogatskiy
  • 1,680
  • 12
  • 19

2 Answers2

10

When manipulating B-splines in this manner, it is often convenient to fall back on the definitions. Luckily, since Mathematica supplies the function BSplineBasis[], using the definitions are easy:

pts = {{0, 0}, {1, 1}, {2, -1}, {3, 0}, {4, -2}, {5, 1}};

n = 3; (* B-spline degree *)
m = Length[pts];
(* clamped uniform knots for B-spline *)
knots = {ConstantArray[0, n + 1], Range[m - n - 1]/(m - n), ConstantArray[1, n + 1]}
        // Flatten;

{xu, yu} = Transpose[pts];
bs = BSplineFunction[pts, SplineDegree -> n];

(* B-spline component functions *)
f[t_] = xu.Table[BSplineBasis[{n, knots}, i - 1, t], {i, Length[pts]}];
g[t_] = yu.Table[BSplineBasis[{n, knots}, i - 1, t], {i, Length[pts]}];

Compare:

{ParametricPlot[bs[t], {t, 0, 1}, Axes -> None, Frame -> True,
                Epilog -> {Directive[AbsolutePointSize[5], Red], Point[pts]}], 
 ParametricPlot[{f[t], g[t]}, {t, 0, 1}, Axes -> None, Frame -> True,
                Epilog -> {Directive[AbsolutePointSize[5], Red], Point[pts]}]}

Spot the difference!

One can now plot the component functions as needed:

Plot[{f[t], g[t]}, {t, 0, 1}, Axes -> None, Frame -> True]

B-spline components

or use derivatives:

With[{t = 1/3}, g''[t]/Sqrt[f'[t]^2 + g'[t]^2]]
   48/Sqrt[41]
J. M.'s missing motivation
  • 124,525
  • 11
  • 401
  • 574
5

What about trying something like the following!

pts = {{1, 1}, {2, 3}, {3, -1}, {4, 1}, {5, 0}};
f = BSplineFunction[pts];
x[t_?NumericQ] := Module[{val}, val = f[t]; First@val];
y[t_?NumericQ] := Module[{val}, val = f[t]; Last@val];

Check it!

Plot[{x[t], y[t]}, {t, 0, 1}, Frame -> True]

enter image description here

Now the value you are looking for.

nf[t_?NumericQ] := y''[t]/Sqrt[x'[t]^2 + y'[t]^2];
nf''[0.5]

-758.244

BR

PlatoManiac
  • 14,723
  • 2
  • 42
  • 74
  • Wow, that's a simple and awesome idea! SetDelayed did half of the job, but Module is obviously the winner. Thanks! – Alex Bogatskiy Feb 07 '13 at 14:07
  • Though is there a way to do this without SetDelayed? I intend to use these functions in NDSolve inside Manipulate, thus SetDelayed is not welcome. x[t] by its nature is a known value, so why does it need to be SetDelayed? – Alex Bogatskiy Feb 07 '13 at 14:18