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