Drexel dragonThe Math ForumDonate to the Math Forum



Search All of the Math Forum:

Views expressed in these public forums are not endorsed by Drexel University or The Math Forum.


Math Forum » Discussions » Software » comp.soft-sys.math.mathematica

Topic: Re: Elasticity functions for Bezier and rectangular
Replies: 0  

Advanced Search

Back to Topic List Back to Topic List  
Tomas Garza Hernandez

Posts: 264
Registered: 4/15/05
Re: Elasticity functions for Bezier and rectangular
Posted: Jan 12, 2014 2:12 AM
  Click to see the message monospaced in plain text Plain Text   Click to reply to this topic Reply


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@gmail.com
> Subject: Re: Elasticity functions for Bezier and rectangular forms
> To: mathgroup@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@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@gmail.com]
> > Enviado el: viernes, 10 de enero de 2014 8:49
> > Para: mathgroup@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@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.
> > >
> > >

> >
> >
> >
> >

>
=





Point your RSS reader here for a feed of the latest messages in this topic.

[Privacy Policy] [Terms of Use]

© Drexel University 1994-2014. All Rights Reserved.
The Math Forum is a research and educational enterprise of the Drexel University School of Education.