24 Years of Teaching & Research with Mathematica

by Keith Stroyan   & 	Mark Nawrot

University of Iowa		North Dakota State University

Mathematica in Elementary Calculus

I started using Mathematica in my classes in 1989 because I believed then that this tool can help produce much better-trained scientists and engineers. Almost every class that I taught in the last 24 years had some Mathematica - most had a lot!  My various calculus classes have impacted around 6000 students (currently 500/yr) and 100 graduate TAs.  I will describe several of the most successful educational uses of Mathematica and describe some exciting future plans for multivariable calculus.

Mathematica in Visual Depth Perception

A few years ago Mark Nawrot (North Dakota State University) and I settled an important open problem in visual perception of depth from motion.  Mathematica played an important role in the discovery of the necessary extra-retinal signal and has been very helpful in explaining the mathematics to vision scientists.  One of our follow-up papers on the integration time of the two brain signals contains the first .cdf to appear in a scientific journal.  I will describe on-going work and show some animations of retinal flow.

Courses for 6000 students and 100 TAs

I began using Mathematica in my classes in 1989 and have used it in almost every class since then.

Calculus 1 & 2: About 100 students Fall & Spring from 1989 to 2001, small sections to 2010

roughly 2000 student-semesters

Associated texts and software

Calculus using Mathematica

Calculus: The Language of Change

Projects for Calculus: The Language of Change (2 editions)

Mathematica Help Notebooks for Projects for Calculus

Foundations of Infinitesimal Calculus (earlier Background for Calculus using Mathematica)

Multivariable Calculus: About 25 students/semester 1998 - 2003

roughly 250 student-semesters

Engineering Math 2: Multivariable Calculus 2002 - 2013

roughly 4000 student-semesters

Associated texts and software

Interactive Multivariable Calclulus (print text)

Interactive Multivariable Calclulus (eText)

webMathematica Site for Interactive Multivariable Calculus

Foundations of Infinitesimal Calculus (earlier Background for Calculus using Mathematica)

Forthcoming

Advanced Calculus with Mathematica

Summer Workshops for Graduate Student T.A.s 1992 - 2013

roughly 100 graduate students learning to teach with Mathematica

The Calculus Wiz 1998 - 2009 (?)

software to solve most template exercises in regular calculus

Several of my texts are available free at www.math.uiowa.edu/~stroyan

(just "Google" Keith Stroyan)

Research on Visual Depth from Motion

The Motion/Pursuit Law for Visual Depth Perception from Motion Parallax

with Mark Nawrot, North Dakota State U, Vision Research, Volume 49, Issue 15, 22 July 2009, Pages 1969-1978, http://dx.doi.org/10.1016/j.visres.2009.05.008

& Visual depth from motion parallax and eye pursuit, with Mark Nawrot, J. Math. Biol. (2012) 64:1157–1188, DOI 10.1007/s00285-011-0445-1

((d θ)/(d α))= 1-((Cos[β]  (Subscript[ρ, F]))/(Cos[α](Subscript[ρ, D])))=(1/f)(((f (((Subscript[d, 2])^2)+(Subscript[d, 1]) ((Subscript[d, 1])+f)-2 (Subscript[d, 2]) s t)-(Subscript[d, 2]) (s^2) (t^2))/((((((Subscript[d, 1])+f))^2)+((((Subscript[d, 2])-s t))^2)))))

Retinal Motion & Smooth Eye Pursuit

