Summer ﷿  Project 
for Calculus and Mathematica
Workshop
Jenna Caldwell

DensityPlot[Sin[x/y], {x, -10,10}, {y,-10,10}, PlotPoints->250, Mesh->False]

Mathematica 2.0 Initialization Cells

Vector Drawers

(* Two and Three Dimensional Vector Builder *)

(* It includes a couple of useful commands like the cross
    product and norm of a vector.  *)

(* Bill Davis,  January, 1991 *)

BeginPackage["`Vectors3D`"];

Perp::usage = "Perp[expr] returns a single 3-d vector which is 
		perpendicular to the vector, 'expr'.";
		
Cross::usage = "Cross[a,b] returns the cross product of a and b.";

Norm::usage = "Norm[expr] returns the Euclidean length of the
		vector, 'expr'.";
		
Turn::usage = "Turn[expr] returns an orthogonal 3 by 3 matrix 
		which takes {0,0,1} to 'expr'.";
		
Vector3D::usage = "Vector3D[a,b] produces the 3-d graphics object,
		a vector from a to b.
		Vector3D[a,b,PlotStyle->{styles}] produces the graphics object with
		the styles included.";
		
Vector3D::notnum = "The vectors `1` and `2` aren't numeric.";
		
Vector2D::usage = "Vector2D[a,b] produces a 2-d graphics object, a 
  vector from a to b.
		Vector[a,b,PlotStyle->{styles}] produces the graphics object with
		the styles included.";
		
Begin["`Private`"]

SetOptions[ParametricPlot,AspectRatio->Automatic];
SetOptions[Plot,AspectRatio->Automatic];
SetOptions[Graphics,AspectRatio->Automatic];
Z = {0,0};  (* The Origin *)

(*  Perp[a] returns a single vector perpendicular to a  *) 
Perp[a_?VectorQ] := If[a[[1]]==0,Return[{1,0,0}],
			(*else*) If[a[[2]]==0,Return[{0,1,0}],
			(*else*)  Return[{-a[[2]],a[[1]],0}]]];
			
(*  Cross product of 3-dim vectors                *)
Cross[a_?VectorQ,b_?VectorQ]:={a[[2]]b[[3]]-a[[3]]b[[2]], 
				a[[3]]b[[1]]-a[[1]]b[[3]],
				a[[1]]b[[2]]-a[[2]]b[[1]]};
				
(*  Length of a vector        *) 
Norm[a_?VectorQ]:=Sqrt[a.a];

(*  Produce an orthogonal matrix which moves {0,0,1}
				to the direction of the vector a                *)
Turn[a_?VectorQ] := Block[{A = a, B},
		B = Perp[A]/Norm[Perp[A]];
		A = a/Norm[a];
		Return[Transpose[{B,A~Cross~B,A}]]
					];
					
corn = Table[N[1/4 {Cos[2 k Pi/7],Sin[2 k Pi/7],-4}],{k,0,7}]; 

corners[a_] := N[Table[(a.corn[[j]]),{j,1,8}]]; 

Vector3D[a_,b_] := Block[{A,B,AA,BB,m,aa,bb},
		aa=N[a];bb=N[b];
		If[!NumberQ[aa.aa+bb.bb],
				Message[Vector3D::notnum,a,b];Return[Null],
		A = Turn[bb-aa];
		B = 0.13 Norm[bb-aa] corners[N[A]];
		AA = Table[Line[{bb,bb+B[[m]]}],{m,1,7}];
		BB = Table[bb + B[[m]],{m,1,8}];
		Return[Graphics3D[Join[{Line[{aa,bb}],Line[BB]},AA]]]
						]];

Vector3D[from_,to_,style___]:=
	Graphics3D[
		Flatten[Join[{PlotStyle/.style},
		Vector3D[from,to]/.Graphics3D->List],1]
			];
						
Vector2D[from_,to_] := Block[{A,B,AA,BB,c,d},
			AA=N[to];
			BB=N[from];
			A=AA-BB;
			B = RotateLeft[A] {-1,1};
			c = AA - 0.1 A + .02 B;
			d = AA - 0.1 A - .02 B;
			Return[
			Graphics[
				Line[{BB,AA,c,d,AA}]
					]]];

