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

Question

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]

Answer 1

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"}]

Answer 2

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"]

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}]

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}]