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.