如何在Mathematica中获得精确的绘图曲线？

在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-q^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}]

这给了我非常不准确的曲线：

我已尝试将

ContourPlot

的

PlotPoints

和

WorkingPrecision

选项分别设置为30和20，但均无效。您还将注意到，唯一的数值参数，

r

，是一个精确的有理数。我不知道还能尝试什么。谢谢

编辑：我希望得到的曲线是下图中的三条黑色曲线（标记为A1、A2和A3）

---

函数在显示的等高线区域中给出复数。这就是你所期望的吗？您可以在此处看到真实的区域：

ContourPlot[a[k, w], {w, 0, 6}, {k, 0, 14}]

如果我使用以下方法，我会在某些方面更接近你的台词：

ContourPlot[a[w, k] == 0, {w, 0, 6}, {k, 0, 14}]

有可能是转录错误吗

---

（如果没有帮助，我很抱歉。）

p

ans

q

只有在

w^2-k^2

和

w^2/r^2-k^2

都是非负的情况下才是实值<代码>w^2/r^2-k^2仅在绘图区域的以下区域中为非负：

---

因此，

ContourPlot

将切断所有其他内容。也许你需要对方程做一些修正（你只需要真实的部分？大小？）我不相信Mathematica给你的曲线是非常不准确的。否则，如果增加

PlotPoints

和

MaxRecursion

（例如，增加到50和4），则可以提高等高线的精度。

通过分别绘制方程l.h.s.的实部和虚部，我得到了与您所期望的非常相似的结果：

ContourPlot[{Re@a[k, w] == 0, Im@a[k, w] == 0}, {w, 0, 6}, {k, 0, 14},
  MaxRecursion -> 7]

---

您确定图片和/或

a

的定义吗？从

a

的定义可以得出

a[k，w]==0

在

k==w

上，但该曲线不会出现在您的图片中

无论如何，假设

a

的定义正确，绘制等高线的问题在于域

w^2/r^2-k^20

）。因此，为了解决

a

变得复杂的问题，您可以绘制轮廓

a[k，w]/p[k，w]==0

：

ContourPlot[a[k, w]/p[k, w] == 0, {w, 0, 6}, {k, 0, 14}]

结果

---

试着对方程进行参数化处理。例如，定义

a=w^2-k^2

和

b=w^2/r^2-k^2

，然后求解

a

和

b

，并将它们映射到

k

和

w

也许你可以在@plaes问它：这不是一个关于数学的问题。这是一个关于Mathematica的问题。你能提供一张你大致期望的图片吗？你是对的。我对

a

的定义有误。我修好了。谢谢。除以

p

修正了它。我甚至不需要设置绘图点或其他任何东西！谢谢有一个抄写错误（海克在上面的回答中指出），现在已经修复。但是，它是

a[k，w]

，而不是

a[w，k]

，并且没有错误。无论如何，谢谢你。