# BSpline or other curve through arbitrary ordered sequence of two-dimensional points [duplicate]

How does one create a BSplineCurve or other smooth curve passing through each point in an ordered list, where the curve may be non-simple, i.e., can double-back upon itself, loop, and so forth as for {{0,0},{1,0},{.5, 1}, {-1,-2},{1,3}}?

BSplineCurve, BezierCurve and related functions use control points, but these are not the target points through which the curve must pass.

• @DavidG.Stork a recreational (definitely not serious) application showing curves doubling back using second of PlatoManiac's hyperlinks: ubpdqnmathematica.files.wordpress.com/2014/11/ubpdqn.gif Nov 8, 2014 at 7:53
• About the built-in BSplineCurve[], you need to give the control points. However, to make the interpolation points pass the B-spline curve, you must set the linear-equation to solve the control points.
– xyz
Oct 10, 2015 at 10:29
• @J. M.: Nope. Your link is to a function (e.g., $f(x)$) and cannot apply to the case where the sequence of points forms a spiral, for instance. Oct 11, 2015 at 3:00
• Actually, it will work. Maybe I should write an answer to make it explicit... Oct 11, 2015 at 3:58

You may do it with Interpolation[] by expanding the list with a parameter value:

l = {{0, 0}, {1, 0}, {.5, 1}, {-1, -2}, {1, 3}};
f = Interpolation[Table[{i, l[[i]]}, {i, Length@l}], InterpolationOrder -> #] & /@ {3, 4};
Row[ParametricPlot[f[[#]][t], {t, 1, Length@l},
Epilog -> {Red, PointSize[Medium], Point@l},  AspectRatio -> 1] & /@ {1, 2}]


• By the way, Method -> "Spline" will create a differentiable curve even with the default InterpolationOrder -> 3.
– user484
Nov 8, 2014 at 8:56

As a proof of concept that the procedure in my previous answer straightforwardly carries to this case, allow me to present a short demo:

pts = {{0, 0}, {1, 0}, {.5, 1}, {-1, -2}, {1, 3}};
tvals = parametrizeCurve[pts, 1]; (* chord-length parametrization, just to be ornery *)
m = 3; (*degree of the B-spline*) n = Length[pts];
(*knots for interpolating B-spline*)
knots = Join[ConstantArray[0, m + 1],
MovingAverage[ArrayPad[tvals, -1], m], ConstantArray[1, m + 1]];
(*basis function matrix*)
bas = Outer[BSplineBasis[{m, knots}, #2, #1] &, tvals, Range[0, n - 1]];
ctrlpts = LinearSolve[bas, pts];

Graphics[{Blue, BSplineCurve[ctrlpts, SplineDegree -> m, SplineKnots -> knots],
{Directive[AbsolutePointSize[4], Red], Point[pts]}},
PlotRange -> {{-5/4, 5/4}, {-11/2, 7/2}}]