Manipulate[
nodePercent=.5;
nORM[vector_?VectorQ]:=(Sqrt[vector.vector]);
degrees[q_]:=q*180/π;
arcMinutes[q_]:=q*60*180/π;

aimψ[headAimVector_?VectorQ,base_?VectorQ]:=ArcTan[headAimVector[[1]],headAimVector[[2]]];

midPoint[headAimVector_?VectorQ,base_?VectorQ]:=base-aimOffset*interOcular*{headAimVector[[2]],-headAimVector[[1]]};

rightEyeCenter[headAimVector_?VectorQ,base_?VectorQ]:=base+((1/2)-aimOffset)*interOcular*{headAimVector[[2]],-headAimVector[[1]]};

leftEyeCenter[headAimVector_?VectorQ,base_?VectorQ]:=base-((1/2)+aimOffset)*interOcular*{headAimVector[[2]],-headAimVector[[1]]};


rightViewVector[headAimVector_?VectorQ,fixate_?VectorQ,base_?VectorQ]:=fixate-rightEyeCenter[headAimVector, base];

rightφ[headAimVector_?VectorQ,fixate_?VectorQ,base_?VectorQ]:=ArcTan[rightViewVector[headAimVector, fixate, base][[1]],rightViewVector[headAimVector, fixate, base][[2]]];

rightEyeNode[headAimVector_?VectorQ,fixate_?VectorQ,base_?VectorQ]:=rightEyeCenter[headAimVector, base]+nodePercent*eyeRadius*rightViewVector[headAimVector,fixate, base]/nORM[rightViewVector[headAimVector, fixate, base]];

leftViewVector[headAimVector_?VectorQ,fixate_?VectorQ,base_?VectorQ]:=fixate-leftEyeCenter[headAimVector, base];

leftφ[headAimVector_?VectorQ,fixate_?VectorQ,base_?VectorQ]:=ArcTan[leftViewVector[headAimVector, fixate, base][[1]],leftViewVector[headAimVector, fixate, base][[2]]];

leftEyeNode[headAimVector_?VectorQ,fixate_?VectorQ,base_?VectorQ]:=leftEyeCenter[headAimVector, base]+nodePercent*eyeRadius*leftViewVector[headAimVector, fixate, base]/nORM[leftViewVector[headAimVector, fixate, base]];

fixateConvergence[headAimVector_?VectorQ,fixate_?VectorQ,base_?VectorQ]:=(rightφ[headAimVector,fixate,base]-leftφ[headAimVector,fixate,base]);

leftα[headAimVector_?VectorQ,fixate_?VectorQ,base_?VectorQ]:=leftφ[headAimVector,fixate,base]-aimψ[headAimVector,base];
rightα[headAimVector_?VectorQ,fixate_?VectorQ,base_?VectorQ]:=rightφ[headAimVector,fixate,base]-aimψ[headAimVector,base];

rightDistractVector[headAimVector_?VectorQ,fixate_?VectorQ,distraction_?VectorQ,base_?VectorQ]:=distraction-rightEyeNode[headAimVector,fixate, base];

rightδ[headAimVector_?VectorQ,fixate_?VectorQ,distraction_?VectorQ,base_?VectorQ]:=ArcTan[rightDistractVector[headAimVector,fixate,distraction,base][[1]],rightDistractVector[headAimVector,fixate,distraction,base][[2]]];

leftDistractVector[headAimVector_?VectorQ,fixate_?VectorQ,distraction_?VectorQ,base_?VectorQ]:=distraction-leftEyeNode[headAimVector,fixate, base];

leftδ[headAimVector_?VectorQ,fixate_?VectorQ,distraction_?VectorQ,base_?VectorQ]:=ArcTan[leftDistractVector[headAimVector,fixate,distraction,base][[1]],leftDistractVector[headAimVector,fixate,distraction,base][[2]]];

convergenceDistraction[headAimVector_?VectorQ,fixate_?VectorQ,distraction_?VectorQ,base_?VectorQ]:=If[Or[Abs[leftφ[headAimVector,fixate, base]-leftδ[headAimVector,fixate, distraction,base]]>π/3.,Abs[rightφ[headAimVector,fixate, base]-rightδ[headAimVector,fixate, distraction,base]]>π/3.],0.0,(rightδ[headAimVector,fixate, distraction,base]-leftδ[headAimVector,fixate, distraction,base])];

rightθ[headAimVector_?VectorQ,fixate_?VectorQ,distraction_?VectorQ,base_?VectorQ]:=(rightφ[headAimVector,fixate, base]-rightδ[headAimVector,fixate,distraction,base]);

leftθ[headAimVector_?VectorQ,fixate_?VectorQ,distraction_?VectorQ,base_?VectorQ]:=(leftφ[headAimVector,fixate, base]-leftδ[headAimVector,fixate,distraction,base]);

binocularDisparity[headAimVector_?VectorQ,fixate_?VectorQ,distraction_?VectorQ,base_?VectorQ]:=If[Or[leftθ[headAimVector,fixate,distraction,base]<-π/2.,leftθ[headAimVector,fixate,distraction,base]>π/3.,rightθ[headAimVector,fixate,distraction,base]<-π/3.,rightθ[headAimVector,fixate,distraction,base]>π/2.],0,(rightθ[headAimVector,fixate,distraction,base]-leftθ[headAimVector,fixate,distraction,base])];

rightθinside[headAimVector_?VectorQ,fixate_?VectorQ,distraction_?VectorQ,base_?VectorQ]:=rightθ[headAimVector,fixate,distraction,base]+ArcSin[nodePercent*Sin[rightθ[headAimVector,fixate,distraction,base]]];

leftθinside[headAimVector_?VectorQ,fixate_?VectorQ,distraction_?VectorQ,base_?VectorQ]:=leftθ[headAimVector,fixate,distraction,base]+ArcSin[nodePercent*Sin[leftθ[headAimVector,fixate,distraction,base]]];

retinalDisparity[headAimVector_?VectorQ,fixate_?VectorQ,distraction_?VectorQ,base_?VectorQ]:=If[Or[leftθ[headAimVector,fixate,distraction,base]<-π/2.,leftθ[headAimVector,fixate,distraction,base]>π/3.,rightθ[headAimVector,fixate,distraction,base]<-π/3.,rightθ[headAimVector,fixate,distraction,base]>π/2.],0,(rightθinside[headAimVector,fixate,distraction,base]-leftθinside[headAimVector,fixate,distraction,base])];

eyePict[eyeCenter_?VectorQ,fixate_?VectorQ]:=Module[{λ,viewVector},viewVector=fixate-eyeCenter;
λ=ArcTan[viewVector[[1]],viewVector[[2]]];
viewVector=viewVector/nORM[viewVector];
Show[{Graphics[{AbsoluteThickness[2],Gray,Circle[eyeCenter,eyeRadius,{λ+.4,2π+λ-.4}]}],Graphics[{Gray,
Circle[eyeCenter+ .8eyeRadius viewVector,.5eyeRadius,{λ-1.5,λ+1.5}]}],
Graphics[{Green,
Disk[eyeCenter+eyeRadius*nodePercent*viewVector,eyeRadius/10]
}]
},AspectRatio->Automatic]];


eyeEdge[θ_]:=eyeRadius*{Cos[θ],Sin[θ]};

inRays[headAimVector_?VectorQ,fixate_?VectorQ,distraction_?VectorQ,base_?VectorQ]:=Show[{eyePict[leftEyeCenter[headAimVector, base],fixate],eyePict[rightEyeCenter[headAimVector,base],fixate],Graphics[{Red,{Line[{rightEyeNode[headAimVector,fixate,base],rightEyeCenter[headAimVector,base]-eyeRadius*rightViewVector[headAimVector,fixate,base]/nORM[rightViewVector[headAimVector,fixate,base]]}]}}],Graphics[{Red,{Line[{leftEyeNode[headAimVector,fixate,base],leftEyeCenter[headAimVector, base]-eyeRadius*leftViewVector[headAimVector,fixate,base]/nORM[leftViewVector[headAimVector,fixate,base]]}]}}],Graphics[{Blue,{Line[{rightEyeNode[headAimVector,fixate,base],rightEyeCenter[headAimVector,base]+eyeEdge[rightφ[headAimVector,fixate,base]-π-rightθinside[headAimVector,fixate,distraction,base]]}]}}],
Graphics[{Blue,{Line[{leftEyeNode[headAimVector,fixate,base],leftEyeCenter[headAimVector,base]+eyeEdge[leftφ[headAimVector,fixate,base]-π-leftθinside[headAimVector,fixate,distraction,base]]}]}}],
Graphics[{Purple,{Line[{rightEyeCenter[headAimVector,base],rightEyeCenter[headAimVector,base]+eyeEdge[rightφ[headAimVector,fixate,base]-π-rightθinside[headAimVector,fixate,distraction,base]]}]}}],
Graphics[{Purple,{Line[{leftEyeCenter[headAimVector,base],leftEyeCenter[headAimVector,base]+eyeEdge[leftφ[headAimVector,fixate,base]-π-leftθinside[headAimVector,fixate,distraction,base]]}]}}],
Graphics[{Green,{Line[N[{leftEyeCenter[headAimVector, base],rightEyeCenter[headAimVector, base]}]]}}],
min=Min[{leftφ[headAimVector,fixate,base]-π-leftθinside[headAimVector,fixate,distraction,base]-retinalDisparity[headAimVector,fixate,distraction,base],leftφ[headAimVector,fixate,base]-π-leftθinside[headAimVector,fixate,distraction,base]}];
MAX=Max[{leftφ[headAimVector,fixate,base]-π-leftθinside[headAimVector,fixate,distraction,base]-retinalDisparity[headAimVector,fixate,distraction,base],leftφ[headAimVector,fixate,base]-π-leftθinside[headAimVector,fixate,distraction,base]}];
Graphics[{Brown,AbsoluteThickness[3],{Circle[leftEyeCenter[headAimVector, base],eyeRadius,{min,MAX}]}}]
},AspectRatio->Automatic,PlotRange->{{midPoint[headAimVector,base][[1]]-interOcular,midPoint[headAimVector,base][[1]]+interOcular},{midPoint[headAimVector,base][[2]]-interOcular,midPoint[headAimVector,base][[2]]+interOcular}}];

outRays[headAimVector_?VectorQ,fixate_?VectorQ,distraction_?VectorQ,base_?VectorQ]:=Show[{Graphics[{Red,AbsolutePointSize[4],{Point[N[fixate]]}}],Graphics[{Blue,AbsolutePointSize[4],{Point[N[distraction]]}}],Graphics[{Red,{Line[N[{fixate,rightEyeNode[headAimVector,fixate, base]}]]}}],Graphics[{Red,{Line[N[{fixate,leftEyeNode[headAimVector,fixate, base]}]]}}],Graphics[{Blue,{Line[N[{distraction,rightEyeNode[headAimVector,fixate, base]}]]}}],Graphics[{Blue,{Line[N[{distraction,leftEyeNode[headAimVector,fixate, base]}]]}}],
Graphics[{Green,{Line[N[{headAimVector,base}]]}}]
},AspectRatio->Automatic];

outLabels[aimHead_?VectorQ,fixate_?VectorQ,distraction_?VectorQ,base_?VectorQ]:=
Show[{Graphics[{Magenta,{Text[StringForm["(Subscript[θ, r]) = `1`°",Round[N[(180/π)rightθ[aimHead,fixate,distraction,base]],.1]],{.7,0}+rightEyeNode[aimHead,fixate,base]-2.5eyeRadius(rightEyeCenter[aimHead,base]-distraction-fixate)/nORM[(rightEyeCenter[aimHead,base]-distraction-fixate)]]
,
Circle[rightEyeNode[aimHead,fixate,base],2.5eyeRadius,{Min[rightδ[aimHead,fixate,distraction,base],rightφ[aimHead,fixate,base]],Max[rightδ[aimHead,fixate,distraction,base],rightφ[aimHead,fixate,base]]}]
}}]
},AspectRatio->Automatic];
(*Real Program Starts Here*)
interOcular=6.5;
eyeRadius=1.3;
aimOffset=0;
base[t_]={t,0};
aimHead={0,1};
f=fixate[[2]];(*fixate={0,f};*)
Show[{
inRays[aimHead,fixate,distraction,base[t]]
,
outLabels[aimHead,fixate,distraction,base[t]]
,
Graphics[{AbsolutePointSize[4],Point[midPoint[aimHead,base[t]]]}]
,
Graphics[{Green,AbsolutePointSize[4],{Point[base[t]],
Text["B",base[t]-{0,.5}],
Text["A",1.05aimHead+{0,.5}+base[t]],Line[{base[t],aimHead+base[t],base[t]+{.1,.7}}]
}}],
Graphics[{Orange,
{Circle[rightEyeNode[aimHead,fixate,base[t]],1.5eyeRadius,{Min[{aimψ[aimHead,base[t]],rightφ[aimHead,fixate,base[t]]}],Max[{aimψ[aimHead,base[t]],rightφ[aimHead,fixate,base[t]]}]}]
,
Line[{rightEyeNode[aimHead,fixate,base[t]],rightEyeNode[aimHead,fixate,base[t]]+3aimHead}]
,
Text[StringForm["(Subscript[α, r]) = `1` °",Round[N[rightα[aimHead,fixate,base[t]]180/π],.1]],rightEyeNode[aimHead,fixate,base[t]]+2aimHead+{.8,0}]
}}]
,
Graphics[{Red,AbsolutePointSize[4],{Point[fixate],Text[StringForm["F = (`1`  ,  `2`)",Round[fixate[[1]],.01],Round[fixate[[2]],.01]],fixate+{-1,.5}],Line[{leftEyeNode[aimHead,fixate,base[t]],fixate}],Line[{rightEyeNode[aimHead,fixate,base[t]],fixate}]}}]
,
Graphics[{Blue,AbsolutePointSize[5],{Point[distraction],Text[StringForm["D = (`1`  ,  `2`)",Round[distraction[[1]],.01],Round[distraction[[2]]],.01],distraction+{-1,.5}],Line[{leftEyeNode[aimHead,fixate,base[t]],distraction}],Line[{rightEyeNode[aimHead,fixate,base[t]],distraction}]}}]
,
Graphics[{Brown,
{Text[StringForm["(Subscript[β, r]) = `1` °",Round[N[(rightα[aimHead,fixate,base[t]]-rightθ[aimHead,fixate,distraction,base[t]])180/π],.1]],rightEyeNode[aimHead,fixate,base[t]]+{-.6,0}-2.eyeRadius((rightEyeNode[aimHead,fixate,base[t]]-distraction)/nORM[(rightEyeNode[aimHead,fixate,base[t]]-distraction)])]
,
Circle[rightEyeNode[aimHead,fixate,base[t]],2.eyeRadius,{Min[{aimψ[aimHead,base[t]],rightδ[aimHead,fixate,distraction,base[t]]}],Max[{aimψ[aimHead,base[t]],rightδ[aimHead,fixate,distraction,base[t]]}]}]}}],
Graphics[{AbsoluteThickness[2],Dashing[.025],Gray,
{Line[{base[t]+{-1,-1},base[t]+{1,-1},base[t]+{.8,-1.1}}]
}}]
,
Graphics[{Text["Translation",base[t]+{-.1,-1.5}]}]

},PlotRange->{2{-3.25,3.25},{-2,12}},AspectRatio->Automatic,ImageSize->{400,400}]

,
{{fixate,{-1,8}},{-6,5},{6,11},Locator},
{{distraction,{1,9}},{-6,5},{6,11},Locator},
{{t,0,"time t"},-4,4,Appearance->"Labeled"},TrackedSymbols->Manipulate]

