2
$\begingroup$

I am trying to implement the kind of solution Bob Hanlon provided here, but on another equation. There are two problems. First, this time, the gap at the top-right is not fully closed by the method, and second, I would like to add a standard blue fill to the regions below zero in the contour plot, while the above zero region should remain white.

Can these things be achieved?

Here is my code:

Clear["Global`*"]

expr2 = 1/(32 (p1 - p2)^2 (-(-1 + p2) p2)^(3/2) (-1 + p1 + p2)^2) (-1 + p1)^2 p1^2 (-64 Sqrt[-(-1 + p1) p1] (-1 + p2)^2 p2^2 - 32 (-1 + p1) p1 (-(-1 + p2) p2)^(3/2) - 32 (-(-1 + p2) p2)^(5/2) + (32 (-(-1 + p2) p2)^(7/2))/((-1 + p1) p1) - (192 (p1 - p2)^2 (-1 + p1 + p2)^2)/Sqrt[1/(p2 - p2^2)] + (64 (-1 + p2)^3 p2^3 (-3 + 2 Sqrt[((-1 + p2) p2)/((-1 + p1) p1)]))/Sqrt[-(-1 + p1) p1] + 32 (1/(p1 - p1^2))^(3/2) (6 (-1 + p1) p1 (-1 + p2)^3 p2^3 - 2 (-1 + p2)^4 p2^4 + Sqrt[1/(p1 - p1^2)] (-(-1 + p2) p2)^(9/2) + (2 (-1 + p2)^4 p2^4)/(((-1 + p2) p2)/((-1 + p1) p1))^(3/2) + 6 (-1 + p1)^4 p1^4 Sqrt[((-1 + p2) p2)/((-1 + p1) p1)] - 12 (-1 + p1)^4 p1^4 (((-1 + p2) p2)/((-1 + p1) p1))^(3/2))) // Simplify;


fd = FunctionDomain[expr2, {p1, p2}]; expr3 = expr2 // FullSimplify[#, fd] &; ContourPlot[Numerator@expr3 == 0, {p1, 0.5, 1}, {p2, 0.5, 1}, MaxRecursion -> 5, FrameLabel -> {p1, p2}, WorkingPrecision -> 50] // Quiet

enter image description here

$\endgroup$
  • $\begingroup$ Try the option PlotPoints ->50? $\endgroup$ – kglr Jan 4 at 20:34
3
$\begingroup$

You may do the contour plot for expr3 (instead of expr3==0), then use a region function to pick out the zero line, using 1 contour to just draw the boundary. The fill color is done via ContourShading, like this:

b = Function[{p1, p2}, Numerator@expr3 // Evaluate];
ContourPlot[Numerator@expr3, {p1, 0.5, 1}, {p2, 0.5, 1}, 
  MaxRecursion -> 5, FrameLabel -> {p1, p2}, Contours -> 1, 
  RegionFunction -> Function[{x, y, z}, b[x, y] < 0]] // Quiet

To close off at the {1,1} point, you may try changing MaxRecursion or PlotPoints. To get a quick result, I've set MaxRecursion to 1:

ContourPlot[Numerator@expr3, {p1, 0.5, 1}, {p2, 0.5, 1}, 
  MaxRecursion -> 1, PlotPoints -> 60, FrameLabel -> {p1, p2}, 
  Contours -> 1, RegionFunction -> Function[{x, y, z}, b[x, y] < 0], 
  ContourShading -> {Blue}] // Quiet

To get a smoother boundary, try larger MaxRecursion or PlotPoints.

enter image description here

Edit

To change the contour fill/line style for this plot, one way to get around the contour lines being not smooth/easy to see, plot one without the outline, just the fill color; plot another that shows just the outline, then Show them together, like this:

p0 = ContourPlot[Numerator@expr3, {p1, 0.5, 1}, {p2, 0.5, 1}, 
   PlotPoints -> 50, FrameLabel -> {Subscript[p, 1], Subscript[p, 2]},
    Contours -> 1, RegionFunction -> Function[{x, y, z}, b[x, y] < 0],
    ContourShading -> {RGBColor[223/255, 230/255, 240/255]}, 
   ContourStyle -> None] // Quiet
p1 = ContourPlot[Numerator@expr3 == 0, {p1, 0.5, 1}, {p2, 0.5, 1}, 
   PlotPoints -> 50, 
   ContourStyle -> RGBColor[0.368417, 0.506779, 0.709798]] // Quiet
Show[p0, p1]

enter image description here

$\endgroup$
  • $\begingroup$ I tried chaging your code to make the shading lighter, and I also aimed to set the contour line color with ContourStyle. But the last effect I was unable to get. Can you see what I am doing wrong with ContourStyle? ContourPlot[Numerator@expr3, {p1, 0.5, 1}, {p2, 0.5, 1}, MaxRecursion -> 1, PlotPoints -> 60, FrameLabel -> {Subscript[p, 1], Subscript[p, 2]}, Contours -> 1, RegionFunction -> Function[{x, y, z}, b[x, y] < 0], ContourShading -> {RGBColor[223/255, 230/255, 240/255]}, ContourStyle -> {RGBColor[0.368417, 0.506779, 0.709798]}] // Quiet $\endgroup$ – user120911 Jan 4 at 21:50
  • 1
    $\begingroup$ @user120911 see my edit above. $\endgroup$ – egwene sedai Jan 4 at 22:39

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.