6760, Math 21a, Fall 2009
Mathematica project Math 21a, Multivariable Calculus
Mathematica Demonstration Templates
Course head: Oliver Knill
Office: SciCtr 434

Basic Prototypes

Some slides from our Mathematica workshop of November 19, 2009.

The following Mathematica demonstrations can can serve as templates to produce your own demonstration in the creative part of the mathematica lab. You can copy paste one of the examples into a new notebook and evaluate it (hold down and hit ). I wrote the following examples with clarity in mind. You find many other examples on the Wolfram demonstration project but the code for those examples is usually long and convoluted. The following examples should give you an idea how to build interfaces with sliders, parameter planes or radio buttons. You can try also to submit your project to the official demonstration project. I did a test submission which shows you how such a project page would look like.

From the Workshop

This is the program written impromptu during the workshop. Of course cleaned out a bit ...
gaga1 = Import["http://www.math.harvard.edu/~knill/gaga/01.jpg"];
gaga2 = Import["http://www.math.harvard.edu/~knill/gaga/02.jpg"];
gaga3 = Import["http://www.math.harvard.edu/~knill/gaga/03.jpg"];
gaga4 = Import["http://www.math.harvard.edu/~knill/gaga/04.wav"];

Manipulate[
 If[r == 1, S = Speak["Rah-rah-ah-ah-ah-ah"]; G = gaga1];
 If[r == 2, S = Speak["Ga-ga-ooh-la-la"];     G = gaga2];
 If[r == 3, S = Speak["Roma-roma-mamaa"];     G = gaga3];
 If[r == 4, S = Speak["Oh-oh-oh-oh-oooh"];    G = gaga4];
 Show[G], {{r, 1, "Lady Gaga words of wisdom:"}, 
           {1 -> "1", 2 -> "2", 3 -> "3", 4 -> "4"}}]

Vector Projection

Manipulate[
  Graphics[{v=p2-p1; w=p3-p1; e={0.2,-0.2}; d=(v[[2]] w[[1]]-v[[1]] w[[2]])/Sqrt[v.v];
    p4 = p3 + d*{-v[[2]],v[[1]]}/Sqrt[v.v];
    {RGBColor[0,0,0], FontSize -> 40,Text["Vector Projection", {0, 1.8}]},
    {RGBColor[0,1,0], Thickness[0.001], Dynamic[Line[{p1 - 100*v, p2 + 100*v}]]},
    {RGBColor[0,0,1], Disk[p1, 0.1]}, {RGBColor[0,1,0], Disk[p2, 0.1]},
    {RGBColor[1,0,0], Disk[p3, 0.1]}, {RGBColor[1,1,0], Disk[p4, 0.1]},
    {RGBColor[0,0.4,0], Thickness[0.01],  Arrow[{p1, p2}]},
    {RGBColor[0.5,0,0], Thickness[0.002], Arrow[{p1, p3}]},
    {RGBColor[1,0.8,0], Thickness[0.012], Arrow[{p1, p4}]},
    Locator[Dynamic[p1], ImageSize -> 40], Locator[Dynamic[p2], ImageSize -> 40],
    Locator[Dynamic[p3], ImageSize -> 40]}, PlotRange -> {{-2, 2}, {-2, 2}}],
    {{p1, {-1, -0.3}}, {-1, -1}, {1, 1},  ControlType -> None},
    {{p2, {1, -0.5}}, {-1, -1}, {1, 1},   ControlType -> None},
    {{p3, {-0.3, 1.2}}, {-1, -1}, {1, 1}, ControlType -> None}]

Penrose Tribar

