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: [mg132180] Re: Elasticity functions for Bezier and rectangular forms
  • From: "E. Martin-Serrano" <eMartinSerrano at telefonica.net>
  • Date: Sat, 11 Jan 2014 02:35:51 -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> <20140110074832.DE1A969D4@smc.vnet.net>

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: Compact formulation of array of constraints
  • Next by Date: Re: Elasticity functions for Bezier and rectangular forms
  • Previous by thread: Re: Elasticity functions for Bezier and rectangular forms
  • Next by thread: Re: Elasticity functions for Bezier and rectangular forms