Computing Gaussian curvature

Definition

GaussCurvature[f_] :=
  With[{dfu = D[f, u], dfv = D[f, v]},
     Simplify[(Det[{D[dfu, u], dfu, dfv}] Det[{D[dfv, v], dfu, dfv}] -
     Det[{D[f, u, v], dfu, dfv}]^2) / (dfu.dfu  dfv.dfv - (dfu.dfv)^2)^2]];

Sphere

As @ ubpdqn already remarked

GaussCurvature[{Cos[u] Sin[v], Sin[u] Sin[v], Cos[v]}]

1

Ellipsoid

ellipsoid = {2 Cos[u] Sin[v], Sin[u] Sin[v], Cos[v]};

cur = GaussCurvature[ellipsoid]

enter image description here

plo =
 Plot3D[cur, {u, 0, Pi}, {v, 0, 2 Pi},
  ColorFunction -> "TemperatureMap",
  PlotRange -> Full]

enter image description here

range = Last[PlotRange /. AbsoluteOptions[plo, PlotRange]]

{0.25, 4.}

ParametricPlot3D[ellipsoid, {u, 0, Pi}, {v, 0, 2 Pi},
 Mesh -> False,
 ColorFunction -> Function[{x, y, z, u, v},
   ColorData["TemperatureMap"][Rescale[cur, range]]],
 ColorFunctionScaling -> False]

enter image description here

Torus

torus = {(2 + Cos[v]) Cos[u], (2 + Cos[v]) Sin[u], Sin[v]};

cur = GaussCurvature[torus]

enter image description here

plo =
 Plot3D[cur, {u, 0, 2 Pi}, {v, 0, 2 Pi},
  ColorFunction -> "TemperatureMap",
  PlotRange -> Full]

enter image description here

range = Last[PlotRange /. AbsoluteOptions[plo, PlotRange]]

{-1., 0.333333}

par =
  ParametricPlot3D[
   torus, {u, 0, 2 Pi}, {v, 0, 2 Pi},
   ImageSize -> 400,
   Mesh -> False,
   ColorFunction -> Function[{x, y, z, u, v},
     ColorData["TemperatureMap"][Rescale[cur, range]]],
   ColorFunctionScaling -> False,
   PlotPoints -> 70];

bar =
  BarLegend[{"TemperatureMap", range}, Automatic];

Row[{par, bar}]

enter image description here

Moebius with gaussian mesh lines

f = {Cos[v] (3 + u Cos[v/2]), Sin[v] (3 + u Cos[v/2]), u Sin[v/2]};
cur = GaussCurvature[f];

ParametricPlot3D[f, {u, -1.5, 1.5}, {v, 0, 2 Pi},
 Boxed -> False,
 PlotStyle -> Opacity[0.8],
 ImageSize -> 500,
 Mesh -> 12,
 PlotPoints -> 120,
 MeshFunctions -> Function[{x, y, z, u, v}, Rescale[cur, {-0.04, -0.02}]],
 ColorFunction -> Function[{x, y, z, u, v},
   ColorData["DarkRainbow"][Rescale[cur, {-0.04, -0.02}]]],
 ColorFunctionScaling -> False]

enter image description here

Comparison with Mean Curvature

A must-read about those jolly times: http://en.wikipedia.org/wiki/Sophie_Germain

sincos = {u, v, Sin[u] Cos[v]};
cur = GaussCurvature[sincos];
range = Last[PlotRange /. AbsoluteOptions[plo, PlotRange]];

p1 =
 ParametricPlot3D[sincos, {u, 0, 2 Pi}, {v, 0, 2 Pi},
  ImageSize -> 500,
  Mesh -> 6,
  PlotLabel -> Style["Gaussian Curvature\n", 16, Bold],
  PlotPoints -> 120,
  MeshFunctions -> Function[{x, y, z, u, v}, Rescale[cur, range]],
  ColorFunction -> Function[{x, y, z, u, v},
    ColorData["Rainbow"][Rescale[cur, range]]],
  ColorFunctionScaling -> False];

