“Region Measure” with Mathematica
ー東大入試を １行で  解くー

ー２０１８年１２月　　Cabri研究会　生越 茂樹ー

§１．面積･体積

【面積 （不等式で表された領域）】

reg=ImplicitRegion[y(y-Abs[x^2-5]+4)≤0&&y+x^2-2x-3≤0,{x,y}];

(*1*) RegionPlot[y(y-Abs[x^2-5]+4)≤0&&y+x^2-2x-3≤0,{x,-2,3},{y,-4,1},PlotPoints->50]

(*2*)RegionMeasure[reg]

【体積 （不等式で表された領域）】

● r=1として計算して，((後でr)^3)倍すればよい．

reg=ImplicitRegion[x^2+y^2≤1&&y^2+z^2≥1&&z^2+x^2≤1,{x,y,z}]
v=RegionMeasure[reg]*r^3

●「(x^2)+(y^2)≤1∧(x^2)+(z^2)≤1 」と「(x^2)+(y^2)≤1∧(x^2)+(z^2)≤1∧(y^2)+(z^2)≥1」の比較

RegionPlot3D[x^2+y^2≤1&&z^2+x^2≤1,{x,-1,1},{y,-1,1},{z,-1,1},PlotPoints->50,Boxed->False,Axes->None,Mesh->None]
RegionPlot3D[x^2+y^2≤1&&y^2+z^2≥1&&z^2+x^2≤1,{x,-1,1},{y,-1,1},{z,-1,1},PlotPoints->100,Boxed->False,Axes->None,Mesh->None]

【２つの円錐の共通部分の体積】

v1=((2x y-2x-2y+2≥z^2)&&(2>x+y≥0))∨((2x y+2x+2y+2≥z^2)&&(-2<x+y<0));
v2=((-2x y+2x-2y+2≥z^2)&&(2>-x+y≥0))∨((-2x y-2x+2y+2≥z^2)&&(-2<-x+y<0));
reg=v1 ∧ v2;

【v1 ∧ v2 の概形 と v1の断面】　(RegionPlot3D[v1&&x==1/2,{x,y,z}] などは引数がregionでないので駄目)]

Row[{RegionPlot3D[reg,{x,-3/2,3/2},{y,-3/2,3/2},{z,-3/2,3/2},PlotPoints->50,ImageSize->250],"   ",
Manipulate[RegionPlot[v1/.{x->t},{y,-1,1},{z,-(Sqrt[2]),(Sqrt[2])},ImageSize->Small],{t,0,1}]}]

(*1*)Assuming[0≤t<1,RegionMeasure[ImplicitRegion[v1/.x->t,{y,z}]]]

(*2*)RegionMeasure[ImplicitRegion[reg,{x,y,z}]]

【円錐の一部分の体積】

C上の点をQ(x,y,z),PQとxy平面との交点をR(a,b,0)とおくと,(OverVector[PQ])=t(OverVector[PR ])(t>1)とおける．
Cは中心(0,0,(Sqrt[2])),半径(Sqrt[2])の球と 平面y=z の共通部分だから　C:(x^2)+(((y-(Sqrt[2])))^2)+(z^2)≤2∧y=z

Clear[a,b,t,x,y,z]
(*1*)Exists[{t,x,y,z},{x,y,z-2 Sqrt[2]}== t{a,b,-2 Sqrt[2]}&&y==z&&x^2+(y-Sqrt[2])^2+z^2≤2];
bottom=Reduce[%,Reals]
(*RegionPlot[%,{a,-2,2},{b,0,3},Axes->True,AspectRatio->3/4]*)    (*←Sの概形*)

(*2*)(*線分QR上の点をS(X,Y,Z)とすると (OverVector[PS])=s(OverVector[PR]) かつ 0<Z<Y*)
Clear[a,b,s,X,Y,Z]
Exists[{s,a,b},{X,Y,Z-2Sqrt[2]}== s{a,b,-2Sqrt[2]}&&bottom&&Y>Z>0];
body=Resolve[%,Reals]//FullSimplify
RegionPlot3D[body,{X,-2,2},{Y,0,3},{Z,0,Sqrt[2]},Axes->True,PlotPoints->50,BoxRatios->Automatic,Mesh->False]

RegionMeasure[ImplicitRegion[body,{X,Y,Z}]]//FullSimplify

【回転体の体積】

●　y軸をz軸に取り直して考えると z=(3/4)-((x^2)+(y^2))と　z=x で囲まれた立体の体積と等しい．

reg=ImplicitRegion[z≤3/4-(x^2+y^2)&&z≥x,{x,y,z}]
RegionMeasure[%]

RegionPlot3D[z≤3/4-(x^2+y^2)&&z≥x,{x,-1.5,0.5},{y,-1.5,1.5},{z,-2,1},PlotPoints->50]

§２．表面積＆面積分
ーRegionMeasure で面積や長さを求められるが，Integrate を使ってもできるー

reg=ImplicitRegion[0≤z≤1-x+Sqrt[3]y&&x^2+y^2==1,{x,y,z}];
RegionMeasure[reg]

●RegionMeasure でなく 面積分を使って計算することもできる．

Integrate[1,{x,y,z}∈reg]

●面積･体積･表面積は色々な求め方がある．例えば，
「z軸を軸とする半径1の円柱」と「y軸を軸とする半径1の円柱」の共通部分をEとすると, Eの体積は

