       Re: What do I do to get better curves?

• To: mathgroup at smc.vnet.net
• Subject: [mg120991] Re: What do I do to get better curves?
• From: Dana DeLouis <dana.del at gmail.com>
• Date: Sat, 20 Aug 2011 06:18:43 -0400 (EDT)
• Delivered-to: l-mathgroup@mail-archive0.wolfram.com

```How about a brute-force method?
This idea moves across the k's, and scans for w's using FindRoot.
It removes the small Imaginary 0s using Chop, and removes very close numerical duplicates.
This limited the area to 10 by 10.
There's probably a better graph method than ListPlot.

f[k_, w_] := 4*k^2*Sqrt[w^2 - k^2]*
Sqrt[w^2/r^2 - k^2]*
Sin[Sqrt[w^2 - k^2]]*
Cos[Sqrt[w^2/r^2 - k^2]] +
(k^2 - w^2)^2*Cos[Sqrt[w^2 - k^2]]*
Sin[Sqrt[w^2/r^2 - k^2]]

FindWs[k_]:=Module[{t},
t=Quiet[Table[FindRoot[f[k,w]==0,{w,j}],{j,0,10,1/5}]];
t=Union[Chop[t]]  [[All,1,-1]];
t=DeleteDuplicates[t,Equal];
t=Select[t,NonNegative];
t=Select[t,#<=10&];
SortBy[Map[List[k,#]&,t],Last]
]

r=6197/3122;

m=Table[FindWs[k],{k,0,10,1/5}];

ListPlot[m]

= = = = = = = = = = =
HTH
Dana DeLouis
\$Version
8.0 for Mac OS X x86 (64-bit) (November 6, 2010)

On Aug 17, 5:55 am, "becko" <becko... at hotmail.com> wrote:
> Run the following code in mathematica:
>
> r=6197/3122;
> p[k_,w_]:=Sqrt[w^2/r^2-k^2];q[k_,w_]:=Sqrt[w^2-k^2];
> a[k_,w_,p_,q_]:=(k^2-w^2)^2 Sin[p]Cos[q]+4k^2 p q Cos[p]Sin[q]
> a[k_,w_]:=a[k,w,p[k,w],q[k,w]];
> ContourPlot[a[k,w]==0,{w,0,6},{k,0,14}]
>
> The curves thus obtained are very inaccurate. I tried raising the
> PlotPoints and WorkingPrecision opions of ContourPlot, but it doesn't
> work. Morevoer, you see that the only parameter that shows up, 'r', is
> an exact rational number. I don't know what else to try. Thanks.

```

• Prev by Date: Re: SameQ to check for simplified radical expressions... doesn't work
• Next by Date: Getting 3d printable models out of 3d graphics in Mathematica
• Previous by thread: Re: What do I do to get better curves?
• Next by thread: setting header options in another nb with code