Re: Elasticity functions for Bezier and rectangular
- To: mathgroup at smc.vnet.net
- Subject: [mg132188] Re: Elasticity functions for Bezier and rectangular
- From: Tomas Garza <tgarza10 at msn.com>
- Date: Sun, 12 Jan 2014 02:33:03 -0500 (EST)
- Delivered-to: l-mathgroup@mail-archive0.wolfram.com
- Delivered-to: l-mathgroup@wolfram.com
- Delivered-to: mathgroup-outx@smc.vnet.net
- Delivered-to: mathgroup-newsendx@smc.vnet.net
- References:
Yes, Emilio, Bob's right.I copied and pasted his code from the email and it ran without a hitch.I;m on a MacBook Pro with OS Mavericks and Mathematica version 9.0.1.0
-Tomas
> From: hanlonr357 at gmail.com
> Subject: Re: Elasticity functions for Bezier and rectangular forms
> To: mathgroup at smc.vnet.net
> Date: Sat, 11 Jan 2014 02:36:11 -0500
>
>
> Either it is a version issue or you need to start with a fresh kernel.
>
>
> $Version
>
>
> "9.0 for Mac OS X x86 (64-bit) (January 24, 2013)"
>
>
> pts = {p[0], p[1], p[2], p[3]} =
> Rationalize[{{0, .65}, {1.8, 2.6}, {4, 2.5}, {4, 5}}];
>
>
> n = Length[pts] - 1;
>
>
> bcurve = Sum[Binomial[n, k]*(1 - t)^(n - k)*t^k p[k], {k, 0, n}] //
> Simplify;
>
>
> Solve[{x == bcurve[[1]], 0 <= x <= 4}, t]
>
>
> {{t -> ConditionalExpression[
> Root[5*x - 27*#1 -
> 6*#1^2 + 13*#1^3 & ,
> 1], 0 < x < 4]},
> {t -> ConditionalExpression[
> Root[5*x - 27*#1 -
> 6*#1^2 + 13*#1^3 & ,
> 2], 0 < x < 4]},
> {t -> ConditionalExpression[
> Root[5*x - 27*#1 -
> 6*#1^2 + 13*#1^3 & ,
> 3], 0 < x < 4]}}
>
>
> First /@ (bcurve[[2]] /. %)
>
>
> {(1/20)*(13 + 117*
> Root[5*x - 27*#1 -
> 6*#1^2 + 13*#1^3 & ,
> 1] - 123*
> Root[5*x - 27*#1 -
> 6*#1^2 + 13*#1^3 & ,
> 1]^2 +
> 93*Root[5*x - 27*#1 -
> 6*#1^2 + 13*#1^3 & ,
> 1]^3), (1/20)*
> (13 + 117*Root[
> 5*x - 27*#1 - 6*#1^2 +
> 13*#1^3 & , 2] -
> 123*Root[5*x - 27*#1 -
> 6*#1^2 + 13*#1^3 & ,
> 2]^2 +
> 93*Root[5*x - 27*#1 -
> 6*#1^2 + 13*#1^3 & ,
> 2]^3), (1/20)*
> (13 + 117*Root[
> 5*x - 27*#1 - 6*#1^2 +
> 13*#1^3 & , 3] -
> 123*Root[5*x - 27*#1 -
> 6*#1^2 + 13*#1^3 & ,
> 3]^2 +
> 93*Root[5*x - 27*#1 -
> 6*#1^2 + 13*#1^3 & ,
> 3]^3)}
>
>
> y1[x_] = Select[%,
> Chop[N[# /. x -> p[0][[1]]]] == p[0][[2]] &&
> Chop[N[# /. x -> p[3][[1]]]] == p[3][[2]] &][[1]]
>
>
> (1/20)*(13 +
> 117*Root[5*x - 27*#1 -
> 6*#1^2 + 13*#1^3 & ,
> 2] - 123*
> Root[5*x - 27*#1 - 6*#1^2 +
> 13*#1^3 & , 2]^2 +
> 93*Root[5*x - 27*#1 -
> 6*#1^2 + 13*#1^3 & , 2]^
> 3)
>
>
> Bob Hanlon
>
>
> On Fri, Jan 10, 2014 at 6:19 PM, E. Martin-Serrano <
> eMartinSerrano at telefonica.net> wrote:
>
> > Hi Bob,
> >
> > Thank you very much for your answer, but I am afraid, I am unable to see
> > how
> > from:
> >
> > Select[
> > First /@ (bcurve[[2]] /.
> > Solve[{x == bcurve[[1]], 0 <= x <= 4}, t]),
> > Chop[N[# /. x -> p[0][[1]]]] == p[0][[2]] &&
> > Chop[N[# /. x -> p[3][[1]]]] == p[3][[2]] &][[1]]
> >
> > We get the roots expression:
> >
> > (1/20)*(13 + 117*Root[5*x - 27*#1 - 6*#1^2 + 13*#1^3 & ,
> > 2] - 123*Root[5*x - 27*#1 - 6*#1^2 + 13*#1^3 & , 2]^2 +
> > 93*Root[5*x - 27*#1 - 6*#1^2 + 13*#1^3 & , 2]^3)
> >
> > Since
> >
> > Solve[{x == bcurve[[1]], 0 <= x <= 4}, t]
> >
> > Yields just the empty list '{}' (no possible solutions), and therefore
> > nothing can be selected.
> >
> > In fact from
> >
> > y1[x_] = Select[
> > First /@ (bcurve[[2]] /.
> > Solve[{x == bcurve[[1]], 0 <= x <= 4}, t]),
> > Chop[N[# /. x -> p[0][[1]]]] == p[0][[2]] &&
> > Chop[N[# /. x -> p[3][[1]]]] == p[3][[2]] &][[1]]
> >
> > the result that I obtain is
> >
> > 1[[1]]
> >
> > The same with the alternative solution expressed with radicals.
> >
> > From this, it is clear that I am missing something fundamental.
> >
> > E. Martin-Serrano
> >
> >
> >
> > -----Mensaje original-----
> > De: Bob Hanlon [mailto:hanlonr357 at gmail.com]
> > Enviado el: viernes, 10 de enero de 2014 8:49
> > Para: mathgroup at smc.vnet.net
> > Asunto: Re: Elasticity functions for Bezier and rectangular
> > forms
> >
> >
> > pts = {p[0], p[1], p[2], p[3]} =
> > Rationalize[{{0, .65}, {1.8, 2.6}, {4, 2.5}, {4, 5}}]=
;
> >
> >
> > n = Length[pts] - 1;
> >
> >
> > bcurve = Sum[Binomial[n, k]*(1 - t)^(n - k)*t^k p[k],
> > {k, 0, n}] // Simplify;
> >
> >
> > Solving for solution expressed as Root objects
> >
> >
> > y1[x_] = Select[
> > First /@ (bcurve[[2]] /.
> > Solve[{x == bcurve[[1]], 0 <= x <= 4}, t]),
> > Chop[N[# /. x -> p[0][[1]]]] == p[0][[2]] &&
> > Chop[N[# /. x -> p[3][[1]]]] == p[3][[2]] &][[1]]
> >
> >
> > (1/20)*(13 + 117*Root[5*x - 27*#1 - 6*#1^2 + 13*#1^3 & ,
> > 2] - 123*Root[5*x - 27*#1 - 6*#1^2 + 13*#1^3 & , 2]^2 +
> > 93*Root[5*x - 27*#1 - 6*#1^2 + 13*#1^3 & , 2]^3)
> >
> >
> >
> > Solving for solution expressed with radicals
> >
> >
> > y2[x_] = Select[(First /@ (bcurve[[2]] /.
> > Solve[{x == bcurve[[1]], 0 <= x <= 4}, t])) //
> > ToRadicals //
> > FullSimplify,
> > Chop[N[# /. x -> p[0][[1]]]] == p[0][[2]] &&
> > Chop[N[# /. x -> p[3][[1]]]] == p[3][[2]] &][[1]]
> >
> >
> > (1/20)*(-((465*x)/13) + (1/4394)*(-245386 +
> > (30482562*(-1)^(1/3)*2^(2/3))/
> > (718 - 845*x + 13*Sqrt[5]*Sqrt[(-4 + x)*
> > (1944 + 845*x)])^(2/3) +
> > (11676984*(-1)^(2/3)*2^(1/3))/
> > (718 - 845*x + 13*Sqrt[5]*Sqrt[(-4 + x)*
> > (1944 + 845*x)])^(1/3) - 48252*(-1)^(1/3)*2^(2/=
3)*
> > (718 - 845*x + 13*Sqrt[5]*Sqrt[(-4 + x)*
> > (1944 + 845*x)])^(1/3) - 1041*(-1)^(2/3)*2^(1/3=
)*
> > (718 - 845*x + 13*Sqrt[5]*Sqrt[(-4 + x)*
> > (1944 + 845*x)])^(2/3)))
> >
> >
> >
> > Note that y2 is a different branch than that obtained by converting y1 =
to
> > radicals (see also plot below)
> >
> >
> > y1r[x_] = y1[x] // ToRadicals // FullSimplify
> >
> >
> > (1/20)*(-((465*x)/13) + (1/4394)*(-245386 -
> > (30482562*(-2)^(2/3))/(718 - 845*x +
> > 13*Sqrt[5]*Sqrt[(-4 + x)*(1944 + 845*x)])^(2/3) -
> > (11676984*(-2)^(1/3))/(718 - 845*x +
> > 13*Sqrt[5]*Sqrt[(-4 + x)*(1944 + 845*x)])^(1/3) +
> > 48252*(-2)^(2/3)*(718 - 845*x + 13*Sqrt[5]*
> > Sqrt[(-4 + x)*(1944 + 845*x)])^(1/3) +
> > 1041*(-2)^(1/3)*(718 - 845*x + 13*Sqrt[5]*
> > Sqrt[(-4 + x)*(1944 + 845*x)])^(2/3)))
> >
> >
> >
> > Expressed as an interpolation function
> >
> >
> > y3 = Interpolation[Table[bcurve, {t, 0, 1, .01}]];
> >
> >
> >
> > Note that y1r is not the proper branch:
> >
> >
> > Grid[
> > {{Graphics[{BezierCurve[pts], Red,
> > AbsolutePointSize[4], Point[pts]},
> > AspectRatio -> 1, Frame -> True, Axes -> False,
> > PlotLabel -> "Bezier Curve"],
> > pp = ParametricPlot[BezierFunction[pts][x],
> > {x, 0, 4}, AspectRatio -> 1, Frame -> True, Axes -> Fals=
e,
> > PlotLabel -> "BezierFunction",
> > Epilog -> {Red, AbsolutePointSize[4], Point[pts]}],
> > ParametricPlot[bcurve, {t, 0, 1},
> > AspectRatio -> 1, Frame -> True, Axes -> False,
> > PlotLabel -> "bcurve",
> > Epilog -> {Red, AbsolutePointSize[4], Point[pts]}]},
> > {Plot[y1[x], {x, 0, 4}, AspectRatio -> 1,
> > Frame -> True, Axes -> False,
> > PlotLabel -> "Root Object (y1)",
> > Epilog -> {Red, AbsolutePointSize[4], Point[pts]}],
> > Plot[y2[x], {x, 0, 4}, AspectRatio -> 1,
> > Frame -> True, Axes -> False,
> > PlotLabel -> "Radicals (y2)",
> > Epilog -> {Red, AbsolutePointSize[4], Point[pts]}],
> > Plot[y3[x], {x, 0, 4}, AspectRatio -> 1,
> > Frame -> True, Axes -> False,
> > PlotLabel -> "Interpolation of bcurve (y3)",
> > Epilog -> {Red, AbsolutePointSize[4], Point[pts]}]},
> > {Plot[y1r[x], {x, 0, 4}, AspectRatio -> 1,
> > PlotStyle -> Red, Frame -> True, Axes -> False,
> > PlotLabel -> "Root converted to Radicals (y1r)"],
> > "", ""}}]
> >
> >
> >
> > Bob Hanlon
> >
> >
> >
> >
> > On Thu, Jan 9, 2014 at 1:50 AM, E. Martin-Serrano <
> > eMartinSerrano at telefonica.net> wrote:
> >
> > >
> > > Hi,
> > >
> > >
> > >
> > > (*I have the Bezier curve*)
> > >
> > >
> > >
> > > pts = {p[0], p[1], p[2], p[3]} = {{0, .65}, {1.8, 2.6=
}, {4, 2.5}, {4,
> > > 5}};
> > >
> > >
> > >
> > > n = Length[pts] - 1;
> > >
> > >
> > >
> > > bcurve = Sum[Binomial[n, i]* (1 - t)^(n - i) *t ^i p[i] , {i=
, 0, n}];
> > >
> > >
> > >
> > > (* the plot range for the resulting Bezier curve is obviously
> > > {p[0][[1]], p[3][[1]} -> {0,4} *)
> > >
> > >
> > >
> > > (*Then, I want to transform the above parametric Bezier curve into =
a
> > > rectangular {x,y} curve one by solving curve[[1]] x= x(t) for t a=
nd
> > > plugging the result t-> x(t) into curve[[2]] or y = y(t).*)
> > >
> > >
> > >
> > > sols= Solve[x == bcurve[[1]], t, Reals],
> > >
> > >
> > >
> > > bcurve[[2]]/.%
> > >
> > >
> > >
> > > yvalues = (% /. x -> #) & /@ Range[0, 4]
> > >
> > >
> > >
> > > (*For testing purposes, by visual inspection I discard directly the
> > > resulting yvalues which overflow the plot range interval {0,4} and
> > > select only those values of y which are members of the interval.*)
> > >
> > >
> > >
> > > #[[2]]&/@yvalues
> > >
> > >
> > >
> > > (*But that done, none of these selected {x,y} points belong to t=
he
> > > actual Bezier curve bcurve yet.*)
> > >
> > >
> > >
> > > (*In other words the apparent direct procedure to convert a parametri=
c
> > > curve into rectangular one does not seem to work here.*)
> > >
> > >
> > >
> > > (*Remark: I need the basic Bezier curve bcurve to be reshapable
> > > (dynamic) and be able to calculate the elasticity point function of
> > > each new resulting function as the Bezier curve bcurve gets reshaped=
,
> > > and for some reason I am not being able of getting directly the
> > > elasticity point function of bcurve = Sum[Binomial[n, i]* (1 - t)=
^(n -
> > > i) *t ^i p[i] , {i, 0, n}]; no problem for any other similar=
(or
> > > approximate) function given in rectangular form*) ;
> > >
> > >
> > >
> > > Any help will be welcome.
> > >
> > >
> > >
> > > E. Martin-Serrano
> > >
> > >
> > >
> > > P.S. For the sake of clarity I have enclosed the text in as in
> > > (*text*) and symbols or experssions within text as in symbol (when
> > > necessary).
> > >
> > >
> > >
> > > __________________________________________
> > >
> > > This e-mail and the documents attached are confidential and intended
> > > solely for the addressee; it may also be privileged. If you receive
> > > this e-mail in error, please notify the sender immediately and dest=
roy
> > > it. As its integrity cannot be secured on the Internet, no sender's
> > > liability can be triggered for the message content. Although the
> > > sender endeavors to maintain a computer virus-free network, he/she
> > > does not warrant that this transmission is virus-free and will not b=
e
> > > liable for any damages resulting from any virus transmitted.
> > >
> > > Este mensaje y los ficheros adjuntos pueden contener informaci=F3n
> > > confidencial destinada solamente a la(s) persona(s) mencionadas
> > > anteriormente y su contenido puede estar protegido por secreto
> > > profesional y en cualquier caso el mensaje en su totalidad est=E1
> > > amparado y protegido por la legislaci=F3n vigente que preserva el
> > > secreto de las comunicaciones, y por la legislaci=F3n de protecci=
=F3n
> > > de datos de car=E1cter personal. Si usted recibe este correo
> > > electr=F3nico por error, gracias por informar inmediatamente al
> > > remitente y destruir el mensaje. Al no estar asegurada la integridad
> > > de este mensaje sobre la red, el remitente no se hace responsable p=
or
> > > su contenido.
> > > Su contenido no constituye ning=FAn compromiso para el remitente=
,
> > > salvo ratificaci=F3n escrita por ambas partes. Aunque se esfuerza =
al
> > > m=E1ximo por mantener su red libre de virus, el emisor no puede
> > > garantizar nada al respecto y no ser=E1 responsable de cualesquiera
> > > da=F1os que puedan resultar de una transmisi=F3n de virus.
> > >
> > >
> >
> >
> >
> >
>
=