Bour's Minimal Surface

Author

Eric W. Weisstein
June 20, 2013

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

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

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

Equation

EnneperWeierstrass[1,Sqrt[z], {z,r,ϕ}]

FullSimplify[%,r>0&&0<ϕ<2π]

surf[r_,ϕ_]:={r Cos[ϕ]-(1/2) (r^2) Cos[2 ϕ],-r (1+r Cos[ϕ]) Sin[ϕ],(4/3) (r^(3/2)) Cos[((3 ϕ)/2)]}

eqn=Refine[Append[Thread[{x,y,z}=={r Cos[ϕ]-(1/2) (r^2) Cos[2 ϕ],-r (1+r Cos[ϕ]) Sin[ϕ],(4/3) (r^(3/2)) Cos[((3 ϕ)/2)]}/.{ϕ->2ϕϕ,r->rr^2}/.t:(_Sin|_Cos):>TrigExpand[t]],((Cos[ϕϕ])^2)+((Sin[ϕϕ])^2)==1],rr>0]

{eqn}=Factor/@GroebnerBasis[eqn,{x,y,z},{rr,Sin[ϕϕ],Cos[ϕϕ]},MonomialOrder->EliminationOrder]

eqn=347892350976 (x^8) (y^4)-463856467968 (x^6) (y^6)+231928233984 (x^4) (y^8)-51539607552 (x^2) (y^10)+4294967296 (y^12)+86973087744 (x^7) (y^2) (z^2)+521838526464 (x^8) (y^2) (z^2)-318901321728 (x^5) (y^4) (z^2)+695784701952 (x^6) (y^4) (z^2)+183609851904 (x^3) (y^6) (z^2)-115964116992 (x^4) (y^6) (z^2)-28991029248 x (y^8) (z^2)-231928233984 (x^2) (y^8) (z^2)+57982058496 (y^10) (z^2)+97844723712 (x^7) (z^4)+130459631616 (x^8) (z^4)+43486543872 (x^9) (z^4)-48922361856 (x^4) (y^2) (z^4)-97844723712 (x^5) (y^2) (z^4)+1916125839360 (x^6) (y^2) (z^4)-48922361856 (x^7) (y^2) (z^4)+32614907904 (x^2) (y^4) (z^4)-489223618560 (x^3) (y^4) (z^4)+1247520227328 (x^4) (y^4) (z^4)-81537269760 (x^5) (y^4) (z^4)-5435817984 (y^6) (z^4)-293534171136 x (y^6) (z^4)-252765536256 (x^2) (y^6) (z^4)-451172892672 (x^3) (y^6) (z^4)+285380444160 (y^8) (z^4)-114152177664 x (y^8) (z^4)-55037657088 (x^4) (z^6)+302707113984 (x^5) (z^6)+501454209024 (x^6) (z^6)+183458856960 (x^7) (z^6)-110075314176 (x^2) (y^2) (z^6)-605414227968 (x^3) (y^2) (z^6)+2605115768832 (x^4) (y^2) (z^6)-183458856960 (x^5) (y^2) (z^6)-55037657088 (y^4) (z^6)-908121341952 x (y^4) (z^6)+770527199232 (x^2) (y^4) (z^6)-917294284800 (x^3) (y^4) (z^6)+623760113664 (y^6) (z^6)-550376570880 x (y^6) (z^6)-165112971264 (x^2) (z^8)+233910042624 (x^3) (z^8)+602404356096 (x^4) (z^8)+232190115840 (x^5) (z^8)-12039487488 (x^6) (z^8)-165112971264 (y^2) (z^8)-701730127872 x (y^2) (z^8)+1204808712192 (x^2) (y^2) (z^8)-464380231680 (x^3) (y^2) (z^8)-59337474048 (x^4) (y^2) (z^8)+602404356096 (y^4) (z^8)-696570347520 x (y^4) (z^8)-20639121408 (x^2) (y^4) (z^8)-14619377664 (y^6) (z^8)-123834728448 (z^10)+232190115840 (x^2) (z^10)+80299081728 (x^3) (z^10)-29023764480 (x^4) (z^10)+232190115840 (y^2) (z^10)-240897245184 x (y^2) (z^10)-58047528960 (x^2) (y^2) (z^10)-29023764480 (y^4) (z^10)+26121388032 (z^12)-15509574144 (x^2) (z^12)+544195584 (x^3) (z^12)-15509574144 (y^2) (z^12)-1632586752 x (y^2) (z^12)-1836660096 (z^14)+43046721 (z^16);

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

