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