Vector2D[from_,to_,style___]:=
	Graphics[
		Flatten[Join[{PlotStyle/.style},
		Vector2D[from,to]/.Graphics->List],1]
			];
			
SetOptions[ParametricPlot,AspectRatio->Automatic];
SetOptions[Plot,AspectRatio->Automatic];
SetOptions[Graphics,AspectRatio->Automatic];
					
			
Protect[Perp,Cross,Turn,Vector3D,Vector2D];

End[]


EndPackage[]

Null

Turn Off Annoying Messages

Off[General::spell1];
Off[ParametricPlot3D::ppcom];

Animation Portfolio

"Fly around" 3D view of saddle

Table[Show[h,
ViewPoint->{4.120, d Degree, 71 Degree}],{d,0,360,45}]

f[x_,y_] = y^2 - x^2
surface = 
   Plot3D[f[x,y],{x,-6,6},{y,-7,7},
   DisplayFunction->Identity]

Table[Show[surface,DisplayFunction->$DisplayFunction,
Boxed->False, Axes->None, Mesh->False,
ViewPoint->{2.130, q Degree, 10 Degree}],
{q,-360, 360, 90}]

Limiting Rectangles

Here's what 150 rectangles under √x looks like.  Notice how small the base of the rectangles are.  That is, as n goes to infinity, base width goes to zero.

Area Under Curve Demo

To better assist students visualize the concept of integral, Riemann Sums, and limit, this program enables us to alter a picture of rectangles under a curve.  Default refers to # rectangles, and  refers to the function being graphed.  Simply change these to  vary the results.  Thank you, Allan, for the help here!

Rectangle Code

BeginPackage["RSPlot`",
     "Utilities`FilterOptions`"]
EndPackage[]



RSPlot::usage =
	"RSPlot[f ,{x, xmin, xmax}] generates a plot of f as a
	function of x from xmin to xmax, with the area b/w f
	and the x-axis filled with rectangles. The color, location,
	and number of rectangles can be given by the AreaColor,
	AreaLocation, AreaDivision options. RSPlot can only plot
	one function at a time.";

AreaBorder::usage =
	"An options to RSPlot. AreaBorder determines the color of the
	border of the rectangles. This option requires only a color
	primitive (i.e. Hue[0], RGBColor[.5,.5,.5], etc.) If no color is
	given, the rectangle defaults to black (RGBColor[0,0,0]).";
     
AreaColor::usage = 
	"An option to RSPlot. AreaColor determines the color of the
	rectangles. This option requires only a color primitive
	(i.e. Hue[0], RGBColor[.5,.5,.5], etc.) If no color is given,
	the rectangle defaults to None.";

AreaDivision::usage =
	"An option to RSPlot. AreaDivision determines the number of
	rectangles in an RSPlot. This option requires only a positive
	integer. If no integer is given, the number of rectangles
 	defaults to 20.";

AreaLocation::usage =
	"An option to RSPlot. AreaLocation determines the location of
	the rectangles in an RSPlot. The options takes either the
	primitive Left, Right, or Middle. If no primitive is given, the
	rectangle defaults to Left.";

LeftPoint::usage =
	"An option value for the option AreaLocation for RSPlot.
	LeftPoint plots the rectangles using the left-hand endpoints.";

RightPoint::usage =
	"An option value for the option AreaLocation for RSPlot.
	RightPoint plots the rectangles using the right-hand endpoints.";

MiddlePoint::usage =
	"An option value for the option AreaLocation for RSPlot.
	MiddlePoint plots the rectangles using the middle points.";

RSPlot;

Protect[LeftPoint,RightPoint,MiddlePoint];

Begin["RSPlot`Private`"]


(*  MAKE ALTERATIONS HERE *)

defaultcol = None;
defaultloc = LeftPoint;
defaultdiv = 10;
defaultbor = RGBColor[0,0,0];

Options[RSPlot] = Join[{AreaColor     -> defaultcol,
                        AreaDivision  -> defaultdiv,
                        AreaLocation  -> defaultloc,
                        AreaBorder    -> defaultbor},
	                    Options[Plot]];

RSPlot::badbord =
	"The AreaBorder option has been given a bad value '`1`'; \r 
	using '`2`' in its place.";

