Kiss Surface

Author

Eric W. Weisstein
June 10, 2014

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

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

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

Initialization

surf[u_,v_]:=a{(v^2)(Sqrt[(1-v)/2])Cos[u],(v^2)(Sqrt[(1-v)/2])Sin[u],v}
kiss=(x^2+y^2)-z^4(1-z)/2;

Equation

Numerator[Together[Expand[kiss]]]

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

Cross-Section

Plot[(z^2)(Sqrt[(1-z)/2]),{z,-1,1},PlotStyle->Red]

Graphic

V5

<<Graphics`ContourPlot3D`

ContourPlot3D[kiss,{x,-2,2},{y,-2,2},{z,-1,1},
PlotPoints->{9,12},
ContourStyle->EdgeForm[],Boxed->False,
PlotRange->All]//Timing

V6

ContourPlot3D[kiss==0,{x,-2,2},{y,-2,2},{z,-1,1},Boxed->False,PlotRange->All,Axes->False,Mesh->False,PlotPoints->20]

Show[{ContourPlot3D[kiss==0,{x,-2,2},{y,-2,2},{z,-1,1},Boxed->False,PlotRange->All,Axes->False,Mesh->False,PlotPoints->20],Graphics3D[Sphere[{0,0,0},.1]]}]

ParametricPlot3D[surf[u,v]/.a->1,{u,0,2π},{v,-1,1},PlotRange->All,Boxed->False,Axes->False]

POVRay

<<POVray`

POVCoefficients[kiss//N,{x,y,z}]

Properties

Curvatures[surf[u,v],{u,v},Refine[Factor[FullSimplify[#,v<1&&a>0]],v<1]&]

FullSimplify[PrincipalCurvatures[surf[u,v],{u,v}],a>0&&0<u<2π&&v<1]

GaussianCurvature[kiss,{x,y,z}]

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

Surface Area

Surface Element

2π Integrate[(1/4) (a^2) (v^2) (Sqrt[8-8 v+16 (v^2)-40 (v^3)+25 (v^4)]),{v,0,1}]//FullSimplify

2π (a^2) NIntegrate[(1/4)  (v^2) (Sqrt[8-8 v+16 (v^2)-40 (v^3)+25 (v^4)]),{v,0,1}]

Surface of Revolution

(v^2)(Sqrt[(1-v)/2])

Volume

Numeric

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

Cartesian

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

Cylindrical

FullSimplify[(x^2+y^2)-z^4(1-z)/2/.{x->r Cos[θ],y->r Sin[θ]},r>0&&0<θ<2π]

Integrate[Boole[(1/2) (2 (r^2)+(-1+z) (z^4))<0]r,{z,0,∞},{r,0,∞},{θ,0,2π}]

Solid of Rotation

π Integrate[z^4(1-z)/2,{z,0,1}]

N[%]

Centroid

Cartesian

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

Cylindrical

Integrate[{r Cos[θ],r Sin[θ],z}Boole[(1/2) (2 (r^2)+(-1+z) (z^4))<0]r,{z,0,∞},{r,0,∞},{θ,0,2π}]/(π/60)

Inertia Tensor

Cartesian

(M/(π/60))Integrate[InertiaTensor[{x,y,z},"CoordinateSystem"->"Cartesian"]Boole[(x^2+y^2)-z^4(1-z)/2<0],{z,0,∞},{y,-∞,∞},{x,-∞,∞}]

Cylindrical

(M/(π/60))Integrate[InertiaTensor[{r,θ,z},"CoordinateSystem"->"Cylindrical"]Boole[(1/2) (2 (r^2)+(-1+z) (z^4))<0]r,{z,0,∞},{r,0,∞},{θ,0,2π}]

Metric Properties

Metric Tensor

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

Christoffel Symbol of the Second Kind

FullSimplify[ChristoffelSymbols[surf[u,v],{u,v}],a>0&&v<1]

Vector Properties

eqn=a{v^2Sqrt[(1-v)/2]Cos[u],v^2Sqrt[(1-v)/2]Sin[u],v};
rules={Abs[x_]^(n_/;Mod[n,2]==0):>x^n};
assum=a>0&&0<u<2π&&v∈Reals;

Vector Length

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

Normal Vector

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