# 3D Contour Plot parts of sphere with gradient less than 0, equal to 0 and more than 0

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}] 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]   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}] 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"}] • 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" Jul 31, 2014 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]},
MaxRecursion -> 5, PlotPoints -> 70,
ImageSize -> 400, Lighting -> "Neutral"] 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]},
MaxRecursion -> 5, PlotPoints -> 70, ImageSize -> 400,
Lighting -> "Neutral"] &;
{cp1a, cp2a} = cntrpltFa @@@ {{eq1, deriv1, 1}, {eq2, deriv2, 2}};
Row[{cp1a, cp2a}] 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}] 