Enhanced Animations & Flipbooks

Mathematica code as it appeared in Mathematica in Education,
Volume 2 Number 1, Fall 1992

Carl Swenson
Department of Mathematics
Seattle University
Seattle, WA  98122±4460
swenson@seattleu.edu

(Mathematica version 2.1)

Set up defaults

Needs["Graphics`SurfaceOfRevolution`"]

Surface of Revolution animation code.

First plot of 1 - x^2 in 3D

(* First plot 1-x^2 function in 3D*)
f[x_]:=1-x^2
plot1=Show[
		ParametricPlot3D[{t,0,f[t],Thickness[.01]},
			{t,0,1},DisplayFunction->Identity], 
		Graphics3D[Line[{{0,0,1},{0,0,0}}]],
	PlotRange->{{-1,1},{-1,1},{0,1}},
	Axes->False
	];

Initial page setup

(* =============== Initial page setup ================ *)
(* Set the page dimensions and partition *)
(* This is a 4x3 array in a 7.5x5 inch box *)
w=7.5; h=5.0; dw=w/4; dh=h/3;

(* Create the border and inlines *)
border={ AbsoluteThickness[1],
	Line[{{0,0},{w,0},{w,h},{0,h},{0,0}}]};
inlines=Join[ {AbsoluteThickness[1]},
	Map[Line,Table[{{0,j},{w,j}},{j,dh,h-dh,dh}]],
	Map[Line,Table[{{i,0},{i,h}},{i,dw,w-dw,dw}]]
	];

(* Create the coordinates for rectangles *)
coord1=Flatten[ Table[{i,j-dh},
		{j,h,dh,-dh},{i,0,w-dw,dw}],1];
coord2=Flatten[ Table[{i+dw,j},
		{j,h,dh,-dh},{i,0,w-dw,dw}],1];

Table of plots

(* ================= Table of plots ================== *)
twoPi = N[2Pi];
disks={};dy=.09;
frames=Table[
	Show[plot1,
		SurfaceOfRevolution[f[x],{x,0,1},
			{t,0,.01+n*twoPi/11},
	DisplayFunction->Identity,
	PlotPoints->{10,3n+3}], (* keeps surface uniform *)
	PlotRange->{{-1,1},{-1,1},{0,1}},
	Boxed->False
	],
{n,1,11} ];

Title/text frames created

(* =========== Title/text frames created ============= *)
frame1=Show[
	Graphics[{
		Text[
			FontForm["Surface",{"Times-Bold",12}],
				Scaled[{.5,.9}]],
		Text[ "of",Scaled[{.5,.6}]],
		Text[ "Revolution",Scaled[{.5,.3}]]}],
	DefaultFont->{"Times-Bold",12},
	DisplayFunction->Identity ];
				
(* Use PrependTo[] to add frame(s) to front of list *)	
(* Add Title frame or other special frames *)
PrependTo[frames,frame1];

(* Use AppendTo[] to add to the end of a frame list        *)
(* To leave a frame blank use: AppendTo[frames,Graphics[]] *)

(* ============ Setup frames as Rectangles =========== *)
(* The list of frames must have 12 elements *)
(* The Rectangles are assigned array elements  *)
frames=MapThread[Rectangle,{coord1,coord2,frames}];

Show the complete page

(* ============= Show the complete page ============== *)
Show[ 
	Graphics[border],  (* sets page sizes *)
	AspectRatio->h/w,
	Epilog->Join[frames,inlines,border],
	DisplayFunction->$DisplayFunction
	]
	
(* Pull the graphic image to width 7.5 inches and print *)

Surface of Revolution with Disks

First plot of 1 - x^2

(* First plot 1-x^2 function in 3D*)
f[x_]:=1-x^2
plot1=Show[
		ParametricPlot3D[{t,0,f[t],Thickness[.01]},
			{t,0,1},DisplayFunction->Identity], 
		Graphics3D[Line[{{0,0,1},{0,0,0}}]],
	PlotRange->{{-1,1},{-1,1},{0,1}},
	Axes->False
	];

