Mathematica 教學 旋轉體體積

f[c_]:=Block[{x1,x2,x,fun1,fun2,fun3},
x1=ArcSin[c];x2=Pi-x1;
fun1=
{
{Abs[Sin[x]-c],{x,0,x1},PlotRange->All,RevolutionAxis->"X"},
{Abs[Sin[x]-c],{x,x2,Pi},PlotRange->All,RevolutionAxis->"X"},
{Max[Abs[Sin[x]-c],c],{x,x1,x2},PlotRange->All,RevolutionAxis->"X"}
};
fun2=
{
{Abs[Sin[x]-c],{x,0,Pi/2},PlotRange->All,RevolutionAxis->"X"},
{Abs[Sin[x]-c],{x,Pi/2,Pi},PlotRange->All,RevolutionAxis->"X"}
};
fun3=
{
{Sin[x]-c,{x,0,Pi},PlotRange->All,RevolutionAxis->"X"}
};
If[c==1,fun2,If[c==0,fun3,fun1]]
]


Manipulate[Column@{
Plot[{Sin[x],z},{x,0,Pi},AspectRatio->1/Pi,
PlotRange->{{0,Pi},{0,1}},ImageSize->350],
Show[RevolutionPlot3D@@@f[z],PlotRange->All,
BoxRatios->{Pi,1,1},ImageSize->350]},
{z,0,1}]

g[c_?NumberQ]:=Block[{x1,x2,x,fun,fun1,fun2,fun3},
x1=ArcSin[c];
x2=Pi-x1;
fun1=
{
{(Sin[x]-c)^2Pi,{x,0,x1}},
{(Sin[x]-c)^2Pi,{x,x2,Pi}},
{Max[(Sin[x]-c),c]^2Pi,{x,x1,x2}}
};
fun2=
{
{(Sin[x]-1)^2Pi,{x,0,Pi/2}},
{(Sin[x]-1)^2Pi,{x,Pi/2,Pi}}
};
fun3=
{
{(Sin[x])^2Pi,{x,0,Pi}}
};
fun=If[c==1,fun2,If[c==0,fun3,fun1]];
Total@Map[Integrate[#[[1]],#[[2]]]&,fun]
]

NMinimize[{g[z],0 < z < 1},z, Method->{"NelderMead","PostProcess"->False,
"InitialPoints"->{{Random[]},{Random[]}}},
EvaluationMonitor:>Print@{z,g[z]}]

Ans: {1.77847, {c -> 0.438485}}

Tags: Mathematica 教學, Mathematica 教學 畫圖, Mathematica 教學 微積分, Teaching

• 編輯文章
• 此文章網址
• 轉寄此文章
• 目前有0 意見