The following example is taken from the Mathematica GuideBook by Michael Trott:
Manipulate[
 With[{b=N[1/7]+A, c=1.12, d=1.12, e=1.12, f=0.9333},
  p1 = Polygon[{{b, 0, b}, {b, -b, b}, {1 + b, -b, b}, {1 + b, -b, b}, {1 + b, 0, b}}];
  p2 = Polygon[{{b,-b, b}, {b, -b, 0}, {1 + b, -b, 0}, {1 + b, -b, b}, {1 + b, -b, b}}];
  p3 = Polygon[{{0, 0, b}, {0, -1, b}, {b, -1, b}, {b, 0, b}}];
  p4 = Polygon[{{0, 0, 0}, {0, 0, b},  {0, -1, b}, {0, -1, 0}}];
  p5 = Polygon[{{0,-1, b}, {b, -1, b}, {b, -1, c}, {0, -1, d}}];
  p6 = Polygon[{{0,-1, 0}, {b, -1, 0}, {b, -1, b}, {0, -1, b}, {0, -1, b}}];
  p7 = Polygon[{{0,-1+b, b},{0,-1,b},  {0, -1, e}, {0, -1 + b, f}}]];
  Show[Graphics3D[{RGBColor[1, 1, 0], {p1, p2, p3, p4, p5, p6, p7}}],
    PlotRange->All,ViewPoint->{-12.625,-10.9375,14.21},Boxed->False],{A,-0.2,0.2}]

Free Fall

h[x_]:=If[Abs[x]<1,1,-1];
f[{{a_,b_},{v_,w_}}]:={{a+h[a] v,b+h[b] w},{h[a] v,(h[b]-0.0001)w-0.001}};
DynamicModule[{c={}}, r:=0.03*(Random[]-1/2);
  EventHandler[Graphics[{
    {RGBColor[0,0,1], FontSize -> 40,Text["Click! Again!", {0, 0.8}]},
    {RGBColor[1,0,0],PointSize[0.05], Point[Dynamic[c=Map[f,c]; Map[First,c]]]}},
    PlotRange ->{{-1,1},{-1,1}}, Background -> RGBColor[0.9,0.9,1],ImageSize->500],
    "MouseDown" :> (AppendTo[c,{MousePosition["Graphics"],{r,r}}])]
]

Quadrics

Manipulate[
  If[r==1,S=ContourPlot3D[x^2*P[[1]]+y^2*P[[2]]-z^2==1,{x,-1,1},{y,-1,1},{z,-1,1},Boxed->False,Axes->False]];
  If[r==2,S=ContourPlot3D[x^2*P[[1]]+y^2*P[[2]]+z^2==1,{x,-1,1},{y,-1,1},{z,-1,1},Boxed->False,Axes->False]];
  If[r==3,S=ContourPlot3D[x^2*P[[1]]+y^2*P[[2]]+z  ==1,{x,-1,1},{y,-1,1},{z,-1,1},Boxed->False,Axes->False]];
  If[r==4,S=ContourPlot3D[x^2*P[[1]]+y^2*P[[2]]    ==1,{x,-1,1},{y,-1,1},{z,-1,1},Boxed->False,Axes->False]];S,
  {{r,1,"surface:"},{1 -> "hyperboloid", 2->"ellipsoid", 3->"paraboloid", 4->"cylinder"}},
  Control[{{P,{1,1}},{0,0},{4,4},ImageSize->{350, 200}}]]

Vector fields

Manipulate[
  If[r==1,S=StreamPlot[ {P[[1]] y,P[[2]] x},{x,-2,2},{y,-2,2}]];
  If[r==2,S=VectorPlot[ {P[[1]] y,P[[2]] x},{x,-2,2},{y,-2,2}]];S,
  {{r,1,"type:"},{1 -> "stream lines", 2->"vectors alone"}},
  Control[{{P,{1,0}},{-1,-1},{1,1},ImageSize->{350,200}}]]

Image manipulation

S=Import["http://www.math.harvard.edu/~knill/images/harvard.png"]; 
U=ColorSeparate[S]; 
Manipulate[ 
  If[r==1,T=U[[1]]]; If[r==2,T=U[[2]]]; If[r==3,T=U[[3]]]; If[r==4,T=U[[4]]];T,
  {{r,1,"color:"},{1->"red",2->"green",3->"blue",4->"contrast"}}]
S=Import["http://www.math.harvard.edu/~knill/images/plate.png"];
Manipulate[ 
     ImageAdjust[S,{P[[1]],P[[2]]}],
     Control[{{P,{0.5,0.5}},{0,0},{1,1},ImageSize->{350,200}}]]

