0
$\begingroup$

Please, can someone offer me some help with the code which generates those last three graphs illustrating the three regions - first/conventional region, second/"r.f.-only" region, third/"intermediate" region. [here's the link: Creating a Mathieu stability diagram

Here is the code for the first graph [which works]

x = Plot[
    {MathieuCharacteristicA[0, q], MathieuCharacteristicB[1, q] (upright), -MathieuCharacteristicA[0, q], -MathieuCharacteristicB[1, q] (reflected)}
  , {q, 0, 1}
  , PlotRange -> {All, {0.0, 0.3}}
  , PlotStyle -> {Directive[Thick, Blue], Directive[Thick, Red], Directive[Thick, Dashed, Blue], Directive[Thick, Dashed, Red]}
  , Filling -> Table[{2 n + 1 -> {{2 n + 2}, Directive[Opacity[1/2], Purple]}}, {n, 0, 1}]
] 

Here is the code for the second graph [which also works]

z = p[a_, q_] := -MathieuC[a, q, 0] MathieuSPrime[a, q, 0] 

ContourPlot[p[a, q] p[-a, -q]
  , {q, 0, 1}, {a, 0.00, 0.3}
  , MaxRecursion -> 3
  , RegionFunction -> Function[{x, y, f}, f > 0]
  , ColorFunction -> (ColorData["DarkRainbow"][1 - #] &)
  , AspectRatio -> 1/GoldenRatio
]      

And I don't know how option to use in order to put these graphs on the same chart in order to generate those three graphs in the link mentioned above. Can you help me please? See the link above and look at the graphs illustrating the three regions - first/conventional region, second/"r.f.-only" region, third/"intermediate" region

I tried using Show command for the first 2 graphs on this page but it doesn't work.

Thank you very much! I am hoping for an urgent answer if it is possible.

$\endgroup$
  • $\begingroup$ Welcome to Mathematica.SE! I hope you will become a regular contributor. To get started, 1) take the introductory tour now, 2) when you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge, 3) remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign, and 4) give help too, by answering questions in your areas of expertise. $\endgroup$ – bbgodfrey Jun 26 '17 at 22:41
2
$\begingroup$

This provides the first plot.

