Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2014

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Elasticity functions for Bezier and rectangular forms

  • To: mathgroup at smc.vnet.net
  • Subject: [mg132189] Re: Elasticity functions for Bezier and rectangular forms
  • From: Bob Hanlon <hanlonr357 at gmail.com>
  • Date: Sun, 12 Jan 2014 02:33:23 -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: <20140109065010.D66676A08@smc.vnet.net>

The Root object solution can be obtained with either Mathematica v7 or v8
using Reduce rather than Solve. I haven't kept any versions of
Mathematica versions older than 7.


$Version


7.0 for Mac OS X x86 (64-bit) (February 19, 2009)


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;


y1[x_]=bcurve[[2]]/.{Assuming[{0<=x<=4},

      Reduce[{x==bcurve[[1]],0<=x<=4,0<=t<=1},t]//

       Simplify]//ToRules}[[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)


y3=Interpolation[Table[bcurve,{t,0,1,.01}]];


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->False,

     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[y3[x],{x,0,4},AspectRatio->1,

    Frame->True,Axes->False,

    PlotLabel->"Interpolation of bcurve (y3)",

    Epilog->{Red,AbsolutePointSize[4],Point[pts]}]}}]



Bob Hanlon




On Sat, Jan 11, 2014 at 2:35 AM, 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 -> False,
>      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 and
> > 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 the
> > actual Bezier curve bcurve yet.*)
> >
> >
> >
> > (*In other words the apparent direct procedure to convert a parametric
> > 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 destroy
> > 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 be
> > 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 por
> > 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.
> >
> >
>
>
>
>
>




  • Prev by Date: Re: Elasticity functions for Bezier and rectangular
  • Next by Date: Re: Questions Regarding Mathematica Kernel Supplied With rPi
  • Previous by thread: Re: Elasticity functions for Bezier and rectangular forms
  • Next by thread: Mathematia and (NAIF)-Spice?