With[{r=1},ContourPlot3D[eqn==0,{x,-r,r},{y,-r,r},{z,-r,r},RegionFunction->(#1^2+#2^2+#3^2<r^2&),Boxed->False,Axes->False,PlotPoints->20]]

Plot

V5.2

g=ParametricPlot3D[{r*Cos[phi] - (r^2*Cos[2*phi])/2, -(r*Sin[phi]) - (r^2*Sin[2*phi])/2,(4*r^(3/2)*Cos[(3*phi)/2])/3},{r, 0.0001, 1, 0.9999/8}, {phi, 0, 4Pi, Pi/12},Boxed->False]

WriteLiveForm["maeder.m",g]

V6

ParametricPlot3D[surf[r,ϕ],{r,0,#},{ϕ,0,2π},Boxed->False,Axes->False,PlotPoints->20]&/@{1,2,3}

ParametricPlot3D[surf[r,ϕ],{r,0,#},{ϕ,0,4π},Boxed->False,Axes->False,PlotPoints->20]&/@{1,2,3}

ParametricPlot3D[surf[r,ϕ],{r,0,#},{ϕ,0,6.π},Boxed->False,Axes->False,PlotPoints->20]&/@{1,2,3}

Properties

Curvatures[surf[r,ϕ],{r,ϕ},FullSimplify[#,r>0]&]

Simplify[PrincipalCurvatures[EnneperWeierstrass[1,Sqrt[z],{z,r,ϕ}],{r,ϕ}]]//Timing

FullSimplify[{(Sqrt[(1/(r (((1+r))^4)))]),-(Sqrt[(1/(r (((1+r))^4)))])},r>0]

GaussianCurvature[eqn,{x,y,z},Identity]//Timing

Simplify[Last[%]]

ByteCount/@%

FullSimplify[%4[[2]]]

ByteCount[%]

Metric Properties

Metric Tensor

MetricTensor[{r Cos[ϕ]-(1/2) (r^2) Cos[2 ϕ],-r (1+r Cos[ϕ]) Sin[ϕ],(4/3) (r^(3/2)) Cos[((3 ϕ)/2)]},{r,ϕ}]//FullSimplify

Christoffel Symbol of the Second Kind

FullSimplify[ChristoffelSymbols[{r Cos[ϕ]-(1/2) (r^2) Cos[2 ϕ],-r (1+r Cos[ϕ]) Sin[ϕ],(4/3) (r^(3/2)) Cos[((3 ϕ)/2)]},{r,ϕ}],r>0]

TraditionalForm[%]

Vector Properties

Vector Length

Assuming[r>0&&0<ϕ<4π,FullSimplify[Norm[{r Cos[ϕ]-(1/2) (r^2) Cos[2 ϕ],-r (1+r Cos[ϕ]) Sin[ϕ],(4/3) (r^(3/2)) Cos[((3 ϕ)/2)]}]]]

Normal Vector

Assuming[r>0&&0<ϕ<4π,FullSimplify[NormalVector[{r Cos[ϕ]-(1/2) (r^2) Cos[2 ϕ],-r (1+r Cos[ϕ]) Sin[ϕ],(4/3) (r^(3/2)) Cos[((3 ϕ)/2)]},{r,ϕ}]]]