Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

First I have

ContourPlot3D[{
  (1 - p1) (1 - p2)^3 == p1 p2^3, 
  p1 p2^6 (c p1 + (1 - c) p2)^3 ((1 - c) p1 + c p2)^2 
    == (1 - p1) (1 -p2)^6 (1 - c p1 - (1 - c) p2)^3 (1 - (1 - c) p1 - c p2)^2
 }, {p1, 0.2, 0}, {p2, 1, 0.5}, {c, 0, 1}, 
Lighting -> ({"Directional", White, #} & /@ Tuples[{-1, 1}, 3]), 
Mesh -> None, 
BoxRatios -> {2, 2, 1},
ContourStyle -> {Yellow, Directive[Red, Opacity[0.5]]}, 
BaseStyle -> {FontWeight -> "Bold", FontSize -> 20}]

which will show me (please don't mind the labels)

enter image description here

I want Mathematica to plot the region between the yellow plane and the transparent red plane, so I use RegionPlot3D with the same set of equations.

RegionPlot3D[(1 - p1) (1 - p2)^3 > p1 p2^3 && 
  p1 p2^6 (c p1 + (1 - c) p2)^3 (c p2 + (1 - c) p1)^2 
   > (1 - p1) (1 - p2)^6 (1 - (c p1 + (1 - c) p2))^3 (1 - (c p2 + (1 - c) p1))^2, 
{p1, 0, 0.2}, {p2, 0.5, 1}, {c, 0, 1}, 
Mesh -> None, FaceGrids -> All, ViewPoint -> Front,PlotPoints->100]

which will give me the following:

enter image description here

One will expect RegionPlot3D will give a single connected bulk but instead there are several rod-like artifacts. How to get a nice region plot with that set of equations? (Increasing plotpoints to 200 might work, but it takes so long...)

share|improve this question
add comment

1 Answer

up vote 5 down vote accepted

Maybe you can just plot the boundary surface of the region piece by piece, and then combine them together to shape the region:

funcSet = {
   (1 - p1) (1 - p2)^3 - p1 p2^3,
   -(1 - p1) (1 - p2)^6 (1 - c p1 - (1 - c) p2)^3 (1 - (1 - c) p1 - 
       c p2)^2 + p1 p2^6 (c p1 + (1 - c) p2)^3 ((1 - c) p1 + c p2)^2
   };

Clear[regionBoundaryPlot]
regionBoundaryPlot[f1_, f2_, opts___] := With[
  {f2$temp = f2 /. {p1 -> p1$, p2 -> p2$, c -> c$}},
      ContourPlot3D[f1 == 0,
       {p1, 0, 0.2}, {p2, 0.5, 1}, {c, 0, 1},
       opts,
       RegionFunction -> Function[{p1, p2, c}, f2$temp > 0]
   ]]

Show[{
  regionBoundaryPlot[funcSet[[1]], funcSet[[2]],
   Mesh -> True, MeshStyle -> Blue,
   MeshFunctions -> Function[{p1, p2, c}, Evaluate[funcSet[[2]]]],
   PlotPoints -> 40],
  regionBoundaryPlot[funcSet[[2]], funcSet[[1]],
   Mesh -> True, MeshStyle -> Gray,
   MeshFunctions -> Function[{p1, p2, c}, Evaluate[funcSet[[1]]]],
   PlotPoints -> 40]
  },
 PlotRange -> {{0, .05}, All, All}, BoxRatios -> {.5, 1, .5}]

region plot

share|improve this answer
    
Nice idea! Is there anything special with the variables (in your regionBoundaryPlot function) whose names contain "$"? –  wdg May 10 '13 at 3:55
    
@wdg Thanks for accepting. It's because With renamed the variables inside it. Check this: With[{y = x}, Function[x, y]]. Note it may not be the best way to inject code into Function, please do search relevant posts on this site. –  Silvia May 10 '13 at 9:40
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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