Math Club Applications and Recreation

Edward Zhu

Student, Torrey Pines HS

Mathematica in Math Club

In math club, there is always more to be explained than time allows for. Mathematica is particularly helpful for speeding up explanations, or for clarifying concepts that are difficult to visualize.

Planetary Temperature

The problem below was the final example I gave in a symmetry lecture last year at the San Diego Math Circle. It was difficult to explain with whiteboard and pen alone. Mathematica would have simplified things significantly.                 

A spherical, three dimensional planet has center (0,0,0) and radius r. At any point (x,y,z) on the surface of this 
planet, the temperature is 
		T(x,y,z) =(((x+y))^2)+(((y-z))^2) 
degrees. What is the average temperature of the planet's surface?

						Problem Source: Art and Craft of Problem Solving

A Symmetrical Solution

Because the temperature function is difficult to deal with directly, we will utilize algebraic and geometric symmetry to simplify calculations. 

Step 1: For every point (x,y,z) on the sphere, the points (x,z,y), (y,x,z), (y,z,x), (z,x,y), (z,y,x), are also on the sphere. Hence, by symmetry, the functions T(x,y,z), T(x,z,y), T(y,x,z), T(y,z,x), T(z,x,y), T(z,y,x) have the same total surface temperature.      

Step 2 : Define a total surface temperature function S such that S[T] is total surface temperature of a sphere of radius r centered at (0,0,0) whose surface temperature function is T. Then, due to the symmetry in step 1, 
6S[T(x, y, z)] = S[T(x, y, z)] + S[T(x, z, y)] + S[T(y, x, z)] + S[T(y, z, x)] + S[T(z, x, y)] + S[T(z, y, x)].

Step 3 : Distributive Property
Simplifying, 6 S[T(x, y, z)] = S[T(x, y, z) + T(x, z, y) + T(y, x, z) + T(y, z, x) + T(z, x, y) + T(z, y, x)].

Step 4 : Conclusion
Since T(x,y,z) = (((x+y))^2)+(((y-z))^2),
We have 6S[T(x,y,z)] = S[2(((x+y))^2)+2(((x+z))^2)+2(((y+z))^2)+2(((x-y))^2)+2(((x-z))^2)+2(((y-z))^2)].
Condensing, 6S[T(x,y,z)]= S[8((x^2)+(y^2)+(z^2))]=S[8(r^2)]=8(r^2)S[1].
Hence, S[T(x,y,z)]=8(r^2)(Surface Area of Sphere)/6
The average temperature is 8(r^2)/6.

A Graphical Solution

Picture the Function

We'll use hue to indicate temperature. T(x,y,z)=(((x+y))^2)+(((y-z))^2) looks like this:

ParametricPlot3D[{Cos[u]Sin[v],Sin[u]Sin[v],Cos[v]},{v,0,Pi},{u,0,2Pi},Mesh->5,Axes-> False,Boxed-> False,BoundaryStyle->Black,ColorFunction->Function[{x,y,z},Hue[.2(x+y)^2+.2(y-z)^2]], ImageSize->250]

Symmetrical by Nature

Recall that for every point (x,y,z) on the sphere, the points (x,z,y), (y,x,z), (y,z,x), (z,x,y), (z,y,x) are also on the sphere. T(x,y,z), T(x,z,y), T(y,x,z), T(y,z,x), T(z,x,y), T(z,y,x), are mirror images of one another about the x=y, x=z, and y=z planes. Thus, they have the same total/average surface temperatures. 

Not convinced? Right now, the graphs below have the same orientation. Try rotating them so that they match.

