Orthogonal Group

Author

Eric W. Weisstein
February 16, 2008

This notebook downloaded from http://mathworld.wolfram.com/notebooks/GroupTheory/OrthogonalGroup.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/OrthogonalGroup.html.

©2008 Wolfram Research, Inc. except for portions noted otherwise

Additional Authors

Code by Todd Rowland

Comments

This code could be cleaned up and updated for V6

Code

b1[v_,n_]:=Graphics[Table[{Hue[i/n],Arrow[{{0,0},v[[i]]}]},{i,1,n}]];
com1[tr_,v_]:=Dot[v,Transpose[tr]];
b2[f_,s_,v_,len_]:=b1[com1[f[s],v],len];

mov3[f_,v_,len_,str_,end_,n_,r_]:=Module[{dx},dx=(end-str)/n;
Table[Show[b2[f,s,v,len],Axes->True,AspectRatio->Automatic,PlotRange->{{-r,r},{-r,r}}],{s,str,end,dx}]]
hypnorm[v_]:=v[[1]]^2-v[[2]]^2;

pl[v_]:=Module[{f,c,c1,c2,e1,e2},
c=hypnorm[v];
c1=(Abs[c])^(1/2);
c2=2;
e1=Sign[v[[1]]]; e2=Sign[v[[2]]];
If[c==0,c2=2,c2=Max[2,1/c1]];
If[c>0,f[t_]:=c1 e1{Cosh[t],Sinh[t]},f[t_]:=c1 e2 {Sinh[t],Cosh[t]}];
ParametricPlot[f[t],{t,-c2,c2},PlotRange->{{-2,2},{-2,2}},DisplayFunction->Identity]];
pl0[v_]:=Show[{Graphics[{Thickness[.01],Orange,Line[{{-2,-2},{2,2}}],Line[{{-2,2},{2,-2}}]}],Graphics[{PointSize[.03],Black,Point[{0,0}]}],Table[pl[v[[i]]],{i,Length[v]}]},DisplayFunction->Identity];
flipx={{-1,0},{0,1}};
flip2={{1,0},{0,-1}};
hyp[t_]:={{Cosh[t],Sinh[t]},{Sinh[t],Cosh[t]}};
rot[θ_]:={{Cos[θ],-Sin[θ]},{Sin[θ],Cos[θ]}};
trans[x_]:={{1,x},{0,1}};

mov4[f_,v_,len_,str_,end_,n_,r_]:=Module[{dx},dx=(end-str)/n;
Table[Show[{b2[f,s,v,len],pl0[v]},Axes->True,AspectRatio->Automatic,PlotRange->{{-r,r},{-r,r}}],{s,str,end,dx}]]
w={{.7,-.7},{-1,.1},{.5,.6},{-.3,-.5},{.6,-.2},{-.5,.5},{.4,.4},{-.6,-.6}};

onorm[v_]:=v[[1]]^2+v[[2]]^2;
q1[v_]:=Module[{f,c,c1},
c=onorm[v];
c1=(c)^(1/2);
f[t_]:=c1 {Cos[t],Sin[t]};
ParametricPlot[f[t],{t,0,2 Pi},PlotRange->{{-2,2},{-2,2}},DisplayFunction->Identity]];
q2[v_]:=Show[{Graphics[{PointSize[.03],Black,Point[{0,0}]}],Table[q1[v[[i]]],{i,Length[v]}]},DisplayFunction->Identity];

mov5[f_,v_,len_,str_,end_,n_,r_]:=Module[{dx},dx=(end-str)/n;
Table[Show[{b2[f,s,v,len],q2[v]},Axes->True,AspectRatio->Automatic,PlotRange->{{-r,r},{-r,r}}],{s,str,end,dx}]]
w={{.7,-.7},{0,.7},{.5,.6},{0,-.5},{-.1,.2},{-.3,0},{.4,0},{-.6,-.6}};

Diagram rotations preserving circles

mov5[rot,w,8,Pi/10,2 Pi,20,1.1][[1]]

Animated GIF

Export[gifs<>"orthgrci.gif",mov5[rot,w,8,Pi/10,2 Pi,20,1.2]]

Diagram action of O(1,1) on the plane

mov4[hyp,w,8,-1,1,10,2][[1]]

Animated GIF

Export[gifs<>"orthgrhy.gif",mov4[hyp,w,8,-1,1,10,2]]