Function Repository Resource:

CurveToBSplineFunction

Source Notebook

Create a smooth parametrized function from a list of points with flexible control over smoothing

Contributed by: Alexey Popkov

ResourceFunction["CurveToBSplineFunction"][{pt1,pt2,}, d]

creates a B-spline function of maximal degree d parametrizing a curve defined by the points pti.

ResourceFunction["CurveToBSplineFunction"][{pt1,pt2,}, d, scale]

specifies that the scale factor scale should be used for interval subdivision.

Details and Options

ResourceFunction["CurveToBSplineFunction"] returns a BSplineFunction object.
Before processing, successive duplicate points are removed from the input list of points {pt1,pt2,}.
ResourceFunction["CurveToBSplineFunction"][{pt1,pt2,},d] is equivalent to ResourceFunction["CurveToBSplineFunction"][{pt1,pt2,},d,1].
The second argument d determines the maximal degree of the underlying polynomial basis used by a BSplineFunction object. Increasing this value leads to a smoother spline with fewer details.
The third argument scale is the scale factor used for filling the gaps between successive points of the curve when the option "FillGaps"True is set. With this setting, equidistant control points will be introduced between the points pti and pti+1. By default, it is assumed that a scale of 1 means that no intermediate control points will be introduced when the Euclidean distance between successive points is less than 2. Increasing this value leads to a smoother spline with fewer details.
The following options can be given:
"AssignWeights"Falsecontrols assigning weights to the control point of a generated spline
"CurveClosed"Falsewhether to treat the input curve defined by points {pt1,pt2,} as closed
"DuplicateNodes"Falsecontrols duplication of the input control points pti
"FillGaps"Truewhether to introduce intermediate control points
The option setting "AssignWeights"Automatic assigns to every control point of a generated spline the weight equal to the sum of its distances to the two adjacent points. With the setting "AssignWeights"f, where f is a function, the weight of the point will be set to f[pti, {l, r}, angle, scale]. This option helps to preserve the shape of the original curve by selectively increasing the weights of the control points.
With the setting "CurveClosed"True, the input list of points {pt1,pt2,} is treated as cyclic.
The option "DuplicateNodes" gives flexible control over duplication of the input control points pti inside of a produced BSplineFunction. With the setting "DuplicateNodes"n, every point will be duplicated n times. With the setting "DuplicateNodes"Automatic, every input point pti will be duplicated Max[Floor[(l+r)/(2 scale)],1] times, where l and r are Euclidean distances to the adjacent points from the left and the right, respectively. With "DuplicateNodes"f, where f is a function, the point will be duplicated f[pti, {l, r}, angle, scale] times, where angle is the interior angle at the vertex point pti (for the boundary points, angle is set to Infinity). This option allows preservation of the sharp corners of the original curve by duplicating the corresponding control points.

Examples

Basic Examples (2) 

Convert a 2D curve into a spline function preserving the original shape with different accuracy:

