17
$\begingroup$

Can Gaussian curvature $K$ be computed from WolframAlpha or any other available Mathematica program? Please indicate the program or its reference.

If input parametrization is given as Gaussian curvature of

X[u,v] = {Cos[u] Cos[v], Cos[u] Sin[v], Sin[u]}

it simply outputs an assembly of three individual Cartesian prismatic Monge 3D (u,v) plots and their plotted K but does not refer to meridians and parallels of a single unit sphere surface.

$\endgroup$
2

4 Answers 4

14
$\begingroup$

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

$\endgroup$
6
  • $\begingroup$ Dear @ ubpdqn. Thanks for understanding Gauss. $\endgroup$
    – eldo
    Oct 6, 2014 at 8:20
  • $\begingroup$ @eldo "Die Mathematik ist die Königin der Wissenschaften..." $\endgroup$
    – ubpdqn
    Oct 6, 2014 at 8:25
  • $\begingroup$ en.wikipedia.org/wiki/Sphere $\endgroup$
    – eldo
    Oct 6, 2014 at 8:30
  • 1
    $\begingroup$ @ubpdqn: Jawohl ...ihre Schönheit verdoppelt mit Mathematica. $\endgroup$
    – Narasimham
    Oct 6, 2014 at 9:35
  • $\begingroup$ @Narasimham I just posted the answer to illustrate a way to calculate Gaussian curvature for smooth surfaces (manifolds) using first and second fundamental forms. Varying x[u,v] should work for other surfaces, acknowledging issues of singular points, ugly expressions from limitations of simplifications. $\endgroup$
    – ubpdqn
    Oct 6, 2014 at 9:44
29
$\begingroup$

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

$\endgroup$
3
  • $\begingroup$ @eldo very nice and thank you for book recommendation...will add to my wish list $\endgroup$
    – ubpdqn
    Oct 7, 2014 at 1:40
  • $\begingroup$ @eldo congratulations on 10K! $\endgroup$
    – ubpdqn
    Oct 8, 2014 at 9:00
  • $\begingroup$ @ubpdqn Thank you very much for noticing :) $\endgroup$
    – eldo
    Oct 8, 2014 at 17:58
5
$\begingroup$

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

$\endgroup$
0
3
$\begingroup$

Curvatures of implicitly defined surfaces

1. Gaussian curvature

Based upon burnout's answer to this question:

How to speed up estimation of Mean and Gaussian curvatures on triangular meshes?

we can compute the Gaussian curvature of implicitly defined surfaces as follows:

fun = -x^2 + x^4 - y^2 + y^4 - z^2 + z^4;

d1 = D[fun, {{x, y, z}}] // Simplify;
d2 = D[fun, {{x, y, z}, 2}] // Simplify;

gauss[x_, y_, z_] =
  Simplify[((d1 . LinearSolve[d2, d1]) Det[d2]) / (# . # & [d1])^2];

Legended[
 ContourPlot3D[fun == -1/2, {x, -1, 1}, {y, -1, 1}, {z, -1, 1},
  ColorFunction -> 
   Function[{x, y, z, u, v}, 
    ColorData["TemperatureMap"][Rescale[gauss[x, y, z], {-3, 3}]]],
  ColorFunctionScaling -> False,
  Mesh -> False,
  PlotPoints -> 70],
 BarLegend[{"TemperatureMap", {-3.1, 3.1}}, Automatic]]

enter image description here

The scaling of {-3, 3} was inserted manually, because I didn't find a way to automate this. But this doesn't take too long. Start with {-1, 1} and go up or down.

2. Mean curvature

The same link also provides a formula for Mean curvature:

fun = -x^2 + x^4 - y^2 + y^4 - z^2 + z^4;

d1 = D[fun, {{x, y, z}}] // Simplify;
d2 = D[fun, {{x, y, z}, 2}] // Simplify;

mcur[x_, y_, z_] =
  Simplify[(d1 . d2 . d1 - Tr[d2] (# . # &[d1])) / (2 (# . # & [d1])^(3/2))];

Legended[
 ContourPlot3D[fun == -1/2, {x, -1, 1}, {y, -1, 1}, {z, -1, 1},
  ColorFunction -> Function[{x, y, z, u, v},
    ColorData["TemperatureMap"][Rescale[Abs @ mcur[x, y, z], {0, 3}]]],
  ColorFunctionScaling -> False,
  Mesh -> False,
  PlotPoints -> 70],
 BarLegend[{"TemperatureMap", {0, 3.1}}, Automatic]]

enter image description here

3. Mesh lines

The two curvature functions can also be applied to mesh lines:

fun = x^4 + y^4 + z^4 - (x^2 + y^2 + z^2)^2 + 3 (x^2 + y^2 + z^2);

d1 = D[fun, {{x, y, z}}] // Simplify;
d2 = D[fun, {{x, y, z}, 2}] // Simplify;

mcur[x_, y_, z_] = 
 Simplify[(d1 . d2 . d1 - 
     Tr[d2] (# . # & [d1])) / (2 (# . # &[d1])^(3/2))];


Legended[
 ContourPlot3D[fun == 3, {x, -2, 2}, {y, -2, 2}, {z, -2, 2},
  ColorFunction -> Function[{x, y, z, u, v},
    ColorData["TemperatureMap"][Rescale[Abs @ mcur[x, y, z], {0, 1}]]],
  ColorFunctionScaling -> False,
  Mesh -> 12,
  MeshFunctions -> 
   Function[{x, y, z, u, v}, Rescale[Abs @ mcur[x, y, z], {0, 1}]],
  PlotPoints -> 70],
 BarLegend[{"TemperatureMap", {0, 1.1}}, Automatic]]

enter image description here

$\endgroup$
1
  • $\begingroup$ In the image transition of double curvature K depicted beautifully. Base faces ( of fattened tetrahedron ) transition with negative K from base towards sides and among side faces with positive K . Perhaps in each corner octant $(0,1)$ it would be clearer. $\endgroup$
    – Narasimham
    Oct 24, 2023 at 20:27

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.