使用Mathematica描述小球在封闭空间内碰壁问题

用mathematica画空间曲面图：~

你的命令写错了，ContourPlot3D 里面应该写一个等式，把 - 1 改为 ==。
ContourPlot3D[x^2 + y^2 + z^2 == 1, {x, -1, 1}, {y, -1, 1}, {z, -1, 1}]

第一个问题：
f[x_] := 2 x^2;
xlist = NestList[# - f[#]/f'[#] &, 0.5, 4]; ylist = f[xlist]; list1 = Transpose[{xlist, ylist}]; list2 =
Transpose[{Drop[xlist, 1], Table[0, {Length[xlist] - 1}]}];
list = Riffle[list1, list2];
iterplot = ListLinePlot[list]; funplot = Plot[f[x], {x, 0, 1}, PlotRange -> {0, 1}, PlotStyle -> {Black}]; Show[{funplot, iterplot}]

第二个问题：
singleTest := Module[{data, dataSorted, exist, howmanysame = 2},
data = RandomInteger[{1, 365}, 90]; dataSorted = Sort[data];
If[Or @@ (Map[dataSorted[[#]] == dataSorted[[# + howmanysame]] &,
Range[Length[data] - howmanysame]]), exist = 1, exist = 0];
exist];

result = Table[singleTest, {200}];
In[203]:= Total[result]/200 // N
Out[203]= 0.505
第三个问题：
x[t_] := t; y[t_] := Sin[t]; r = 0.5;
Manipulate[
Show[
{ParametricPlot[{x[t], y[t]}, {t, 0, 2 \[Pi]},
PlotRange -> {{0, 2 \[Pi]}, {-2, 2}}],
Graphics[{
Circle[{x[a], y[a]} + r*{- y'[a], x'[a]}/Norm[{x'[a], y'[a]}], r],
Point[{x[a], y[a]} + r*{- y'[a], x'[a]}/Norm[{x'[a], y'[a]}]]}]}
],
{a, 0, 2 \[Pi]}]
第二个和第三个粘贴反了。一些意见，1里面方程似乎没有根；3里面到底是三个还是三个以上说的不清楚。这个让人很不爽。
2里面我只做了圆心，算是hint吧，其他可以自己搞定的

那么1,3解决了
关于2你说的无摩擦滚动=滑动+绕圆心一定速率的转动。依我看只有用弧长参数代码才容易写。不过就是x,y各增加一项，琢磨琢磨吧:)

呵呵.
这个涉及到几个技术细节.
为了速度快些, 建议你不要即时计算轨道, 而是先把计算出来的轨道存到list里.然后用Manipulate或Animated播放数据即可.
球的运动可以用方程写出出来,专门写一个函数最好. 反射可以用边界条件来做.
运动轨迹的话, 知道打印/显示之前的list从1到当前t时刻的数据即可显示运动轨迹.
当前数据点特别的画出来, 以显示是小球.
t可以取0.1为时间间隔.
OK.
这样的好处是演示时速度快.

另一种方案是Dynamic[静止的图]
在外部或内部按运动方程循环改变坐标值. 轨迹可以用accumulate之类的函数写.或者写一个数据不停的加入当前坐标, 并打印作为轨迹. 这样是即时运算的方法, 有可能会慢, 尤其是运动方程比较复杂时.
------------------------------
一段类似的代码:(2D, N个小球 N可是自己改变的, 不考虑小球之间的碰撞)
Manipulate[
If[PlayOn,
Framed@DynamicModule[{contents = {}},
EventHandler[
Graphics[{Hue[pointcolor], PointSize[points],
Point[Dynamic[
contents =
Map[If[#[[1, 2]] >= 0 && #[[1, 2]] <= 1,
If[#[[1, 1]] >= 0 && #[[1, 1]] <=
1, {#[[1]] + #[[2]], #[[
2]]}, {{UnitStep[#[[1, 1]]], #[[1, 2]]}, {-1, 1} #[[
2]]}], {{#[[1, 1]],
UnitStep[#[[1, 2]]]}, {1, -1} #[[2]]}] &, contents];
Map[First, contents]]]},
PlotRange -> {{-points/2, screen + points/2}, {-points/2,
screen + points/2}}],
"MouseDown" :> (AppendTo[
contents, {MousePosition[
"Graphics"], {RandomReal[{-0.01, 0.01}],
RandomReal[{-0.01, 0.01}]}}])]],
Graphics[{Text[Style["Molecular Dynamics", Large, Blue, Thick]]}]], {{PlayOn,
False, "Display"}, {True, False}}, {{points, 0.1, "points size"},
0, 1}, {{screen, 1, "screen size"}, 0,
5}, {{pointcolor, 0.5, "Points Color"}, 0, 1}]
--------------
外加势场:(并可以统计小球的相空间数值)

fx[x_, y_] = 0.001 y;
fy[x_, y_] = -0.001 x;

Framed@DynamicModule[{contents = {}, statistics = {}},
Manipulate[If[PlayOn,
EventHandler[
Show[
VectorPlot[{fx[x, y], fy[x, y]}, {x, -points/2,
screen + points/2}, {y, -points/2, screen + points/2},
StreamPoints -> None, Axes -> None, Frame -> None,
VectorStyle -> {Opacity[0.6]}, VectorColorFunction -> Hue],
Graphics[{Hue[pointcolor], PointSize[points],
Point[Dynamic[
contents =
Map[If[#[[1, 2]] >= 0 && #[[1, 2]] <= 1,
If[#[[1, 1]] >= 0 && #[[1, 1]] <=
1, {#[[1]] + #[[2]], {fx[#[[1, 1]], #[[1, 2]]],
fy[#[[1, 1]], #[[1, 2]]]} + #[[
2]]}, {{UnitStep[#[[1, 1]]], #[[1, 2]]}, {-1, 1} #[[
2]]}], {{#[[1, 1]],
UnitStep[#[[1, 2]]]}, {1, -1} #[[2]]}] &, contents];
Map[First, contents]]]},
PlotRange -> {{-points/2, screen + points/2}, {-points/2,
screen + points/2}}]],
"MouseDown" :> (AppendTo[
contents, {MousePosition[
"Graphics"], {RandomReal[{-velocity, velocity}],
RandomReal[{-velocity, velocity}]}}])],
Graphics[{Text[
Style["Molecular Dynamics II", Large, Blue,
Thick]]}]], {{PlayOn, False, "Play Now"}, {True,
False}}, {{points, 0.05, "points size"}, 0,
1}, {{screen, 1, "screen size"}, 0,
5}, {{pointcolor, 6, "Points Color"}, 0,
10}, {{velocity, 0.01, "max velocity"}, 0, 1},
Row[{Button["Reset", contents = {}; statistics = {},
ImageSize -> Medium],
Button["Print phrase space", Print[{contents, SessionTime[]}],
ImageSize -> Medium],
Button["Statistics",
AppendTo[statistics, {contents, SessionTime[]}],
Appearance -> "Palette"],
Button["Save statistical data",
Export["molecular dynamics.txt", statistics]]}]]]

在我的空间里
链接：http://hi.baidu.com/philoart/blog/item/f51ea9f955630205d9f9fdf1.html

不过老兄留学国外更是要强调独立思考啊~~

---

陇西县19329059343： Mathematica 动画:用Mathematica画一个小球在一正弦曲线上运动 - ？
謇齿心神： 7.0或8.0上运行Manipulate[ Show[Graphics[Circle[{x, Sin[x]}, .2],PlotRange -> {{-7, 7}, {-1.3, 1.3}}],Plot[Sin[i], {i, -7, 7},PlotRange -> {{-7, 7}, {-1.3, 1.3}}]], {x, -2*Pi, 2*Pi}]

陇西县19329059343： mathematica里用manipulate做小球沿抛物线运动,但是没了坐标轴 - ？
謇齿心神： 方程里有未知变量,当然画不出来 自己查帮助Manipulate 另外,你的\[Pi]和R是两个变量吧,变量相乘中间要有乘号或者空格,不能直接连在一起写 \[Lambda]f同理 最后,想让别人帮你修改代码,就把自己的代码贴上来,没人喜欢抄你的代码

陇西县19329059343： mathematica 小球在椭圆中运动 - ？
謇齿心神： 这个问题有点难,我做了个简单的东西,小圆在大圆内转动:Manipulate[Show[ContourPlot[x^2 + y^2 == 9, {x, -3, 3}, {y, -3, 3}],ParametricPlot[{2 Cos[t], 2 Sin[t]}, {t, 0, 2 Pi}],ContourPlot[(x - 2.5 Cos[u])^2 + (y - 2.5 Sin[u])^2 == 0.25, {x, -3,3}, ...

陇西县19329059343： 使用matlab编写小球下落,我该怎么下手做? - ？
謇齿心神： 这个是可以的.给你一个弹性球的动画程序,你可以参考一下.figure(1);%定义函数 axis([-5.1,5,-0.05,1.05]);%绘制二维图形 hold on;%保持当前图形及轴系所有的特性 axis('off');%覆盖坐标刻度,并填充背景%通过填充绘出台阶及两边的挡...

陇西县19329059343： 使用matlab画出在一个半径为10的圆上,等距分布着10个半径为1的小球并绘出此图形程序? - ？
謇齿心神： % 半径为10的圆 t = linspace(0,2*pi,100); x = 10 * cos(t); y = zeros( size(x) ); z = 10 * sin(t); plot3(x, y, z)% 10个半径为1的小球 hold on for t = 0 : 2*pi/10 : 2*pi*9/10x0 = 10 * cos(t);z0 = 10 * sin(t);[X,Y,Z] = sphere;x = X + x0;z = Z + z0;surf(x,Y,z) end axis equal view(0,0)

陇西县19329059343： 数学实验mathematica应用构造单位球面上依曲面面积服从均匀分布的随机点 - ？
謇齿心神： r =.; dot =.; dot[r_] := Module[{rand, rz, u, rxy}, rand = 2 r*Random[] - r; rz = rand; rand = 2 Pi*Random[]; u = rand; rxy = Sqrt[r^2 - rz^2]; {rxy*Cos[u], rxy*Sin[u], rz} ] Graphics3D[Point[Table[dot[1], {r, 1, 5000}]], Boxed -> False](*复制即可 *)

陇西县19329059343： 如何使用mathematica - ？
謇齿心神： Mathematica >01 打开Mathematica,输入“Integrate[(Cos[x]^2 - Sin[x])/Cos[x]/(1 + Cos[x] E^Sin[x]), x]”,注意不包含双引号,英文状态下输入. 按Shift+Enter就可以得到结果了.点击“更多”还会有其它诸如绘图、求极值等功能. 共2图>02 ...

陇西县19329059343： 请问怎样使用Mathematica作图 - ？
謇齿心神： 如对y=sin(x)在x=0..4作图,则为:Plot[Sin(x),{x,0,4}]; 如对z=cox(x)*sin(y)在x=0..2*pi,y=0..2*pi作图,则为:Plot3D[Cos[x] Sin[y], {x, 0, 2 Pi}, {y, 0, 2 Pi}];

陇西县19329059343： 如何使用mathematica软件产生图形 - ？
謇齿心神： 例子:函数绘图:Plot[Sin[x],{x,10,-10}] Plot3D[Sin[x y],{x,10,-10},{y,10,-10}] ContourPlot[Sin[x]+Sin[y]==1,{x,10,-10},{y,10,-10}] ContourPlot3D[Sin[x]+Cos[y]+Tan[z]==2,{x,10,-10},{y,10,-10},{z,10,-10}] RegionPlot[x/y>=1,{x,10,-10},{y,10-,10}] ...

陇西县19329059343： 如何利用Mathematica 求Pi？
謇齿心神： a = {1}; s = N[{3*Sqrt[3]/2}, 18]; n = 31; For[i = 2, i ≤ n, i++, a = N[Append[a, Sqrt[2 - 2*Sqrt[1 - (a[[i - 1]]/2)^2]]], 18 ]; s = N[Append[s, 3*2^(i - 1)*a[[i]]], 18]; ] s1 = Table[s[[i + 1]] - s[[i]] , {i, 1, n - 1}]; Print[＂n＂, ＂ s＂, ＂ ＂, ＂s1＂] For[i = 1, i ≤ n - 1, i++, Print[i, ＂ ＂, s[[i]], ＂ ＂, s1[[i]]]]