In[1]:=
SeedRandom[8];
curve = RandomReal[1, {5, 2}];
scales = {1, .3, .17};
functs = ResourceFunction["CurveToBSplineFunction"][curve, 2, #][\[FormalT]] & /@ scales;
ParametricPlot[functs, {\[FormalT], 0, 1}, Frame -> True, PlotLegends -> scales,
 Prolog -> {Green, Dashed, Line[curve], Red, PointSize[Medium], Point[curve]}]
Out[5]=

Parametrize 3D data:

In[6]:=
SeedRandom[8];
g = ResourceFunction["CurveToBSplineFunction"][RandomReal[3, {6, 3}], 5]
ParametricPlot3D[g[u], {u, 0, 1}]
Out[7]=
Out[8]=

Scope (1) 

Parametrization of an arbitrary polygon with different scale factors:

In[9]:=
SeedRandom[1];
nodes = RandomPolygon[{"Simple", 30}][[1]];
scales = {1, .1, .05};
functs = Table[
   ResourceFunction["CurveToBSplineFunction"][nodes, 10, scale, "CurveClosed" -> True][\[FormalT]], {scale, scales}];
ParametricPlot[functs, {\[FormalT], 0, 1}, PlotLegends -> scales, Frame -> True, Epilog -> {Red, Point[nodes]}, Prolog -> {LightGray, Polygon[nodes]}]
Out[13]=

Options (7) 

AssignWeights

With option value "AssignWeights"Automatic, original control points get weights equal to the sum of their Euclidean distances to the adjacent points, which is equivalent to "AssignWeights"(Total[#2]&). Compare with a weighting function dependent on the interior angle at the node (argument #3):

In[14]:=
nodes = 5 {{-1, 0}, {-1, 1}, {0, 0}, {1, 1}, {1, 0}};
opts = {"FillGaps" -> False, #} & /@
   {"AssignWeights" -> False, "AssignWeights" -> Automatic, "AssignWeights" -> (Total[#2] &), "AssignWeights" -> (If[#3 < \[Pi], 50, 1] &)};
functs = ResourceFunction["CurveToBSplineFunction"][nodes, 3, #][\[FormalT]] & /@ opts;
ParametricPlot[functs, {\[FormalT], 0, 1}, Epilog -> {Green, Dashed, Line[nodes], Red, PointSize[Large], Point[nodes]}, PlotRange -> {{-5.1, 5.1}, {0, 5.1}}, PlotRangeClipping -> False, PlotLegends -> (Style[StandardForm@#, "Input", "Notebook", ShowSyntaxStyles -> True] & /@ opts), PlotStyle -> {Automatic, Black, {Yellow, Dashed}, Automatic}]
Out[17]=

CurveClosed

With option value "CurveClosed"True, a parametric function describing a closed contour is produced. Its geometric form is invariant to the rotation of the points:

In[18]:=
nodes = {{-1, 0}, {-1, 1}, {0, 0}, {1, 1}, {1, 0}};
functs = ResourceFunction["CurveToBSplineFunction"][#, 3, "CurveClosed" -> True][\[FormalT]] & /@ {nodes, RotateLeft[nodes, 3], Reverse[nodes]};
ParametricPlot[functs, {\[FormalT], 0, 1}, Axes -> False, PlotStyle -> {Blue, {Red, Dashing[0.04]}, {Green, Dashing[0.02]}}]
Out[20]=

DuplicateNodes

With option value "DuplicateNodes"n, original distinct control points will be duplicated n times. The default option value "DuplicateNodes"False is equivalent to "DuplicateNodes"1 (no point duplication). The option value "DuplicateNodes"Automatic tries to preserve significant sharp features of the original shape and is equivalent to "DuplicateNodes"(Max[Floor[Total[#2]/(2#4)],1]&). Compare them with a node duplication function dependent on the interior angle at the node (argument #3):

In[21]:=
nodes = 2 {{-1, 0}, {-1, 1}, {0, 0}, {1, 1}, {1, 0}};
opts = {"FillGaps" -> False, #} & /@
   {"DuplicateNodes" -> False, "DuplicateNodes" -> 2, "DuplicateNodes" -> Automatic,
    "DuplicateNodes" -> (Max[Floor[Total[#2]/(2 #4)], 1] &), "DuplicateNodes" -> (If[#3 < \[Pi]/2, 3, 1] &)};
functs = ResourceFunction["CurveToBSplineFunction"][nodes, 3, #][\[FormalT]] & /@ opts;
ParametricPlot[functs, {\[FormalT], 0, 1}, Epilog -> {Green, Dashed, Line[nodes], Red, PointSize[Large], Point[nodes]}, PlotRange -> {{-2.1, 2.1}, {0, 2.1}}, PlotRangeClipping -> False, PlotLegends -> (Style[StandardForm@#, "Input", "Notebook", ShowSyntaxStyles -> True] & /@ opts), PlotStyle -> {Automatic, Automatic, Black, {Yellow, Dashed}, Red}]
Out[24]=

FillGaps

With the default option value "FillGaps"True, intermediate control points are added when the distance between successive nodes is at least twice the scale:

In[25]:=
nodes = 5 {{-1, 0}, {-1, 1}, {0, 0}, {1, 1}, {1, 0}};
scale = 1;
f = ResourceFunction["CurveToBSplineFunction"][nodes, 3, scale];
ParametricPlot[f[t], {t, 0, 1}, Epilog -> {Green, Dashed, Line[nodes], Red, Point[f[[5, 1]]], PointSize[Large], Point[nodes]}, PlotRange -> {{-5.1, 5.1}, {0, 5.1}}, PlotRangeClipping -> False]
Out[28]=

Turn off introduction of intermediate control points by specifying "FillGaps"False:

In[29]:=
f = ResourceFunction["CurveToBSplineFunction"][nodes, 3, scale, "FillGaps" -> False];
ParametricPlot[f[t], {t, 0, 1}, Epilog -> {Green, Dashed, Line[nodes], Red, Point[f[[5, 1]]], PointSize[Large], Point[nodes]}, PlotRange -> {{-5.1, 5.1}, {0, 5.1}}, PlotRangeClipping -> False]
Out[30]=

The same happens when the scale factor is sufficiently large:

In[31]:=
f = ResourceFunction["CurveToBSplineFunction"][nodes, 3, 6];
ParametricPlot[f[t], {t, 0, 1}, Epilog -> {Green, Dashed, Line[nodes], Red, Point[f[[5, 1]]], PointSize[Large], Point[nodes]}, PlotRange -> {{-5.1, 5.1}, {0, 5.1}}, PlotRangeClipping -> False]
Out[32]=

Construct a parametric function from the intermediate points only (the original nodes will not be included):

In[33]:=
f = ResourceFunction["CurveToBSplineFunction"][nodes, 3, scale, "DuplicateNodes" -> 0];
ParametricPlot[f[t], {t, 0, 1}, Epilog -> {Green, Dashed, Line[f[[5, 1]]], Red, Point[f[[5, 1]]]}, PlotRange -> {{-5.1, 5.1}, {0, 5.1}}, PlotRangeClipping -> False]
Out[34]=

Applications (7) 

Look at some jagged contours:

In[35]:=
img = Blur[
   Rasterize[
    Graphics[{Red, Rectangle[], Blue, Annulus[], Green, Triangle[{{-1, -1}, {0, -1}, {-1, 1}}]}, PlotRangePadding -> None], RasterSize -> 200], 5];
contours = Flatten[ComponentMeasurements[ClusteringComponents[img, 4], "Contours"][[2 ;;, 2]], 1];
Graphics[MapIndexed[{Thick, Opacity[.8], ColorData[97][#2[[1]]], #} &,
   contours]]
Out[37]=

Parametrize the contours and plot them:

In[38]:=
functs = ResourceFunction["CurveToBSplineFunction"][#, 90, "CurveClosed" -> True][\[FormalT]] & @@@ contours;
ParametricPlot[functs, {\[FormalT], 0, 1}, Axes -> False, PlotStyle -> {{Thick, Opacity[.8]}}]
Out[39]=

With automatic node duplication, the sharp features are preserved:

In[40]:=
functs = ResourceFunction["CurveToBSplineFunction"][#, 90, "CurveClosed" -> True,
      "DuplicateNodes" -> Automatic][\[FormalT]] & @@@ contours;
ParametricPlot[functs, {\[FormalT], 0, 1}, Axes -> False]
Out[41]=

Provide a custom node duplication function in order to preserve only the features you are interested in:

In[42]:=
functs = ResourceFunction["CurveToBSplineFunction"][#, 90, "CurveClosed" -> True,
      "DuplicateNodes" -> (If[Max[#2] > 40 && #3 <= \[Pi]/2, 9, 1] &)][\[FormalT]] & @@@ contours;
ParametricPlot[functs, {\[FormalT], 0, 1}, Frame -> True]
Out[43]=

Automatic weights are trying to preserve only significant sharp features:

In[44]:=
functs = ResourceFunction["CurveToBSplineFunction"][#, 60,
      "CurveClosed" -> True, "AssignWeights" -> Automatic][\[FormalT]] & @@@ contours;
ParametricPlot[functs, {\[FormalT], 0, 1}, Axes -> False]
Out[45]=

Increasing the scale flattens out the features:

In[46]:=
functs = ResourceFunction["CurveToBSplineFunction"][#, 40, 10,
      "CurveClosed" -> True, "AssignWeights" -> Automatic][\[FormalT]] & @@@ contours;
ParametricPlot[functs, {\[FormalT], 0, 1}, Axes -> False]
Out[47]=

Make some features in a particular region stronger by duplicating the corresponding control points:

In[48]:=
region = Polygon[{{50, 160}, {200, 214}, {250, 130}, {100, 70}}];
mf = RegionMember[region];
functs = ResourceFunction["CurveToBSplineFunction"][#, 40, 10, "CurveClosed" -> True, "AssignWeights" -> Automatic,
      "DuplicateNodes" -> (If[mf[#1] && Max[#2] > 20, 8, 1] &)][\[FormalT]] & @@@ contours;
ParametricPlot[functs, {\[FormalT], 0, 1}, Frame -> True, Prolog -> {FaceForm[LightGray], EdgeForm[{Gray, Dashed}], region}]
Out[51]=

Properties and Relations (1) 

Compare the areas of an exact region, its discretized version obtained through Rasterize and a smoothed version of the latter obtained via CurveToBSplineFunction:

In[52]:=
(* Original exact region *)
\[ScriptCapitalR] = DiskSegment[{110, 110}, 100, {0, 3 Pi/2}];
gr = Graphics[{Lighter@Green, \[ScriptCapitalR]}, PlotRange -> {{0, 220}, {0, 220}}, PlotRangePadding -> None];
img = Rasterize[gr, RasterSize -> {220, 220}];
(* Drop the background component 1, take the contour of the shape *)

contour = ComponentMeasurements[ClusteringComponents[img, 2], "Contours"][[2, 2, 1]];
(* Discretized region with jaggies obtained through Rasterize *)
\[ScriptCapitalR]R = Polygon@First[contour];
(* Parametrize the contour *)

fun = ResourceFunction["CurveToBSplineFunction"][First[contour], 190, "CurveClosed" -> True, "AssignWeights" -> Automatic, "DuplicateNodes" -> (If[Max[#2] > 30, 9, 1] &)];
(* Plot the function with high resolution: we will extract the result of plotting for comparison with NIntegrate *)

plot = ParametricPlot[fun[t], {t, 0, 1}, PlotStyle -> Red, PlotPoints -> 1000, MaxRecursion -> 5];
(* Extract from the plot smoothed version of discretized region \[ScriptCapitalR]2, without jaggies *)
\[ScriptCapitalR]RS = BoundaryDiscretizeGraphics[plot];
(* Calculate the areas *)
Grid[{{"Area of the shape", SpanFromLeft}, {"Exact", "After Rasterize", "From plot", "From NIntegrate"},
  {N@Area[\[ScriptCapitalR]], Area[\[ScriptCapitalR]R], Area[\[ScriptCapitalR]RS], Abs@NIntegrate[
     Indexed[fun[t], 2] Indexed[D[fun[t], t], 1], {t, 0, 1}]}}, Frame -> All, FrameStyle -> Gray]
(* Visually compare the regions (background is added for better contrast) *)
Grid[{{"\[ScriptCapitalR]RS against \[ScriptCapitalR]R", "\[ScriptCapitalR]R against \[ScriptCapitalR]", "\[ScriptCapitalR]RS against \[ScriptCapitalR]"}, {Show[
    Graphics[{AbsoluteThickness[5], Blue, contour}], plot, ImageSize -> 360, Background -> Gray], Show[gr, Graphics[{AbsoluteThickness[5], Blue, Opacity[.5], contour}], ImageSize -> 360, Background -> Gray], Show[gr, plot, ImageSize -> 360, Background -> Gray]}}]
Out[53]=
Out[54]=

Possible Issues (2) 

The default scaling factor of 1 may be insufficient to reproduce essential features of the shape:

In[55]:=
SeedRandom[260];
nodes = RandomPolygon[50][[1]];
funct = ResourceFunction["CurveToBSplineFunction"][nodes, 2, "CurveClosed" -> True][\[FormalT]];
Show[Graphics[{LightGray, Polygon[nodes]}, Frame -> True], ParametricPlot[funct, {\[FormalT], 0, 1}]]
Out[56]=

Decrease the scaling factor in order to reproduce the shape more closely:

In[57]:=
funct = ResourceFunction["CurveToBSplineFunction"][nodes, 2, 0.04, "CurveClosed" -> True][\[FormalT]];
Show[Graphics[{LightGray, Polygon[nodes]}, Frame -> True], ParametricPlot[funct, {\[FormalT], 0, 1}]]
Out[58]=

Without additional intermediate control points, significant sharp features may be lost:

In[59]:=
SeedRandom[1];
nodes = 100 RandomPolygon[17][[1]];
opts = {"FillGaps" -> False, "FillGaps" -> True};
functs = ResourceFunction["CurveToBSplineFunction"][nodes, 12, #, "CurveClosed" -> True][\[FormalT]] & /@ opts;
Show[Graphics[{LightGray, Polygon[nodes]}, Frame -> True],
 ParametricPlot[functs, {\[FormalT], 0, 1},
  PlotLegends -> (Style[StandardForm@#, "Input", "Notebook", ShowSyntaxStyles -> True] & /@ opts)]]
Out[59]=

Neat Examples (2) 

Create a parametric function from a discretized implicit region:

In[60]:=
\[ScriptCapitalR] = ImplicitRegion[
   0 < x < 1 && y < Cos[x] && y < Tan[x] && y > Sin[x], {x, y}];
\[ScriptCapitalR]D = BoundaryDiscretizeRegion[\[ScriptCapitalR], MaxCellMeasure -> .1];
nodes = Extract[MeshCoordinates[\[ScriptCapitalR]D], List /@ MeshCells[\[ScriptCapitalR]D, 2][[1, 1]]];
fun = ResourceFunction["CurveToBSplineFunction"][nodes, 2,
  "FillGaps" -> False, "DuplicateNodes" -> (If[#3 < \[Pi]/2, 3, 2] &),
   "CurveClosed" -> True]
Show[RegionPlot[\[ScriptCapitalR]], ParametricPlot[fun[t], {t, 0, 1}, PlotStyle -> Green], Epilog -> {Red, Point[nodes]}]
Out[61]=
Out[62]=

Compare the areas of the exact region, its discretized version obtained through BoundaryDiscretizeRegion and a smoothed version of the latter obtained via CurveToBSplineFunction:

In[63]:=
Grid[{{"Area of the shape", SpanFromLeft}, {"Exact", "After BoundaryDiscretizeRegion", "From NIntegrate"},
  Abs@{N@Area[\[ScriptCapitalR]], Area[\[ScriptCapitalR]D], NIntegrate[Indexed[fun[t], 2] Indexed[D[fun[t], t], 1], {t, 0, 1},
      Method -> "LocalAdaptive"]}}, Frame -> All, FrameStyle -> Gray]
Out[63]=

Publisher

AlexeyPopkov

Version History

  • 1.0.2 – 28 October 2021

Related Resources

License Information