v1=Integrate[1,{x,y,z}∈ImplicitRegion[x^2+y^2≤1&&x^2+z^2≤1,{x,y,z}]]
v2=Integrate[Boole[x^2+y^2≤1&&x^2+z^2≤1],{x,-1,1},{y,-1,1},{z,-1,1}]
v3=RegionMeasure[ImplicitRegion[x^2+y^2≤1&&x^2+z^2≤1,{x,y,z}]]

Eの表面積は

s1=Integrate[1,{x,y,z}∈ImplicitRegion[x^2+y^2==1&&x^2+z^2==1,{x,y,z}]]
s2=Integrate[Boole[x^2+y^2==1&&x^2+z^2==1],{x,-1,1},{y,-1,1},{z,-1,1}]
s3=RegionMeasure[ImplicitRegion[x^2+y^2==1&&x^2+z^2==1,{x,y,z}]]

”s2” のみ 「体積」 として計算するので，値が 0 となる．表面積は region を使わないといけないようだ．

§３．ルベーグ測度
ー２次元では RegionMeasure[reg,2], ｎ次元では RegionMeasure[reg,n]ー

●区間[0, 1] における有理数のルベーグ測度

r1=ImplicitRegion[x∈Rationals&&0<x<1,x];
RegionMeasure[r1,1]

●単位正方形[0, 1]×[0, 1] における「有理数×実数」のルベーグ測度

r2=ImplicitRegion[x∈Rationals&&y∈Reals&&0<x<1&&0<y<1,{x,y}];
RegionMeasure[r2,2]

●Cantor集合の測度

Plot[CantorStaircase[x],{x,0,1},PlotLabel->"Cantor関数"]

cantorset=ImplicitRegion[D[CantorStaircase[x],x]==Infinity,x];
RegionMeasure[cantorset,1]

●Cantor集合の測度は正しい．しかし，他の同値な表現では答えが出ない．またもっと簡単な測度も測れない．

c1=ImplicitRegion[CantorStaircase[x]==1/2,x];
RegionMeasure[c1,1]

●連続関数なら測れるけど...

f[x_]=x^3-3x;
c2=ImplicitRegion[1/3<f[x]<1/2,{x}];
RegionMeasure[c2,1]//N

● Integrate でも同様のことは可能．

r1'=Integrate[Boole[x∈Rationals],{x,0,1}]

●下のf(x)はグラフはかけないが面積は（ルベーグの意味で) 求まる．

f[x_]=If[!x∈Rationals,1,0]
Plot[Evaluate[f[x]],{x,0,1}]
Integrate[f[x],{x,0,1}]

●NIntegrate を使うと Cantor関数の下側の面積が求まる．(でもこれはRiemann積分可能)

Plot[CantorStaircase[x],{x,0,1},PlotLabel->"Cantor関数"]

Integrate[CantorStaircase[x],{x,0,1}]

NIntegrate[CantorStaircase[x],{x,0,1}]

【私の結論】 有理数の直接絡んだ場合以外は，RegionMeasure や Integrate のルベーグ積分は，リーマン積分と同じ．

補充

【体積 （不等式で表された領域）】

reg=ImplicitRegion[x≥0&&y≥0&&z≥0&&x+y+z≤3&&x+2z≤4&&y-z≤1,{x,y,z}];
RegionMeasure[reg]
RegionPlot3D[reg,PlotPoints->70,Axes->True]

【体積 （不等式で表された領域）】

reg=ImplicitRegion[0≤z≤1+x+y-3(x-y)y&&0≤y≤1&&y≤x≤y+1,{x,y,z}];
RegionMeasure[reg]
RegionPlot3D[reg,PlotPoints->70,Axes->True,AxesLabel->{"x","y","z"}]

【体積 （不等式で表される領域）】

reg=ImplicitRegion[x^2+y^2≥1&&z≤-3x+3&&z≤3x+3&&z≤-3y+3&&z≤3y+3&&z≥0,{x,y,z}]//RegionMeasure

【体積 （変数の順序に注意）】

●ImplicitRegionの変数の順序が大切．{y,z,x}では計算できない.それ以外はOK.

(*2*) regXYZ=ImplicitRegion[x^2+y^2≤z^2&&z^2≤x&&0≤z≤1,{x,y,z}];
RegionPlot3D[regXYZ,PlotPoints->100]
RegionMeasure[regXYZ]

●体積は {y, z, x} では計算できない （図は描ける)

regYZX=ImplicitRegion[x^2+y^2≤z^2&&z^2≤x&&0≤z≤1,{y,z,x}];
RegionMeasure[regYZX]

【表面積】

RegionPlot3D[(x^2)-(Sqrt[3]) x z+(z^2)≥(1/4)&&(y^2)+(z^2)<=1,{x,-1,1},{y,-1,1},{z,-1,1},PlotPoints->200,Boxed->False,Axes->False,Mesh->None]

●変数の順序に注意！{x, y, z} では計算できない

reg=ImplicitRegion[y^2+z^2==1&&x^2-Sqrt[3]x z+z^2≤1/4,{z,x,y}];
s1=RegionMeasure[%]; Print["S=",s1,"  by RegionMeasure"]

●θt平面上で積分しても同じ

s2=Integrate[2(Sin[t-Pi/6]-Sin[t+Pi/6]),{t,Pi/2,3Pi/2}];
Print["S=",s2,"  by integral on θt plane"]

●回転体の体積はやや苦手のようだ．頭を使って積分に持ち込まないといけないケースもある．

reg=ImplicitRegion[0≤z≤Pi (x^2+y^2) Sin[Pi (x^2+y^2)]&&x^2+y^2≤1,{y,x,z}];
RegionMeasure[reg]

v=2Pi *Integrate[x Pi x^2 Sin[Pi x^2],{x,0,1}]