RSPlot::badcolo = 
	"The AreaColor option has been given a bad value '`1`'; \r
	using '`2`' in its place.";

RSPlot::baddivi =
	"The AreaDivision option has been given a bad value '`1`'; \r
	using '`2`' in its place.";
    
RSPlot::badloca =
	"The AreaLocation option has been given a bad value '`1`'; \r
	using '`2`' in its place.";

RSPlot::badflis =
	"Since only one function can be RS-plotted at a time,
	only the first function will be used.";


RSPlot[func_,{x_Symbol,xmin_,xmax_},opts___] :=

Module[{step,recs,lines,i,fplot,points,
        areadiv,areacol,arealoc,areabor,f,disp,areas = {}},

f       = Evaluate[Part[Flatten[{func}],1]];

areabor = Evaluate[AreaBorder     /.{opts}/.Options[RSPlot]];

areadiv = Evaluate[AreaDivision   /.{opts}/.Options[RSPlot]];

areacol = Evaluate[AreaColor      /.{opts}/.Options[RSPlot]];

arealoc = Evaluate[AreaLocation   /.{opts}/.Options[RSPlot]];

disp    = Evaluate[DisplayFunction/.{opts}/.Options[RSPlot]];

If[Length[Flatten[{func}]] > 1,Message[RSPlot::badflis]];

If[!IntegerQ[areadiv],
   Message[RSPlot::baddivi,areadiv,defaultdiv];
   areadiv = defaultdiv];

If[!MatchQ[areacol,(RGBColor[___] | Hue[___] | CMYKColor[___] | GrayLevel[___] | None)],
   Message[RSPlot::badcolo,areacol,defaultcol];
   areacol = defaultcol];

If[!MatchQ[areabor,(RGBColor[___] | Hue[___] | CMYKColor[___] | GrayLevel[___] | None)],
   Message[RSPlot::badbord,areabor,defaultbor];
   areabor = defaultbor];

If[!MatchQ[arealoc,(LeftPoint | RightPoint | MiddlePoint)],
   Message[RSPlot::badloca,arealoc,defaultloc];
   arealoc = defaultloc];

step    = (xmax - xmin)/areadiv;

points  = Switch[arealoc,
                 LeftPoint,
                 Table[{{i,0},{i,f/.x->i},{i+step,f/.x->i},{i+step,0}},
                        {i,xmin,xmax-step,step}],
                 RightPoint,
                 Table[{{i-step,0},{i-step,f/.x->i},
                        {i,f/.x->i},{i,0}},
                        {i,xmin+step,xmax,step}],
                 MiddlePoint,
                 Table[{{i-step/2,0},{i-step/2,f/.x->i},
                        {i+step/2,f/.x->i},{i+step/2,0}},
                        {i,xmin+step,xmax,step}]];

If[areacol =!= None,
   AppendTo[areas,
            Evaluate[Table[Graphics[
              {areacol,Polygon[points[[i]]]}],
              {i,1,Length[points]}]]
           ]
  ];

If[areabor =!= None,
   AppendTo[areas,
            Evaluate[Table[Graphics[
              {areabor,Line[points[[i]]]}],
              {i,1,Length[points]}]]
           ]
  ];

fplot  = Plot[f,{x,xmin,xmax},
              DisplayFunction:>Identity,
              Evaluate[FilterOptions[Plot,opts]]];
       
Show[fplot,areas,fplot,DisplayFunction:>disp]

(* End Module *)

]
    
End[];

Null

(*  MAKE ALTERATIONS for function and intervals HERE  *)

RSPlot[Cos[x],{x,0,2Pi},DisplayFunction->Identity]

Show[%,DisplayFunction->$DisplayFunction];

?RSPlot

?AreaDivision

Derivitive Stuff

Clear[t,P,x,y]
P[t_] = {t,t^3};
curveplot = 
     ParametricPlot[P[t],{t,-2,2}, 
     PlotStyle->Thickness[0.01],                                                                                                                              
     PlotRange->All];

Clear[vel,accel]
vel[t_] = D[P[t],t]

??Vector2D

Clear[unittan]
unittan[t_] = vel[t]/Sqrt[vel[t].vel[t]];

velvectors =
Show[
Table[Vector2D[P[t],(P[t] + unittan[t]),PlotStyle->{Thickness[.02],RGBColor[0,0,1]}], {t,-2,2,.5}]]

