Mathematica demos for teaching

by Oliver Knill

Interactive geometric object with points and lines

CircumscribedCircle=Manipulate[ (* Oliver Knill, Mathematica 7, 2008 *)
 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}
]

By the way, here is the computation of the center of the circumscribed circle

p1={x1,y1}; p2={x2,y2}; p3={x3,y3}; perp[{a_,b_}]:={-b,a};
n2=p1-p2; n3=p1-p3; m2=(p1+p2)/2; m3=(p1+p3)/2; 
Solve[{n2.({x,y}-m2)==0, n3.({x,y}-m3)==0},{x,y}]  *)

2. Interactive example with dynamics

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.1*(Random[]-1/2);
  EventHandler[Graphics[{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}}])]
]

3. Interacting with lines and showing text

Manipulate[ A={{a,b},{c,d}};
  Q1 = {0,0}; Q2 = Dynamic[A.{1,0}]; Q3 = {0,0}; Q4 = Dynamic[A.{0,1}];
  B0={RGBColor[0,1,0],PointSize[0.04], Dynamic[Point[Q1]]};
  B1={RGBColor[1,0,0],Thickness[0.02], Dynamic[Arrow[{Q1,Q2}]]};
  B2={RGBColor[0,0,1],Thickness[0.01], Dynamic[Arrow[{Q1,Q4}]]};
  B3={RGBColor[1,1,0],Dynamic[Polygon[{Q1,Q2,Q2+Q4,Q4}]]};
  B4 = Locator[Dynamic[{a,c}]];
  B5 = Locator[Dynamic[{b,d}]];
  B6 = Text[MatrixForm[Dynamic[Floor[10*{{a,b},{c,d}}]]],{1.5,1.5}]; 
  Graphics[{B6,B3,B2,B1,B0,B4,B5}, 
   PlotRange -> {{-2,2},{-2,2}},
   ImageSize -> {400,400}], 
   {{a,1},{-1,1},ControlType->None},
   {{b,0},{-1,1},ControlType->None},
   {{c,0},{-1,1},ControlType->None},
   {{d,1},{-1,1},ControlType->None}]