Visualization of Gaussian Curvature

Question

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.

Please help me out.

Answer 1

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 = Function @@ {{u, v}, GaussianCurvature[f, {u, v}]};
         ParametricPlot3D[f, {u, ura}, {v, vra}, 
                          ColorFunction -> (cf[1/(1 + Exp[-2 gc[#4, #5]])] &), 
                          ColorFunctionScaling -> False, 
                          Evaluate[FilterRules[{opts}, Options[gccolor]]], 
                          Lighting -> "Neutral"]]

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.)