p[a_, q_] := -MathieuC[a, q, 0] MathieuSPrime[a, q, 0];
m1 = ContourPlot[p[a, q] p[-a, -q], {q, 0.05, 0.95}, {a, 0.00, 0.3}, MaxRecursion -> 3, 
    ColorFunction -> (ColorData["DarkRainbow"][1 - #] &), AspectRatio -> 1/GoldenRatio];
l1 = Plot[Evaluate@Flatten@Table[{MathieuCharacteristicA[r, q], 
    MathieuCharacteristicB[r + 1, q], -MathieuCharacteristicA[r, q], 
   -MathieuCharacteristicB[r + 1, q]}, {r, 0, 1}], {q, 0, 1}, PlotRange -> {All, {0, .3}}, 
    PlotStyle -> {Directive[Thick, Blue], Directive[Thick, Red], 
        Directive[Thick, Dashed, Blue], Directive[Thick, Dashed, Red]}, 
    Filling -> {{1 -> {2}}, {3 -> {4}}}, FillingStyle -> Directive[Opacity[1/2], Purple], 
    AxesLabel -> {q, a}]
Show[l1, m1]

enter image description here

Note that Evaluate is used in l1 instead of Evaluated -> True, the option employed in the answer to 46750, because a bug arose after the answer was submitted. See 66336.

The second plot can be obtained in a similar manner, although Contours -> 10 should be specified for a good appearance.

m2 = ContourPlot[p[a, q] p[-a, -q], {q, 7.5, 7.6}, {a, 0.00, 0.04}, 
    MaxRecursion -> 3, ColorFunction -> (ColorData["DarkRainbow"][1 - #] &), 
    AspectRatio -> 1/GoldenRatio, Contours -> 10];
l2 = Plot[Evaluate@Flatten@Table[{MathieuCharacteristicA[r, q], 
    MathieuCharacteristicB[r + 1, q], -MathieuCharacteristicA[r, q], 
   -MathieuCharacteristicB[r + 1, q]}, {r, 0, 1}], {q, 7.5, 7.6}, 
    PlotRange -> {All, {0, .04}}, PlotStyle -> {Directive[Thick, Blue], 
    Directive[Thick, Red], Directive[Thick, Dashed, Blue], Directive[Thick, Dashed, Red]}, 
    Filling -> {{5 -> {6}}, {7 -> {8}}}, FillingStyle -> Directive[Opacity[1/2], Purple], 
    AxesLabel -> {q, a}];
Show[l2, m2]

enter image description here

The final plot requires PlotPoints -> 50, making the already slow computation slower still.

m3 = ContourPlot[p[a, q] p[-a, -q], {q, 2.7, 3.4}, {a, 2.4, 3.3}, 
    MaxRecursion -> 3, ColorFunction -> (ColorData["DarkRainbow"][1 - #] &), 
    AspectRatio -> 1/GoldenRatio, Contours -> 10, PlotPoints -> 50];
l3 = Plot[Evaluate@Flatten@Table[{MathieuCharacteristicA[r, q], 
    MathieuCharacteristicB[r + 1, q], -MathieuCharacteristicA[r, q], 
    -MathieuCharacteristicB[r + 1, q]}, {r, 0, 1}], {q, 2.7, 3.4}, 
    PlotRange -> {All, {2.4, 3.3}}, PlotStyle -> {Directive[Thick, Blue], 
    Directive[Thick, Red], Directive[Thick, Dashed, Blue], Directive[Thick, Dashed, Red]}, 
    Filling -> {{3 -> {4}}, {5 -> {6}}}, FillingStyle -> Directive[Opacity[1/2], Purple], 
    AxesLabel -> {q, a}];
Show[l3, m3]

enter image description here

Addendum

With so many curves, it may be difficult to determine which curves to fill between. In response to a comment by the OP,

Plot[Evaluate@Flatten@Table[{Tooltip[MathieuCharacteristicA[r, q], 1 + 4 r], 
    Tooltip[MathieuCharacteristicB[r + 1, q], 2 + 4 r], 
    Tooltip[-MathieuCharacteristicA[r, q], 3 + 4 r], 
    Tooltip[-MathieuCharacteristicB[r + 1, q], 4 + 4 r]}, {r, 0, 1}], {q, 0, 8}, 
    PlotRange -> All, 
    PlotStyle -> {Directive[Thick, Blue], Directive[Thick, Red], 
        Directive[Thick, Dashed, Blue], Directive[Thick, Dashed, Red]}]

displays all eight curves and activates Tooltip. Moving the cursor to a curve on this plot in an active notebook causes the curve number to appear near that curve. In this way, the curve numbers are easily identified and can be included in the Filling option.

$\endgroup$
  • $\begingroup$ Thank you very much @bbgodfrey. I tried in the same manner to plot the other two graphs, but I think there is something which I miss because I don't obtain exactly the same figure. In addition, I have problems with the shaded Purple regions. Please, can you offer me an evaluation of the errors in the code. Thus, $\endgroup$ – April Jun 26 '17 at 19:24
  • $\begingroup$ The code for the second graph: $\endgroup$ – April Jun 26 '17 at 19:25
  • $\begingroup$ @April Getting the purple regions correct requires knowing which indices to include in the Filling option. I'll get back to you in an hour or so. $\endgroup$ – bbgodfrey Jun 26 '17 at 19:48
  • $\begingroup$ Thank you very much for your help! It worked perfectly. But when I tried to plot the other two graphs, it seems that I am wrong somewhere because I obtain not the plots it should. Please, can you offer me the line code for the other two? Here is what I obtained $\endgroup$ – April Jun 26 '17 at 20:01
  • 2
    $\begingroup$ @April do not use answers for comments. Also, next time put some effort in making the topic useful for more than you, I've copied your comments to the question while it was your task. $\endgroup$ – Kuba Jun 26 '17 at 21:05

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.