2
$\begingroup$

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.

$\endgroup$

closed as unclear what you're asking by MarcoB, dr.blochwave, xyz, ubpdqn, Öskå Jul 17 '15 at 18:10

Please clarify your specific problem or add additional details to highlight exactly what you need. As it's currently written, it’s hard to tell exactly what you're asking. See the How to Ask page for help clarifying this question. If this question can be reworded to fit the rules in the help center, please edit the question.

  • $\begingroup$ What are/is the "value (top and bottom displacement - actually the difference)"? $\endgroup$ – Dr. belisarius Jul 13 '15 at 11:32
  • $\begingroup$ So you actually have two Bézier curves in there? $\endgroup$ – J. M. is away Jul 13 '15 at 11:32
  • $\begingroup$ @belisarius: Difference of y coordinate of the intersection points of the two Bezier curves at a given x. $\endgroup$ – skrat Jul 13 '15 at 11:36
  • $\begingroup$ @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). $\endgroup$ – skrat Jul 13 '15 at 11:38
  • $\begingroup$ 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. $\endgroup$ – J. M. is away Jul 13 '15 at 11:47
3
$\begingroup$

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]

Mathematica graphics

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}}  *)
$\endgroup$
  • $\begingroup$ 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? $\endgroup$ – skrat Jul 23 '15 at 13:23
  • $\begingroup$ @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.) $\endgroup$ – Michael E2 Jul 23 '15 at 23:24
  • $\begingroup$ Hmm, I am using 10.0.0.0. $\endgroup$ – skrat Jul 24 '15 at 5:52
  • 1
    $\begingroup$ @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]]}]. $\endgroup$ – Michael E2 Jul 24 '15 at 12:38
  • 1
    $\begingroup$ @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]]. $\endgroup$ – Michael E2 Jul 24 '15 at 13:12
1
$\begingroup$

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]]

curves

$\endgroup$

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