Retinal Motion More Generally

Import["3dmotionmovie_cos_cube.mov","Animation"]

Interactive Computation of Geometric Inputs to Vision (demo site)

2008.1  Motion Pursuit Law In 1D Visual Depth Perception 1, http://demonstrations.wolfram.com/MotionPursuitLawIn1DVisualDepthPerception1/

2008.2  Motion Pursuit Fixate And Distraction: Visual Depth Perception 2, http://demonstrations.wolfram.com/MotionPursuitFixateAndDistractorVisualDepthPerception2/

2008.3  Motion Pursuit LawI n 2D: Visual Depth Perception 3, http://demonstrations.wolfram.com/MotionPursuitLawIn2DVisualDepthPerception3/

2008.4  Motion Pursuit Law On Invariant Circles: Visual Depth Perception 4, http://demonstrations.wolfram.com/MotionPursuitLawOnInvariantCirclesVisualDepthPerception4/

2008.5  Fixation And Distraction: Visual Depth Perception 5, http://demonstrations.wolfram.com/FixationAndDistractionVisualDepthPerception5/

2008.6  Eye Parameters: Visual Depth Perception 6, http://demonstrations.wolfram.com/EyeParametersVisualDepthPerception6/

2008.7  Binocular Disparity: Visual Depth Perception 7, http://demonstrations.wolfram.com/BinocularDisparityVisualDepthPerception7/

2008.8  Vieth Meuller Circles: Visual Depth Perception 8, http://demonstrations.wolfram.com/ViethMullerCirclesVisualDepthPerception8/

2008.9  Binocular Disparity Vs Depth: Visual Depth Perception 9, http://demonstrations.wolfram.com/BinocularDisparityVersusDepthVisualDepthPerception9/