balls = Show[Table[Graphics[{PointSize[0.02],Point[{t,3t^2}]}],{t,-2,2,.25}]]

velocities =
     Show[curveplot,velvectors,balls,
          AspectRatio->Automatic];

Compare the graphs of f, f', f'', and f'''.

h[x_] = x^3
g = Plot[h[x], {x, -1.5,1.5},PlotRange->{{-1.5,1.5},{-4,4}},DisplayFunction->Identity];

g1 = Plot[h'[x], {x,-1.5,1.5},PlotRange->{{-1.5,1.5},{-4,4}},DisplayFunction->Identity];

g2 = Plot[h''[x], 		{x,-1.5,1.5},PlotRange->{{-1.5,1.5},{-4,4}},DisplayFunction->Identity];

g3 = Plot[h'''[x], 		{x,-1.5,1.5},PlotRange->{{-1.5,1.5},{-4,4}},DisplayFunction->Identity];

Show[GraphicsArray[{g, g1,g2, g3}],DisplayFunction->$DisplayFunction];

Funky Fonts

Rabbits vs. Robots (assigning pencil vs. calculator racers)

Ÿ   Rabbits  (no calculators)       Ÿ Robots  (calculators)
 
				Ÿ    Anglen, Donald
				Ÿ    Barrette, Shirley
				Ÿ   BonDurant, Edward
				Ÿ   Caldwell, Jenna
				Ÿ    Case, Jr. Robert
				Ÿ   Clinton, Nancy
				Ÿ   Conroy, Susan
				Ÿ    Cremer, Marcella
				Ÿ    Davis, Ronald
				Ÿ   Doenes, James
				Ÿ    Hayes, James
				Ÿ    Jones, Roberta
				Ÿ   Kang, Shinae
				Ÿ    Lagle, Gena
				Ÿ   Kenyen, Jo
				Ÿ   Lagle, Gena
				Ÿ    Luker, John
				Ÿ   Lystilla, David
				Ÿ    McLaughin, Pat
				Ÿ    Robinson, Marian
				Ÿ   Simpson, Charles
				Ÿ  Smith, Judy
				Ÿ  Smith, Kathleen
				Ÿ   Sparks, Dennis
				Ÿ   Wilkins, Jay
				Ÿ  Yu, Paul

Cards and Probability

Assume we have a normal deck of cards, with markings 1-10, J, Q, K, & A, and suits:
  black spade ♠   
  	  black club  ♣ 
  	  red heart   ♡ 
  	  red diamond ♢. 
We could refer a Jack of spades by "J♣ ", for example.

Examples

What is the probability that, by randomly chooses ONE card from this deck, we get a:

		1.) red
		2.) ♣
		   3.) 5
		4.) A♡
	 5.) black seven of diamonds

Answers:

		1.) 1/2
		2.) 1/4
		3.) 1/14
		   4.) 1/14 * 1/4
	  5.) 0

What is the probability that, by randomly chooses TWO cards from this deck, we get:

		1.) a red and a blçck?
		2.) ♣         ♠  
		3.) K♡    Q♢
		4.) 7♣       ♡ 
		5.) ♢        A♣

Answers:

		1.) 1/2 * 1/2
		2.) 1/4 * 1/4
		3.) (1/14 * 1/4) * (1/14 * 1/4)
		   4.) (1/14 * 1/4) * (1/4)
	  5.) same as 4

Now pick FIVE cards and compute chances of getting:
   10, J, Q, K, A
   ♢ ♢ ♢ ♢ ♢
        ♠ ♣ ♢ ♡
        4♠ 4♢ 4♣ 4♡
        7♡ 
Use your "poker intuition" to compare your results, and see if they make sense.

A Different Outlook on Variables

Instead of using conventional notations for unknowns (x, y, and z),  it is recommended to try also some unfamiliar notations to provide a more concrete representation of word problems.   Consider examples:
 
 3Ÿ +  4Ÿ =  7Ÿ          they'll see the "light" better this way than with x!
 6Δ + 2◇ + ◇  + 8◇  + 10Δ  collect like terms
 5﷿ +  5•  =  5(﷿  + •)      add apples and oranges