Mean curvature of Sphere

Question

I am trying to calculate mean curvature of a parametric surface(like sphere), and I wrote this code based on this discussion. Here is my code:

MeanCurvature[(f_)?VectorQ, {u_, v_}] := 
Simplify[(-2*D[f, {u}] . D[f, {v}]*
   Det[{D[f, {u}, {v}], D[f, {u}], D[f, {v}]}] + 

  Abs[D[f, {v}] . D[f, {v}]]*
   Det[{D[f, {u, 2}], D[f, {u}], D[f, {v}]}] + 
  Abs[D[f, {u}] . D[f, {u}]]*
   Det[{D[f, {v, 2}], D[f, {u}], D[f, {v}]}])/
     (2*
  PowerExpand[
   Simplify[
     Abs[D[f, {u}] . D[f, {u}]]*
       Abs[D[f, {v}] . D[f, {v}]] - (D[f, {u}] . D[f, {v}])^2]^(3/
      2)])]; 
Options[gccolor] = 
Select[Options[ParametricPlot3D], 
FreeQ[#1, ColorFunctionScaling] & ]; 
Off[RuleDelayed::rhs]; 
signgccolor[f_, {u_, ura__}, {v_, vra__}, (opts___)?OptionQ] := 
  Module[{cf, gc, rng}, 
   cf = ColorFunction /. {opts} /. Options[gccolor]; 
        If[cf === Automatic, 
    cf = Which[Positive[#1], RGBColor[#1/(#1 + 1), 0, 0], 
       Negative[#1], RGBColor[0, 0, -(#1/(1 - #1))], True, 
                RGBColor[1, 1, 1]] & ]; 
   gc[u_, v_] = MeanCurvature[f, {u, v}]; 
   ParametricPlot3D[f, {u, ura}, {v, vra}, 
          ColorFunction -> Function[{x, y, z, u, v}, cf[gc[u, v]]], 
    ColorFunctionScaling -> False, 
    Evaluate[FilterRules[{opts}, Options[gccolor]]]]]; 
On[RuleDelayed::rhs]; 
rng = {NMinValue[{MeanCurvature[{Cos[u]*Cos[v], Sin[u]*Cos[v], 
      Sin[v]}, {u, v}], -(Pi/2) < u < Pi/2 && 0 < v < 2*Pi}, {u, v}], 
     NMaxValue[{MeanCurvature[{Cos[u]*Cos[v], Sin[u]*Cos[v], 
      Sin[v]}, {u, v}], -(Pi/2) < u < Pi/2 && 0 < v < 2*Pi}, {u, v}]}

range = {-1.0000000000000002, 1.0000000000000002} this is the first problem! mean curvature of a sphere is a constant positive number.

twist = signgccolor[{Cos[u]*Cos[v], Sin[u]*Cos[v], 
   Sin[v]}, {u, -(Pi/2), Pi/2}, {v, 0, 2*Pi}, 
     ColorFunction -> (Glow[
      Which[Positive[#1], Lighter[Red, Rescale[#1, {0, 1}, {1, 0}]], 
       Negative[#1], Lighter[Blue, Rescale[#1, {0, -1}, {1, 0}]], 
       True, 
              White]] & )]
 Animate[With[{v = RotationTransform[θ, {0, 0, 1}][{3, 0, 3}]}, 
  Show[twist, ViewPoint -> v, SphericalRegion -> True, 
   Boxed -> False, Axes -> False]], 
   {θ, 0, 2*Pi}, AnimationRate -> 0.1, 
 AnimationRunning -> True]

and the output looks like this:

Answer 1

My output looks a little bit different

sphere = {Cos[u] Sin[v], Sin[u] Sin[v], Cos[v]};

MeanCurvature[f_] :=
  With[{du = D[f, u], dv = D[f, v]},
      Simplify[(Det[{D[du, u], du, dv}] * dv.dv -
       2 Det[{D[f, u, v], du, dv}] * du.dv + Det[{D[dv, v], du, dv}] * du.du) /
            (2 Simplify[(du.du * dv.dv - (du.dv)^2)]^(3/2))]];

mean = MeanCurvature[sphere]

plo = Plot[mean, {v, 0, 2 Pi}]

range = Last[PlotRange /. AbsoluteOptions[plo, PlotRange]]

{-1., 1.}

ParametricPlot3D[sphere, {u, 0, Pi}, {v, 0, 2 Pi},
 Mesh -> 10,
 ColorFunction -> Function[{x, y, z, u, v},
   ColorData["TemperatureMap"][Rescale[mean, range]]],
 ColorFunctionScaling -> False]

To answer your comment: Unlike "GaussianCurvature" "MeanCurvature" gives misleading results for "closed" surfaces like spheres or ellipsoids (a unit sphere has constant positive curvature of 1). Another example:

ellipsoid = {3/2 Cos[u] Sin[v], Sin[u] Sin[v], Cos[v]}; 

It is important to precede the following with Abs

mean = Abs @ MeanCurvature[ellipsoid];

plo =
 Plot3D[mean, {u, 0, Pi}, {v, 0, 2 Pi},
  ColorFunction -> "TemperatureMap",
  PlotRange -> All]

range = Last[PlotRange /. AbsoluteOptions[plo, PlotRange]];

ParametricPlot3D[ellipsoid, {u, 0, Pi}, {v, 0, 2 Pi},
 Mesh -> 10,
 MeshFunctions -> Function[{x, y, z, u, v}, Rescale[mean, range]],
 ColorFunction -> Function[{x, y, z, u, v},
   ColorData["TemperatureMap"][Rescale[mean, range]]],
 ColorFunctionScaling -> False]