Column[{
Row[{
Column[{Style["T(x,y,z)",Blue,15,Bold],
ParametricPlot3D[{Cos[u]Sin[v],Sin[u]Sin[v],Cos[v]},{v,0,Pi},{u,0,2Pi},Mesh->5,Axes-> False,Boxed-> False,BoundaryStyle->Black,ColorFunction->Function[{x,y,z},Hue[.2(x+y)^2+.2(y-z)^2]], ImageSize->150] (* T[x,y,z] *)}],
Column[{Style["T(y,x,z)",Blue,15,Bold],
ParametricPlot3D[{Cos[u]Sin[v],Sin[u]Sin[v],Cos[v]},{v,0,Pi},{u,0,2Pi},Mesh->5,Axes-> False,Boxed-> False,BoundaryStyle->Black,ColorFunction->Function[{x,y,z},Hue[.2(y+x)^2+.2(x-z)^2]], ImageSize->150](* T[y,x,z] *)}],
Column[{Style["T(z,y,x)",Blue,15,Bold],
ParametricPlot3D[{Cos[u]Sin[v],Sin[u]Sin[v],Cos[v]},{v,0,Pi},{u,0,2Pi},Mesh->5,Axes-> False,Boxed-> False,BoundaryStyle->Black,ColorFunction->Function[{x,y,z},Hue[.2(z+y)^2+.2(y-x)^2]], ImageSize->150](* T[z,y,x] *)}]
}],
Row[{
Column[{Style["T(x,z,y)",Blue,15,Bold],
ParametricPlot3D[{Cos[u]Sin[v],Sin[u]Sin[v],Cos[v]},{v,0,Pi},{u,0,2Pi},Mesh->5,Axes-> False,Boxed-> False,BoundaryStyle->Black,ColorFunction->Function[{x,y,z},Hue[.2(x+z)^2+.2(z-y)^2]], ImageSize->150] (* T[x,z,y] *)}],
Column[{Style["T(y,z,x)",Blue,15,Bold],
ParametricPlot3D[{Cos[u]Sin[v],Sin[u]Sin[v],Cos[v]},{v,0,Pi},{u,0,2Pi},Mesh->5,Axes-> False,Boxed-> False,BoundaryStyle->Black,ColorFunction->Function[{x,y,z},Hue[.2(y+z)^2+.2(z-x)^2]], ImageSize->150](* T[y,z,x] *)}],
Column[{Style["T(z,y,x)",Blue,15,Bold],
ParametricPlot3D[{Cos[u]Sin[v],Sin[u]Sin[v],Cos[v]},{v,0,Pi},{u,0,2Pi},Mesh->5,Axes-> False,Boxed-> False,BoundaryStyle->Black,ColorFunction->Function[{x,y,z}, Hue[.2(z+y)^2+.2(y-x)^2]], ImageSize->150](* T[z,y,x] *)}]
}]
}]

Visualizing 6S[T(x, y, z)] = S[T(x, y, z) + T(x, z, y) + T(y, x, z) + T(y, z, x) + T(z, x, y) + T(z, y, x)]

This essentially means: Combine the Spheres!!

Manipulate[
Which[t<1.8,
Graphics[{(*Animation of six spheres merging*)
{Hue[0.3],Disk[(2-t)*{Cos[0],Sin[0]},.25]},
{Hue[0.6],Disk[(2-t)*{Cos[Pi/3],Sin[Pi/3]},.25]},
{Hue[1.05],Disk[(2-t)*{Cos[2Pi/3],Sin[2Pi/3]},.25]},
{Hue[0.3],Disk[(2-t)*{Cos[Pi],Sin[Pi]},.25]},
{Hue[0.6],Disk[(2-t)*{Cos[4Pi/3],Sin[4Pi/3]},.25]},
{Hue[1.05],Disk[(2-t)*{Cos[5Pi/3],Sin[5Pi/3]},.25]},
Text[Style["Combine the Spheres!",18,Black, Bold],{0,1.05t}]
},PlotRange->2.3],
t≤2.2,
Graphics[{(*Six spheres squished*)
{Hue[0.3],Disk[(.2)*{Cos[0],Sin[0]},.25]},
{Hue[0.6],Disk[(.2)*{Cos[Pi/3],Sin[Pi/3]},.25]},
{Hue[1.05],Disk[(.2)*{Cos[2Pi/3],Sin[2Pi/3]},.25]},
{Hue[0.3],Disk[(.2)*{Cos[Pi],Sin[Pi]},.25]},
{Hue[0.6],Disk[(.2)*{Cos[4Pi/3],Sin[4Pi/3]},.25]},
{Hue[1.05],Disk[(.2)*{Cos[5Pi/3],Sin[5Pi/3]},.25]},
Text[Style["Combine the Spheres!",18,Black, Bold],{0,1.05t}]
},PlotRange->2.3],
t>2.2,
ParametricPlot3D[{Cos[u]Sin[v],Sin[u]Sin[v],Cos[v]},{v,0,Pi},{u,0,2Pi},Mesh->5,Axes-> False,Boxed-> False,BoundaryStyle->Black,ColorFunction->Function[{x,y,z},Hue[1.6]], ImageSize->350]
],
{t,0,3,Animator,AnimationRunning->False}]

Result

ParametricPlot3D[{Cos[u]Sin[v],Sin[u]Sin[v],Cos[v]},{v,0,Pi},{u,0,2Pi},Mesh->5,Axes-> False,Boxed-> False,BoundaryStyle->Black,ColorFunction->Function[{x,y,z},Hue[1.6/6]], ImageSize->250]

