# Re-parameterizing sections of a Bézier curve into normal Cartesian functions [closed]

I have a table:

    {{0., 0., 0.}, {0.002, 0.08942, -0.08942}, {0.008,
0.233889, -0.178706}, {0.018, 0.366918, -0.267724}, {0.031,
0.496136, -0.350769}, {0.049, 0.639568, -0.439999}, {0.07,
0.779356, -0.5245}, {0.095, 0.922931, -0.609077}, {0.124,
1.06945, -0.693271}, {0.156, 1.21404, -0.77438}, {0.191,
1.35745, -0.852947}, {0.229, 1.50013, -0.929279}, {0.271,
1.64566, -1.00987}}


where first column is the x axis, second column is top displacement and third column is bottom displacement. Using this table I can draw a BezierCurve. Now what I would need is value (top and bottom displacement - actually the difference) at given value x.

For example I want to know f(x=0.08) for top and bottom displacement which is a Bézier curve.

I have thought about how to do this. And one idea is of course find the two intersection points of a Bézier curve and vertical line at given x. OR I wanted to multiply the Bézier curve with KroneckerDelta, assuming it would return me the right value, but it doesn't work as I had imagined.

So, any ideas are highly appreciated.

EDIT: Here is the code:

data = {{0., 0., 0.}, {0.002, 0.08942, -0.08942}, {0.008,
0.233889, -0.178706}, {0.018, 0.366918, -0.267724}, {0.031,
0.496136, -0.350769}, {0.049, 0.639568, -0.439999}, {0.07,
0.779356, -0.5245}, {0.095, 0.922931, -0.609077}, {0.124,
1.06945, -0.693271}, {0.156, 1.21404, -0.77438}, {0.191,
1.35745, -0.852947}, {0.229, 1.50013, -0.929279}, {0.271,
1.64566, -1.00987}, {0.315, 1.78733, -1.08524}, {0.363,
1.93174, -1.16256}, {0.412, 2.0702, -1.23705}, {0.464,
2.20889, -1.31193}, {0.518, 2.3453, -1.38579}, {0.574,
2.47975, -1.45874}, {0.632, 2.6125, -1.53086}, {0.691,
2.74158, -1.60107}, {0.751, 2.86742, -1.66957}, {0.813,
2.99234, -1.73757}}
Graphics[BezierCurve[{Transpose[{data[[All, 1]], data[[All, 3]]}],
Transpose[{data[[All, 1]], data[[All, 2]]}]}], Axes -> True]


I assume this answers all the questions about what the input data means. Now to explain what I want. Let's consider the last two elements in the table

{0.751, 2.86742, -1.66957}


and

{0.813,  2.99234, -1.73757}


What I want is the y value that Bézier curve takes IF 0.715 < x <0.813 . For both - top and bottom Bézier Curve. I hope this makes things a bit more clear. And of course I picked this range randomly - I want this to work for any x.

• What are/is the "value (top and bottom displacement - actually the difference)"? Commented Jul 13, 2015 at 11:32
• So you actually have two Bézier curves in there? Commented Jul 13, 2015 at 11:32
• @belisarius: Difference of y coordinate of the intersection points of the two Bezier curves at a given x. Commented Jul 13, 2015 at 11:36
• @Guess who it is.: Two curves yes. One at the bottom (negative y if you wish) and one at the top (positive y, as seen from the table). Commented Jul 13, 2015 at 11:38
• Bézier curves take control points as input, so they won't pass through the points you've given. Rather, your points will be the convex hull of the resulting curves. Commented Jul 13, 2015 at 11:47

You can use bezier from my answer to How to know form of plotted Bézier function to get the formulas:

