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 ∂z∂x\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 x2+y2+z2<0.5x^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 ∂z∂x=0\frac{\partial z}{\partial x} = 0 for the equation but it didn't work: x2+y2+z2==xyx^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]

=================

=================

2 Answers
2

=================

I’m not sure that I would call ∂z/∂x\partial z/\partial x the gradient in this context but, assuming your condition is on ∂z/∂x\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 ∂z/∂x\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-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 xx-axis to the negative portion and expanded the domain of the plot. I guess the zz 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”
– user44840
Jul 31 ’14 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”]

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 ∂z/∂x=0\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}]