Maximizing the Volume and Surface Area of Geometric Solids Inscribed in a Sphere

Manipulate[
If[r>maxr,r=maxr];
theSphere=Graphics3D[{Opacity[0.4],Sphere[]}];
theCircle=Graphics[Circle[]];

theCylinder=Graphics3D[{Green,Cylinder[{{0,0,-Sqrt[1-r^2]},{0,0,Sqrt[1-r^2]}},r]}];
volCylinder[r_]:=Pi*r^2*2Sqrt[1-r^2];
surfCylinder[r_]:=2Pi *r^2+2Pi*r*2Sqrt[1-r^2];
projCylinder=Graphics[{EdgeForm[Directive[Thick,Blue]],RGBColor[.25,.75,.25],Rectangle[{-r,-Sqrt[1-r^2]},{r,Sqrt[1-r^2]}]}];

theCone=Graphics3D[{Green,Cone[{{0,0,-Sqrt[1-r^2]},{0,0,1}},r]}];
volCone[r_]:=1/3*Pi*r^2*(1+Sqrt[1-r^2]);
surfCone[r_]:=Pi *r^2+Pi*r*Sqrt[r^2+(1+Sqrt[1-r^2])^2];
projCone=Graphics[{EdgeForm[Directive[Thick,Blue]],RGBColor[.25,.75,.25],Polygon[{{-r,-Sqrt[1-r^2]},{0,1},{r,-Sqrt[1-r^2]}}]}];


theCuboid=Graphics3D[{Green,Cuboid[{-r ,-r,-Sqrt[1-2r^2]},{r ,r ,Sqrt[1-2r^2]}]}];
volCuboid[r_]:=4r^2*2Sqrt[1-2r^2];
surfCuboid[r_]:=8r^2+4*2r*2Sqrt[1-2r^2];
projCuboid=Graphics[{EdgeForm[Directive[Thick,Blue]],RGBColor[.25,.75,.25],Rectangle[{-r ,-Sqrt[1-2r^2]},{r ,Sqrt[1-2r^2]}]}];

Switch[fig,
cylinder,theFigure=theCylinder;maxr=1;volFunc=volCylinder;surfFunc=surfCylinder;proj=projCylinder,
cone,theFigure=theCone;maxr=1;volFunc=volCone;surfFunc=surfCone;proj=projCone,
cuboid,theFigure=theCuboid;maxr=Sqrt[2]/2;If[r>Sqrt[2]/2,r=0.25];volFunc=volCuboid;surfFunc=surfCuboid;proj=projCuboid];

volPlot=Plot[volFunc[x],{x,0,maxr},PlotLabel->Style[Row[{"volume of ",fig}],18],ImageSize->250,ImagePadding->20];
surfPlot=Plot[surfFunc[x],{x,0,maxr},PlotLabel->Style[Row[{"surface area of ",fig}],18],ImageSize->250,ImagePadding->20];
projPlot=Show[theCircle,proj,Axes->True,AxesLabel->{x,z},ImageSize->200];
pointOnVolCurve=Graphics[{PointSize[Large],Green,Point[{r,volFunc[r]}]}];
pointOnSurfCurve=Graphics[{PointSize[Large],Green,Point[{r,surfFunc[r]}]}];
volDisplay=Show[volPlot,pointOnVolCurve,ImageSize->250];
surfDisplay=Show[surfPlot,pointOnSurfCurve,ImageSize->250];

Switch[obj,volume,displayFunc=volDisplay,surface,displayFunc=surfDisplay];
Switch[disp,False,theDisplay=displayFunc,True,theDisplay=projPlot];

Text@Pane[Row[{Show[theSphere,theFigure,Axes->True,AxesOrigin->{0,0,0},ImageSize->300],Column[{Show[theDisplay],"",Style[Row[{Style["r",Italic]," = ",NumberForm[r,{6,4}]}],24],Style[Row[{"volume = ",NumberForm[volFunc[r],{6,4}]}],24],Style[Row[{"surface area = ",NumberForm[surfFunc[r],{6,4}]}],24]}]}],ImageSize->{560,360}],


{{fig,cylinder,"figure"},{cylinder,cone,cuboid}},
{{obj,volume,"objective"},{volume->"volume",surface->"surface area"},Enabled->!disp},
{{r,0.5},0,maxr},
{{disp,False,"show projection"},{False,True}},
{{maxr,1},ControlType->None},
TrackedSymbols->True,AutorunSequencing->{1,2,3,4}]

This Demonstration illustrates two common types of max-min problem from a Calculus I course—those of finding the maximum volume and finding the maximum surface area of a geometric figure inscribed in a sphere. The figures available are a cylinder, a cone, and a cuboid with a square base. The sphere has radius 1. For the cylinder and the cone, r is the radius of the base. For the cuboid, r is one-half the length of a side of the base. An option to show the projection of the sphere and the inscribed solid onto the x-z  plane is included (see snapshot 5).

Contributed by: Marc Brodie (Wheeling Jesuit University)