MeanCurvature[f_] :=
  With[{du = D[f, u], dv = D[f, v]},
      Simplify[(Det[{D[du, u], du, dv}] * dv.dv -
       2 Det[{D[f, u, v], du, dv}] * du.dv + Det[{D[dv, v], du, dv}] * du.du) /
           (2 Simplify[(du.du*dv.dv - (du.dv)^2)]^(3/2))]];

cur = MeanCurvature[sincos];
plo = Plot3D[cur, {u, 0, 2 Pi}, {v, 0, 2 Pi}];
range = Last[PlotRange /. AbsoluteOptions[plo, PlotRange]];

p2 =
 ParametricPlot3D[sincos, {u, 0, 2 Pi}, {v, 0, 2 Pi},
  ImageSize -> 500,
  Mesh -> 6,
  PlotLabel -> Style["Mean Curvature\n", 16, Bold],
  PlotPoints -> 120,
  MeshFunctions -> Function[{x, y, z, u, v}, Rescale[cur, range]],
  ColorFunction -> Function[{x, y, z, u, v},
    ColorData["Rainbow"][Rescale[cur, range]]],
  ColorFunctionScaling -> False];

Row[{p1, p2, BarLegend[{"Rainbow", range}, LegendMarkerSize -> 400]}]

enter image description here

Update for space curves

curvature[f_] :=
 With[{d1 = D[f, u], d2 = D[f, {u, 2}]},
  Norm[Cross[d1, d2]] / Norm[d1]^3 // Simplify]

loxodromes[a_, b_] :=
 {
   2 a E^(b u) Cos[u],
   2 a E^(b u) Sin[u],
   a^2 E^(2 b u) - 1
   } / (1 + a^2 E^(2 b u))

cur = curvature[loxodromes[1, 0.1]];

plo = Plot[cur, {u, -4 Pi, 4 Pi}, PlotRange -> All]

enter image description here

range = Last[PlotRange /. AbsoluteOptions[plo, PlotRange]];

Show[

 ParametricPlot3D[loxodromes[1, 0.1], {u, -4 Pi, 4 Pi},
  ColorFunction -> Function[{x, y, z, u, v},
    ColorData["Rainbow"][Rescale[cur, range]]],
  ColorFunctionScaling -> False,
  PlotStyle -> Thickness[0.01]],

 Graphics3D[{Opacity[0.2], Sphere[]}],

 ImageSize -> 500]

enter image description here

A nice novel about Gauss

enter image description here


Note this parametric surface of unit sphere (S^2) should have constant Gaussian curvature: 1.

Surface:

x[u_, v_] := {Cos[u] Cos[v], Cos[u] Sin[v], Sin[u]}

First fundamental form:

fff = FullSimplify[With[{p1 = D[x[a, b], a], p2 = D[x[a, b], b]},
   {p1.p1, p1.p2, p2.p2}]];

Second fundamental form:

nm = FullSimplify[Cross[D[x[a, b], a], D[x[a, b], b]]];
unm = FullSimplify[nm/Sqrt[nm.nm]];
sec = {D[x[a, b], {a, 2}], Derivative[1, 1][x][a, b], 
  D[x[a, b], {b, 2}]};
sff = FullSimplify[#.unm & /@ sec];

Gaussian Curvature:

de[{e_, f_, g_}] = e g - f^2
FullSimplify[de[#1]/de[#2] & @@ {sff, fff}]

yields 1

The mean curvature:

FullSimplify[(sff Reverse[fff]).{1, -2, 1}/(2 de[fff])]

yields: Sqrt[Cos[a]^2] Sec[a], which is clearly 1 as required.

i.e. K=1, H=1, $\kappa1 =1,\kappa2=1$

Simplifications can be challenging...others will have better approaches


Another expression using Cross

gaussianCurvature[r_, {u_, v_}] := 
 Module[{n, ru = D[r, u], rv = D[r, v], ruv = D[r, u, v]},
  n = Cross[ru, rv];
  ((D[ru, u].n) (D[rv, v].n) - (ruv.n)^2)/(n.n)^2 // Simplify
]

Examples

gaussianCurvature[{Cos[u] Sin[v], Sin[u] Sin[v], Cos[v]}, {u, v}]

1