1
$\begingroup$

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

$\endgroup$

2 Answers 2

4
$\begingroup$

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

$\endgroup$
1
  • $\begingroup$ 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" $\endgroup$
    – user44840
    Jul 31, 2014 at 12:51
2
$\begingroup$

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

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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