2008.10  Disparity Convergence And Depth: Visual Depth Perception 10, http://demonstrations.wolfram.com/DisparityConvergenceAndDepthVisualDepthPerception10/

2008.11  Tracking And Separation: Visual Depth Perception 11, http://demonstrations.wolfram.com/TrackingAndSeparationVisualDepthPerception11/

2008.12  Motion Vs Depth: 2D Visual Depth Perception 12, http://demonstrations.wolfram.com/MotionParallaxVersusDepth2DVisualDepthPerception12/

2008.13  Motion Vs Depth: 3D Visual Depth Perception 13, http://demonstrations.wolfram.com/MotionParallaxVersusDepth3DVisualDepthPerception13/

2008.14  Dynamic Approximation Of Static Quantities: Visual Depth Perception 14, http://demonstrations.wolfram.com/DynamicApproximationOfStaticQuantitiesVisualDepthPerception1/

2008.15  Speed Motion Pursuit And Depth: Visual Depth Perception 15, http://demonstrations.wolfram.com/SpeedMotionPursuitAndDepthVisualDepthPerception15/

2008.16  Speed Pursuit MP Ratio And Depth: Visual Depth Perception 16, http://demonstrations.wolfram.com/SpeedPursuitMPRatioAndDepthVisualDepthPerception16/

2008.17  Motion Pursuit Ratio And Depth In 1D: Visual Depth Perception 17, http://demonstrations.wolfram.com/MotionPursuitRatioAndDepthIn1DVisualDepthPerception17/

2008.18  Motion Pursuit Ratio And Depth In 2D: Visual Depth Perception 18, http://demonstrations.wolfram.com/MotionPursuitRatioAndDepthIn2DVisualDepthPerception18/

The First .cdf in a Scientific Journal

Integration time for the perception of depth from motion parallax, with Mark Nawrot, Vision Research 59 (2012) 64–71, doi:10.1016/j.visres.2012.02.007

