Double Integral for Volume

Manipulate[
Module[{a,npnts,rp,zmax,zmin,gr,grS,grLPAI},
a=3;
npnts=Sqrt[npntsSq];
rp=MakePiecewise[func[#1,#2]&,npnts,{-a,a},{-a,a},False];
zmax=FindMaximum[{func[x,y],-a≤x≤a,-a≤y≤a},{{x,0.1},{y,0.1}}]//First;zmin=FindMinimum[{func[x,y],-a≤x≤a,-a≤y≤a},{{x,0.1},{y,0.1}}]//First;
gr=PlotRawPiecewise[rp];
gr=ReplacePart[gr,{1}->Append[gr[[1]],OffsetAxes[a,a,1.2*zmax,2,1.5]]];
If[showsurface,
grS=Plot3D[func[x,y],{x,-a,a},{y,-a,a},Mesh->False];
(*gr=Show[ReplacePart[gr,{1}->Prepend[gr[[1]],Opacity[0.5]]],grS];*)gr=Show[gr,ReplacePart[grS,{1}->{Opacity[0.5],grS[[1]]}]];
];
gr=Fold[Append,gr,{ImageSize->{250,250},ViewPoint->{1.102, -2.829, 1.494},SphericalRegion->True,PlotRange->{{-2a,2a},{-2a,2a},{If[zmin<0,1.2zmin,0],1.2zmax}}}];
grLPAI=ListPlotApproxIntegrals[func,{{-a,a},{-a,a}},Range[1,npnts]];grLPAI=Fold[Append,grLPAI,{GridLines->{None,{NIntegrate[func[x,y],{x,-a,a},{y,-a,a}]}},
AxesLabel->{"n","approximate volume"},ImageSize->{250,250}}];
Grid[{{Text@Column[{Row[{TraditionalForm[HoldForm[f[x,y]]],"=",If[func===fHP,TraditionalForm[func[x,y]],TraditionalForm[Piecewise[{{(-x^2-y^2+9),x^2+y^2≤ 9},{"0",x^2+y^2>9}}]]]}],"",Row[{"n="<>ToString[npnts^2]," ","Δx="<>ToString[N@Abs[Subtract@@rp[[1,2]]]]," ","Δy="<>ToString[N@Abs[Subtract@@rp[[1,3]]]]}],"",Row[{"volume=",IntegrateRawPiecewise[rp]//N}]},Center],Text@Row[{TraditionalForm[HoldForm[Integrate[XXX,{x,-A,A},{y,-A,A}]]/.{XXX->If[func===fHP,func[x,y],Piecewise[{{(-x^2-2y^2+9),x^2+y^2≤9},{"0",x^2+y^2>9}}]],A->a}],"=",Integrate[func[x,y],{x,-a,a},{y,-a,a}]}]},{gr,grLPAI}},ItemSize->{{20,25},{10,15}}]],
{{func,fCP,""},{fCP->"circular paraboloid",fHP->"hyperbolic paraboloid"}},
{{npntsSq,9,"prisms"},Range[3,11]^2},{{showsurface,False,"show surface"},{True,False},ControlPlacement->Bottom},
AutorunSequencing->{1,2},
TrackedSymbols:>{npntsSq,func,showsurface},
SynchronousUpdating->False,
ContentSize->{620,425},
Initialization:>(
MakePiecewise[f_,npoints_,{xa_,xb_},{ya_,yb_},funcQ_:True]:=
Module[{pnts,t,xbounds,ybounds,boundaries,x,y},
xbounds=Rescale[Range[1,npoints+1],{1,npoints+1},{xa,xb}];
ybounds=Rescale[Range[1,npoints+1],{1,npoints+1},{ya,yb}];
xbounds=Partition[xbounds,2,1];
ybounds=Partition[ybounds,2,1];
boundaries=Flatten[Outer[List,xbounds,ybounds,1],1];
If[funcQ,
t=Map[{f[Mean[#[[1]]],Mean[#[[2]]]],#[[1,1]]<=x≤#[[1,2]]&&#[[2,1]]≤y≤#[[2,2]]}&,boundaries];
Evaluate[Piecewise[t]]&/.{x->#1,y->#2},
Map[{f[Mean[#[[1]]],Mean[#[[2]]]],#[[1]],#[[2]]}&,boundaries]
]
];
IntegrateRawPiecewise[rp_]:=Total@Map[#[[1]]*Abs[Subtract@@#[[2]]]Abs[Subtract@@#[[3]]]&,rp];
PlotRawPiecewise[rp_]:=Graphics3D[Map[Cuboid[{Min[#[[2]]],Min[#[[3]]],0},{Max[#[[2]]],Max[#[[3]]],#[[1]]}]&,rp],Boxed->False];
OffsetAxes[ax_,ay_,az_,faxis_,frect_]:={Line[{{-ax,0,0},{ax,0,0}}faxis],Line[{{0,-ay,0},{0,ay,0}}faxis],Line[{{0,0,0},{0,0,az}}],Polygon[{{-ax,-ay,0},{-ax,ay,0},{ax,ay,0},{ax,-ay,0}}frect]};ListPlotApproxIntegrals[f_,ranges_,npnts_List]:=
Module[{t,exact=NIntegrate[f[x,y],Prepend[ranges[[1]],x]//Evaluate,Prepend[ranges[[2]],y]//Evaluate]},
t=npnts^2;
t=MakePiecewise[f,#,ranges[[1]],ranges[[2]],False]&/@t;
t=IntegrateRawPiecewise/@t;
ListPlot[Tooltip[#,#[[1]]]&/@Transpose[{npnts^2,t}],Ticks->{npnts^2,Automatic},GridLines->{None,{exact}},PlotRange->{Automatic,{exact-.1exact,Automatic}}]
];

fHP[x_,y_]:=(x^2-2y^2+9);
(*fCP[x_,y_]:=Piecewise[{{(-x^2-y^2+9),x^2+y^2≤9},{0,x^2+y^2≥9}}];*)
fCP[x_,y_]:=(-x^2-y^2+9)Boole[x^2+y^2<9];
)]

81.*Pi/2

CAPTION

Increase the number of rectangular prisms to generate volume approximations closer to the true value. Note that some prisms effectively have zero volume.

THIS NOTEBOOK IS THE SOURCE CODE FROM

"Double Integral for Volume" from the Wolfram Demonstrations Project
 http://demonstrations.wolfram.com/DoubleIntegralForVolume/

Contributed by: Anton Antonov

Based on a program by: Abby Brown (Torrey Pines High School, San Diego, CA)

A full-function Wolfram Mathematica system (Version 6 or higher) is required to edit this notebook.
GET WOLFRAM MATHEMATICA »

© Wolfram Demonstrations Project & Contributors   |   Terms of Use   |   Make a new version of this Demonstration »