Re: Re: Attempt to generalize a constant
- To: mathgroup at smc.vnet.net
- Subject: [mg57938] Re: [mg57906] Re: Attempt to generalize a constant
- From: Pratik Desai <pdesai1 at umbc.edu>
- Date: Mon, 13 Jun 2005 05:50:57 -0400 (EDT)
- References: <d7rk50$bl7$1@smc.vnet.net> <200506120834.EAA20458@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
Narasimham wrote: >Thanks Bob, Pratik and Wouter Meeussen. Wouter sent me a private email >and opines (hope it is ok to state it here,) that as z increases from >.5 to .999, the ImplicitPlot finds a string of small islands along the >crest of the ridges. The >numerics approach z=1 but rounding errors will obfuscate the nice >mathematical ( top ridge) line. > >This has since been partially obtained in FindRoot/ListPlot. > ><< Graphics`ParametricPlot3D`; ><< Graphics`ImplicitPlot`; >F[t_, mu_] := mu*JacobiSN[t, mu^2]; >Jaco = ParametricPlot3D[{mu, t, F[t, mu]}, {mu, 1, 3, .1}, {t, Pi/6, >2Pi, Pi/12}, AspectRatio -> Automatic] ; >Plane = Plot3D[.95, {mu, 1, 3}, {t, Pi/6, 2Pi}] ; >Show[Jaco, Plane] ; > >data = Table[{mu /. FindRoot[F[t, mu] == 1, {mu, 1, 3}, MaxIterations >-> 100], t}, {t, Pi/6, 2Pi, Pi/96}]; >ListPlot[data, Frame -> True, Axes -> False, PlotJoined -> True, >PlotRange -> {{0.95, 3.15}, Automatic}, Epilog -> >{AbsolutePointSize[4], Red, Point /@ Select[data, IntegerQ[6*#[[2]]/Pi] >&]}, PlotStyle -> Blue, ImageSize -> 360]; > >" (* In a simpler example, y is a variable, x1 was a known constant at >the outset/beginning in parabolic relation, before being variablized or >generalized to x, x1-> x ; It generalizes parabola to an ellipse while >including a second parameter *)" > >G[x1_, y_] = x1^2 + x1* y + y^2 ; >Plot3D[G[x1, y], {y, -1.2, 1.2}, {x1, -1.2, 1.2}]; >Impl = ImplicitPlot[G[x, y] == 1 , {x, -1.2, 1.2}, {y, -1.2, >1.2},AspectRatio -> Automatic]; >dat = Table[{y /. >FindRoot[G[x1, y] == 1, {y, -1.2, 1.2}, MaxIterations -> 100],x1}, {x1, >-1.2, 1.2, .1}]; >LP = ListPlot[dat, Frame -> True, Axes -> False, PlotJoined -> True, >PlotRange -> {{-1.2, 1.2}, Automatic}, Epilog -> {AbsolutePointSize[4], >Red,Point /@ Select[data, IntegerQ[6*#[[2]]/Pi] &]}, PlotStyle -> Blue, >ImageSize -> 360]; Show[Impl, LP]; > >(* Intersection of above Jacobi function and flat plane z = > 1 intersection curves look like hyperbolae mu * t = constant. By >assembling ListPlot roots obtained from FindRoot either in the given >known ellipse case or in JacobiSN case we do not capture all of the >possible function points. Is the problem due to convergence? >branching? seed value location? -- Implicit Plot / Contour Plot was >expected to capture ALL the roots! *) > > > As far as I can understand from your plots, the matter of capturing all the zeros boils down to the step size of your iterator in your Table construct. Note that JacobiSN is a NumericFunction as defined in mathematica. Then it is a question of fitting a curve through your data set. Hence the more refined your step sizes the more zeros you get and on several of your curves. I think Impicitplot uses solve and you don't have control over the accuracy of the numerics. Tinkering around I get the following plot using two different step sizes and multipleplot. I don't know if it is quite what you are looking for, but it was fun doing it :-) Clear[F, t, m, sol1, m1, m2,data1,data2] n = 3 a = 10 sol1 = Table[First[SetAccuracy[FindRoot[m*JacobiSN[u, m^2] == 100/100, { m, 1, Sqrt[ 3]}, MaxIterations -> 100], a]], {u, SetAccuracy[Pi, a]/6, \ 2*SetAccuracy[Pi, a], SetAccuracy[Pi, a]/(n*24)}]; sol2 = Table[First[SetAccuracy[FindRoot[m*JacobiSN[u, m^2] == 99/100, {m, 2, 3}, MaxIterations -> 100], a]], {u, SetAccuracy[Pi, a]/6, 2* SetAccuracy[Pi, a], SetAccuracy[Pi, a]/(n*6)}]; l = Length[sol1]; l1 = Length[sol2]; m1 = Range[Pi/6, 2*Pi, Pi/(n*24)] // N; m2 = Range[Pi/6, 2*Pi, Pi/(n*6)] // N; data1 = Table[{m /. sol1[[s]], m1[[s]]}, {s, 1, l}] // Chop; data2 = Table[{m /. sol2[[s]], m2[[s]]}, {s, 1, l1}] // Chop; << Graphics`MultipleListPlot` MultipleListPlot[data1, data2, PlotJoined -> True] Best regards Pratik -- Pratik Desai Graduate Student UMBC Department of Mechanical Engineering Phone: 410 455 8134
- References:
- Re: Attempt to generalize a constant
- From: "Narasimham" <mathma18@hotmail.com>
- Re: Attempt to generalize a constant