Можно ли создать полярный CountourPlot / ListCountourPlot / DensityPlot в Mathematica?

Question

Я ищу график, похожий на моды шепчущей галереи - двумерный цилиндрически симметричный график в полярных координатах. Примерно так:

Я нашел следующий фрагмент кода в руководстве по символике Тротта. Пробовал запустить его на очень маленьком наборе данных; он съел 4 ГБ памяти и запустил мое ядро:

(* add points to get smooth curves *)
addPoints[lp_][points_, \[Delta]\[CurlyEpsilon]_] := 
Module[{n, l}, Join @@ (Function[pair,
       If[(* additional points needed? *)
          (l = Sqrt[#. #]&[Subtract @@ pair]) < \[Delta]\[CurlyEpsilon], pair, 
          n = Floor[l/\[Delta]\[CurlyEpsilon]] + 1; 
          Table[# + i/n (#2 - #1), {i, 0, n - 1}]& @@ pair]] /@ 
          Partition[If[lp === Polygon, 
                       Append[#, First[#]], #]&[points], 2, 1])]

(* Make the plot circular *)
With[{\[Delta]\[CurlyEpsilon] = 0.1, R = 10}, 
 Show[{gr /. (lp : (Polygon | Line))[l_] :> 
     lp[{#2 Cos[#1], #2 Sin[#1]} & @@@(* add points *)
       addPoints[lp][l, \[Delta]\[CurlyEpsilon]]], 
   Graphics[{Thickness[0.01], GrayLevel[0], Circle[{0, 0}, R]}]}, 
  DisplayFunction -> $DisplayFunction, Frame -> False]]

Здесь gr - это прямоугольный 2D ListContourPlot, сгенерированный с использованием чего-то подобного (например):

data = With[{eth = 2, er = 2, wc = 1, m = 4}, 
   Table[Re[
     BesselJ[(Sqrt[eth] m)/Sqrt[er], Sqrt[eth] r wc] Exp[
       I m phi]], {r, 0, 10, .2}, {phi, 0, 2 Pi, 0.1}]];
gr = ListContourPlot[data, Contours -> 50, ContourLines -> False, 
  DataRange -> {{0, 2 Pi}, {0, 10}}, DisplayFunction -> Identity, 
  ContourStyle -> {Thickness[0.002]}, PlotRange -> All, 
  ColorFunctionScaling -> False]

Есть ли простой способ делать цилиндрические графики, подобные этой? .. Мне трудно поверить, что мне пришлось бы обратиться к Matlab для моих потребностей в криволинейных координатах:)

Answer 1

Предыдущие фрагменты удалены, так как это лучший ответ, который я придумал:

With[{eth = 2, er = 2, wc = 1, m = 4}, 
 ContourPlot[
  Re[BesselJ[(Sqrt[eth] m)/Sqrt[er], Sqrt[eth] r wc] Exp[I phi m]]/. 
                                         {r ->Norm[{x, y}], phi ->ArcTan[x, y]}, 
  {x, -10, 10}, {y, -10, 10}, 
  Contours -> 50, ContourLines -> False, 
  RegionFunction -> (#1^2 + #2^2 < 100 &), 
  ColorFunction -> "SunsetColors"
 ]
]

Редактировать

Замена ContourPlot на Plot3D и удаление неподдерживаемых параметров, которые вы получаете:

Answer 2

Это относительно простая проблема. Ключ в том, что если вы можете параметризовать его, вы можете построить его. Согласно документации ListContourPlot и ListDensityPlot принимают данные в двух формах: массив значений высоты или список координат плюс значение функции ({{x, y, f} ..}). Со второй формой легче работать, так что даже если ваши данные находятся в первой форме, мы преобразуем их во вторую форму.

Просто, чтобы преобразовать данные формы {{r, t, f} ..} в данные формы {{x, y, f} ..}, вы делаете N[{#[[1]] Cos[ #[[2]] ], #[[1]] Sin[ #[[2]] ], #[[3]]}]& /@ data, при применении к данным, взятым из BesselJ[1, r/2] Cos[3 t], вы получаете

А как насчет того, когда у вас просто есть массив данных, например этот парень ? В этом случае у вас есть 2D-массив, в котором каждая точка в массиве имеет известное местоположение, и для того, чтобы построить его, вы должны превратить его во вторую форму. Я неравнодушен к MapIndexed, но есть и другие способы сделать это. Допустим, ваши данные хранятся в массиве, где строки соответствуют радиальной координате, а столбцы - угловой координате. Затем, чтобы преобразовать его, я бы использовал

R = 0.01;    (*radial increment*)
T = 0.05 Pi; (*angular increment*)
xformed = MapIndexed[ 
   With[{r = #2[[1]]*R, t = #2[[1]]*t, f = #1},
   {r Cos[t], r Sin[t], f}]&, data, {2}]//Flatten[#,1]&

, который дает тот же результат.

---

Если у вас есть аналитическое решение, вам нужно преобразовать его в декартовы координаты, как описано выше, но вместо этого вы используете правила замены. Например,

ContourPlot[ Evaluate[
    BesselJ[1, r/2]*Cos[3 t ] /. {r -> Sqrt[x^2 + y^2], t -> ArcTan[x, y]}], 
   {x, -5, 5}, {y, -5, 5}, PlotPoints -> 50, 
   ColorFunction -> ColorData["DarkRainbow"], Contours -> 25]

дает

Следует отметить две вещи: 1) Evaluate необходим для обеспечения правильного выполнения замены, и 2) ArcTan[x, y] учитывает квадрант, в котором находится точка {x,y}.