11
$\begingroup$

Three months ago, I asked a quesion about B-Spline basis function here, Today, I used this function to plot B-spline curve.

The definition of $N_{i,p}$

  NBSpline[i_Integer, 0, knots_?(VectorQ[#, NumericQ] && OrderedQ[#] &),u_] /;
   i <= Length[knots] - 2 :=
  Piecewise[
   {{1, knots[[i + 1]] <= u < knots[[i + 2]]},
    {0, u < knots[[i + 1]] || u >= knots[[i + 2]]}}]

  coeff[u_, i_, j_, knots_] /; knots[[i]] == knots[[j]] := 0;
  coeff[u_, i_, j_, knots_] := (u - knots[[i]])/(knots[[j]] - knots[[i]])

  NBSpline[i_Integer, p_Integer, knots_?(VectorQ[#, NumericQ] && OrderedQ[#] &), 
    u_] /;p > 0 && i + p <= Length[knots] - 2 :=
   Module[{init, res},
    init = Table[NBSpline[j, 0, knots, u], {j, i, i + p}];
    res = First@
    Nest[
     Dot @@@
      (Thread@
        {Partition[#, 2, 1],
         With[{m = p + 2 - Length@#},
          Table[
           {coeff[u, k + 1, k + m + 1, knots],
            coeff[u, k + m + 2, k + 2, knots]}, {k, i, i + Length@# - 2}]]}) &,
    init, p]
  ]

The definition of B-Spline curve

$$\overset{\rightharpoonup }{C}(u)=\sum _{i=0}^n N_{i,p}(u) \overset{\rightharpoonup }{P}_i \text{ }\qquad (a\leq u\leq b)$$

where, $P_i$ is the control point, the $N_ {i, p} (u)$ are the pth - degree Bspline basis functions defined on the nonperiodic (and nonuniform) knot vector

knots= $\{\underbrace {a,\cdots ,a}_{p+1},u_{p+1},\cdots u_{m-p-1},\underbrace {b,\cdots,b}_{p+1}\}$


Trail 1

(Update) with george2079's solution

 BSplinePlot1[pts : {{_, _} ..}, knots_, opts : OptionsPattern[Plot]] :=
 Module[{p = Length@First@Split[knots] - 1, a, b},
  {a, b} = {First[knots], Last[knots]};
  ParametricPlot[
  Evaluate@
  Simplify@
    Total@ 
     MapIndexed[
      NBSpline[First@#2 - 1, p, knots, u] #1 &, pts], {u, a, b}, opts
 ]
]

Test1

 pts3 = {{1, 6}, {2, 8}, {3, 6}, {4, 12}, {7, 11}, {9, 3}, {12, 7}, {14, 5}, {15, 8}, {17, 8}};
 knots3= {0, 0, 0, 1/8, 2/8, 3/8, 4/8, 5/8, 6/8, 7/8, 1, 1, 1};

 BSplinePlot1[pts3, knots3, ImageSize -> 600]

enter image description here

 Graphics[{BSplineCurve[pts, SplineKnots -> knots], Green, Line[pts], 
  Red, Point[pts]}] // AbsoluteTiming

enter image description here


Update

  • Is there any method to speed up the calculation of NBSPline?

    See george2079's solution and my answer

  • How to deal with the problem of discontinuity shown in the first graph?

    Add the option PlotPoints

$\endgroup$
  • $\begingroup$ Now I have a trial in Mathematica 9, I found that the graph didn't have the problem of discontinuity. $\endgroup$ – xyz Jan 15 '15 at 12:42
  • 1
    $\begingroup$ your Piecewise function is defined for knot[[1]]<=u<knot[[-1]]. You need to make the last interval inclusive (<=knot[[-1]]). The out of bounds default is {0,0}, it should probably be undefined. $\endgroup$ – george2079 Jan 16 '15 at 15:33
  • $\begingroup$ @george2079,I rewritten the NBSpline function(shown in picture), However, it cannot deal with that probelm. In addition, I cannot understand this sentence:"The out of bounds default is {0,0}". $\endgroup$ – xyz Jan 17 '15 at 5:08
  • $\begingroup$ you need to look at the Piecewisw expression, then that will make sense. $\endgroup$ – george2079 Jan 17 '15 at 13:36
  • $\begingroup$ @george2079, OK,thanks a lot:) I have found the main question,see my new question $\endgroup$ – xyz Jan 17 '15 at 13:43
4
$\begingroup$

The plot is sped up substantially if you use Evaluate:

  ParametricPlot[
      Evaluate[ Total@MapIndexed[NBSpline[First@#2 - 1, p, knots, u] #1 &, pts]] ,
           {u, a, b}, opts]

(I only looked a trial 1 , but I think your other try have the same issue )

It helps a little more if you remove the Simplify from NBSpline and simplify the whole thing:

 ParametricPlot[
       Evaluate[Total@
             MapIndexed[NBSpline[First@#2 - 1, p, knots, u] #1 &, pts] // 
                  Simplify], {u, a, b}, opts]

Your original form is a sum of piecewise expressions. The outer Simplify condenses the whole thing into a single piecewise.

The gaps seem to relate the nature of the discontinuity in derivatives of the bspline w/ respect to its parameter at the knots, which evidently fools Parametric Plot into thinking there is an actual discontinuity.

The gaps close with PlotPoints -> 1000 , though if you look at the graphics produced you'll see you still have separate Lines for each portion. I don't think there is anything to do about that except not use ParametricPlot.

You might try doing away with ParametricPlot and doing Graphics@Line@Table .., which may speed it up as well.

$\endgroup$
3
$\begingroup$

Re: your error

BSplinePlot2[pts : {{_, _} ..}, knots_, opts : OptionsPattern[{Plot, BSplinePlot}]] := 
 Module[{p = Length@First@Split[knots] - 1, a, b}, 
  {a, b} = {First[knots], Last[knots]};
  With[{a1 = a, b1 = b}, 
   ParametricPlot[
    Total@MapIndexed[NBSpline[First@#2 - 1, p, knots, u] #1 &, pts], {u, a1, b1},
    Evaluate[Sequence @@ FilterRules[{opts}, Options[Plot]]], 
    Epilog -> If[OptionValue[ShowPoints], 
                Join[Text @@@ (Thread@{Table[ Style[Subscript["P", i], 14], {i, 0, Length@pts - 1}], 
                     # + {.4, .2} & /@ pts}), {Red,PointSize[0.015],Point[pts], Green, Line[pts]}]]]]]

pts = {{0, 0}, {0, 2}, {2, 3}, {4, 0}, {6, 3}, {8, 2}, {8, 0}};
knots = {0, 0, 0, 1/5, 2/5, 3/5, 4/5, 1, 1, 1}; 
BSplinePlot2[pts, knots, PlotRange -> {{0, 10}, {0, 5}}, ShowPoints -> True]

Mathematica graphics

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.