Как получить точные кривые сюжета в Mathematica?

Question

Запустите следующий код в 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}]

Это дает мне очень неточные кривые:

Я попытался установить PlotPoints иWorkingPrecision опции от ContourPlot до 30 и 20 соответственно безрезультатно.Вы также заметите, что единственным числовым параметром r является точное рациональное число.Я не знаю, что еще попробовать.Спасибо.

Редактировать: Кривые, которые я ожидаю получить, представляют собой три черных (обозначенные A1, A2 и A3) на следующем рисунке

Answer 1

Вы уверены насчет картинки и / или определения для a?Из определения a следует, что a[k,w]==0 на k==w, но эта кривая не появляется на вашей картинке.

В любом случае, при условии, что определение a правильно, проблема впостроение контуров таково, что в области w^2/r^2-k^2<0 оба значения p[k,w] и Sin[p[k,w]] становятся чисто мнимыми, что означает, что a[k,w] также становится чисто мнимым.Поскольку ContourPlot не любит комплексные функции, на графике отображаются только части контуров в области w^2/r^2>=k^2.

Не то, чтобы Sin[p[k,w]]/p[k,w] было действительным для всех значений k и w (и оно прекрасно ведет себя в пределе p[k,w]->0).Поэтому, чтобы обойти проблему сложности a, вы можете вместо этого построить контуры a[k,w]/p[k,w]==0:

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

Результат

Answer 2

У меня есть нечто очень похожее на то, что вы ожидаете, раздельно изображая реальные и мнимые части l.h.s. уравнения:

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

Answer 3

p и q будут иметь реальную стоимость, только если w^2 - k^2 и w^2/r^2 - k^2 оба неотрицательны. w^2 / r^2 - k^2 будет неотрицательным только в следующей области вашего участка графика:

Поэтому все остальное будет отрезано на ContourPlot. Возможно, вам нужно внести некоторые поправки в уравнения (вам нужна только действительная часть - величина?) Я не верю, что кривые, которые Mathematica дает вам, очень неточны. В противном случае можно пойти по пути повышения точности контуров при увеличении PlotPoints и MaxRecursion (скажем, до 50 и 4).

Answer 4

Ваша функция выдает комплексные числа в области линий контура, которые вы показываете. Это то, что вы ожидаете? Здесь вы можете увидеть реальный регион:

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

Я получаю кое-что ближе к твоим строкам, если использую:

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

Возможно ли, что произошла ошибка транскрипции?

(Мои извинения, если это бесполезно.)

Answer 5

Попробуйте поиграть с параметризацией ваших уравнений. Например, определите a=w^2-k^2 и b=w^2/r^2-k^2, затем решите для a и b и сопоставьте их с k и w