# How can I show that a sphere is rolling in a simulation?

I recently wrote code to simulate a table tennis ball rolling on the ground.

v0 = 10; w0 = 8; R = 4; mu = 0.2; g = 9.8;
δ = (2 (v0 + w0 R))/(5 mu g);


This gives the ball's location

location[t_] =
Piecewise[
{{If[t <= δ,
v0 t - 1/2* mu*g*t^2 + R,
(3 v0 - 2 w0 R)/5 (t - δ) + v0 δ - 1/2* mu*g*δ^2 + R],
3 v0 - 2 w0 R < 0}, (*<0 roll back*)
{If[t <= δ,
v0 t - 1/2* mu*g*t^2 + R,
v0 δ - 1/2* mu*g*δ^2 + R],
3 v0 - 2 w0 R == 0},
{If[t <= δ,
v0 t - 1/2* mu*g*t^2 + R,
(3 v0 - 2 w0 R)/5 (t - δ) + v0 δ - 1/2* mu*g*δ^2 + R],
3 v0 - 2 w0 R > 0}}]; (*>0roll front*)


and this gives the rotation angle

zhuanjiao[t_] =
If[t <= δ,
w0 t - (3 mu g )/(4 R) t^2,
w0 δ - (3 mu g )/(4 R) δ^2 - (3 v0 - 2 w0 R)/(5 R) (t - δ)]; (*>0 roll front*)


This implements the simulation.

Manipulate[
Graphics3D[
Rotate[Sphere[{location[t], R, R}, R], -zhuanjiao[t], {0, 1,
0}, {location[t], R, R}] ,
Method -> {"SpherePoints" -> 10},(*lower the sample to show roll*)
Axes -> True, AxesOrigin -> {0, 0, 0},
PlotRange -> {{0, 40}, {0, 2 R}, {0, 2 R}}, AxesLabel -> {x, y, z}
], {t, 0, 2 (2 (v0 + w0 R))/(5 mu g) + 10}]


My question is: my way of showing that the ball is rolling is to lower its sample. Which is kind of uncomfortable and ugly. Is there better way to do so?

It is hard to show that a sphere is rotating. If I don't do what I've done, it looks like it sliding on plane, not rolling.

• maybe you can play with Lighting specs? For example, change the first argument of Graphics3D to {Lighting -> {{"Ambient", GrayLevel[.3]}, {"Point", Orange, {20, -2 R, -R}}}, Orange, Rotate[Sphere[{location[t], R, R}, R], -zhuanjiao[t], {0, 1, 0}, {location[t], R, R}]}. – kglr Dec 15 '19 at 18:37

Well, you might do it by putting spots on the sphere. However, if you were to do that, you would the rotation you have imposed is not the rotation of a rolling ball. At least, it doesn't look it to me.

The following demonstrates a set of points, located on the surface of a ball, being moved and rotated by your functions location and zhuanjiao. Evaluate it to see what I mean.

R = 1;

v0 = 10; w0 = 8; mu = 0.2; g = 9.8;
δ = (2 (v0 + w0 R))/(5 mu g);

location[t_] :=
Piecewise[
{{If[t <= δ,
v0 t - 1/2* mu*g*t^2 + R,
(3 v0 - 2 w0 R)/5 (t - δ) + v0 δ - 1/2* mu*g*δ^2 + R],
3 v0 - 2 w0 R < 0}, (*<0 roll back*)
{If[t <= δ,
v0 t - 1/2* mu*g*t^2 + R,
v0 δ - 1/2* mu*g*δ^2 + R],
3 v0 - 2 w0 R == 0},
{If[t <= δ,
v0 t - 1/2* mu*g*t^2 + R,
(3 v0 - 2 w0 R)/5 (t - δ) + v0 δ - 1/2* mu*g*δ^2 + R],
3 v0 - 2 w0 R > 0}}]

zhuanjiao[t_] :=
If[t <= δ,
w0 t - (3 mu g)/(4 R) t^2,
w0 δ - (3 mu g)/(4 R) δ^2 - (3 v0 - 2 w0 R)/(5 R) (t - δ)]

Manipulate[
Graphics3D[
Rotate[
Translate[Point[SpherePoints[100]], {location[t], R, R}],
-zhuanjiao[t],
{1, 0, 0}, (* changed to get rolling to look right *)
{location[t], R, R}],
Axes -> True,
AxesOrigin -> {0, 0, 0},
PlotRange -> {{0, 10}, {0, 2 R}, {0, 2 R}},
AxesLabel -> {x, y, z}],
{t, 0, 1, .01}]

• If you use the positive version of zhuanjiao and {0, 1, 0} it seems to rotate appropriately. I also put a Sphere[] inside the Translate as that made it a little bit clearer what was going on, to me. – b3m2a1 Dec 15 '19 at 19:42
• sorry for be so late to reponse. since there is a little mistake in the code.-zhuanjiao[t], {1, 0, 0}, seems to be -zhuanjiao[t], {0, 1, 0}, . the final effect nice. thx. it takes me sometime to find it :) – wuyudi Dec 19 '19 at 9:54

Any reason why you want to show a Sphere? To my mind using another shape would be a lot more fun. Here's m_goldberg's code with a demo from SphericalPlot3D:

myWheel =
SphericalPlot3D[
.8 + Sin[5 ϕ]/5, {θ, 0, Pi}, {ϕ, 0, 2 Pi},
PlotStyle -> Directive[Orange, Opacity[.9], Specularity[White, 10]],
Mesh -> None, PlotPoints -> 30
];

frames =
Table[
Graphics3D[
Rotate[
Translate[
myWheel[[1]],
{location[t], R, R}
],
zhuanjiao[t],
{0, 1, 0},
(*changed to get rolling to work*)
{location[t], R, R}
],
Axes -> True,
AxesEdge -> {{1, -1}, {-1, -1}, {-1, 1}},
Ticks -> None,
Boxed -> False,
Lighting -> "Neutral",
PlotRange -> {{0, 10}, {0, 2 R}, {0, 2 R}},
AxesLabel -> {x, y, z},
ViewPoint -> 4*{1, -2, .5}
],
{t, 0, 1, .05}
];

rast = Rasterize[#, ImageResolution -> 144] & /@ frames;

CloudExport[rast, "GIF", "test.gif", "AnimationRepetitions" -> Infinity, Permissions -> "Public"]