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

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

Thanks a lot.

-

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] = 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];


The default coloring option colors regions of negative Gaussian curvature blue, regions of zero Gaussian curvature white, and regions of positive Gaussian curvature brown.

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

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] = Select[Options[ParametricPlot3D],
FreeQ[#, ColorFunctionScaling] &];

Off[RuleDelayed::rhs];

mccolor[f_, {u_, ura__}, {v_, vra__}, opts___?OptionQ] :=
Module[{cf, mc, rng},
cf = ColorFunction /. {opts} /. Options[mccolor];
If[cf === Automatic, cf = ColorData["LightTemperatureMap"]];
mc[u_, v_] = MeanCurvature[f, {u, v}];
rng = Last[
PlotRange /.
AbsoluteOptions[
Plot3D[mc[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[mc[u, v], rng]]],
ColorFunctionScaling -> False,
Evaluate[FilterRules[{opts}, Options[mccolor]]]]];

On[RuleDelayed::rhs];


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

-