How to visualize the Gaussian curvature of a 3D surface using color?

I have a 3D surface. I want to visualize color-coded Gaussian curvature. Is there any software (e.g. MATLAB, Mathematica) which can be used for calculating and visualizing the curvature in color code (for example, we can specify the color coding in MATLAB while visualizing the 3D surface based on height. I want to do it based on Gaussian curvature).

Solution 1:

Here's a few Mathematica routines for coloring a surface by its Gaussian curvature:

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 default coloring option colors regions of negative Gaussian curvature blue, regions of zero Gaussian curvature white, and regions of positive Gaussian curvature red.

Here for instance is a "corkscrew surface", gccolor[{Cos[u] Cos[v], Sin[u] Cos[v], u + Sin[v]}, {u, 0, 2 π}, {v, -π, π}]:

For completeness, here are the corresponding routines for mean curvature:

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

Options[mccolor] = DeleteCases[Options[ParametricPlot3D], ColorFunctionScaling -> _];

mccolor[f_, {u_, ura__}, {v_, vra__}, opts : OptionsPattern[]] := 
  Module[{cf = OptionValue[ColorFunction], mc},
         If[cf === Automatic, cf = ColorData["ThermometerColors"]];
         mc = Function @@ {{u, v}, MeanCurvature[f, {u, v}]};
         ParametricPlot3D[f, {u, ura}, {v, vra}, 
                          ColorFunction -> (cf[1/(1 + Exp[-2 mc[#4, #5]])] &), 
                          ColorFunctionScaling -> False, 
                          Evaluate[FilterRules[{opts}, Options[gccolor]]], 
                          Lighting -> "Neutral"]]

Here's mccolor[{Cos[u] Cos[v], Sin[u] Cos[v], u + Sin[v]}, {u, 0, 2 π}, {v, -π, π}]: