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}]