How to make BSplineFunction pass each data point and naturally smooth?

Question

Old package, works good

Needs["Splines`"];

testData = 
  {{10, 10}, {10, 20}, {10, 25}, {10, 27}, {10, 28}, {9, 26}, {8, 25}, {5, 20}, {3, 1}};

fFit = SplineFit[testData, Cubic];

ParametricPlot[fFit[n], {n, 0, Length[testData] - 1}, Epilog -> Point[testData]]

New spline package, how to make it work like the old one: passing each point exactly and naturally smooth

fFit01 = BSplineFunction[testData];

ParametricPlot[fFit01[n], {n, 0, Length[testData] - 1}, 
               Epilog -> Point[testData]]

However,the fitting results are different: some points are not passed exactly, which is not what I need.

Answer 1

I've used the method I'm about to show in this answer, but I suppose having it explicitly answer an interpolation question would be convenient.

Starting with your points,

testData = {{10, 10}, {10, 20}, {10, 25}, {10, 27}, {10, 28}, {9, 26},
            {8, 25}, {5, 20}, {3, 1}};

we use Lee's centripetal parametrization scheme to generate corresponding parameter values:

parametrizeCurve[pts_ /; MatrixQ[pts, NumericQ], a : (_?NumericQ) : 1/2] := 
                          FoldList[Plus, 0, Normalize[(Norm /@ Differences[pts])^a, Total]]

tvals = parametrizeCurve[testData];

We then generate control points for the B-spline from the interpolation points. To do that, we use a procedure suggested by Piegl and Tiller (see The NURBS Book by Piegl and Tiller if you want more details):

m = 3; (* degree of the B-spline *)
(* knots for interpolating B-spline *)
knots = Join[ConstantArray[0, m + 1], MovingAverage[ArrayPad[tvals, -1], m],
             ConstantArray[1, m + 1]];
(* basis function matrix *)
bas = Table[BSplineBasis[{m, knots}, j - 1, tvals[[i]]] // N,
            {i, Length[testData]}, {j, Length[testData]}];
ctrlpts = LinearSolve[bas, testData];

Now, we can see the B-spline in two different ways:

{Graphics[{{ColorData[1, 1], BSplineCurve[ctrlpts, SplineDegree -> m,
                                          SplineKnots -> knots]},
           {Directive[Green, AbsolutePointSize[6]], Point[testData]}}, Frame -> True], 
 ParametricPlot[BSplineFunction[ctrlpts, SplineDegree -> m, SplineKnots -> knots][t]
                // Evaluate, {t, 0, 1}, Axes -> None,
                Epilog -> {Directive[Green, AbsolutePointSize[6]], Point[testData]},
                Frame -> True]} // GraphicsRow

---

It can be observed that parametrizeCurve[] takes a second argument; this controls the type of parametrization used for the points. The default setting of $1/2$ generates a centripetal parametrization, as previously mentioned. Setting that parameter to $1$ will yield a chord-length parametrization, and setting it to $0$ yields a uniform parametrization. This parameter can take values in $[0,1]$, and one can adjust it as needed for the application at hand.

Answer 2

The data points you provided to BSplineFunction act as spline control points. Generally, splines do not go through them. The effect you want to achieve can be gotten using Interpolation:

First plotting your function with a prettier aspect ratio:

ParametricPlot[fFit[n], 
    {n, 0, Length[testData] - 1}, 
    Epilog -> Point[testData], AspectRatio -> 1/GoldenRatio]

fFit01 = Interpolation[{Range[Length@testData], testData}\[Transpose], Method -> "Spline"];

ListPlot[
  Table[fFit01[n], {n, 1, Length[testData], 0.01}], 
  Epilog -> Point[testData], Joined -> True
]

There are some small differences in the beginning of the curve that can be reduced by specifying derivatives at that point or by lowering the InterpolationOrder option in Interpolate.