1
$\begingroup$

Edit: I'm working through a textbook by Alfred Gray, Modern Differential Geometry of Curves and Surfaces with Mathematica.

I'm trying to plot the principal curvature of a monkey saddle, which I've defined as:

monkeysaddle[u_, v_] := {u, v, u^3 - 3 u v^2}

Ive defined principal curvature as:

k1[x_][u_, v_] := mcurvature[x][u, v] +
   Sqrt[Simplify[mcurvature[x][u, v]^2 -
   gcurvature[x][u, v]]]

k2[x][u_, v_] := mcurvature[x][u, v] -
   Sqrt[Simplify[mcurvature[x][u, v]^2 -
   gcurvature[x][u, v]]]

When I run this code, it shows blank:

ParametricPlot3D[Evaluate[{
   {r Cos[theta], r Sin[theta],
   k1[monkeysaddle ] [
   r Cos[theta], r Sin[theta]]},
   {r Cos[theta], r Sin[theta],
   k2[monkeysaddle] [
   r Cos[theta], r Sin[theta]]}}],
  {r, 0, 0.6}, {theta, 0, 3 Pi/2},
     PlotPoints -> {10, 30},
     BoxRatios -> {1, 1, 1},
     ViewPoint -> {1.5, -3.0, 0.6}]

my code for mcurvature (mean curvature) and gcurvature (Gauss curvature) work so I know the problem isn't there. Thanks!

EDIT:

ee[x_][u_, v_] := Simplify[D[x[uu, vv], uu].
D[x[uu, vv], uu]] /. {uu -> u, vv -> v}

ff[x_][u_, v_] := Simplify[D[x[uu, vv], uu].
D[x[uu, vv], vv]] /. {uu -> u, vv -> v}

gg[x_][u_, v_] := Simplify[D[x[uu, vv], vv]. 
D[x[uu, vv], vv]] /. {uu -> u, vv -> v}

eee[x_][u_, v_] := Simplify[Det[{
  D[x[uu, vv], uu, uu], D[x[uu, vv], uu], D[x[uu, vv], vv]}]/
  Sqrt[Simplify[D[x[uu, vv], uu]. D[x[uu, vv], uu] *
  D[x[uu, vv], vv].D[x[uu, vv], vv] -
  D[x[uu, vv], uu].
  D[x[uu, vv], vv]^2]]] /. {uu -> u, vv -> v}

fff[x_][u_, v_] := Simplify[Det[{
  D[x[uu, vv], uu, vv] D[x[uu, vv], uu] D[x[uu, vv], vv]}]/
  Sqrt[Simplify[D[x[uu, vv], uu].D[x[uu, vv], uu]*
  D[x[uu, vv], vv].D[x[uu, vv], vv] - 
  D[x[uu, vv], uu].
  D[x[uu, vv], vv]^2]]] /. {uu -> u, vv -> v}

ggg[x_][u_, v_] := Simplify[Det[{
  D[x[uu, vv], vv, vv] D[x[uu, vv], uu] D[x[uu, vv], vv]}]/
  Sqrt[Simplify[D[x[uu, vv], uu].D[x[uu, vv], uu]*
  D[x[uu, vv], vv].D[x[uu, vv], vv] - 
  D[x[uu, vv], uu].
  D[x[uu, vv], vv]^2]]] /. {uu -> u, vv -> v}

gcurvature[x_][u_, V_] := Simplify[
  (Det[{D[x[uu, vv], uu, uu], D[x[uu, vv], uu],
      D[x[uu, vv], vv]}]*
   Det[{D[x[uu, vv], vv, vv], D[x[uu, vv], uu],
      D[x[uu, vv], vv]}] -
   Det[{D[x[uu, vv], uu, vv], D[x[uu, vv], uu],
      D[x[uu, vv], vv]}]^2)/
  (D[x[uu, vv], uu].D[x[uu, vv], uu]*
      D[x[uu, vv], vv].D[x[uu, vv], vv] -
      D[x[uu, vv], uu].
      D[x[uu, vv], vv]^2)^2] /. {uu -> u, vv -> v}

