¿Cómo visualizar la curvatura gaussiana de una superficie 3D utilizando el color?

Question

Tengo una superficie 3D. Quiero visualizar la curvatura gaussiana codificada por colores. ¿Existe algún software (por ejemplo, MATLAB, Mathematica) que pueda utilizarse para calcular y visualizar la curvatura en código de colores (por ejemplo, podemos especificar el código de colores en MATLAB mientras visualizamos la superficie 3D basada en la altura. Yo quiero hacerlo en base a la curvatura gaussiana).

Answer 1

Aquí hay algunos Mathematica rutinas para colorear una superficie por su curvatura gaussiana:

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"]]

La opción de coloración por defecto colorea las regiones de curvatura gaussiana negativa en azul, las regiones de curvatura gaussiana cero en blanco y las regiones de curvatura gaussiana positiva en rojo.

Aquí, por ejemplo, hay una "superficie sacacorchos", gccolor[{Cos[u] Cos[v], Sin[u] Cos[v], u + Sin[v]}, {u, 0, 2 }, {v, -, }] :

---

Para completar, aquí están las rutinas correspondientes para la curvatura media:

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"]]

Aquí está mccolor[{Cos[u] Cos[v], Sin[u] Cos[v], u + Sin[v]}, {u, 0, 2 }, {v, -, }] :