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.

I want to plot only parts of the sphere of radius 1 where the gradient $\frac{\partial z}{\partial x}$ is < 0, = 0 and > 0.

The full sphere is given by:

ContourPlot3D[x^2 + y^2 + z^2 == 1, {x, -1, 1}, {y, -1, 1}, {z, -1, 1}]

enter image description here

I know how to plot parts of the sphere where $x^2 + y^2 + z^2 < 0.5 $ or something, but I can't figure out how to apply the condition to the gradient.

UPDATE: The positive and negative gradients turn out fine, but when I try to plot gradient = 0 it turns out funny.

I tried to find $\frac{\partial z}{\partial x} = 0$ for the equation but it didn't work: $$x^2 + y^2 + z^2 == xy $$

eq1 = x^2  y + y^2 + z^2 x == x y
ContourPlot3D[Evaluate[eq1], {x, -2, 1}, {y, -2, 2}, {z, -2, 2}]

deriv = Derivative[1, 0][z][x, y] /. 
    First[  Solve[    D[eq1 /. z ->   z[x, y], x],  
      Derivative[1, 0][z][x, y]  ]  ]  /. z[x, y] ->  z;

Positive1 = 
  ContourPlot3D[Evaluate[eq1], {x, -2, 2}, {y, -2, 2}, {z, -2, 2}, 
   RegionFunction ->  Function[{x, y, z}, deriv > 0], Mesh -> False,  
   ContourStyle -> Blue, MaxRecursion -> 5];
Negative1 = 
  ContourPlot3D[Evaluate[eq1], {x, -2, 2}, {y, -2, 2}, {z, -2, 2}, 
   RegionFunction ->  Function[{x, y, z}, deriv < 0], Mesh -> False, 
   ContourStyle -> Red, MaxRecursion -> 5];
zero1 = ContourPlot3D[
   Evaluate[eq1], {x, -2, 2}, {y, -2, 2}, {z, -2, 2}, 
   RegionFunction ->  Function[{x, y, z}, deriv = 0], Mesh -> False, 
   ContourStyle -> Green, MaxRecursion -> 5];

Show[Positive1]
Show[Negative1]
show[zero1]

enter image description here enter image description here enter image description here

share|improve this question

2 Answers 2

I'm not sure that I would call $\partial z/\partial x$ the gradient in this context but, assuming your condition is on $\partial z/\partial x$, you could do something like this:

eq = x^2 + y^2 + z^2 == 1;
deriv = Derivative[1, 0][z][x, y] /. First[
   Solve[D[eq /. z -> z[x, y], x], Derivative[1, 0][z][x, y]]] /.
  z[x, y] -> z
(* Out: -x/z *)

Note that we substituted z->z[x,y] into eq, allowing us to differentiate the whole thing with respect to x. We then solved for the $\partial z/\partial x$ (which, in InputForm looks like Derivative[1, 0][z][x, y]) and substituted back. Thus, your condition is on the sign of $-x/z$. We can apply it like so:

positive = 
  ContourPlot3D[Evaluate[eq], {x, -1, 1}, {y, -1, 1}, {z, -1, 1},
   RegionFunction -> Function[{x, y, z}, deriv > 0],
   Mesh -> False, ContourStyle -> ColorData[1, 1],
   MaxRecursion -> 5];
negative = 
  ContourPlot3D[Evaluate[eq], {x, -1, 1}, {y, -1, 1}, {z, -1, 1},
   RegionFunction -> Function[{x, y, z}, deriv < 0],
   Mesh -> False, ContourStyle -> ColorData[1, 3],
   MaxRecursion -> 5];
Show[{positive, negative}]

enter image description here

The technique is sufficiently general that you should be able change just the eq to get a similar picture for a different equation. Here's another example. In addition to changing the equation, I added mesh lines parallel to the $x$-axis to the negative portion and expanded the domain of the plot. I guess the $z$ value should be decreasing as we move along those mesh lines.

eq = x^2 y + y^2 + z^2 x == x*y;
deriv = Derivative[1, 0][z][x, y] /. First[
    Solve[D[eq /. z -> z[x, y], x], Derivative[1, 0][z][x, y]]] /.
  z[x, y] -> z;
positive = 
  ContourPlot3D[Evaluate[eq], {x, -2, 2}, {y, -2, 2}, {z, -2, 2},
   RegionFunction -> Function[{x, y, z}, deriv > 0],
   Mesh -> False, ContourStyle -> ColorData[1, 1],
   MaxRecursion -> 5];
negative = 
  ContourPlot3D[Evaluate[eq], {x, -2, 2}, {y, -2, 2}, {z, -2, 2},
   RegionFunction -> Function[{x, y, z}, deriv < 0],
    MeshFunctions -> (#2 &), ContourStyle -> ColorData[1, 3],
   MaxRecursion -> 5];
Show[{positive, negative}, AxesLabel -> {"x", "y", "z"}]

enter image description here

share|improve this answer
    
I tried using the same technique on a harder equation, but came out with the error of "ContourPlot3D::invregion: "deriv2>0 must be a Boolean function" –  user44840 Jul 31 at 12:51

Using @MarkMcClure's method

eq1 = x^2 + y^2 + z^2 == 1;
deriv1 = Derivative[1, 0][z][x, y] /.  
          First[Solve[D[eq1 /. z -> z[x, y], x], Derivative[1, 0][z][x, y]]] /.
           z[x, y] -> z;

with the options Mesh, MeshFunctions and MeshShading gives:

ContourPlot3D[Evaluate[eq1], {x, -1, 1}, {y, -1, 1}, {z, -1, 1}, 
              Mesh -> {{{0, Directive[Thick, Red]}}}, 
              MeshFunctions -> {Function[{x, y, z}, deriv1]}, 
              MeshShading -> {Yellow, Blue}, 
              MaxRecursion -> 5, PlotPoints -> 70, 
              ImageSize -> 400, Lighting -> "Neutral"]

enter image description here

Further variations:

eq2 = x^2 y + y^2 + z^2 x == x*y;
deriv2 = Derivative[1, 0][z][x, y] /. 
           First[Solve[D[eq2 /. z -> z[x, y], x], Derivative[1, 0][z][x, y]]] /.
           z[x, y] -> z;
cntrpltFa = ContourPlot3D[Evaluate[#], {x, -#3, #3}, {y, -#3, #3}, {z, -#3, #3},
               Mesh -> {{{0, Directive[Thick, Red]}}},
               MeshFunctions -> {Function[{x, y, z}, #2]},
               MeshShading -> {Yellow, Blue},
               MaxRecursion -> 5, PlotPoints -> 70, ImageSize -> 400, 
               Lighting -> "Neutral"] &; 
{cp1a, cp2a} = cntrpltFa @@@ {{eq1, deriv1, 1}, {eq2, deriv2, 2}};
Row[{cp1a, cp2a}]

enter image description here

If you can do without the mesh at $\partial z/\partial x = 0 $ you can also use ColorFunction similarly:

cntrpltFb =  ContourPlot3D[Evaluate[#], {x, -#3, #3}, {y, -#3, #3}, {z, -#3, #3},
                 Mesh -> False,
                 ColorFunction -> {Function[{x, y, z}, If[#2 < 0, Yellow, Blue]]},
                 ColorFunctionScaling -> False,
                 MaxRecursion -> 5, PlotPoints -> 70, ImageSize -> 400, 
                 Lighting -> "Neutral"] & ;
{cp1b, cp2b} =  cntrpltFb @@@ {{eq1, deriv1, 1}, {eq2, deriv2, 2}};
Row[{cp1b, cp2b}]

enter image description here

share|improve this answer

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.