Function to create a disk of radius r

(* function to create a disk of radius r *)
twoPi=2Pi//N; (* speeds up calculations *)
onedisk[r_,top_,bottom_,dt_]:=
	Graphics3D[
		{SurfaceColor[GrayLevel[(r+0.5)/1.5],GrayLevel[.4],10],EdgeForm[],
		Table[{
			Polygon[{
			{0,0,top},
			{r Sin[t], r Cos[t],top},
			{r Sin[t+dt],r Cos[t+dt],top}}],
			Polygon[{
			{r Sin[t], r Cos[t],bottom},
			{r Sin[t+dt],r Cos[t+dt],bottom},
			{r Sin[t+dt],r Cos[t+dt],top},
			{r Sin[t], r Cos[t],top}
			}]},
		{t,dt,twoPi,dt}]
		}
	];

Create sound function

(* Create sound function *)
tone[m_]=  (* well-tempered tuning, A with 3 overtones *)
	Sin[twoPi*220*(2.^(m/12))*t]+
	Sin[twoPi*220*(2.^(m/12))*2t]+
	Sin[twoPi*220*(2.^(m/12))*4t]+
	Sin[twoPi*220*(2.^(m/12))*8t];

Initial page setup

(* =============== Initial page setup ================ *)
(* Set the page dimensions and partition *)
(* This is a 3x4 array in a 7.0x8.9 inch box *)
w=7.0;h=8.9;dw=w/3;dh=h/4;

(* Create the border and inlines *)
border={ AbsoluteThickness[1],
	Line[{{0,0},{w,0},{w,h},{0,h},{0,0}}]};
inlines=Join[ {AbsoluteThickness[1]},
	Map[Line,Table[{{0,j},{w,j}},{j,dh,h-dh,dh}]],
	Map[Line,Table[{{i,0},{i,h}},{i,dw,w-dw,dw}]]
	];

(* Create the coordinates for rectangles *)
coord1=Flatten[ Table[{i,j-dh},
		{j,h,dh,-dh},{i,0,w-dw,dw}],1];
coord2=Flatten[ Table[{i+dw,j},
		{j,h,dh,-dh},{i,0,w-dw,dw}],1];

Table of plots

(* ================= Table of plots ================== *)
disks={};dy=.09;
frames=Table[ 
	AppendTo[disks,
		onedisk[(1-dy*n)^.5,dy*n,dy*(n-1),twoPi/(25-n)]];
	Show[plot1,disks,
		PlotRange->{{-1,1},{-1,1},{0,1}},
		DisplayFunction->Identity],
{n,1,11} ];

Title/text frames created

(* =========== Title/text frames created ============= *)
frame1=Show[
	Graphics[{
		Text[
			FontForm["Solid of Revolution:",{"Times-Bold",18}],
				Scaled[{.5,.9}]],
		Text[ "f(x) = 1-x^2 on [0,1]",Scaled[{.5,.6}]],
		Text[ "revolved about the y-axis.",Scaled[{.5,.4}]],
		Text[ "- Approximated by disks -",Scaled[{.5,.10}]]
		}],
	DefaultFont->{"Times-Bold",14},
	DisplayFunction->Identity ];
				
(* Use PrependTo[] to add frame(s) to front of list *)	
(* Add Title frame or other special frames *)
PrependTo[frames,frame1];

(* Use AppendTo[] to add to the end of a frame list        *)
(* To leave a frame blank use: AppendTo[frames,Graphics[]] *)

(* ============ Setup frames as Rectangles =========== *)
(* The list of frames must have 12 elements *)
(* The Rectangles are assigned array elements  *)
frames=MapThread[Rectangle,{coord1,coord2,frames}];

Show the complete page

(* ============= Show the complete page ============== *)
Show[ 
	Graphics[border],  (* sets page sizes *)
	AspectRatio->h/w,
	Epilog->Join[frames,inlines,border],
	DisplayFunction->$DisplayFunction
	];
	
(* Pull the graphic image to width 7.5 inches and print *)