Give me tools, not tutorials

or     
Making Mathematica almost as useful as chalk

Marcus McGuff,
Professor of Mathematics

Austin Community College

http://www.austincc.edu/mmcguff

http://www.austincc.edu/mmcguff/mathematica/diffeq

The Setting

A large Community College with 40,000 students, 7 main campuses, about 40 full-time and 200 adjunct math faculty; very mixed availability of computers in classrooms

The Conflict

The department wants to integrate technology into our courses in a non-trivial way

Department allows individual instructors to choose what they feel comfortable using

Mathematica must compete with other technologies for instructor attention

The Competition (In order of appearance)

•    Chalk    •    Graphing calculators    
•    Computer graphing programs
•    Publisher supplied course-specific programs and tutorials

Levels of Mathematica Usage in Classes

Require students to learn to use Mathematica commands directly

Pro - Gives students experience with professional level tools

Con - Requires instructor time/training and dedicating some time in class to "teach the program" to students

Write your own demonstrations for use in class

Pro - Allows faculty to address topics exactly as they see fit

Con - Once you get beyond basic Manipulate usage, there are a lot of details you need to know; many faculty give up when they can't see how to do something easily.

Use pre-written demonstrations in class

Pro - Little or no time/training required; sometimes possible to modify to taste

Con - You take what you can find, even if it isn't really what you want

Paradox Alert - Even though this requires the least amount of preparation, time, and knowledge, it attracts the shortest attention span from faculty.  After the "new" has worn off, teachers only continue to use those that really interest the students.

Design Goals for Classroom Widgets

Ease of Use:  Little or no knowledge of Mathematica required for use; allow TraditionalForm input and display wherever possible

Interactivity:  Try to allow for direct interaction with the graph; make good use of dynamic and interactive content to add something new to student understanding

Show Relationships:  Emphasize relationships between different views of the system

Lecture AND Student Friendly:  Useful for faculty in lectures - allow for maximum flexibility in choosing examples; also usable by students (compatible with Mathematica Player), provide examples and labs to guide exploration

Breadth and Depth:  Allow for broad and flexible exploration of a topic; it should be pedagogically driven, but not pedagogically limited

Bonus points: It should do something that simply isn't possible using other competing, more familiar technologies (or at least do it in a more compelling way)

The phase plane

Ex: m y-x^2

