Scherk's Minimal Surfaces

Author

Eric W. Weisstein
June 10, 2014

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Surfaces/ScherksMinimalSurfaces.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/ScherksMinimalSurfaces.html.

©2014 Wolfram Research, Inc. except for portions noted otherwise

Initialization

Scherk's First Minimal Surface

<<ImplicitPlot3D`
<<Utilities`LiveGraphics3D`

LiveGraphics3D

WriteLiveForm["scherk1.m",
	ImplicitPlot3D[Exp[z]Cos[y]==Cos[x],{x,-Pi,Pi},{y,-Pi,Pi},{z,-Pi,Pi},Boxed->False]]

f[x_,y_]:=Log[Cos[x]/Cos[y]]
		
Simplify[(1+D[f[x,y],y]^2)D[f[x,y],{x,2}]+2D[f[x,y],x]D[f[x,y],y]D[f[x,y],x,y]+(1+D[f[x,y],x]^2)D[f[x,y],{y,2}]]

V6

ContourPlot3D[Exp[z]Cos[y]==Cos[x],{x,-Pi,Pi},{y,-Pi,Pi},{z,-Pi,Pi}]

ContourPlot3D[Exp[z]Cos[y]==Cos[x],{x,-5,5},{y,-5,5},{z,-5,5}]

Plot3D[Log[Cos[x]/Cos[y]],{x,-5,5},{y,-5,5},PlotPoints->50]

Plot3D[Log[Cos[x]/Cos[y]],{x,-3,3},{y,-3,3},PlotPoints->50]

Properties

Curvatures[a {u,v,Log[Cos[u]/Cos[v]]},{u,v},FullSimplify[#,a>0]&]

FullSimplify[PrincipalCurvatures[a {u,v,Log[Cos[u]/Cos[v]]},{u,v}],a>0&&(u|v)∈Reals]

eqn=Exp[z]Cos[y]-Cos[x];

FullSimplify[GaussianCurvature[eqn,{x,y,z}],(x|y|z)∈Reals]

MeanCurvature[eqn,{x,y,z}]

Metric Tensor

MetricTensor[a {u,v,Log[Cos[u]/Cos[v]]},{u,v}]//FullSimplify

Christoffel Symbol of the Second Kind

FullSimplify[ChristoffelSymbols[a {u,v,Log[Cos[u]/Cos[v]]},{u,v}],a>0&&(u|v)∈Reals]

Vector Properties

eqn=a{u,v,Log[Cos[u]/Cos[v]]};
rules={Abs[x_]^(n_/;Mod[n,2]==0):>x^n};
assum=a>0&&(u|v)∈Reals;

Vector Length

Assuming[assum,FullSimplify[Norm[eqn]/.rules]]

Normal Vector

Assuming[assum,FullSimplify[NormalVector[eqn,{u,v}]/.rules]]

Scherk's Second Minimal Surface

Equations and Plot

Dickson

Solve[z==r Exp[I ϕ],ϕ]

{2*(-Log[1 - E^(I*th)*r] + Log[1 + E^(I*th)*r]), 
  4*I*ArcTan[E^(I*th)*r], 
  2*I*(-Log[1 - E^(2*I*th)*r^2] + Log[1 + E^(2*I*th)*r^2])}/.th->-Log[z/r]I//FullSimplify

D[%,z]

Solve[{f(1-g^2),I f(1+g^2),2f g}=={(4/(1-(z^2))),((4 I)/(1+(z^2))),((8 I z)/(1-(z^4)))},{f,g}]//Simplify

EnneperWeierstrass[-(4/(-1+(z^4))),I z,{z,r,ϕ}]

FullSimplify[%,r>0&&ϕ∈Reals]

Factor[-1+(1/((1/2)+((r Sin[ϕ])/(1+(r^2)))))]

ComplexExpand[Re[((1-(E^(2 I ϕ)) (r^2))/(1+(E^(2 I ϕ)) (r^2)))]]//FullSimplify

ComplexExpand[Im[((1-(E^(2 I ϕ)) (r^2))/(1+(E^(2 I ϕ)) (r^2)))]]//FullSimplify

FullSimplify[ArcTan[((2 (r^2) Sin[2 ϕ])/(-1+(r^4)))]]

{Log[((1+(r^2)+2 r Cos[ϕ])/(1+(r^2)-2 r Cos[ϕ]))],Log[((1+(r^2)-2 r Sin[ϕ])/(1+(r^2)+2 r Sin[ϕ]))],2 ArcTan[((2 (r^2) Sin[2 ϕ])/(-1+(r^4)))]}

D[2 (Arg[1-(E^(2 I ϕ)) (r^2)]-Arg[1+(E^(2 I ϕ)) (r^2)]),r]

ComplexExpand[2 (Arg[1-(E^(2 I ϕ)) (r^2)]-Arg[1+(E^(2 I ϕ)) (r^2)])]

WriteLiveForm["scherk2.m",
	Show[ParametricPlot3D[
{Re[2*(-Log[1 - E^(I*th)*r] + Log[1 + E^(I*th)*r])], 
  Re[4*I*ArcTan[E^(I*th)*r]], 
  Re[2*I*(-Log[1 - E^(2*I*th)*r^2] + Log[1 + E^(2*I*th)*r^2])]},
{th, 0, 2 Pi}, {r, .01, .98}, PlotPoints->{60,19},
 ViewPoint->{1.3, -2.4, 2.0}, 
        Boxed->False, Axes-> False, PlotRange->All ]]]

ParametricPlot3D[Re[{2*(-Log[1 - E^(I*th)*r] + Log[1 + E^(I*th)*r]), 
  4*I*ArcTan[E^(I*th)*r], 
  2*I*(-Log[1 - E^(2*I*th)*r^2] + Log[1 + E^(2*I*th)*r^2])}],{r,0,1},{th,0,2π}]

ParametricPlot3D[{-Log[1+(r^2)-2 r Cos[ϕ]]+Log[1+(r^2)+2 r Cos[ϕ]],Log[1+(r^2)-2 r Sin[ϕ]]-Log[1+(r^2)+2 r Sin[ϕ]],2 (Arg[1-(E^(2 I ϕ)) (r^2)]-Arg[1+(E^(2 I ϕ)) (r^2)])},{r,0,1},{ϕ,0,2π}]

ParametricPlot3D[{Log[((1+(r^2)+2 r Cos[ϕ])/(1+(r^2)-2 r Cos[ϕ]))],Log[((1+(r^2)-2 r Sin[ϕ])/(1+(r^2)+2 r Sin[ϕ]))],2 ArcTan[((2 (r^2) Sin[2 ϕ])/(-1+(r^4)))]},{r,0,1},{ϕ,0,2π}]

scherk2[a_][r_,ϕ_]:=a{Log[((1+(r^2)+2 r Cos[ϕ])/(1+(r^2)-2 r Cos[ϕ]))],Log[((1+(r^2)-2 r Sin[ϕ])/(1+(r^2)+2 r Sin[ϕ]))],2 ArcTan[((2 (r^2) Sin[2 ϕ])/(-1+(r^4)))]}

Properties

Curvatures[scherk2[a][r,ϕ],{r,ϕ},Simplify[#,r>0&&ϕ∈Reals&&a>0]&]

ss

FullSimplify[PrincipalCurvatures[scherk2[a][r,ϕ],{r,ϕ}],r>0&&ϕ∈Reals&&a>0]

...crash (out of memory?)

Simplify[PrincipalCurvatures[scherk2[a][r,ϕ],{r,ϕ}],r>0&&ϕ∈Reals&&a>0]

Metric Tensor

MetricTensor[scherk2[a][r,ϕ],{r,ϕ}]//FullSimplify

Christoffel Symbol of the Second Kind

Simplify[ChristoffelSymbols[scherk2[a][r,ϕ],{r,ϕ}],r>0]

Refine[%,a>0]//FullSimplify

Vector Properties

eqn=a{Log[(1+r^2+2 r Cos[ϕ])/(1+r^2-2 r Cos[ϕ])],Log[(1+r^2-2 r Sin[ϕ])/(1+r^2+2 r Sin[ϕ])],2 ArcTan[(2 r^2 Sin[2 ϕ])/(-1+r^4)]};
rules={Abs[x_]^(n_/;Mod[n,2]==0):>x^n,(Sqrt[(1/((x_)^2))])x_:>Abs[x]};
vars={r,ϕ};
assum=a>0&&r>0&&0<v<2π;

Vector Length

Assuming[assum,FullSimplify[Norm[eqn]/.rules]]

Normal Vector

Assuming[assum,FullSimplify[NormalVector[eqn,vars]/.rules]]/.rules