Bohemian Dome

Author

Eric W. Weisstein
June 10, 2014

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

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

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

Definition

surf[a_,b_,c_][u_,v_]:={a Cos[u],b Cos[v]+a Sin[u],c Sin[v]}

surf[a,b,c][u,v]

Equation

eqns=Join[Thread[{x,y,z}==surf[a,b,c][u,v]],Sin[#]^2+Cos[#]^2==1&/@{u,v}]

{eqn}=Factor/@GroebnerBasis[eqns,{x,y,z},{Sin[u],Cos[u],Sin[v],Cos[v]}]

FullSimplify[eqn]

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

Graphic

V5

dome=Show[BohemianDome[],Boxed->False]

Show[BohemianDome[8,3,3],Boxed->False]

V6

ParametricPlot3D[surf[Sequence@@#][u,v],{u,0,2Pi},{v,0,2Pi},Boxed->False,Axes->False]&/@{{1,1,1},{1,2,3},{8,3,3}}

LiveGraphics3D

<<Utilities`LiveGraphics3D`

WriteLiveForm[bohemian.m,dome]

Properties

dome={a Cos[u],b Cos[v]+a Sin[u],c Sin[v]};

Curvatures[dome,{u,v},FullSimplify[#,a>0&&b>0&&c>0]&]

Gaussian Curvature

FullSimplify[GaussianCurvature[dome,{u,v}]]

SortBy[FullSimplify[GaussianCurvature[eqn,{x,y,z}],a>0&&b>0&&c>0],ByteCount]

ByteCount/@%

Mean Curvature

FullSimplify[MeanCurvature[dome,{u,v}],(a|b|c)∈Reals]

Principal Curvature

Simplify[PrincipalCurvatures[dome,{u,v}],(a|b|c)∈Reals]

curv={(1/(8 (Sqrt[2])))(√(((c^2) (16 (a^2) (b^2)+2 (b^4)+4 (b^2) (c^2)+10 (c^4)-16 (a^2) (b^2) Cos[2 u]+(-(b^4)+2 (b^2) (c^2)+15 (c^4)) Cos[2 v]-2 (b^4) Cos[4 v]-4 (b^2) (c^2) Cos[4 v]+6 (c^4) Cos[4 v]+(b^4) Cos[6 v]-2 (b^2) (c^2) Cos[6 v]+(c^4) Cos[6 v]-8 a (b^3) Cos[v] Sin[u]-48 a b (c^2) Cos[v] Sin[u]+8 a (b^3) Cos[3 v] Sin[u]-16 a b (c^2) Cos[3 v] Sin[u]+8 a (b^3) Cos[v] Sin[3 u]-8 a (b^3) Cos[3 v] Sin[3 u]))/((a^2) ((((c^2) ((Cos[u])^2) ((Cos[v])^2)+((Sin[u])^2) ((c^2) ((Cos[v])^2)+(b^2) ((Sin[v])^2))))^3))))-((c (((b^2)+3 (c^2)) Cos[v]+(-(b^2)+(c^2)) Cos[3 v]+4 a b Sin[u]))/(8 Abs[a] ((((c^2) ((Cos[u])^2) ((Cos[v])^2)+((Sin[u])^2) ((c^2) ((Cos[v])^2)+(b^2) ((Sin[v])^2))))^(3/2)))),-(1/(8 (Sqrt[2])))(√(((c^2) (16 (a^2) (b^2)+2 (b^4)+4 (b^2) (c^2)+10 (c^4)-16 (a^2) (b^2) Cos[2 u]+(-(b^4)+2 (b^2) (c^2)+15 (c^4)) Cos[2 v]-2 (b^4) Cos[4 v]-4 (b^2) (c^2) Cos[4 v]+6 (c^4) Cos[4 v]+(b^4) Cos[6 v]-2 (b^2) (c^2) Cos[6 v]+(c^4) Cos[6 v]-8 a (b^3) Cos[v] Sin[u]-48 a b (c^2) Cos[v] Sin[u]+8 a (b^3) Cos[3 v] Sin[u]-16 a b (c^2) Cos[3 v] Sin[u]+8 a (b^3) Cos[v] Sin[3 u]-8 a (b^3) Cos[3 v] Sin[3 u]))/((a^2) ((((c^2) ((Cos[u])^2) ((Cos[v])^2)+((Sin[u])^2) ((c^2) ((Cos[v])^2)+(b^2) ((Sin[v])^2))))^3))))-((c (((b^2)+3 (c^2)) Cos[v]+(-(b^2)+(c^2)) Cos[3 v]+4 a b Sin[u]))/(8 Abs[a] ((((c^2) ((Cos[u])^2) ((Cos[v])^2)+((Sin[u])^2) ((c^2) ((Cos[v])^2)+(b^2) ((Sin[v])^2))))^(3/2))))};

FullSimplify[curv,a>0&&b>0&&c>0]

Singular Points

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

Surface Area

Integrate[a (Sqrt[(c^2) ((Cos[v])^2)+(b^2) ((Sin[u])^2) ((Sin[v])^2)]),{u,0,2π},{v,0,2π},Assumptions->a>0&&b>0&&c>0]//Timing

Integrate[a (Sqrt[(c^2) ((Cos[v])^2)+(b^2) ((Sin[u])^2) ((Sin[v])^2)]),{v,0,2π},{u,0,2π},Assumptions->a>0&&b>0&&c>0]//Timing

Volume

eqn/.{a->1,b->1,c->1}

NIntegrate[Boole[(x^4)-4 (y^2)+2 (x^2) (y^2)+(y^4)-2 (x^2) (z^2)+2 (y^2) (z^2)+(z^4)<0],{x,-5,5},{y,-5,5},{z,-5,5}]

Integrate[Boole[(x^4)-4 (y^2)+2 (x^2) (y^2)+(y^4)-2 (x^2) (z^2)+2 (y^2) (z^2)+(z^4)<0],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞}]//Timing

Integrate[Boole[(x^4)-4 (y^2)+2 (x^2) (y^2)+(y^4)-2 (x^2) (z^2)+2 (y^2) (z^2)+(z^4)<0],{z,-∞,∞},{y,-∞,∞},{x,-∞,∞}]//Timing

Metric Properties

Metric Tensor

MetricTensor[dome,{u,v}]//FullSimplify

Christoffel Symbol of the Second Kind

FullSimplify[ChristoffelSymbols[dome,{u,v}]]

TraditionalForm[%]

Vector Properties

VectorLength

assum=a>0&&b>0&&c>0&&0<u<2π&&0<v<2π;

FullSimplify[VectorLength[surf[a,b,c][u,v],{u,v}],assum]

Refine[%,assum]

FullSimplify[%,assum]

NormalVector

FullSimplify[NormalVector[surf[a,b,c][u,v],{u,v}],assum]

Refine[%,assum]

FullSimplify[%,assum]