How to generate a closed B-spline curve?

Question

I wrote a function called deBoor using the Cox-de Boor algorithm to generate a B-spline curve.

(*Search the index of span [ui,ui+1)*)
searchSpan[knots_, u0_] :=
 With[{max = Max[knots]},
  If[u0 == max,
   Position[knots, max][[1, 1]] - 2,
   Ordering[UnitStep[u0 - knots], 1][[1]] - 2]
]
(*The definition of α coefficient*)
α[{deg_, knots_}, {j_, k_}, u0_] /; 
  knots[[j + deg + 2]] == knots[[j + k + 1]] := 0
α[{deg_, knots_}, {j_, k_}, u0_] := 
  (u0 - knots[[j + k + 1]])/(knots[[j + deg + 2]] - knots[[j + k + 1]])

(*Implementation of de Boor algorithm*)
deBoor[pts : {{_, _} ..}, {deg_, knots_}, u0_] := 
 Module[{calcNextGroup, idx = searchSpan[knots, u0]},
  calcNextGroup =
   Function[{points, k},
    Module[{coords, coeffs},
     coords = Partition[points, 2, 1];
     coeffs = {1 - #, #} & /@ (α[{deg, knots}, {#, k + 1}, u0] & /@
      Range[idx - deg, idx - k - 1]);
     {Plus @@@ MapThread[Times, {coords, coeffs}], k + 1}]
  ];
  Nest[calcNextGroup[Sequence @@ #] &,
   {pts[[idx - deg + 1 ;; idx + 1]], 0}, deg][[1, 1]]
]

TEST

points = 
 {{1, 4}, {.5, 6}, {5, 4}, {3, 12}, {11, 14}, {8, 4}, {12, 3}, {11, 9}, {15, 10}, {17, 8}};
(*here, I set the knots uniformly*)
knots = {0, 0, 0, 0, 1/7, 2/7, 3/7, 4/7, 5/7, 6/7, 1, 1, 1, 1};

ParametricPlot[
  deBoor[points, {3, knots}, t], {t, 0, 1}, Axes -> False]

Now, I need to close this curve. My first thought is append the first point to the pts list.

pointsCLOSE = 
 {{1, 4}, {.5, 6}, {5, 4}, {3, 12}, {11, 14}, {8, 4}, {12, 3}, 
  {11, 9}, {15, 10}, {17, 8}, {1, 4}};
(*here, I set the knots uniformly*)
knotsCLOSE = {0, 0, 0, 0, 1/8, 2/8, 3/8, 4/8, 5/8, 6/8, 7/8, 1, 1, 1, 1};
ParametricPlot[
 deBoor[pointsCLOSE, {3, knotsCLOSE}, t], {t, 0, 1}, Axes -> False]

However, the built-in BSplineCurve gives a different curve

Graphics[{BSplineCurve[points, SplineClosed -> True]}]

The comparison of two graphics

So my thought is wrong

In the chat room, thanks to halirutan's suggestion

For this closed form, you need to assume the endpoints to be periodic. It is not enough to just pre-/append one point.

QUESTION

• What does the the endpoints to be periodic mean? I didn't learn it from The NURBS Book

• How to generate a closed B-spline curve like the built-in BSplineCurve[pts, SplineClosed -> True] ?

UPDATE

uniformKnots[pts_, deg_] :=
 With[{n = Length@pts},
  Join[
   ConstantArray[0, deg + 1],
   Range[1, n - deg - 1]/(n - deg),
   ConstantArray[1, deg + 1]]
  ]

Manipulate[
 With[{pts = Join[points, points[[1 ;; n]]]},
  ParametricPlot[
   deBoor[pts, {3, uniformKnots[pts, 3]}, t], {t, 0, 1}, 
   Axes -> False]], {n, 1, 10, 1}
]

• I didn't how many points should I append to the original points list?

Answer 1

The following works for your curve:

points = {{1, 4}, {.5, 6}, {5, 4}, {3, 12}, {11, 14}, {8, 4}, {12, 3}, {11, 9},
          {15, 10}, {17, 8}};
deg = 3; 
pointsCLOSE1 = Join[points, points];
n = Length@pointsCLOSE1;
knotsCLOSE1 = Range[0, 1, 1/(n + 1)];
ParametricPlot[deBoor[pointsCLOSE1, {deg, knotsCLOSE1}, t], {t, deg/(n + 1), 1}, 
               Axes -> False]

And also for many other curves

curve[nPts_, deg_] := Module[{points, pointsCLOSE1, n, knotsCLOSE1},
  points = RandomReal[{0, 1}, {nPts, 2}]; 
  pointsCLOSE1 = Join[points, points];
  n = Length@pointsCLOSE1;
  knotsCLOSE1 = Range[0, 1, 1/(n + 1)];
  ParametricPlot[ deBoor[pointsCLOSE1, {deg, knotsCLOSE1}, t], 
                  {t, deg/(n + 1), 1}, Axes -> False]
  ]

degs = RandomInteger[{3, 6}, 6];
npoints = RandomInteger[{2 #, 3 #}] & /@ degs;
Partition[MapThread[curve, {npoints, degs}], 3] // Grid

But I've also found some counterexamples, so it should be taken with care ...

Answer 2

I seem to have missed this earlier. Anyway, creating a closed spline in Mathematica explicitly is actually rather simple. Witness the following:

pts = {{1, 4}, {.5, 6}, {5, 4}, {3, 12}, {11, 14}, {8, 4}, {12, 3}, {11, 9},
       {15, 10}, {17, 8}};

m = 5; (* degree *) n = Length[pts];
f = BSplineFunction[pts, SplineClosed -> True, SplineDegree -> m];

fn = BSplineFunction[ArrayPad[pts, {{0, m}, {0, 0}}, "Periodic"], 
                     SplineDegree -> m, 
                     SplineKnots -> ArrayPad[Subdivide[n], m, "Extrapolated"]];

See the correspondence:

ParametricPlot[{f[t], fn[t]}, {t, 0, 1}, Axes -> None, Frame -> True, 
               PlotStyle -> {AbsoluteThickness[6], AbsoluteThickness[2]}]

Further proof of correspondence can be seen by trying ParametricPlot[f[t] - fn[t], {t, 0, 1}].

Another example:

pts = {{0, 1, 1}, {1, 1, -1}, {1, 0, 1}, {1, -1, -1}, {0, -1, 1}, {-1, -1, -1},
       {-1, 0, 1}, {-1, 1, -1}};
n = Length[pts];
f = BSplineFunction[pts, SplineClosed -> True];
fn = BSplineFunction[ArrayPad[pts, {{0, 3}, {0, 0}}, "Periodic"], 
                     SplineKnots -> ArrayPad[Subdivide[n], 3, "Extrapolated"]];

{ParametricPlot3D[f[t], {t, 0, 1}], ParametricPlot3D[fn[t], {t, 0, 1}]}
// GraphicsRow