mcurvature[x_][u_, v_] := Simplify[
 (Det[{D[x[uu, vv], uu, uu], D[x[uu, vv], uu],
     D[x[uu, vv] , vv]}]*
     D[x[uu, vv] , vv].D[x[uu, vv] , vv] -
  2 Det[{D[x[uu, vv], uu , vv], D[x[uu, vv] , uu],
     D[x[uu, vv] , vv]}]*
     D[x[uu, vv] , uu].D[x[uu, vv] , vv] +
  Det[{D[x[uu, vv] , vv, vv], D[x[uu, vv] , uu],
     D[x[uu, vv] , vv]}]*
     D[x[uu, vv] , uu].D[x[uu, vv] , uu])/
 (2 (D[x[uu, vv] , uu].D[x[uu, vv] , uu]*
     D[x[uu, vv] , vv].D[x[uu, vv] , vv] -
     D[x[uu, vv] , uu].
     D[x[uu, vv] , vv]^2)^(3/2))] /. {uu -> u, vv -> v}

NOTE: Code for Gauss curvature and mean curvature are based off of these formulas:enter image description here

Also, thanks for pointing out my neglectfulness. I wasn't intentionally trying to pass code off as my own. Lesson learned!

$\endgroup$
  • 2
    $\begingroup$ Can you provide your mcurvature and gcurvature? People are most likely to help when they can just paste your code and play with it. On the other hand I think your issue is just that you need to use x_ instead of x in k2[x][u_, v_] := ... $\endgroup$ – b3m2a1 Mar 20 '18 at 4:47
2
$\begingroup$

It seems the OP has been neglectful in mentioning that the routines gcurvature and mcurvature were obtained from the Mathematica notebooks associated with the book Modern Differential Geometry of Curves and Surfaces with Mathematica. Here are the required definitions (which I modified slightly):

gcurvature[x_][u_, v_] := Block[{uu, vv},
      (Det[{D[x[uu, vv], uu, uu], D[x[uu, vv], uu], D[x[uu, vv], vv]}] 
       Det[{D[x[uu, vv], vv, vv], D[x[uu, vv], uu], D[x[uu, vv], vv]}] - 
       Det[{D[x[uu, vv], uu, vv], D[x[uu, vv], uu], D[x[uu, vv], vv]}]^2)/
      (D[x[uu, vv], uu].D[x[uu, vv], uu] D[x[uu, vv], vv].D[x[uu, vv], vv] -
       (D[x[uu, vv], uu].D[x[uu, vv], vv])^2)^2 /. {uu -> u, vv -> v}]

mcurvature[x_][u_, v_] := Block[{uu, vv},
      (Det[{D[x[uu, vv], uu, uu], D[x[uu, vv], uu], D[x[uu, vv], vv]}]
       D[x[uu, vv], vv].D[x[uu, vv], vv] - 
       2 Det[{D[x[uu, vv], uu, vv], D[x[uu, vv], uu], D[x[uu, vv], vv]}]
       D[x[uu, vv], uu].D[x[uu, vv], vv] +
       Det[{D[x[uu, vv], vv, vv], D[x[uu, vv], uu], D[x[uu, vv], vv]}]
       D[x[uu, vv], uu].D[x[uu, vv], uu])/
      (2 (D[x[uu, vv], uu].D[x[uu, vv], uu] D[x[uu, vv], vv].D[x[uu, vv], vv] -
       (D[x[uu, vv], uu].D[x[uu, vv], vv])^2)^(3/2)) /. {uu -> u, vv -> v}]

Note the use of dummy variables, so that the differentiation can proceed before numerical values of u and v are passed to the curvature routines. Rewriting your principal curvature routines in a similar style, we have

k1[x_][u_, v_] := Block[{uu, vv}, mcurvature[x][uu, vv] +
   Sqrt[Simplify[mcurvature[x][uu, vv]^2 - gcurvature[x][uu, vv]]] /. {uu -> u, vv -> v}]

k2[x_][u_, v_] := Block[{uu, vv}, mcurvature[x][uu, vv] - 
   Sqrt[Simplify[mcurvature[x][uu, vv]^2 - gcurvature[x][uu, vv]]] /. {uu -> u, vv -> v}]

Then:

monkeysaddle[u_, v_] := {u, v, u^3 - 3 u v^2}

ParametricPlot3D[Evaluate[{{r Cos[θ], r Sin[θ], k1[monkeysaddle][r Cos[θ], r Sin[θ]]},
                           {r Cos[θ], r Sin[θ], k2[monkeysaddle][r Cos[θ], r Sin[θ]]}}],
                 {r, 0, 0.6}, {θ, 0, 3 π/2}, BoxRatios -> {1, 1, 1},
                 PlotPoints -> {10, 30}, ViewPoint -> {1.5, -3.0, 0.6}]

principal curvatures of a monkey saddle

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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