Annoying sound

Manipulate[S=Play[Sin[10000 x]^n,{x,0,1}]; S,{n,1,10}]

More examples

Circumscribed Circle

Manipulate[
 Graphics[{{x1, y1} = p1; {x2, y2} = p2; {x3, y3} = p3;
   R = 2*(x3*(y1-y2)+x1*(y2-y3) + x2*(-y1 + y3));
   m1=(x3^2*(y1-y2)+(x1^2+(y1-y2)*(y1-y3))*(y2-y3)+x2^2*(-y1+y3))/R;
   m2=(-(x2^2*x3)+x1^2*(-x2+x3)+x3*(y1^2-y2^2)+x1*(x2^2-x3^2+y2^2-y3^2)+x2*(x3^2 - y1^2+y3^2))/R;
   center = {m1, m2}; radius = Sqrt[(center - p1).(center - p1)];
   {RGBColor[1, 0, 0], Dynamic[Disk[center, 0.07]]},
   {RGBColor[0, 0, 1], Dynamic[{Disk[p1, 0.1], Disk[p2, 0.1], Disk[p3, 0.1]}]},
   {RGBColor[1, 0, 0], Thickness[0.007], Dynamic[Circle[center, radius]]},
   {RGBColor[0, 1, 0], Thickness[0.004], Dynamic[Line[{p1, p2, p3, p1}]]},
   Locator[Dynamic[p1], ImageSize -> 40],
   Locator[Dynamic[p2], ImageSize -> 40],
   Locator[Dynamic[p3], ImageSize -> 40]},
  PlotRange -> {{-2, 2}, {-2, 2}}, ImageSize -> {600, 600}],
  {{p1, {1.1, 0.6}}, {-1, -1}, {1, 1}, ControlType -> None},
  {{p2, {-0.9, 0.5}}, {-1, -1}, {1, 1}, ControlType -> None},
  {{p3, {-0.3, 1.2}}, {-1, -1}, {1, 1}, ControlType -> None}]

Cross Product

Manipulate[ Graphics[{
 Q1 = {0,0}; Q3 = Q2 + Q4; c=Floor[100*(Q2[[1]]*Q4[[2]]-Q4[[1]]*Q2[[2]])];
 {RGBColor[0, 0, 1], Disk[Q2,0.1]},
 {RGBColor[1, 0, 0], Disk[Q4,0.1]},
 {RGBColor[0, 1, 0], PointSize[0.04], Point[Q1]},
 {RGBColor[1, 0, 0], Thickness[0.01], Dynamic[Arrow[{Q1, Q2}]]},
 {RGBColor[0, 0, 1], Thickness[0.01], Dynamic[Arrow[{Q1, Q4}]]},
 {RGBColor[1, 1, 0], Dynamic[Polygon[{Q1,Q2,Q3,Q4,Q1}]]},
  Locator[Dynamic[Q2],ImageSize->40],
  Locator[Dynamic[Q4],ImageSize->40],
 {FontSize -> 40,Text["Cross Product", {0,1.8}]}},
  PlotRange -> {{-2,2}, {-2,2}}],
 {{Q2,{1,0}},{{-1,-1},{1,1}},ControlType -> None}, 
 {{Q4,{0,1}},{{-1,-1},{1,1}},ControlType -> None} ] 

Image Manipulation

More image manipulation examples:
S=Import["http://www.math.harvard.edu/~knill/images/harvard.png"]
Manipulate[MatrixPlot[MorphologicalComponents[S, t],Frame->False],{t,0,1}]
S=Import["http://www.math.harvard.edu/~knill/images/plate.png"];
Manipulate[ColorQuantize[S,Floor[k]],{k,3,10}]
S=Import["http://www.math.harvard.edu/~knill/images/plate.png"];
Manipulate[ImageCompose[DistanceTransform[S,t],{S,s}], {t,0.5,1},{s,0,1}]
Questions and comments to knill@math.harvard.edu
Math21b | Math 21a | Fall 2009 | Department of Mathematics | Faculty of Art and Sciences | Harvard University