When the spheres are combined, our symmetrical manipulation results in  6S[T(x,y,z)]= S[8((x^2)+(y^2)+(z^2))]=S[8(r^2)]. 
In other words, when we combine the six mirror images of the original sphere, the aggregate surface temperature function becomes a constant! Some final calculation yields an average surface temperature of 8(r^2)/6.

Billiards Simulation

In the Works

I just started this simulation recently, so I haven't gotten many functions implemented yet. One major difficulty I've encountered is that it is difficult to add additional velocity functions (collision, friction against the wall, angular momentum) and keep the simulation in real-time.

(* ---------------- Constants --------------------*)
W=200;H=100;Rad:=3; 
g = 10; (* gravitational constant *)
Mu = .5; (*Friction constant for wool fiber on horn + ivory is (clean .4-.6), (greasy .5-.8). Using .5*)
P=2; (*The Ratio between Pocket Radius and Ball Radius*)
m=1; (* mass of balls*)
DeltaT = 1; (* Impact time of pool stick and ball *) 

(* ------------------ Velocity/Position Function --------------------------- *)
Cue0 := {150, 50 }; (*stored position vector*)
V0 :={0,0}; (*Stored velocity vector*)

(*CuePos[F_,q_,t_] := Which[Cue[F,q,t] [[1]]<=Rad || Cue[F,q,t][[1]] >= W-Rad, 1,Cue[F,q,t] [[2]]<=Rad || Cue[F,q,t][[2]] >= H-Rad,2, Cue[F,q,t] [[1]]> Rad && Cue[F,q,t] [[2]] > Rad,3 ];*)
(* returns 1 when x out of bounds, returns 2 when y out of bounds, returns 3 when in bounds *)

V[F_,q_,t_]:=If [F*DeltaT/m  - Mu*g*t > 0, (F*DeltaT/m -Mu*g*t)*{Cos[q],Sin[q]}, {0,0}];
(* V[F_,q_,t_]:= Which[CuePos[F,q,t] ==3, id,CuePos[F,q,t]==1,negY, CuePos[F,q,t] == 2, negX];  *)

Cue[F_,q_,t_] := Integrate[V[F,q,#&],{#&,0,t}]+Cue0;

Bound[{x_,y_}]:={Abs[W-Abs[Mod[x,2(W-Rad)]]]+Rad,Abs[H-Abs[Mod[y,2(H-Rad)]]]+Rad};
BoundedCue[F_,q_,t_]:=Bound[Cue[F,q,t]]; 
BallCue[pos_]:={White,Disk[pos,Rad]};
 Ball8[pos_]:={
{Black, Disk[pos,3]},
{White, Disk[pos,1.5]},
{ Text[Style["8",FontSize->10],pos]}
}

Pockets ={{0,0},{W,0},{0,H},{W,H},{W/2,0},{W/2,H}};

(* Balls = *)
Balls =Table[{RandomInteger[{Rad,W-Rad}],RandomInteger[{Rad,H-Rad}]},{10}];

Manipulate[
Column[{
Graphics[ 
{
{Darker[Brown],Rectangle[{-5,-5},{W+5,H+5}]},
{Darker[Brown],Map[Disk[#, P*5/3*Rad] &,Pockets]},
{Darker[Green],Rectangle[{0,0},{W,H}]},
BallCue[BoundedCue[F,q,t]],
{Black,Map[Disk[#,P*Rad]&,Pockets]},
Ball8[{100,50}]
}, (* End of Graphics *)
ImageSize->680]

}],
{F,0,100},{q,Pi,3Pi},{t,0,20}
]

Concept for Future

Everything revolves around the velocity functions. Velocity functions will be piecewise (pieces are added as calculations proceed). The following features will be necessary:

1. Collision Equations:
 If initially,(Subscript[V, 1])=(Subscript[V, N1])+(Subscript[V, T1]); (Subscript[V, 2])=(Subscript[V, N2])+(Subscript[V, T2]), then after the collision,(Subscript[V, 1])=(Subscript[V, N1])+(Subscript[V, T2]); (Subscript[V, 1])=(Subscript[V, N1])+(Subscript[V, T1]).

2. Collision with Rail: 
Every time the ball reaches a rail, either its x or y velocity component is multiplied by -1. The use of matrices should allow for easy adding of friction later on. Basic matrices:
negX =  {{-1, 0}, {0, 1}}
negY = {{1, 0}, {0, -1}}

3. Rotational Features:
I have the equations, but will only implement after (1) and (2) are finished.

4. 3D Table and Jump Shots
Would be really cool!