Apple Surface

Author

Eric W. Weisstein
February 19, 2020

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

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

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

Slice

AppleSlice[R_,r_]:=ParametricPlot[{{x,Sqrt[R^2-(x-r)^2]},{x,-Sqrt[R^2-(x-r)^2]},{-x,Sqrt[R^2-(x-r)^2]},{-x,-Sqrt[R^2-(x-r)^2]}},{x,0,r+R},Axes->None,PlotRange->{-(r+R),r+R},PlotStyle->Red]

AppleSlice[1.,0.5]

Solid

Apple[R_,r_]:=RevolutionPlot3D[Evaluate[{x,#Sqrt[R^2-(x-r)^2]}&/@{-1,1}],{x,0,R+r},PlotStyle->Red]

Apple[1.,.5]

Manipulate[Apple[1,r],{{r,.5},0,1}]

ContourPlot3D

ContourPlot3D[z^2+((Sqrt[x^2+y^2])-#2)^2==#1^2,{x,-2,2},{y,-2,2},{z,-2,2},Boxed->False,Axes->False,PlotPoints->10,Mesh->False]&@@@{{1,.9},{1,.5},{1,.3}}

Equation

Parametric

Solve[z^2==R^2-(ℛ-r)^2,ℛ]

Apple2[r_,R_][u_,v_]:={Cos[u](r-(Sqrt[(R^2)-(v^2)])),Sin[u](r-(Sqrt[(R^2)-(v^2)])),v}

Apple3[r_,R_][u_,v_]:={Cos[u](r+(Sqrt[(R^2)-(v^2)])),Sin[u](r+(Sqrt[(R^2)-(v^2)])),v}

With[{r=.5,R=1},ParametricPlot3D[Apple2[r,R][u,v],{u,0,2π},{v,-R,R}]]

With[{r=.5,R=1},ParametricPlot3D[Apple3[r,R][u,v],{u,0,2π},{v,-R,R}]]

Cartesian

Expand[((Sqrt[x^2+y^2])-r)^2-R^2+z^2==0]

(r^2)-(R^2)+(x^2)+(y^2)+(z^2)==2 r (Sqrt[(x^2)+(y^2)])

eqn=FullSimplify[((((r^2)-(R^2)+(x^2)+(y^2)+(z^2)))^2)==4r^2((x^2)+(y^2))]

FullSimplify[Expand[Subtract@@eqn]]

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

With[{r=.5,R=1},
ContourPlot3D[((((r^2)-(R^2)+(x^2)+(y^2)+(z^2)))^2)==4 (r^2) ((x^2)+(y^2)),{x,-2,2},{y,-2,2},{z,-2,2},Boxed->False,Axes->False,PlotPoints->10,Mesh->False]
]

Region

ParametricPlot

Solve[z^2==R^2-(x-r)^2,x]

With[{r=.5,R=1},ParametricPlot3D[{Cos[u](r-(Sqrt[(R^2)-(v^2)])),Sin[u](r-(Sqrt[(R^2)-(v^2)])),v},{u,0,2π},{v,-(Sqrt[(R^2)+(r^2)]),(Sqrt[(R^2)+(r^2)])},PlotRange->All]]

RegionPlot3D

With[{R=1,r=.5},RegionPlot3D[(r^4)-2 (r^2) ((R^2)+(x^2)+(y^2)-(z^2))+(((-(R^2)+(x^2)+(y^2)+(z^2)))^2)<0,{x,-(R+r),R+r},{y,-(R+r),R+r},{z,-(Sqrt[(R^2)+(r^2)]),(Sqrt[(R^2)+(r^2)])},BoxRatios->Automatic]]

ContourPlot3D

With[{R=1,r=.5},ContourPlot3D[z^2==R^2-((Sqrt[x^2+y^2])-r)^2,{x,-(R+r),R+r},{y,-(R+r),R+r},{z,-(Sqrt[(R^2)+(r^2)]),(Sqrt[(R^2)+(r^2)])},BoxRatios->Automatic]]

ParametricRegion

Solve[z^2==R^2-(x-r)^2,x]

Block[{R=1,r=.5},Region@ParametricRegion[{Cos[u](r-(Sqrt[(R^2)-(v^2)])),Sin[u](r-(Sqrt[(R^2)-(v^2)])),v},{{u,0,2π},{v,-(Sqrt[(R^2)+(r^2)]),(Sqrt[(R^2)+(r^2)])}}]]

Properties

FirstFundamentalForm

FullSimplify[FirstFundamentalForm[{Cos[u](-r+(Sqrt[(R^2)-(v^2)])),Sin[u](-r+(Sqrt[(R^2)-(v^2)])),v},{u,v}]]

Volume

Integrate[Boole[z^2+((Sqrt[x^2+y^2])-r)^2<R^2],{x,-∞,∞},{y,-∞,∞},{z,-∞,∞},Assumptions->0<r<R]