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: [mg132201] Re: Elasticity functions for Bezier and rectangular forms
  • From: "E. Martin-Serrano" <eMartinSerrano at telefonica.net>
  • Date: Wed, 15 Jan 2014 04:17:17 -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> <20140111073611.A5E3369F4@smc.vnet.net>

Bob,

In fact, your solution works perfectly with the initial 'Solve' code.

Probably it did not work because I had copied and pasted the code directly
from your email.

I tried the code with several fresh notebooks and kernels but always using
the initial pasted code (maybe it contained some invisible characters for
both, The Mathematica frontend and Outlook). After the attempts with the
copied and pasted code, I tried it hand typing and the solution worked fine.

Many thanks again.

E. Martin-Serrano..

-----Mensaje original-----
De: Bob Hanlon [mailto:hanlonr357 at gmail.com]
Enviado el: s=E1bado, 11 de enero de 2014 8:36
Para: mathgroup at smc.vnet.net
Asunto: Re: Elasticity functions for Bezier and rectangular forms


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 -> 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: Simple question
  • Next by Date: Re: Simple question
  • Previous by thread: Re: Elasticity functions for Bezier and rectangular forms
  • Next by thread: Re: Elasticity functions for Bezier and rectangular forms