# Mean curvature of Sphere

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: • Take look at this – Junho Lee Oct 19 '14 at 13:11
• The main problem is that you've got the domains of u and v reversed in your plot: Try {v, -(Pi/2), Pi/2}, {u, 0, 2*Pi}. Whether the mean curvature of the unit sphere is +1 or -1 depends on its (surface) orientation that arise from the parametrization. Try switching Sin[v] and Cos[v], which will switch the orientation. – Michael E2 Oct 19 '14 at 18:07

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] • See update of answer – eldo Oct 19 '14 at 14:05