(* This mathematica file creates the frames for three animations which
animate a bouncing ball. The first animation only shows the ball
together with a clock and axes. The second adds the graph of
the height versus time, and the third displays the graph of the
derivative as well. (Actually we show a graph of the derivative
divided by 20, so that the same axes can be used for the function and
the derivative.
The ball is released at time 0 from 100 centimeters. We display
its height versus time over the interval [0,3], measured in second,
although it comes to rest at time 2.4 seconds. The height function
is a piecewise quadratic. It is reasonably realistic, but not meant
to conform to any exact model.
Douglas N. Arnold, 8/29/92, 8/25/94
Douglas N. Arnold
Department of Mathematics
Penn State
University Park, PA 16802
Online documentation related to this file can be found at WWW URL
http://www.math.psu.edu/dna/graphics.html.
*)
BeginPackage["Bounce`", "Graphics`Colors`"]
Begin["Private`"]
(* Define the ground contact times. These have been adjusted to give a
fairly realistic bouncing ball, but also to be integers/20. This way we
can animate with frames every 1/20 second and the ball always hits the
ground exactly at a frame time.
*)
xp = {-10, 10, 23, 32, 38, 42, 45, 47, 48}/20
g[x_]:= 0 /; x <= First[xp] || x >= Last[xp]
g[x_]:=
Module[{m},
m = Last[Position[Map[(#= Last[xp]
gp[x_]:=
Module[{m},
m = Last[Position[Map[(# (DisplayAnimation["bounce0.anim",#]&) )
opts1 = ( AnimationFunction -> (DisplayAnimation["bounce1.anim",#]&) )
opts2 = ( AnimationFunction -> (DisplayAnimation["bounce2.anim",#]&) )
(* Define a single frame of the animation. *)
frame[i_,showgraph_,showdgraph_] :=
( x = N[times[[i]]];
y = g[x];
(* Create the graph, a polyline plotting the height of the ball versus time
from time 0 to the present moment. Use the points with integer abscissas
as breakpoints for the polyline except include the present point as
well and include the starting point twice so that Line doesn't get
confused on the first frame when it has only one endpoint. *)
graph = If[showgraph,
{ Blue, Thickness[0.007],
Line[Map[{#,g[#]}& , Prepend[Union[Table[t,{t,0,x,1/20}],{x}],0]]]},
{} ] ;
(* Create the graph of the derivative. This is a bit of a bother since
the derivative is undefined at the break points. *)
dgraph = If[showdgraph,
eps = .005;
m = Last[Position[Map[(#{{xmin,xmax},{ymin,ymax}}, Frame->True] )
(* Create the frames. *)
prefix = "bounce0/T";
pixels=400;
filename[prefix_,number_] := StringJoin[prefix,ToString[number],".gif"]
Table[ Display[filename[prefix,i],frame[i,False,False],"gif",ImageSize->pixels],
{i,1,Length[times]}]
prefix = "bounce1/T";
filename[prefix_,number_] := StringJoin[prefix,ToString[number],".gif"]
Table[ Display[filename[prefix,i],frame[i,True,False],"gif",ImageSize->pixels],
{i,1,Length[times]}]
prefix = "bounce2/Tounce0/T";
pix";
filename[prefix_,number_] := StringJoin[prefix,ToString[number],".gif"]
Table[ Display[filename[prefix,i],frame[i,True,True],"gif",ImageSize->pixels],
{i,1,Length[times]}]
End[] (* end of context private *)
EndPackage[]
(* write an exit message *)
Print["-- wrote frames --"]