Manipulate[

Refresh[If[var===Null,Clear[var];var["highrect"]={};var["computePlotrange"]=plotrange;
var["xEqOld"]=xEq;
var["yEqOld"]=yEq;
var["paramsOld"]=params];
(*This is the list of functions to be included in the drop-down lists; can add extra info later inside each inner bracket; be SURE that each function is enclosed in ToBoxes[...], and function is entered in StandardForm
*)
If[xText===Null,Clear[x,y];
xFunctions={
{ToBoxes[a x + b y]},
{ToBoxes[a x + b y+c]},
{ToBoxes[ x(a-b y)]},
{ToBoxes[ x(a - b x - c y)]},
{ToBoxes[ x(a - b x - c y)-d]},
{ToBoxes[a y]},
{ToBoxes[y]}
};
xText=xFunctions[[1,1]]];
If[yText===Null,Clear[x,y];
yFunctions={
{ToBoxes[p x + q y]},
{ToBoxes[p x + q y+r]},
{ToBoxes[y(q x - p)]},
{ToBoxes[ y(p -q y-r x)]},
{ToBoxes[ y(p -q y-r x)-s]},
{ToBoxes[p x - q (x^3)]},
{ToBoxes[μ(1-(x^2))y-x]}
};
yText=yFunctions[[1,1]]],None];

(* Convert input text boxes into expressions in TraditionalForm*)
xEq=ToExpression[xText,TraditionalForm];
yEq=ToExpression[yText,TraditionalForm];
If[xEq===Null&&yEq===Null,var["xEqOld"]=xEq;
var["yEqOld"]=yEq];


(* Finds parameters in xEq and yEq, then writes the replacement rules for them; can specify exclusion cases here; set default value for all parameters here with {_->1.} *)
params=SortBy[Thread[Rule[#,Replace[#,Join[params,{_->1.}],1]]],First]&[Cases[Level[{xEq,yEq},-1],s_Symbol/;And[FreeQ[{x,y},s],FreeQ[Attributes[s],Locked|Constant]]]];
If[params===Null,var["paramsOld"]=params];

(* Compute the critical points and Eignesets *)
Refresh[
If[findCrPtsYN&&PolynomialQ[xEq,{x,y}]&&PolynomialQ[yEq,{x,y}],
eqPts={};
var["allEqPts"]=Union[Quiet@Solve[Thread[{xEq,yEq}=={0,0}]/.params,{x,y}]];

If[!NumberQ[Simplify[(xEq/yEq)/.params]],
Table[If[({x,y}/.var["allEqPts"][[k]])∈Reals,AppendTo[eqPts,var["allEqPts"][[k]]]],{k,1,Length[var["allEqPts"]]}],
AppendTo[eqPts,{x->0,y->0}]];

If[Length[eqPts]>0,
localLin=D[{xEq,yEq}/.params,{{x,y}}]/.eqPts//N;
eigenSets=Map[Eigensystem,localLin],
findCrPtsYN=False;MessageDialog["There are no Real-valued critical points."]],
If[findCrPtsYN,findCrPtsYN=False;MessageDialog["Your equations need to be polynomials in x and y to find the critical points in this demonstration."]]],TrackedSymbols:>{xText,yText,params}];


If[!(var["xEqOld"]===xEq&&var["yEqOld"]===yEq&&var["paramsOld"]===params),

(* Recompute existing trajectories whenever params change *)
If[Length[pts]>0,
Table[
pts[[k,2]]=First[({x[t],y[t]}/.Quiet[var["eqSol"]=NDSolve[{Thread[{x'[t],y'[t]}==({xEq,yEq}/.params/.{x->x[t],y->y[t]})],Thread[{x[0],y[0]}==pts[[k,1]]]},{x,y},{t,0,tMax}]])];
pts[[k,3]]=Flatten[Thread@DifferentialEquations`InterpolatingFunctionAnatomy`InterpolatingFunctionDomain[Flatten[{x,y}/.var["eqSol"]]],1],
{k,1,Length[pts]}]];

var["xEqOld"]=xEq;
var["yEqOld"]=yEq;
var["paramsOld"]=params];



Grid[{{Text@Style[If[findCrPtsYN&&(Length[eqPts]>0),Row[{"Equilibrium pts: ",Dynamic[{x,y}/.eqPts]}],"Phase plane"]]},
{EventHandler[Tooltip[Dynamic[Graphics[{
(* Vector field or StreamPlot *)
Dynamic[First[plotter[Evaluate[{xEq,yEq}/.params],
{x,Part[var["computePlotrange"],1,1],Part[var["computePlotrange"],1,2]},{y,Part[var["computePlotrange"],2,1],Part[var["computePlotrange"],2,2]},
StreamStyle->Blue,
VectorScale->{0.03,Automatic,1&},
VectorStyle->{Blue,Arrowheads[0.02]}]],
(*,*)
(*TrackedSymbols->{pts,plotter,xText,yText,var["computePlotrange"]}*)],

(* Set of solution curves and initial points, with Tooltips displaying x(t) and y(t) *)
Dynamic[If[Length[pts]>0,
Table[
Tooltip[{{Red,PointSize[Medium],Point[pts[[k,1]]]},
First@ParametricPlot[pts[[k,2]],{t,Max[pts[[k,3,All,1]]],Min[pts[[k,3,All,2]]]}]},
With[{k=k},Dynamic@Column[
{Plot[Part[pts,k,2,1],{t,pts[[k,3,1,1]],pts[[k,3,1,2]]},AxesLabel->{t,x},AxesOrigin->{0,0},
PlotRange->2{Part[var["computePlotrange"],1,1],Part[var["computePlotrange"],1,2]}],
Plot[Part[pts,k,2,2],{t,pts[[k,3,2,1]],pts[[k,3,2,2]]},AxesLabel->{t,y},AxesOrigin->{0,0},
PlotRange->2{Part[var["computePlotrange"],2,1],Part[var["computePlotrange"],2,2]}]}]]],
{k,1,Length[pts]}],
{}]],

(* Show nullclines *)
Dynamic[If[showNullclinesYN,
First@ContourPlot[Evaluate[Thread[{xEq,yEq}=={0,0}]/.params],{x,Part[var["computePlotrange"],1,1],Part[var["computePlotrange"],1,2]},{y,Part[var["computePlotrange"],2,1],Part[var["computePlotrange"],2,2]},
MaxRecursion->ControlActive[3,Automatic],
ContourStyle->{Directive[Green,Dotted,Thickness[0.004]],Directive[Orange,Dotted,Thickness[0.004]]}],
{}]],

(* Highlight rectangle for zooming *)
Dynamic[var["highrect"]],

(* Plot equilibrium points and draw eigenvectors *)
Dynamic[If[findCrPtsYN&&(Length[eqPts]>0),
{PointSize[Large],Blue,Thickness[0.003],Dashed,
Table[With[{ptk={x,y}/.eqPts[[k]]},
Append[
Append[Table[If[(eigenSets[[k,1,m]]∈Reals),
Tooltip[Line[{ptk-Max[(Part[var["computePlotrange"],1,2]-Part[var["computePlotrange"],1,1]),(Part[var["computePlotrange"],2,2]-Part[var["computePlotrange"],2,1])]eigenSets[[k,2,m]],ptk+Max[(Part[var["computePlotrange"],1,2]-Part[var["computePlotrange"],1,1]),(Part[var["computePlotrange"],2,2]-Part[var["computePlotrange"],2,1])]eigenSets[[k,2,m]]}],
Text@Style[Row[{"λ = ",eigenSets[[k,1,m]],", Eigenvector: ",eigenSets[[k,2,m]]}],Medium]],{}],{m,1,Length[eigenSets[[k,1]]]}],Red],

Tooltip[Point[ptk],With[{k=k},Dynamic@Column[{Text@Style[Row[{"λ = ",eigenSets[[k,1]]}],Medium],StreamPlot[localLin[[k]].{x,y},{x,-0.25(Part[var["computePlotrange"],1,2]-Part[var["computePlotrange"],1,1]),0.25(Part[var["computePlotrange"],1,2]-Part[var["computePlotrange"],1,1])},{y,-0.25(Part[var["computePlotrange"],2,2]-Part[var["computePlotrange"],2,1]),0.25(Part[var["computePlotrange"],1,2]-Part[var["computePlotrange"],1,1])},
Axes->False,Frame->False,StreamStyle->"Arrow"]}]]]]],
{k,1,Length[eqPts]}]



(*Table[With[{ptk={x,y}/.eqPts[[k]]},
Append[
Append[If[(eigenSets[[k,1,1]]∈Reals),
Table[Tooltip[Line[{ptk-10eigenSets[[k,2,m]],ptk+10eigenSets[[k,2,m]]}],
Text@Style[Row[{"λ = ",eigenSets[[k,1,m]],", Eigenvector: ",eigenSets[[k,2,m]]}],Medium]],{m,1,2}],{}],Red],

Tooltip[Point[ptk],With[{k=k},Dynamic@Column[{Text@Style[Row[{"λ = ",eigenSets[[k,1]]}],Medium],StreamPlot[localLin[[k]].{x,y},{x,-0.25(Part[var["computePlotrange"],1,2]-Part[var["computePlotrange"],1,1]),0.25(Part[var["computePlotrange"],1,2]-Part[var["computePlotrange"],1,1])},{y,-0.25(Part[var["computePlotrange"],2,2]-Part[var["computePlotrange"],2,1]),0.25(Part[var["computePlotrange"],1,2]-Part[var["computePlotrange"],1,1])},
Axes->False,Frame->False,PerformanceGoal->"Speed"]}]]]]],
{k,1,Length[eqPts]}]*)},
{}]]

},
PlotRange->Dynamic[plotrange],AspectRatio->1,AxesOrigin->{0,0},Axes->True,AxesLabel->{x,y},Frame->False,ImageSize-> 500,FilterRules[Options[VectorPlot],Options[Graphics]]
]],
Dynamic[Text@Style[MousePosition["Graphics"],Medium]]],

{"MouseClicked":>
Switch[mouseMode[],
"pan",None,
"zoomIn",None,
"zoomOut",None,
"special",If[!MemberQ[pts[[All,1]],MousePosition["Graphics"]],AppendTo[pts,
{MousePosition["Graphics"],First[({x[t],y[t]}/.Quiet[var["eqSol"]=NDSolve[{Thread[{x'[t],y'[t]}==({xEq,yEq}/.params/.{x->x[t],y->y[t]})],Thread[{x[0],y[0]}==MousePosition["Graphics"]]},{x,y},{t,0,tMax}]])],
Flatten[Thread@InterpolatingFunctionDomain[Flatten[{x,y}/.var["eqSol"]]],1]}],
None]],
"MouseDown":>
(readMouse["start"];
Switch[mouseMode[],
"pan",None,
"zoomIn",None,
"zoomOut",None,
"special",None]
),
"MouseDragged":>
(readMouse["end"];
Switch[mouseMode[],
"pan",(plotrange=plotrange-Apply[Subtract,-plotrange,1](var["endScaled"]-var["startScaled"]);
readMouse["start"]),
"zoomIn",var["highrect"]={Opacity[0.2],Blue,Rectangle[var["start"],var["end"]]},
"zoomOut",var["highrect"]={Opacity[0.2],Red,Rectangle[var["start"],var["end"]]},
"special",None]),
"MouseUp":>(Switch[mouseMode[],
"pan",None,
"zoomIn",If[var["highrect"]=!={},
plotrange=Sort/@Transpose[var/@{"start","end"}]],
"zoomOut",If[var["highrect"]=!={},
plotrange=1/Abs[(var["endScaled"]-var["startScaled"])]plotrange],
"special",None];
var["highrect"]={};
readMouse["start"];
pts=Union@pts;
var["computePlotrange"]=plotrange)}]
},
{Text@Grid[{{"Mouse actions",SpanFromLeft},{"Click - Plot solution curve","","Shift/Drag - Move graph"},
{"Alt(Cmd)/Drag - Zoom in","","Shift/Alt(Cmd)/Drag - Zoom out"}},Alignment->Center,Dividers->{False,{False,True,False,False}},ItemStyle->Directive[Black,10,FontFamily->"Times"]]},
{Text@Grid[{
If[findCrPtsYN,{"Red - Eq. pts/initial conditions","","Blue - Eigenvectors"},{}],
If[showNullclinesYN,{"Green - x nullclines","","Orange - y nullclines"},{}]},Alignment->Center,Dividers->{False,{True,False,False,False}},ItemStyle->Directive[Black,10,FontFamily->"Times",Italic]]}}],



(* Allows for TraditionalForm input - Must apply ToExpression[xText,TraditionalForm] before use, see xEq and yEq below *)
OpenerView[{
Row[{Control[{{xText,,"(dx/dt)="},(#->ToExpression[#,StandardForm,TraditionalForm])&/@xFunctions[[All,1]],ControlType->PopupMenu}],"                                    ",
Control[{{yText,,"(dy/dt)="},(#->ToExpression[#,StandardForm,TraditionalForm])&/@yFunctions[[All,1]],ControlType->PopupMenu}]}],
Dynamic@If[$LicenseType≠"Player",
Row[{Control[{{xText,,"(dx/dt)="},TraditionalForm[InputField[Dynamic[xText],Boxes]]&}],"  ",Control[{{yText,,"(dy/dt)="},TraditionalForm[InputField[Dynamic[yText],Boxes]]&}]}],Text@Style[
"Extra input options not available in the free Mathematica Player; to enter your own equations, you must be using a full version of Mathematica",Italic]]}],

(* Allows tMax to continue moving upwards indefinitely; tLimit is initial upper value for tMax *)
{{tLimit, 20}, ControlType -> None}, {{tMax, 5,"Max time domain"}, Refresh[Slider[Dynamic[tMax, {Automatic, (tLimit = tMax + 0.5tLimit) &}], {0.000000001, tLimit},Appearance->"Labeled"], TrackedSymbols -> {tLimit}] &}, 

Row[{Button["Clear Curves",pts={},BaseStyle->Small,ImageSize->All],"     ",
Button["Default Range",plotrange={{-5,5},{-5,5}},BaseStyle->Small,ImageSize->All],"     ",
Control@{{findCrPtsYN,False,"Show equilibrium pts"},{True,False}},"   ",Control@{{showNullclinesYN,False,"Show nullclines"},{True,False}},"   ",Control@{{plotter,VectorPlot,"Show me all"},{VectorPlot,StreamPlot},Checkbox}
}],

Delimiter,
(* Produces sliders dynamically for parameters *)
Item[Column[{"Parameters",Dynamic[Grid[MapIndexed[{params[[First@#2,1]],Manipulator[Dynamic[params[[First@#2,2]]],{-2,2,0.01},Appearance->{"Labeled","Open"}]}&,params]]]}],ControlPlacement->Left],

{xEq,ControlType->None},
{yEq,ControlType->None},
{{params,{}},ControlType->None},
{{plotrange,{{-5,5},{-5,5}}},ControlType->None},

(* temporary holding variable *)
{var,ControlType->None},

(* pts -> list of info for each init cond: { coord , {x[t],y[t]}, {{t domain for x}, {t domain for y}}
so: pts[[k,1]] gives initial condition, pts[[k,2]] gives solution curves, and pts[[k,3]] gives safe domains of t for each solution curve*)
{{pts,{}},ControlType->None},

{{eqPts,{}},ControlType->None},
{{localLin,{}},ControlType->None},
{{eigenSets,{}},ControlType->None},
{xFunctions,None},
{yFunctions,None},

Initialization:>(mouseMode[]:=Switch[CurrentValue/@{"ShiftKey","CommandKey"},
{False,False},"special",
{True,False},"pan",
{False,True},"zoomIn",
{True,True},"zoomOut"];
readMouse[startOrEnd_]:=(var[startOrEnd]=MousePosition["Graphics"];
var[startOrEnd<>"Scaled"]=MousePosition["GraphicsScaled"]);
Needs["DifferentialEquations`InterpolatingFunctionAnatomy`"]
),Alignment->Center,SynchronousInitialization->False]

The Montagues, the Capulets, and the Zombies
(student lab)

A socio-historical study in population dynamics (or not)

Introduction

Systems of differential equations can be used to model many mechanical systems.  Some researchers have also tried to use these same methods to examine other less mechanistic systems, such as modeling population growth and interactions in biology.  A little contemplation will probably convince you that this is really one of those Hard (Subscript[Problems, TM]) that can give scientists fits:  There are so many different variables involved, many of which are difficult to measure (assuming that we even know what all of them are), that finding an accurate model for population growth seems moderately hopeless.  This doesn't mean that attempting to model these systems is a waste of time; we can start with fairly simple models and then work our way up to more comprehensive ones.  Along the way, we can capture some basic properties of population dynamics by examining these models.  This lab will take you through some basic ideas to model population using some very simple equations and systems using several "species" from historical fiction.

Enter the Montagues - Some basic equations to model a population

The Montague species is descended from 13th Century Italian roots.  The simplest model for their population might be that the rate at which their population increases is proportional to their size at any time, or mathematically: 

(dx/dt)=a x 

(where a>0 is some constant growth rate).

StreamPlot[{1,0.1y},{x,0,10},{y,0,10},Axes->True,AxesOrigin->{0,0},Frame->False,PlotLabel->"Exponential Growth",AxesLabel->{"t","x"}]

This exponential growth model captures the basic idea that the more Montagues there are, the more Montagues there will be; they start off growing relatively slowly, but grow faster over time as their numbers increase.  However, it makes the idealistic assumption that there will always be food for any number of Montagues to eat.  In most ecosystems, there is a definite upper limit to the size of a population that the environment can support (due to limited food supplies, build up of waste materials, overcrowding, etc.), called the carrying capacity of the environment.  So perhaps it might be better to consider a growth rate that is proportional to how far away the population is from the maximum carrying capacity:

(dx/dt)=a (1-b x)  

(where a>0 is some constant growth rate and b>0 is a constant that gives an equilibrium population value of (1/b))

StreamPlot[{1,1-0.2y},{x,0,10},{y,0,10},Axes->True,AxesOrigin->{0,0},Frame->False,PlotLabel->"Limited Growth",AxesLabel->{"t","x"}]

This limited growth model captures the idea of an upper limit for the population (why is that limit (1/b)?), so it better captures the likely long-term behavior of the Montagues.  However, this method loses some of the useful short-term features of the exponential growth model used earlier (limited growth curves always start out growing or shrinking the fastest at the very beginning).  So, we can combine those behaviors together by multiplying the two models together:

(dx/dt)=a x(1-b x)

(where a>0 and b>0 are as above).

StreamPlot[{1,y(1-0.2y)},{x,0,10},{y,0,10},Axes->True,AxesOrigin->{0,0},Frame->False,PlotLabel->"Logistic Growth",AxesLabel->{"t","x"}]

Notice that this has the short-term growth characteristics of exponential growth (as long as you start below the carrying capacity) and the long-term behavior of limited growth.  This model is called the logistic growth model.

Of course, none of these models is particularly accurate, since they completely ignore the impact of other species on the Montagues (and the impact of the Montagues on those species...).  However, we will use variations on these models to build up models for the behavior of interdependent species.

Interface summary points

Direct control of graph for zooming/panning as well as setting initial conditions

Dynamic display of parameters (allows systems with arbitrary parameters)

Flexible set of examples included

Users with full version of Mathematica can enter their own equations (OpenerView); if opened in Mathematica Player, displays

Tooltips display a lot of information - Hover over eigenvectors for corresponding eigenvalue, hover over equilibrium points for graph of local linearization and eigenvalues of Jacobian, hover over solution curves for graphs of x(t) and y(t)

Display as vectors or StreamPlot

Useful throughout study of linear and nonlinear systems, second order equations; can easily be used as the basis for student lab questions

The Lorenz Attractor

Manipulate[Refresh[If[var===Null,Clear[var];var["computePlotrange"]=plotrange;
var["highrect"]={}],None];


Refresh[(*Print["Eq pt solve"];*)

eqLorenz={x'[t]==s (-x[t]+y[t]),
y'[t]==r x[t]-y[t]-x[t] z[t],
z'[t]==-b z[t]+x[t] y[t]};

eqPts=Solve[eqLorenz/.{x'[t]->0,y'[t]->0,z'[t]->0},{x[t],y[t],z[t]}];

(*Make a function to find the eq pt nearest to any other pt (exclude origin)*)

If[Length[eqPts]>1,
nearestEqPt=Nearest[N[Select[({x[t],y[t],z[t]}/.eqPts),#≠{0.,0.,0.}&]]],nearestEqPt=Nearest[{{0,0,0}}]];

(*localLin[[j]] is lin matirx for pt k*)localLin=D[eqLorenz[[All,2]],{{x[t],y[t],z[t]}}]/.eqPts//N;

(*eigenSets[[k]] is eigset for pt k,eigenSets[[k,1]] is set of eigenvalues-eigenSets[[k,1,j]] is jth eigenvalue for pt k,eigenSets[[k,2]] is set of all eigenvectors,eigenSets[[k,2,j]] is jth eigenvector*)eigenSets=Map[Eigensystem,localLin],
TrackedSymbols:>{rPar,sPar,bPar}];

(* 
solveLorenzIC[{x0,y0,z0},currentPos,0];

solveLorenzIC[{xIC_,yIC_,zIC_},end_,pert_]:=First[{x[t],y[t],z[t]}/.Quiet[NDSolve[SetPrecision[{Dynamic[eqLorenz],Thread[{x[0],y[0],z[0]}==N[({xIC,yIC,zIC}+pert*RandomInteger[1,3])]]},Infinity],{x,y,z},{t,0,end},PrecisionGoal->ControlActive[4,8],WorkingPrecision->ControlActive[MachinePrecision,20]]]]

*)

Refresh[(*Print["DE solve"];*)
solLorenz=First[{x[t],y[t],z[t]}/.Quiet[NDSolve[SetPrecision[{eqLorenz,Thread[{x[0],y[0],z[0]}=={x0,y0,z0}]},Infinity],{x,y,z},{t,0,currentPos},PrecisionGoal->ControlActive[4,8],WorkingPrecision->ControlActive[MachinePrecision,20]]]];

endpt=Min[Flatten[Thread@DifferentialEquations`InterpolatingFunctionAnatomy`InterpolatingFunctionDomain[solLorenz[[All,0]]],1][[All,2]]],
TrackedSymbols:>{x0,y0,z0,eqLorenz,currentPos}];

With[{
optGr2D=Sequence[Axes->True,AxesOrigin->{0,0},AspectRatio->0.5,ImageSize->150,Ticks->None],plotOpt=Sequence[ColorFunction->(Hue[#1]&),PlotPoints->ControlActive[30,50],ColorFunctionScaling->False],
parPlotOpt=Sequence[PlotPoints->ControlActive[100,100],MaxRecursion->ControlActive[4,4],ColorFunctionScaling->False,ColorFunction->(Hue[#3]&)]},

Switch[ctrlPane,
2,
Dynamic@Grid[(*Print["Main loop 2"];*){{Graphics3D[{Dynamic[First[ParametricPlot3D[solLorenz,{t,0,endpt},PlotPoints->ControlActive[100,150],MaxRecursion->ControlActive[4,5],ColorFunction->(Hue[#4]&),ColorFunctionScaling->False]]],

{Red,PointSize[Large],Point[solLorenz/.t->Evaluate@Min[currentPos,endpt]]},

Dynamic[Table[{Blue,PointSize[Large],Tooltip[Point[{x[t],y[t],z[t]}/.eqPts[[k]]],Text@Style[Row[{"Eigenvalues: ",eigenSets[[k,1]]}],FontSize->12]]},{k,1,Length[eqPts]}]],

With[{curpt=(solLorenz/.t->Evaluate@Min[currentPos,endpt])},Tooltip[{Blue,Dashed,Arrow[{curpt,First[nearestEqPt[curpt]]}]},First[nearestEqPt[curpt]]]]},
ImageSize->400,AxesLabel->{"X","Y","Z"},Axes->True],

Graphics[{First[Plot[solLorenz[[1]],{t,0,endpt},plotOpt]],
{Red,PointSize[Large],Tooltip[Point[{t,solLorenz[[1]]}/.t->Evaluate@Min[currentPos,endpt]],{t,solLorenz[[1]]}/.t->Evaluate@Min[currentPos,endpt]]}},
AxesLabel->{"t","X"},Axes->True,optGr2D]},

{SpanFromAbove,
Graphics[{First[Plot[solLorenz[[2]],{t,0,endpt},plotOpt]],
{Red,PointSize[Large],Tooltip[Point[{t,solLorenz[[2]]}/.t->Evaluate@Min[currentPos,endpt]],{t,solLorenz[[2]]}/.t->Evaluate@Min[currentPos,endpt]]}},
AxesLabel->{"t","Y"},Axes->True,optGr2D]},

{SpanFromAbove,
Graphics[{First[Plot[solLorenz[[3]],{t,0,endpt},plotOpt]],
{Red,PointSize[Large],Tooltip[Point[{t,solLorenz[[3]]}/.t->Evaluate@Min[currentPos,endpt]],{t,solLorenz[[3]]}/.t->Evaluate@Min[currentPos,endpt]]}},
AxesLabel->{"t","Z"},Axes->True,optGr2D]}}],

1,
Dynamic@Grid[(*Print["Main loop 1"];*)Transpose@{{
Graphics[{First[ParametricPlot[Evaluate[solLorenz[[1;;2]]],{t,0,endpt},parPlotOpt]],

{Red,PointSize[Large],Tooltip[Point[solLorenz[[1;;2]]/.t->Min[currentPos,endpt]],solLorenz[[1;;2]]/.t->Min[currentPos,endpt]]},

Dynamic[
Table[{Blue,PointSize[Large],
Tooltip[Point[{x[t],y[t]}/.eqPts[[k]]],Text@Style[Row[{"Eigenvalues: ",eigenSets[[k,1]]}],FontSize->12]]},{k,1,3}]]


},
ImageSize->150,AxesLabel->{"X","Y"},Axes->True
],

Graphics[{First[Plot[solLorenz[[1]],{t,0,endpt},plotOpt]],
{Red,PointSize[Large],Tooltip[Point[{t,solLorenz[[1]]}/.t->Evaluate@Min[currentPos,endpt]],{t,solLorenz[[1]]}/.t->Evaluate@Min[currentPos,endpt]]}},
AxesLabel->{"t","X"},Axes->True,optGr2D]},

{Graphics[{First[ParametricPlot[Evaluate[solLorenz[[1;;3;;2]]],{t,0,endpt},parPlotOpt]],

{Red,PointSize[Large],Tooltip[Point[solLorenz[[1;;3;;2]]/.t->Min[currentPos,endpt]],solLorenz[[1;;3;;2]]/.t->Min[currentPos,endpt]]},

Dynamic[
Table[{Blue,PointSize[Large],
Tooltip[Point[{x[t],z[t]}/.eqPts[[k]]],Text@Style[Row[{"Eigenvalues: ",eigenSets[[k,1]]}],FontSize->12]]},{k,1,3}]]


},
ImageSize->150,AxesLabel->{"X","Z"},Axes->True
],

Graphics[{First[Plot[solLorenz[[2]],{t,0,endpt},plotOpt]],
{Red,PointSize[Large],Tooltip[Point[{t,solLorenz[[2]]}/.t->Evaluate@Min[currentPos,endpt]],{t,solLorenz[[2]]}/.t->Evaluate@Min[currentPos,endpt]]}},
AxesLabel->{"t","Y"},Axes->True,optGr2D]},

{Graphics[{First[ParametricPlot[Evaluate[solLorenz[[2;;3]]],{t,0,endpt},parPlotOpt]],

{Red,PointSize[Large],Tooltip[Point[solLorenz[[2;;3]]/.t->Min[currentPos,endpt]],solLorenz[[2;;3]]/.t->Min[currentPos,endpt]]},

Dynamic[
Table[{Blue,PointSize[Large],
Tooltip[Point[{y[t],z[t]}/.eqPts[[k]]],Text@Style[Row[{"Eigenvalues: ",eigenSets[[k,1]]}],FontSize->12]]},{k,1,3}]]


},
ImageSize->150,AxesLabel->{"Y","Z"},Axes->True
],

Graphics[{First[Plot[solLorenz[[3]],{t,0,endpt},plotOpt]],
{Red,PointSize[Large],Tooltip[Point[{t,solLorenz[[3]]}/.t->Evaluate@Min[currentPos,endpt]],{t,solLorenz[[3]]}/.t->Evaluate@Min[currentPos,endpt]]}},
AxesLabel->{"t","Z"},Axes->True,optGr2D]}
},Dividers->{False,{False,True,False}}],

3,Dynamic[(*Print["Main loop 3"];*)
With[{solPert1=First[{x[t],y[t],z[t]}/.Quiet[NDSolve[SetPrecision[{eqLorenz,Thread[{x[0],y[0],z[0]}=={x0+perturbation RandomInteger[1],y0+perturbation RandomInteger[1],z0+perturbation RandomInteger[1]}]},Infinity],{x,y,z},{t,0,currentPos},PrecisionGoal->ControlActive[4,8],WorkingPrecision->ControlActive[MachinePrecision,20]]]],solPert2=First[{x[t],y[t],z[t]}/.Quiet[NDSolve[SetPrecision[{eqLorenz,Thread[{x[0],y[0],z[0]}=={x0+2perturbation RandomInteger[1],y0+2perturbation RandomInteger[1],z0+2perturbation RandomInteger[1]}]},Infinity],{x,y,z},{t,0,currentPos},PrecisionGoal->ControlActive[4,8],WorkingPrecision->ControlActive[MachinePrecision,20]]]],
plotOpt2=Sequence[PlotPoints->ControlActive[30,30]],parPlotOpt2=Sequence[PlotPoints->ControlActive[80,80],MaxRecursion->ControlActive[4,4]]},
Grid[{{Graphics[{First@DensityPlot[Evaluate[-Sign[solLorenz[[2]]/.t->currentPos]x+2(1-(y+If[(solLorenz[[3]]/.t->currentPos)>200,1/3.,(solLorenz[[3]]/.t->currentPos)/600] Sin[π y]))],{x,-1.7,1.7},{y,0,1.1},ColorFunction->ColorData["TemperatureMap"],Frame->None,AspectRatio->1/3],

({Red,PointSize[Large],
Arrowheads[
     {{-Sign[solPert1[[1]]]0.04, 1}, {-Sign[solPert1[[1]]]0.04,0.5},
      {-Sign[solPert1[[1]]]0.04, 0}}],Arrow[{0.5Sin[solPert1[[1]]t-tLag]+xShift,0.5Cos[solPert1[[1]]t-tLag]+0.55}/.tLag->Range[0,4,0.2]/.xShift->-1.05//Transpose],

Green,
Arrowheads[
     {{-Sign[solLorenz[[1]]]0.04, 1}, {-Sign[solLorenz[[1]]]0.04,0.5},
      {-Sign[solLorenz[[1]]]0.04, 0}}],
Arrow[{0.5Sin[solLorenz[[1]]t-tLag]+xShift,0.5Cos[solLorenz[[1]]t-tLag]+0.55}/.tLag->Range[0,4,0.2]/.xShift->0//Transpose],

Blue,
Arrowheads[
     {{-Sign[solPert2[[1]]]0.04, 1}, {-Sign[solPert2[[1]]]0.04,0.5},
      {-Sign[solPert2[[1]]]0.04, 0}}],Arrow[{0.5Sin[solPert2[[1]]t-tLag]+xShift,0.5Cos[solPert2[[1]]t-tLag]+0.55}/.tLag->Range[0,4,0.2]/.xShift->1.05//Transpose],
Thick,Line[{{-1.7,0},{1.7,0}}],
Line[{{-1.7,1.1},{1.7,1.1}}]}/.t->currentPos)
},ImageSize->500],
SpanFromLeft,SpanFromLeft},

{Text@Row[{Style["Perturbed",Red],"        ",Style["Initial",Green],"        ",Style["Extremely Perturbed",Blue]}],
SpanFromLeft,SpanFromLeft},

Switch[whichView,
"Time plots",
{Graphics[Dynamic[First[Plot[solLorenz[[1]],{t,0,endpt},plotOpt2]]],AxesLabel->{"t","X"},Axes->True,optGr2D],

Graphics[Dynamic[First[Plot[solLorenz[[2]],{t,0,endpt},plotOpt2]]],AxesLabel->{"t","Y"},Axes->True,optGr2D],

Graphics[Dynamic[First[Plot[solLorenz[[3]],{t,0,endpt},plotOpt2]]],AxesLabel->{"t","Z"},Axes->True,optGr2D]
},

"Phase plots",
{Graphics[{Dynamic[First[ParametricPlot[Evaluate[solLorenz[[1;;2]]],{t,0,endpt},parPlotOpt2]]],

{Red,PointSize[Large],Point[solLorenz[[1;;2]]/.t->Min[currentPos,endpt]]},

Dynamic[
Table[{Blue,PointSize[Large],
Tooltip[Point[{x[t],y[t]}/.eqPts[[k]]],Text@Style[Row[{"Eigenvalues: ",eigenSets[[k,1]]}],FontSize->12]]},{k,1,3}]]
},
ImageSize->150,AxesLabel->{"X","Y"},Axes->True
],

Graphics[{Dynamic[First[ParametricPlot[Evaluate[solLorenz[[1;;3;;2]]],{t,0,endpt},parPlotOpt]]],

{Red,PointSize[Large],Point[solLorenz[[1;;3;;2]]/.t->Min[currentPos,endpt]]},

Dynamic[
Table[{Blue,PointSize[Large],
Tooltip[Point[{x[t],z[t]}/.eqPts[[k]]],Text@Style[Row[{"Eigenvalues: ",eigenSets[[k,1]]}],FontSize->12]]},{k,1,3}]]
},
ImageSize->150,AxesLabel->{"X","Z"},Axes->True
],

Graphics[{Dynamic[First[ParametricPlot[Evaluate[solLorenz[[2;;3]]],{t,0,endpt},parPlotOpt]]],

{Red,PointSize[Large],Point[solLorenz[[2;;3]]/.t->Min[currentPos,endpt]]},

Dynamic[
Table[{Blue,PointSize[Large],
Tooltip[Point[{y[t],z[t]}/.eqPts[[k]]],Text@Style[Row[{"Eigenvalues: ",eigenSets[[k,1]]}],FontSize->12]]},{k,1,3}]]
},
ImageSize->150,AxesLabel->{"Y","Z"},Axes->True
]
}]}

]]
],

4,
Dynamic@
With[{solPert3=First[{x[t],y[t],z[t]}/.Quiet[NDSolve[SetPrecision[{eqLorenz,Thread[{x[0],y[0],z[0]}=={x0+perturbation*pertX,y0+perturbation*pertY,z0+perturbation*pertZ}]},Infinity],{x,y,z},{t,0,currentPos},PrecisionGoal->ControlActive[4,6],WorkingPrecision->ControlActive[MachinePrecision,20]]]],
pertPt={x0+perturbation*pertX,y0+perturbation*pertY,z0+perturbation*pertZ},
plotOpt3=Sequence[PlotPoints->ControlActive[30,30],PlotStyle->{Green,Red}],parPlotOpt2=Sequence[PlotPoints->ControlActive[80,80],MaxRecursion->ControlActive[4,4]],
optGr2D2=Sequence[Axes->True,AxesOrigin->{0,0},AspectRatio->0.8,ImageSize->200,Ticks->None]},

Row[
{
Graphics3D[(*Print["3d loop"];*){First[ParametricPlot3D[{Tooltip[solLorenz,{x0,y0,z0}],Tooltip[solPert3,pertPt]},{t,0,endpt},PlotPoints->ControlActive[100,100],MaxRecursion->ControlActive[4,4],PlotStyle->{Green,Red}]],

{Green,PointSize[Large],Point[solLorenz/.t->Evaluate@Min[currentPos,endpt]],
Red,Point[solPert3/.t->Evaluate@Min[currentPos,endpt]]},

Dynamic[Table[{Blue,PointSize[Large],Tooltip[Point[{x[t],y[t],z[t]}/.eqPts[[k]]],Text@Style[Row[{"Eigenvalues: ",eigenSets[[k,1]]}],FontSize->12]]},{k,1,Length[eqPts]}]]
},
ImageSize->300,AxesLabel->{"X","Y","Z"},Axes->True],

Graphics[First[Plot[Evaluate[{Tooltip[solLorenz[[Switch[whichGraph,"X(t)",1,"Y(t)",2,"Z(t)",3]]],{x0,y0,z0}],Tooltip[solPert3[[Switch[whichGraph,"X(t)",1,"Y(t)",2,"Z(t)",3]]],Evaluate[{x0+perturbation*pertX,y0+perturbation*pertY,z0+perturbation*pertZ}]]}],{t,0,endpt},plotOpt3]],AxesLabel->{"t",Switch[whichGraph,"X(t)","X","Y(t)","Y","Z(t)","Z"]},Axes->True,optGr2D2]
}

]]
]],

Grid[{{"The Lorenz Equations: ","Parameters:","Initial conditions:"},{"  "<>ToString@TraditionalForm[X'[t]==σ (-X[t]+Y[t])]<>"  ",Control[{{s,10,"σ"},0.1,100,0.01,ImageSize->Small,Appearance->"Labeled"}],Control[{{x0,5,"   (Subscript[X, 0])"},1,200,0.01,ImageSize->Small,Appearance->"Labeled"}]},{"  "<>ToString@TraditionalForm[Y'[t]==r*X[t]-Y[t]-X[t] Z[t]]<>"  ",Control[{{r,28,"r"},1,100,0.01,ImageSize->Small,Appearance->"Labeled"}],Control[{{y0,5,"   (Subscript[Y, 0])"},0,200,0.01,ImageSize->Small,Appearance->"Labeled"}]},{"  "<>ToString@TraditionalForm[Z'[t]==-b Z[t]+X[t] Y[t]]<>"  ",Control[{{b,8/3,"b"},0,10,0.01,ImageSize->Small,Appearance->"Labeled"}],Control[{{z0,5,"   (Subscript[Z, 0])"},1,200,0.01,ImageSize->Small,Appearance->"Labeled"}]}},Alignment->Left,Dividers->{False,{False,True,False,False,False}},ItemStyle->{Directive[Black,12,FontFamily->"Times"],None}],


Row[{Control[{{currentPos,4,"Time: "},1,40,0.01,ControlType->Animator,AnimationRepetitions->1,DefaultDuration->180,AnimationDirection->Forward,AnimationRunning->False}](*,
"Time = ",Dynamic@currentPos*)},ItemStyle->{Directive[Black,12,FontFamily->"Times"],None}],

{{ctrlPane,1,""},{
1->"Projections into coordinate planes",
2->"Lorenz attractor in 3 dimensions",
3->"Lorenz Simulation",
4->"Perturbations to initial conditions"}},

PaneSelector[
{
3->Row[{Control[{{whichView,"Time plots"},{"Time plots","Phase plots"}}],
Control[{{perturbation,0.1,"Perturbation size"},0,5,0.005}]}],
4-> Row[{Control[{{whichGraph,"X(t)"},{"X(t)","Y(t)","Z(t)"}}],
Control[{{perturbation,0.1,"Perturbation size"},0,5,0.005,ImageSize->Small,Appearance->"Labeled"}],"Direction:",
Control[{{pertX,1,"X"},{0,1},ControlType->Checkbox}],
Control[{{pertY,0,"Y"},{0,1},ControlType->Checkbox}],
Control[{{pertZ,0,"Z"},{0,1},ControlType->Checkbox}]}]
},
Dynamic[ctrlPane]],

(*Used for built-in scrolling/zoom-can reference directly or use var["computePlotrange"] for better performance during drags*)

{{plotrange,{{-5,5},{-5,5}}},ControlType->None},
{{eqPts,{}},ControlType->None},
{{localLin,{}},ControlType->None},
{eqLorenz,ControlType->None},
{{eigenSets,{}},ControlType->None},
{{solLorenz,{}},ControlType->None},
{nearestEqPt,ControlType->None},
{endpt,ControlType->None},

(*temporary holding variable*)
{var,ControlType->None},

Initialization:>(mouseMode[]:=Switch[CurrentValue/@{"ShiftKey","CommandKey"},{False,False},"special",{True,False},"pan",{False,True},"zoomIn",{True,True},"zoomOut"];

readMouse[startOrEnd_]:=(var[startOrEnd]=MousePosition["Graphics"];
var[startOrEnd<>"Scaled"]=MousePosition["GraphicsScaled"]);


Needs["DifferentialEquations`InterpolatingFunctionAnatomy`"]),
Alignment->Center,
SynchronousInitialization->False(*,SynchronousUpdating->False*)]

The Lorenz Attractor 
(student lab)

Or Chaos for beginners

Introduction

Edward Lorenz (1917 - 2008) was an American mathematician and meteorologist who published a paper in 1962 that was one of the pioneering efforts into what has become known as "chaos theory".  In it, he wanted to consider the feasibility of long-term weather forecasting by examining a mathematical model of a simplified physical system.  This led to a system of first order autonomous differential equations whose solutions turn out to have some very odd behaviors.

Since modeling the actual weather is insanely difficult, scientists have studied several simplified models, one of which is the "convection cell".  This is a long, thin cell of negligible width (eliminating one spatial dimension for simplicity) of some height that is heated on the bottom (as the earth heats the air above it) and cooled at the top (as the atmosphere radiates heat into space).  This can be considered a very simplified model of the atmosphere.  If the air could not move, then heat would simply radiate upwards via conduction.  However, when air is heated it expands, becoming less dense.  As all balloonists know, lighter/hotter air rises.  If the heating isn't too intense, the heat will leak out of the pocket of air (via conduction) and it will lose buoyancy before it can force its way upwards, so there isn't much movement.  However, if the heating is more intense, the pocket of air will retain enough heat/buoyancy to force its way upwards before it loses steam (well, heat anyway).  Once it gets high enough, there will have been enough heat loss for the pocket to be colder and denser and it will tend to fall again.  So, as air cools off higher in the atmosphere, it gets denser and tends to fall.  This motion of the hotter air rising from the ground while the colder air sinks out of the higher atmosphere is called convection.  You can see the same sort of phenomena when you heat a container of water; at first, the heat will simply be conducted upwards through the water, but as you continue to add heat, the water will began to circulate and begin roiling.  This convection causes air currents that lead to much of the weather patterns we see.  The convection cell is a simplified model of this system.

In his paper, Lorenz derived a system of 3 first order autonomous equations from earlier much more complicated equations developed to study fluid flow and thermal energy, making several changes of variable and approximations along the way.  The derivation is beyond the scope of this course, so we'll skip straight to his set of equations (you can thank me later):

	X' (t) = σ (-X(t) + Y(t))
Y' (t) = r X(t) - Y(t) - X(t) Z(t)
Z' (t) = -b Z(t) + X(t) Y (t)
To understand the meaning of the variables here,  take a look at the following simulated convection cell:

           
 
      t≡ time (actually, time with some rescaled units)

X(t)≡ This gives the direction and speed of the convection "roll", where a positive value means the air is circulating clockwise (illustrated by the circulating arrows).

Y(t)≡ This gives the temperature difference between the left and right sides of the box, where a positive value means the left side is hotter (illustrated by the color gradient across the box).

Z(t)≡ This gives the deviation of the temperature function from a straight, linear (conductive) increase (illustrated by the color gradient vertically in the box).  Z is always positive, but the larger Z is, the more quickly the temperature will change at the boundaries.

Notice, there are also 3 constants:

σ≡ This is the Prandtl number, which is the ratio of momentum diffusivity (kinematic viscosity) and thermal diffusivity; in other words, it is a measure of the relative rates at which particles can move to the rate at which heat is transferred.  (When σ is small, it means that the heat diffuses very quickly compared to the velocity/momentum, so the pockets of air lose heat more quickly than they can move upwards, for example.)

r≡ This is the Rayleigh number, which is a dimensionless number associated with buoyancy driven flow (also known as free convection or natural convection).  When the Rayleigh number is below some critical value for a fluid, heat transfer is primarily in the form of conduction; when it exceeds that value, heat transfer is primarily in the form of convection.  This is the most important one for our model (physically and mathematically).

b≡ This is a constant related to the pressure of the fluid/gas.

Interface summary points

Four different "views" of the information (2-dimensional projections, 3-dimensional view, physical model view, and divergence of nearby points over time)

When the view changes, shared controls remain in place, but view-specific controls change; using PaneSelector to change controls, Switch command to change content

Use of Control command to format placement of control objects using Row, Column, Grid structures

Moving dot helps focus on relationship between graphs (as does the color variation)

More focused on a singe topic, but allows in-depth exploration of this topic

Spring simulation

The Fourth Season:  Spring in Four Acts 
(student lab)

Everything you didn't realize you wanted to know about springs but never got around to asking

Introduction

One of the simplest second order differential equations can be used to model the oscillation of a spring with a mass attached.  I will be the first to admit that this doesn't really sound all that interesting.  I have good news:  It is, and more importantly, there are several important characteristics of this system that show up in much more complicated systems.  We are going to take a look at some of those characteristics and I will point out some of their wider applications.  (Like many other things in math, we can start to understand things with a simpler system, where things don't get all that complicated.  From there, you can work your way up to reality...)

So, to start off, we need to derive the equation of motion of a mass suspended from a spring; we will ignore the mass of the spring itself for simplicity.  As usual, when trying to find the equation of motion of an object, we need to find the total forces acting upon it, so we can use Newton's second law of motion (the ever popular F=m a).  In this case, there are two forces:  the force exerted by the spring and the force exerted by gravity due to the weight of the mass.  The force exerted by the spring can be modeled by Hooke's Law F=-k y, where y is the distance the spring has been stretched beyond equilibrium (I have arbitrarily decided to consider +y to be upwards in the figure below), where k is called the spring constant, which measures the "stiffness" of the spring; note that it is negative so that it acts in opposition to the displacement.

					
					
Now, it turns out that we can ignore the force due to gravity here:  Since the force due to gravity remains constant, that means that it will cause the spring to stretch an extra amount even when at rest; that extra stretch remains the same, no matter what the mass is doing (just solve (Subscript[F, gravity])=-m g=-k y=(Subscript[F, spring]) for y).  So, the basic effect of this is to simply make our "equilibrium length" a bit longer.  (Okay, this is only strictly true for a perfectly linear spring.  If you really feel the urge, you can enter in a gravity term to your "spring force" in the widget...)  So, our equilibrium point will be measured from this gravitationally stretched spring.

Now, if we put this all together, we get m y''=F=-k y or:   m y''+k y=0.

In the lab that follows, many of the questions can actually be answered without knowing how to use Mathematica beyond using the spring simulation widget I included with the lab.  Some of the things I ask you to compute using Mathematica can be done fairly easily by hand (certainly all of Acts I and II); if you are not required to know how to know Mathematica in your course, you should be able to answer most of the questions in the lab without using anything beyond the spring widget.  If you are required to know how to use Mathematica some, then you should use it to compute the things I ask for.  In either case, when you describe the impact of some parameter on the system, you need to give me examples; you can do that by copying the entire widget or just clicking on the particular graph you want to copy and then copy/paste that.  (Don't get carried away, but I do want some examples showing what behavior you are seeing.)

Interface summary points

Multiple simultaneous views of the information is pedagogically central; emphasizes the importance of the phase plane and aids in drawing connections between the physical system and the mathematical representations of it

Use of consistent colors to aid in drawing relationships between views

Multiple methods of input for initial conditions (click on phase plane or use sliders)

View changes based on selections (i.e., whether damping and/or driving force are checked)

Allows far more experimentation than most simulations like this do - Enter arbitrary spring force, damping force, and driving force in TraditionalForm notation (in full version of Mathematica), but also provides standard examples and variations

More focused on a singe topic, but allows in-depth exploration of this topic

Forms the basis for a lab on spring oscillatory motion

Odds and Ends - More tools in the toybox

Eigenvalue Explorer

Interface summary points

Multiple/alternate controls for input

Direct control of the system from the graph (eigenvectors)

Developed to solve a particular pedagogical problem, but also simplifies further exploration than might normally be pursued

Spirals of curvature

Interface sumary points

Accepts and displays input in TraditionalForm notation

Uses Animator control rather than default Manipulator

Moving dot helps focus on relationship between graphs (as does the color variation)

Example arc-length functions include function and domain of interest

Function transformations - Applications to other courses

Interface summary points

Two different, but related programs packaged together, using PaneSelector and Switch statements (controls and display change)

Large set of examples included, based on standard functions studied in appropriate classes (can be modified to only present "appropriate" list in a particular class), but allows for input of arbitrary functions (with parameters) in TraditionalForm when run in a full version of Mathematica

Automatic detection of vertical asymptotes

Direct manipulation of the graph with the mouse - Rather than using mouse/key combinations, I decided that simplicity was more important than flexibility, so I introduced the "Mouse mode" bar right above the graph; this requires less thought.

When transformations are "in progress", a "heads-up" style display shows the progress of the transformation

Tooltips are used to list the transformations used to create a particular graph, along with the equation for it

My goal here was to come up with something that couldn't be done more easily using a graphing calculator or a simpler computer graphing program - Showing the steps of a compound transformation, allowing for input of functions with arbitrary parameters, move away from sliders for control elements

Summary and Review:  Interface elements to play with

Direct control of the graph - Pan graph with mouse, Zoom in/zoom out with mouse, direct actions on the graphs (set initial conditions, shift, stretch, reflect graphs, identify root to find)

PopupMenu with associated InputField - useful for targeting Player and Mathematica with the same notebook (tied together using OpenerView) in .nbp format

Allows for a list of "interesting" examples for students to explore right away

Also provides flexibility to explore arbitrary examples (in Mathematica)

Graceful "degradation" of capabilities when used in Player

InputFields accept and display math in TraditionalForm

Tooltips can display more than just text...

Use of Control to place Manipulate controls anywhere

Dynamic and automatic detection of parameters in inputs

PaneSelector to allow for multi-screen application

Multi-view approach to information

Multiple inputs for same controls

Visual elements to "draw the eye" to what you want them to see

Manipulator vs. Animator control

ControlActive is important to control options during dynamic updates