bezier[pts_List] :=
With[{n = Length[pts] - 1},
Evaluate@ Sum[Binomial[n, i] (1 - #)^(n - i) #^i pts[[i + 1]], {i, 0, n}] &]


Following the explanation in the linked answer, we can solve the equation bezier[pp][t] == {x, y} for y in terms of x as follows:

yfn[pts_] := Piecewise[
Function[pp,
Select[
y /. N@ Solve[
Rationalize[bezier[pp][t] == {x, y} && pp[[1, 1]] <= x <= pp[[-1, 1]], 0],
{y}, {t}, Reals, Method -> Reduce] /.
Less -> LessEqual // Expand,
Chop[# - pp[[1, 2]] /. x -> pp[[1, 1]]] == 0 &] /.
ConditionalExpression -> Sequence] /@
(If[Length@ Last@ # == 1, Most@ #, #] &@ Partition[pts, 4, 3, 1, {}]),
Indeterminate]


(I used Rationalize and N, because that's what Solve would do, except Solve would issue warning messages about it.)

{y1, y2} = yfn /@ {Transpose[{data[[All, 1]], data[[All, 3]]}],
Transpose[{data[[All, 1]], data[[All, 2]]}]};


(The equations are somewhat long and complicated, as you might expect from plugging in the solution to a cubic polynomial into another cubic polynomial.)

Plot[{y1, y2}, {x, 0, Max@data[[All, 1]]}, Exclusions -> None]


Update notice: The original code for yfn had two weaknesses. (1) Equal on approximate numeric data sometimes returns False for numbers close to zero which differ only because of round-off error. Chop was added to address this. (It has a tolerance that can be adjusted depending on the magnitudes of the numbers in the data.) (2) The Partition call on a list of length $3n+1$ results in a singleton list at the end that should be deleted. For example,

Partition[Range[7], 4, 3, 1, {}]
(*  {{1, 2, 3, 4}, {4, 5, 6, 7}, {7}}  *)

• I am trying to work with your code. But, somehow it doesn't work and since this is way beyond my knowledge of mathematica, I have to admit that I don't understand why. Here is my printscreen also one more question, what is pp supposed to be? Commented Jul 23, 2015 at 13:23
• @skrat pp is the argument of Function. it represents each group of four points created by Partition (points 1,2,3,4, then 4,5,6,7, then 7,8,9,10, and so forth). What version of Mathematica are you using? I suspect that Solve is returning results in a different form than mine. (I checked: the above code and it works for me on V10.1.) Commented Jul 23, 2015 at 23:24
• Hmm, I am using 10.0.0.0. Commented Jul 24, 2015 at 5:52
• @skrat See if it works now. It's a little slow to solve 1000 cubic equations. I don't see an easy way around it, if you want exact solutions. For a quick approximation, you could just interpolate: y1 = Interpolation@Transpose[{data[[All, 1]], data[[All, 3]]}]; y2 = Interpolation@Transpose[{data[[All, 1]], data[[All, 2]]}]. Commented Jul 24, 2015 at 12:38
• @skrat Piecewise constructs an expression that is not a function. So you have to evaluate it with N[y1 /. x -> 60] or Block[{x = 60}, N[y1]]. Commented Jul 24, 2015 at 13:12

### Edit

Based on the latest info from the OP, I offer up the following way to derive a Cartesian function from a suitable Bezier curve using BezierFunction.

ctrlPts = {
{0., 0., 0.}, {0.002, 0.08942, -0.08942}, {0.008, 0.233889, -0.178706},
{0.018, 0.366918, -0.267724}, {0.031, 0.496136, -0.350769},
{0.049, 0.639568, -0.439999}, {0.07, 0.779356, -0.5245},
{0.095, 0.922931, -0.609077}, {0.124, 1.06945, -0.693271},
{0.156, 1.21404, -0.77438}, {0.191, 1.35745, -0.852947},
{0.229, 1.50013, -0.929279}, {0.271, 1.64566, -1.00987}
};

topCtrlPts = ctrlPts[[All, {1, 2}]];
btmCtrlPts = ctrlPts[[All, {1, 3}]];
topBPts = Table[BezierFunction[topCtrlPts][s], {s, 0., 1., .01}];
btmBPts = Table[BezierFunction[btmCtrlPts][s], {s, 0., 1., .01}];
topF = Interpolation[topBPts];
btmF = Interpolation[btmBPts];

With[{domain = {x, Sequence @@ (topF["Domain"][[1]])}},
Plot[{topF[x], btmF[x]}, domain]]