Linear Transformation

Author

Eric W. Weisstein
October 26, 2008

This notebook downloaded from http://mathworld.wolfram.com/notebooks/LinearAlgebra/LinearTransformation.nb.

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

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

Additional Authors

Original code by Todd Rowland

Notes

This code needs to be further cleaned up

Diagram plane with vectors to image in (ℝ^3)

<<Graphics`Colors`

2-D

clr={VioletRed,Blue,DarkViolet,CadmiumYellow,CobaltGreen,OrangeRed};
vects={{2,-1},{1,2},{3,1},{-1,0.5},{-2,-1.5},{0,-2.5}};
str3={"Tv","Tw","T(v+w)","T(-v/2)","T(-v/2+w)","T(v/2-w)"};
str={"v","w","v+w","-v/2","-v/2-w","v/2-w"};
usu[n_]={Line[{{-n,0,0},{n,0,0}}],Line[{{0,-n,0},{0,n,0}}],Line[{{0,0,-n},{0,0,n}}]};

redraw[v_]:={grs=Table[{},{6}];
Do[Module[{v1,g1,g2,g3},v1=v[[i]];
g1={Thickness[.008],clr[[i]],Arrow[{{0,0},v1}]};
g2=Text[ToExpression[str[[i]]],1.1v1,{0,0},Background->White];
g3=Graphics[{g1,g2}];
grs[[i]]=g3],{i,6}]} 
algrs[f_,s_]:=redraw[Dot[vects,Transpose[f[s]]]];
redraw[vects];

V6

Show[grs,Axes->True,AspectRatio->Automatic,PlotRange->{{-1,1},{-1,1}}3.6,Ticks->None];

V7

Show[grs,Axes->True,AspectRatio->Automatic,Ticks->None,Method->{"AxesInFront"->False}]

3-D

arr3[{s_,v_,jac_}]:=Module[{rot,r1,r2,arscal,d,a1,a2,b1,v2,b2},rot[x_]:={{Cos[x],-Sin[x]},{Sin[x],Cos[x]}};
r1=rot[.2]; 
r2=rot[-.2];
 arscal=.1;
d=arscal v;
a1=Dot[r1,d];
a2=Dot[r2,d];
v2=Dot[jac,v];
b1=Dot[jac,a1];
b2=Dot[jac,a2];
{Point[s],Line[{s,s+v2}],Line[{s+v2,s+v2-b1}],Line[{s+v2,s+v2-b2}]}
]

axe=Graphics3D[usu[4]];
redraw3[v_,jac_]:={Clear[grs3]; grs3=Table[,{6}];
Do[Module[{g1,g2,v1,g3,tscale},tscale=1.1;
v1=v[[i]];
g1={clr[[i]],arr3[{{0,0,0},v1,jac}]};
g2=Text[str3[[i]],tscale Dot[jac,v1]];
g3=Graphics3D[{g1,g2}];
grs3[[i]]=g3],{i,1,6}]};
blah3:=Show[{grs3,axe},ViewPoint->{.244,3.181,.464}] 

j3={{0,1},{-2,2},{1,0}};
redraw3[vects,j3];

WriteLiveForm["lineartr.m",blah3]

Animation of homotopy from identity to T Using code from above

mov[f_,str_,end_,n_,opts___?OptionQ]:=Module[{dx=(end-str)/n},
Table[algrs[f,s];
Show[grs,Axes->True,AspectRatio->Automatic,opts,Ticks->None,Method->{"AxesInFront"->False}],{s,str,end,dx}]
]

hom[t_,a_,b_]:=(1-t)a+t b;
h[t_]:=hom[t,IdentityMatrix[2],{{1.4,-1},{.8,0}}];

V6

Show[GraphicsArray[Partition[mov[h,0,1,3,4],2]]]

Export[gifs<>"lineartr.gif",mov[h,0,1,20,4]]

V7

GraphicsGrid[Partition[mov[h,0,1,3],2]]

ListAnimate[mov[h,0,1,20,PlotRange->4]]