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. > > > > > > > >
- References:
- Elasticity functions for Bezier and rectangular forms
- From: "E. Martin-Serrano" <eMartinSerrano@telefonica.net>
- Re: Elasticity functions for Bezier and rectangular forms
- From: Bob Hanlon <hanlonr357@gmail.com>
- Elasticity functions for Bezier and rectangular forms