# Visualization of Gaussian Curvature

I need to visualize Gaussian Curvature of a parametric surface. There is a solution in this math.SE post.

However, I'm not sure its working because when I draw a sphere it's all white, but it should be red or brown (because its Gaussian curvature is positive):

GaussianCurvature[f_, {u_, v_}] :=
Simplify[(Det[{D[f, {u, 2}], D[f, u], D[f, v]}] Det[{D[f, {v, 2}],
D[f, u], D[f, v]}] -
Det[{D[f, u, v], D[f, u],
D[f, v]}]^2)/(D[f, u].D[f, u] D[f, v].D[f,
v] - (D[f, u].D[f, v])^2)^2];

Options[gccolor] =
Select[Options[ParametricPlot3D], FreeQ[#, ColorFunctionScaling] &];

Off[RuleDelayed::rhs];

gccolor[f_, {u_, ura__}, {v_, vra__}, opts___?OptionQ] :=
Module[{cf, gc, rng},
cf = ColorFunction /. {opts} /. Options[gccolor];
If[cf === Automatic, cf = ColorData["LightTemperatureMap"]];
gc[u_, v_] = GaussianCurvature[f, {u, v}];
rng = Last[
PlotRange /.
AbsoluteOptions[
Plot3D[gc[u, v], {u, ura}, {v, vra},
PerformanceGoal -> "Speed", PlotRange -> Full], PlotRange]];
ParametricPlot3D[f, {u, ura}, {v, vra},
ColorFunction ->
Function[{x, y, z, u, v}, cf[Rescale[gc[u, v], rng]]],
ColorFunctionScaling -> False,
Evaluate[FilterRules[{opts}, Options[gccolor]]]]];

On[RuleDelayed::rhs];

gccolor[{Cos[u] Sqrt[1 - v^2], Sin[u] Sqrt[1 - v^2], v}, {u, 0,
2 Pi}, {v, -1, 1}]


How can I modify that code such that for any point on the surface if its Gaussian curvature is positive it turns red and if its zero it turns to white and for negative it turns to blue? Also, if I can do this with any other software please tell me.

-
Hi, try put there ColorFunction similar to those: mathematica.stackexchange.com/q/47749/5478 – Kuba May 14 '14 at 5:10
You are right, I don't have time now to focus on this. I will try to update my answer later unless someone else do this. – Kuba May 14 '14 at 9:44
Thank you, I will wait. – lino May 14 '14 at 9:59
I prolly should fix that routine when I find the time… – J. M. Jun 9 '15 at 10:09
OP says he can wait... ;) – VividD Jun 9 '15 at 10:33

I finally got around to fixing the routine in the math.SE answer the OP linked to. To make this answer self-contained, I'll reproduce the definitions here:

GaussianCurvature[f_, {u_, v_}] :=
Simplify[(Det[{D[f, {u, 2}], D[f, u], D[f, v]}]
Det[{D[f, {v, 2}], D[f, u], D[f, v]}] -
Det[{D[f, u, v], D[f, u], D[f, v]}]^2)/
(D[f, u].D[f, u] D[f, v].D[f, v] - (D[f, u].D[f, v])^2)^2];

Options[gccolor] = DeleteCases[Options[ParametricPlot3D], ColorFunctionScaling -> _];
(gccolor[f_, {u_, ura__}, {v_, vra__}, opts : OptionsPattern[]] :=
Module[{cf = OptionValue[ColorFunction], gc},

If[cf === Automatic, cf = ColorData["ThermometerColors"]];
gc[u_, v_] = GaussianCurvature[f, {u, v}];

ParametricPlot3D[f, {u, ura}, {v, vra},
ColorFunction -> Function[{x, y, z, u, v},
cf[1/(1 + Exp[-2 gc[u, v]])]],
ColorFunctionScaling -> False,
Evaluate[FilterRules[{opts}, Options[gccolor]]],
Lighting -> "Neutral"]]) // Quiet


The fix involved the use of a sigmoidal function to map values of the curvature to the interval $(0,1)$, which is the natural domain of the usual color functions. With this, we obtain the expected red sphere:

gccolor[{Cos[u] Sqrt[1 - v^2], Sin[u] Sqrt[1 - v^2], v}, {u, 0, 2 π}, {v, -1, 1}]


and a pseudosphere now has the expected blue color:

gccolor[{Cos[u] Sech[v], Sin[u] Sech[v], v - Tanh[v]}, {u, 0, 2 π}, {v, 0, 3}]


(P.S. I also fixed the corresponding mean curvature coloring routine.)

-