(* These definitions place the fixate and define the eye's motion along the x axis. *)
f=110; (*fixate distance from origin*)
s=6.6; (*translation rate along x-axis*)
tmin=-10;
tmax=10; (*these two define the starting and ending time*)
eyeRadius=13/3;
Fix={0,f}; (*vector position of fixate*)
Eye[t_]:={s t,0}; (*vector position of eye*)

(* The following functions perform the calculations related to dθ/dβ and select the best appromation point for each discrete point on the distractor "curve." *)
dθdβ[f_,d1_,d2_,t_]:=((f(d1(d1+f)+(d2^2)-2d2 s t)-d1 (s^2) (t^2))/((d1+f) ((f^2)+(s^2) (t^2))));
crit1[f_,d1_,d2_]:=(1/(2 d2 s))((d1^2) +(d2^2) +2 d1 f +(Sqrt[(d1^2)+(d2^2)]) (Sqrt[(d1^2)+(d2^2)+4 d1 f+4 (f^2)]) );
crit2[f_,d1_,d2_]:=(1/(2 d2 s))((d1^2) +(d2^2) +2 d1 f -(Sqrt[(d1^2)+(d2^2)]) (Sqrt[(d1^2)+(d2^2)+4 d1 f+4 (f^2)]) );
chosencrit[f_,d1_,d2_]:=If[Abs[d2]>.01,If[d1≥0,crit2[f,d1,d2],crit1[f,d1,d2]],0]; 

dθdβPeak[f_,d1_,d2_,tt_]:=If[tt<chosencrit[f,d1,d2],dθdβ[f,d1,d2,tt],dθdβ[f,d1,d2,chosencrit[f,d1,d2]]];

dθdα[f_,d1_,d2_,t_]:=(1/f)(((f ((d2^2)+d1 (d1+f)-2 d2 s t)-d2 (s^2) (t^2))/(((((d1+f))^2)+(((d2-s t))^2)))))

(* critical times and condition choosing the more appropriate time*)

AbsDF[t_,Dis_?VectorQ]:=f*dθdβ[f,Dis[[2]]-f,Dis[[1]],t]; 
(*Estimation of absolute distance from focus to distractor*)

PeakDF[Dis_?VectorQ]:=f*dθdβ[f,Dis[[2]]-f,Dis[[1]],chosencrit[f,Dis[[2]]-f,Dis[[1]]]]; 
(*Best approximation of absolute distance from focus to distractor*)

pIntersect[t_,Dis_?VectorQ,AbsDF_]:=
If[(((((Dis-Eye[t]).(Fix-Eye[t])))^2)-(Dis-Eye[t]).(Dis-Eye[t])((Fix-Eye[t]).(Fix-Eye[t])-(AbsDF^2)))≥0,

((Dis-Eye[t]).(Fix-Eye[t])+Sign[AbsDF]√(((((Dis-Eye[t]).(Fix-Eye[t])))^2)-(Dis-Eye[t]).(Dis-Eye[t])((Fix-Eye[t]).(Fix-Eye[t])-(AbsDF^2))))/(Dis-Eye[t]).(Dis-Eye[t]),

(Dis-Eye[t]).(Fix-Eye[t])/(Dis-Eye[t]).(Dis-Eye[t])]; (*Finds up to two paramater values that satisfy both the absolute distance approximations and line of sight conditions*)

pPoint[p_,t_,Dis_?VectorQ]:=Eye[t]+p(Dis-Eye[t]);(*Intersection of the line through the eye and distractor and circle generated by the absolute distance approximation*)

peakP[Dis_?VectorQ]:=pPoint[pIntersect[chosencrit[f,Dis[[2]]-f,Dis[[1]]],Dis,PeakDF[Dis]],chosencrit[f,Dis[[2]]-f,Dis[[1]]],Dis]; 
(*Best estimate of the intersection of the line through the eye and distractor and circle generated by the absolute distance approximation at the chosen critical time*)

nORM[x_?VectorQ]:=(Sqrt[x.x]);

eyePict[eyeCenter_?VectorQ,fixate_?VectorQ]:=Module[{λ,viewVector},viewVector=fixate-eyeCenter;
λ=ArcTan[viewVector[[1]],viewVector[[2]]];
viewVector=viewVector/nORM[viewVector];
Show[{Graphics[{AbsoluteThickness[2],Gray,Circle[eyeCenter,eyeRadius,Sort@{λ+.4,2π+λ-.4}]}],Graphics[{Gray,
Circle[eyeCenter+ .8eyeRadius viewVector,.5eyeRadius,Sort@{λ-1.5,λ+1.5}]}],
Graphics[{Green,
Disk[eyeCenter,eyeRadius/10]
}]
},AspectRatio->Automatic]];


(* These lists define the shapes we want to examine; they are selected by the user. *)

FarParabola[depth_]=Table[{ tt,110+20depth(1-(((tt/15))^2))},{tt,-12,12,2}];
nePoint[depth_]={ tt,110+20depth(1-(((tt/15))^2))}/.tt->8;
nwPoint[depth_]={ tt,110+20depth(1-(((tt/15))^2))}/.tt->-8;
nPoint[depth_]={ tt,110+20depth(1-(((tt/15))^2))}/.tt->0;
NearParabola[depth_]=Table[{ tt,110-20depth(1-(((tt/15))^2))},{tt,-12,12,2}];
sePoint[depth_]={ tt,110-20depth(1-(((tt/15))^2))}/.tt->8;
swPoint[depth_]={ tt,110-20depth(1-(((tt/15))^2))}/.tt->-8;
sPoint[depth_]={ tt,110-20depth(1-(((tt/15))^2))}/.tt->0;

(*Stores near and far lists of the distractor image shapes.*)

image[Far_,Near_,size_]:=Show[
Graphics[{AbsolutePointSize[size],Red,Point[Fix]}],
Graphics[{AbsolutePointSize[size],AbsoluteThickness[7],Blue,Map[Point[#]&,Far],Line[Far]}],
Graphics[{AbsolutePointSize[size],AbsoluteThickness[7],Blue,Map[Point[#]&,Near],Line[Near]}],
Graphics[{Yellow,AbsoluteThickness[2],Line[Map[peakP[#]&,Far]]}],
Graphics[{Yellow,AbsoluteThickness[2],Line[Map[peakP[#]&,Near]]}]];
(*Generates the fixate and distractor points and connects the distractor points; shows the best estimate of the shape of the distractors using the peak times*)

depth=1.5;
Animate[
Far=FarParabola[depth];
Near=NearParabola[depth];
allPoints={nePoint[depth],
nwPoint[depth],
nPoint[depth],
sePoint[depth],
swPoint[depth],
sPoint[depth]};
GraphicsRow[{
Show[
{eyePict[Eye[t],Fix],image[Far,Near,1],
Graphics[Line[{Eye[t],Eye[t]+1.5(Fix-Eye[t])}]],
Map[If[t>chosencrit[f,#[[2]]-f,#[[1]]],Graphics[{AbsolutePointSize[1],Point[peakP[#]]}],Graphics[{AbsolutePointSize[4],Red,Point[Fix]}]]&,Far],
Map[If[t>chosencrit[f,#[[2]]-f,#[[1]]],Graphics[{AbsolutePointSize[1],Point[peakP[#]]}],Graphics[{AbsolutePointSize[1],Black,Point[Fix]}]]&,Near],
Graphics[Line[Map[pPoint[pIntersect[t,#,AbsDF[t,#]],t,#]&,Far]]],
Graphics[Line[Map[pPoint[pIntersect[t,#,AbsDF[t,#]],t,#]&,Near]]]},PlotRange->{{s tmin -2,s tmax +2},{-7,f+25depth}}]
,
Show[
{image[Far,Near,8],
Graphics[{AbsolutePointSize[10],Brown,Point[nePoint[depth]]}],
Graphics[{AbsolutePointSize[10],Purple,Point[nwPoint[depth]]}],
Graphics[{AbsolutePointSize[10],Orange,Point[nPoint[depth]]}],
Graphics[{AbsolutePointSize[10],Purple,Point[sePoint[depth]]}],
Graphics[{AbsolutePointSize[10],Brown,Point[swPoint[depth]]}],
Graphics[{AbsolutePointSize[10],Orange,Point[sPoint[depth]]}],
Graphics[Line[{Eye[t],Eye[t]+1.5(Fix-Eye[t])}]],
Map[If[t>chosencrit[f,#[[2]]-f,#[[1]]],Graphics[{AbsolutePointSize[5],Green,Point[peakP[#]]}],Graphics[{AbsolutePointSize[6],Red,Point[Fix]}]]&,Far],
Map[If[t>chosencrit[f,#[[2]]-f,#[[1]]],Graphics[{AbsolutePointSize[5],Green,Point[peakP[#]]}],Graphics[{AbsolutePointSize[6],Red,Point[Fix]}]]&,Near],
Graphics[Line[Map[pPoint[pIntersect[t,#,AbsDF[t,#]],t,#]&,Far]]],
Graphics[Line[Map[pPoint[pIntersect[t,#,AbsDF[t,#]],t,#]&,Near]]]},PlotRange->{depth{-15,15},{f-25depth,f+25depth}}]
,
Show[{Plot[{dθdβ[f,nePoint[depth][[2]]-f,nePoint[depth][[1]],tt],dθdβ[f,nPoint[depth][[2]]-f,nPoint[depth][[1]],tt],dθdβ[f,nwPoint[depth][[2]]-f,nwPoint[depth][[1]],tt],dθdβ[f,swPoint[depth][[2]]-f,swPoint[depth][[1]],tt],dθdβ[f,sPoint[depth][[2]]-f,sPoint[depth][[1]],tt],dθdβ[f,sePoint[depth][[2]]-f,sePoint[depth][[1]],tt]},{tt,tmin-.01,t},PlotStyle->{Brown,Orange,Purple},PlotRange->{{-7,7},{-.2depth,.2 depth}},AspectRatio->1.5]
,
Map[If[t>chosencrit[f,#[[2]]-f,#[[1]]],Show[{
Graphics[{Green,AbsoluteThickness[2],
Line[{{chosencrit[f,#[[2]]-f,#[[1]]],dθdβ[f,#[[2]]-f,#[[1]],chosencrit[f,#[[2]]-f,#[[1]]]]},{chosencrit[f,#[[2]]-f,#[[1]]],0}}]
}]
}]
,
Show[{
Graphics[{
}]
}]
]&,allPoints]
}]
},ImageSize->440]
,
{{t,-2},tmin,tmax,AnimationRate->2},

SaveDefinitions->True]
(*This maps the approximate images of the distractors as perceived by the eye over time*)

Calculus with Mathematica

Why do so many students take calculus?, Notices of the AMS, Sept. 2011, pp.1122-1124, http://www.ams.org/notices/201108/rtx110801122p.pdf

Calculus and DNA, The UMAP Journal 32(2) (2012) 93-98.

My favorite calculus question: Why did we eradicate polio by vaccination, but not measles?

s[t]=((Number of people susceptible)/(Total population))  - a function of time

i[t]=((Number of people infectious)/(Total population))  (“infectious” means able to transmit with or without symptoms)

r[t]=(Removed/(Total population))  Note that we don’t need to track r=1-s-i because of the fixed population.

Mathematically the changes in the susceptible and infectious fractions are given by differential equations that just say how they change.

({{ds/dt =-a s i}, {di/dt=a s i-b i}})

Descriptive details of how these work is at: http://homepage.math.uiowa.edu/~stroyan/CTLC3rdEd/3rdCTLCText/Chapters/Ch2.pdf

The role of vaccination

Vaccination increases r=1-s-i and reduces the susceptible fraction.  We assume a disease starts with a small group. (the red curve)

Given initial values of the susceptible and infectious fractions, the program below will map the tim-course of the disease.

Clear[s,i,t,soln,sRate,iRate];

Print["Spread of smallpox in a large fixed population."];
Print["Contact number, c = ",c,", Infectious period 1/b =",(1/b)];
Print["Daily contact rate, a =",Round[a,.005]];

sRate[s_,i_]:=-a s i;
iRate[s_,i_]:=(a s-b) i;

Manipulate[
b=(1/16.);
a=b c;
soln=NDSolve[{s[0]==1-R0,i[0]==.05,s'[t]==sRate[s[t],i[t]],i'[t]==iRate[s[t],i[t]]},{s[t],i[t]},{t,0,finalTime}];
Plot[{s[t]/.soln[[1,1]],i[t]/.soln[[1,2]]},{t,0,finalTime},AxesLabel->{"t","susceptible & infectious"},AxesOrigin->{0,0},PlotRange->{0,1},PlotStyle->{Blue,Red},PlotLabel->StringForm["Initial fraction immune =`1`, final susceptible s[`2`] = `3`",R0,finalTime,Round[s[t]/.soln[[1,1]]/.t->finalTime,.0005]]]
,{{c,5,"contact # = a/b"},.5,15},{{R0,.05,"Initial immune fraction"},.05,.95},{finalTime,60,120},SaveDefinitions->True]

Herd Immunity

We are interested in using vaccination to make the red curve decline.  (The blue one always goes down, because if you get sick you move out of the susceptible group.)

The following things are equivalent

i decreases

di/dt<0  -  the derivative is the slope of the i-curve, so negative is decreasing

a s i-b i<0  - this is just di/dt<0 written anoter way

a s <b   - algebra on the last thing

s < b/a  - more algebra

The epidemic declines

The quantity c=a/b is called the “contact number” and represents the average number of cases an infectious person could transmit if everyone he contacted was susceptible.  This number can be measured for real diseases (see the link above).

ContactsList={{"Measles",16.3},{"Whooping Cough",16.5},{"Chicken Pox",11.3},{"Scarlet Fever",8.5},{"Mumps",8.1},{"Rubella",7.3},{"Smallpox",5.2},{"Polio",4.6},{"Influenza",1.4}}
diseases=Transpose[ContactsList][[1]]
contactNumbers=Transpose[ContactsList][[2]]
oneOverCs=Transpose[{diseases,contactNumbers,Round[1/contactNumbers,.001],Round[1-1/contactNumbers,.01]}]
TableForm[Prepend[oneOverCs,{"Disease","c","1/c","1-1/c"}]]
TableForm[ContactsList]

Herd Immunity for Smallpox, http://demonstrations.wolfram.com/HerdImmunityForSmallpox/

What’s the point?

Mathematica makes a real problem accessible to FIRST WEEK calculus students by allowing them to focus on a basic concept (slope of the i-curve), while solving a system of ODEs based on THEIR description of change.

(Most students would ask: ‘What good is it?’)

Visualization, Calculus & Mathematica

The plane tangent to an explicit surface

Clear[x,y,f,fX,fY,dx,dy,dz];

f[x_,y_]:=4-(1/3)(((x))^2)-(1/5)(y^2);
label=StringForm["z =`1`",f["x","y"]];

fX[x_,y_]=D[f[x,y],x];
fY[x_,y_]=D[f[x,y],y];

xLo=-2;
xHi=2;
yLo=-2;
yHi=2;

dFrame3D[delta_]:=
    Graphics3D[{Orange,Line[{{-delta/5,0,0},{delta,0,0}}],
        Text["dx",{1.1 delta,0,0}],Line[{{0,-delta/5,0},{0,delta,0}}],
        Text["dy",{0,1.1 delta,0}],Line[{{0,0,-delta/5},{0,0,delta}}],
        Text["dz",{0,0,1.1 delta}]}];
xyzFrame[{x_,y_,z_},delta_]:=
    Graphics3D[{Brown,Line[{{-x-delta/4,-y,-z},{-x+delta,-y,-z}}],
        Text["x",{-x+1.01 delta,-y,-z}],
        Line[{{-x,-y-delta/4,-z},{-x,-y+delta,-z}}],
        Text["y",{-x,-y+1.01 delta,-z}],
        Line[{{-x,-y,-z-delta/4},{-x,-y,-z+delta}}],
        Text["z",{-x,-y,-z+1.01 delta}]}];

pair[x_,y_,scale_,δ_,size_]:=Module[{box,surface,plane},
box=
        Line[N[{{-δ,-δ,-δ},{-δ,δ,-δ},{-δ,δ,δ},{-δ,-δ,
                δ},{-δ,-δ,-δ},{-δ,-δ,-δ},{δ,-δ,-δ},{δ,δ,-δ},{δ,
                δ,δ},{δ,-δ,δ},{δ,-δ,-δ}}]];
      box=
        Join[{box,Line[N[{{-δ,-δ,δ},{δ,-δ,δ}}]],
            Line[N[{{-δ,δ,δ},{δ,δ,δ}}]],
            Line[N[{{-δ,δ,-δ},{δ,δ,-δ}}]]}];
      box=Graphics3D[{AbsoluteThickness[2],Red,{box}}];
surface=Plot3D[f[x+dx,y+dy]-f[x,y],{dx,-scale,scale},{dy,-scale,scale},MeshFunctions->{#1&,#2&},Mesh->1,MeshStyle->{{AbsoluteThickness[2],Magenta},{AbsoluteThickness[2],Green}}];

plane=Plot3D[dz,{dx,-.5scale,.5scale},{dy,-.5scale,.5scale},PlotStyle->{Opacity[.5],Orange},MeshFunctions->{#1&,#2&},Mesh->1,MeshStyle->{{AbsoluteThickness[2],Cyan},{AbsoluteThickness[2],Yellow}}];

Show[{xyzFrame[{x,y,z},1.25],dFrame3D[scale],surface,plane,box},PlotRange->1.5{{-scale,scale},{-scale,scale},{-scale,scale}},ImageSize->size,ViewPoint->{7,3,2},Boxed->False]];

Manipulate[

x=-TanPt[[2]];
y=TanPt[[1]];
z=f[x,y];
dz=fX[x,y] dx+fY[x,y] dy;

pair[x,y,BIG/magnification,small,Medium]

,
Style["Scales",12,Bold],
{{BIG,2.5},1/2,3},
{{small,.2},.01,.5},
{{magnification,1,"Zoom"},1,Max[1,BIG/small]},
Dynamic[pair[x,y,2BIG,small,Small]],
{{TanPt,{-2,-1},"TangentPoint"},{xLo,xLo},{xHi,yHi}},
Dynamic[Row[{"Tangent at {x,y} =",{-TanPt[[2]],TanPt[[1]]}}]],
Dynamic[Row[{"dz =",fX[x,y],"dx + ",fY[x,y],"dy"}]],
 ControlPlacement->Left,SaveDefinitions->True,FrameLabel->label]

Fastest rate of increase & the contour plot

Clear[x,y,z,dx,dy,dz,xx,yy,f,fX,fY,gradf];
Needs["iMultiCalc`iMCUtilities`"];
f[x_,y_]=(3/2)-((x^2)/3)-((y^2)/6);

fX[x_,y_] = Simplify[D[f[x,y],x]];
fY[x_,y_] = Simplify[D[f[x,y],y]];
gradf[x_,y_]={fX[x,y],fY[x,y]};
label=StringForm["z =`1`",f["x","y"]];
dz[x_,y_,dx_,dy_]=gradf[x,y].{dx,dy};
V[θ_]={Cos[θ],Sin[θ]};
BIG=3;
largeTopo=ContourPlot[f[xx,yy],{xx,-BIG,BIG},{yy,-BIG,BIG}];
δ=1/5;
small=2δ;
 
Manipulate[
x=TanPt[[1]];
y=TanPt[[2]];
z=f[x,y];

GraphicsRow[{
Show[{
largeTopo
,
ContourPlot[f[xx,yy]==z,{xx,-BIG,BIG},{yy,-BIG,BIG},ContourStyle->{AbsoluteThickness[2],Magenta}]
,
ContourPlot[dz[x,y,(xx-x),(yy-y)]==0,{xx,-BIG,BIG},{yy,-BIG,BIG},ContourStyle->{AbsoluteThickness[2],Cyan}]
,
Graphics[{Red,
,{Line[{{x+δ,y+δ},{x-δ,y+δ},{x-δ,y-δ},{x+δ,y-δ},{x+δ,y+δ}}]}
}]
,
Graphics[{Yellow,AbsolutePointSize[7],
,{Point[{x,y}]}
}]
,
Arrow2D[gradf[x,y],Tail->{x,y},Brown]
,
Arrow2D[ u/Norm[u],Red,Tail->{x,y},AbsoluteThickness[1]]
,
Arrow2D[V[θ+ArcTan[gradf[x,y][[1]],gradf[x,y][[2]]]],Tail->{x,y},Orange]
,
Frame2D[2.75]
}]
,
Show[{
ContourPlot[f[x+dx,y+dy],{dx,-small,small},{dy,-small,small},FrameLabel->{"dx","dy"}]
,
ContourPlot[f[x+dx,y+dy]==z,{dx,-small,small},{dy,-small,small},ContourStyle->{AbsoluteThickness[2],Magenta}]
,
ContourPlot[dz[x,y,(dx),(dy)]==0,{dx,-small,small},{dy,-small,small},ContourStyle->{AbsoluteThickness[2],Cyan}]
,
Graphics[{Red,
,{Line[{{δ,δ},{-δ,δ},{-δ,-δ},{δ,-δ},{δ,δ}}]}
}]
,
Graphics[{Yellow,AbsolutePointSize[7],
,{Point[{0,0}]}
}]
,
Arrow2D[small gradf[x,y],Brown]
,
Arrow2D[small u/Norm[u],Red,AbsoluteThickness[1]]
,
Arrow2D[small*V[θ+ArcTan[gradf[x,y][[1]],gradf[x,y][[2]]]],Orange]
,
dFrame2D[.75 small]
}]
},ImageSize->Large]
,
{{TanPt,{2,1}},{{2,1}->"(2,1)",{-1,2}->"(-1,2)",{-2,-1}->"(-2,-1)"},
 ControlPlacement->Bottom}
,
{{u,gradf[x,y],"U"},{gradf[x,y]->"Up",-gradf[x,y]->"Dwn",{fY[x,y],-fX[x,y]}->"Rt",{-fY[x,y],fX[x,y]}->"Lft"}}
,
Dynamic[Row[{"                                 (Subscript[D, U])f ≈ ",N[gradf[x,y].u/Norm[u]]," ,     ","(Subscript[D, V])f ≈ ",N[gradf[x,y].V[θ+ArcTan[gradf[x,y][[1]],gradf[x,y][[2]]]]]}]]
,
{{θ,π/4},-π,π,π/24}
,
Dynamic[Row[{"∇f[",x,",",y,"] ≈ ",MatrixForm[N[gradf[x,y]]]," ,     ","V[θ] = ",MatrixForm[N[V[θ]]]}]],SaveDefinitions->True,FrameLabel->label]

Flows

Clear[x,y,f,g];
Needs["iMultiCalc`iMCUtilities`"];

f[x_,y_]:=x (1-x/10-y/5);
g[x_,y_]:=y (1-x/7-y/7);

initVals=Union[Table[{k,10},{k,1,10}],Table[{10,j},{j,1,9}]];
initVals=Union[initVals,{{.5,.3},{.5,.2},{.5,.1},{.1,.5},{.2,.5},{.3,.5},{.2,.2},{.2,.3},{.3,.2}}];

tFinal=6;

vectorFlow2D[{f,g},initVals,tFinal,AxesLabel->{"x","y"},PlotRange->{{-1,10},{-1,10}}]

Equilibria of ODEs

Needs["iMultiCalc`iMCUtilities`"];
f[x_,y_]:=x (1-x/10-y/5);
g[x_,y_]:=y (1-x/7-y/7);

A[x_,y_]={{D[f[x,y],x],D[f[x,y],y]},{D[g[x,y],x],D[g[x,y],y]}};

mult[v_]=(1/(1+v/10));
uVect[vec_?VectorQ]:=vec mult[vec.vec];

tFinal=5;

Manipulate[
xe=equilibrium[[1]];
ye=equilibrium[[2]];

{lx[u_,v_],ly[u_,v_]}=A[xe,ye].{u,v};

stringf=StringForm["dx = `1` dt",f["x","y"]];
stringg=StringForm["dy = `1` dt",g["x","y"]];
stringu=StringForm["du =`1` dt",lx["u","v"]];
stringv=StringForm["dv =`1` dt",ly["u","v"]];

initialValues=Table[{δ,y},{y,-δ,δ,δ/2}];
initialValues=Union[initialValues,Table[{-δ,y},{y,-δ,δ,δ/2}]];
initialValues=Union[initialValues,Table[{x,δ},{x,-δ,δ,δ/2}]];
initialValues=Union[initialValues,Table[{x,-δ},{x,-δ,δ,δ/2}]];
{fδ[z_,w_],gδ[z_,w_]}=uVect[(1/δ){f[δ z+xe,δ w+ye],g[δ z+xe,δ w+ye]}];
soln1=Flatten[
          Map[NDSolve[{x[0]==#[[1]],y[0]==#[[2]],
                  x'[t]==fδ[x[t],y[t]],y'[t]==gδ[x[t],y[t]]},{x[t],
                  y[t]},{t,0,tFinal}]&,initialValues],1];

   arr1[ttt_]:=Map[Graphics[{Red,AbsoluteThickness[2],Arrowheads[Small],Arrow[{{#[[1]],#[[2]]},{#[[1]],#[[2]]}+
              {fδ[#[[1]],#[[2]]],gδ[#[[1]],#[[2]]]}}]}]&,{x[t],y[t]}/.soln1/.t->ttt];

      pt1[ttt_]:=Map[Graphics[{Blue,AbsolutePointSize[4],
                Point[{#[[1]],#[[2]]}]}]&,{x[t],y[t]}/.soln1/.t->ttt];

      crv1[ttt_]:=ParametricPlot[Evaluate[{x[t],y[t]}/.soln1],{t,0,ttt},PlotStyle->{{Purple,AbsoluteThickness[2]}},AxesLabel->{"u","v"},
          AspectRatio->1];

      soln2=Flatten[
          Map[NDSolve[{x[0]==#[[1]],y[0]==#[[2]],
                  x'[t]==lx[x[t],y[t]],y'[t]==ly[x[t],y[t]]},{x[t],
                  y[t]},{t,0,tFinal}]&,initialValues],1];

   arr2[ttt_]:=
        Map[Graphics[{Green,Arrowheads[Small],Arrow[{{#[[1]],#[[2]]},{#[[1]],#[[2]]}+
              {lx[#[[1]],#[[2]]],ly[#[[1]],#[[2]]]}}]}]&,{x[t],y[t]}/.soln2/.t->ttt];

      pt2[ttt_]:=
        Map[Graphics[{Blue,AbsolutePointSize[4],
                Point[{#[[1]],#[[2]]}]}]&,{x[t],y[t]}/.soln2/.t->ttt];

      crv2[ttt_]:=
        ParametricPlot[Evaluate[{x[t],y[t]}/.soln2],{t,0,ttt},Axes->None,PlotStyle->Cyan,
          AspectRatio->1];

eigenV=Map[Graphics[{Magenta,AbsoluteThickness[3],Arrow[{{0,0},#1}]}]&,Eigenvectors[A[xe,ye]]];

Show[{crv1[tt],pt1[tt],arr1[tt],crv2[tt],pt2[tt],arr2[tt],eigenV,Graphics[{Brown,AbsoluteThickness[2],{Line[{{δ,δ},{δ,-δ},{-δ,-δ},{-δ,+δ},{+δ,+δ}}]}}]},AspectRatio->1,PlotRange->1.5{{-δ,δ},{-δ,δ}}
,ImageSize->Large]
,
Dynamic[Row[{stringf}]]
,
Dynamic[Row[{stringg}]]
,
{{equilibrium,{4,3},"Equilibrium"},{{0,0},{0,7},{4,3},{10,0}},ControlType->PopupMenu}
,
Dynamic[Row[{"Equilibrium {(Subscript[x, e]),(Subscript[y, e])} = {",xe,",",ye,"} ± δ"}]]
,
{{δ,1,"δ"},{3/2,1,1/2,1/4}}
,
Dynamic[Show[{
StreamPlot[{f[x,y],g[x,y]},{x,-2,13},{y,-2,13},FrameLabel->{"x","y"},RotateLabel->False]
,
Graphics[{Brown,AbsoluteThickness[2],{Line[{{xe+δ,ye+δ},{xe+δ,ye-δ},{xe-δ,ye-δ},{xe-δ,ye+δ},{xe+δ,ye+δ}}]}}]
,
Graphics[{Red,AbsolutePointSize[5],{Point[{0,0}],Point[{0,7}],Point[{10,0}],Point[{4,3}]}}]
},ImageSize->Small]]
, 
Dynamic[Row[{stringu}]]
,
Dynamic[Row[{stringv}]]
,
Dynamic[Row[{"Eigenvalues[A[(Subscript[x, e]),(Subscript[y, e])}] =",Eigenvalues[A[xe,ye]]}]]
,
Dynamic[Row[{"Eigenvectors[A[(Subscript[x, e]),(Subscript[y, e])}] = {",MatrixForm[Eigenvectors[A[xe,ye]][[1]]]," , ",MatrixForm[Eigenvectors[A[xe,ye]][[2]]],"}"}]]
,
Dynamic[Row[{"\!\(\*
StyleBox[\(P\*
 StyleBox[\"urple\",\nFontColor->RGBColor[0.5, 0, 0.5]]\)]\)\!\(\*
StyleBox[\" \",\nFontColor->RGBColor[0.5, 0, 0.5]]\)\!\(\*
StyleBox[\"nonlinear\",\nFontColor->RGBColor[0.5, 0, 0.5]]\)\!\(\*
StyleBox[\" \",\nFontColor->RGBColor[0.5, 0, 0.5]]\)\!\(\*
StyleBox[\"flow\",\nFontColor->RGBColor[0.5, 0, 0.5]]\)\!\(\*
StyleBox[\",\",\nFontColor->RGBColor[0.5, 0, 0.5]]\) vector field in \!\(\*
StyleBox[\"red\",\nFontColor->RGBColor[1, 0, 0]]\)."}]]
,
Dynamic[Row[{"\!\(\*
StyleBox[\"Linear\",\nFontColor->RGBColor[0, 1, 1]]\)\!\(\*
StyleBox[\" \",\nFontColor->RGBColor[0, 1, 1]]\)\!\(\*
StyleBox[\"flow\",\nFontColor->RGBColor[0, 1, 1]]\)\!\(\*
StyleBox[\" \",\nFontColor->RGBColor[0, 1, 1]]\)\!\(\*
StyleBox[\"in\",\nFontColor->RGBColor[0, 1, 1]]\)\!\(\*
StyleBox[\" \",\nFontColor->RGBColor[0, 1, 1]]\)\!\(\*
StyleBox[\"cyan\",\nFontColor->RGBColor[0, 1, 1]]\), vector field in \!\(\*
StyleBox[\"green\",\nFontColor->RGBColor[0, 1, 0]]\)."}]]
,
{{tt,.5,"Flow at t ="},{0.1,0.5,1,5}},
ControlPlacement->Left,SaveDefinitions->True]

Understanding Procedures & Mathematica

The program to plot a tangent plane is just the procedure learned to do it by hand.

Get the Correct Answer - Next Year or On the Job in 5 Years

Even after you’ve taught calculus many times, you forget how to compute:

(∫_0^(π/4))((Sec[θ])^3)\[DifferentialD]θ

Or even:

(∫_0^1)((∫_1^2)(1/(x+y))\[DifferentialD]y)\[DifferentialD]x

My engineering students have a hard time understanding why the “summation” of integrals gives center of gravity or moment of inertial.  Understanding this is more important.

Beyond Basic Skills

Modern computing offers us the potential to teach students things only highly specialized folks used to know.

Arclength of the Ellipse (Distance traveled by a planet.)

X[t_]={3Cos[t],4Sin[t]};
(∫_0^(π/2))Norm[X'[t]]\[DifferentialD]t

The “Normal” Distribution

(2/(Sqrt[π]))(∫_(-∞)^x)(E^(-(ξ^2)))\[DifferentialD]ξ

Inverse Functions

Plot[(x^x),{x,0,2}]

Solve[D[(x^x),x]==0]

Solve[y==(x^x),x]

Plot[((Log[y])/(ProductLog[Log[y]])),{y,(E^(-1/E)),4}]

Wolfram Alpha

One final observation:

The only people in Math Departments who don’t know what Wolfram Alpha is are

Professors.