Skip to main content
Mathematica

Return to Answer

added another demo
Source Link
J. M.'s missing motivation
J. M.'s missing motivation
  • 126.6k
  • 11
  • 411
  • 590
With[{A = {{1, 3}, {4, 2}}/4}, Manipulate[LocatorPane[Dynamic[p, (p = Normalize[#]) &], Legended[Graphics[{FaceForm[], {EdgeForm[Blue], Disk[], Blue, Arrow[{{0, 0}, Dynamic[p]}]}, {EdgeForm[Green], TransformedRegion[Disk[],  AffineTransform[A]], Green, Arrow[{{0, 0}, Dynamic[A.p]}]}}], LineLegend[{Blue, Green}, {"x", "Ax"}]], Appearance -> None], {{p, {1, 0}}, ControlType -> None}]]

eigenvector demo

As a further extension, I just did the demonstration with the repeated matrix-vector products by straightforwardly modifying my initial implementation:

Manipulate[With[{A = Transpose[{v1, v2}]}, Panel[Graphics[{With[{ev = Eigenvectors[A]}, If[MatrixQ[ev, Internal`RealValuedNumberQ], {Gray, AbsoluteThickness[6], InfiniteLine[{0, 0}, #] & /@ ev}, {}]], {{GrayLevel[1/2, 1/4], AbsolutePointSize[12], Point[v1]}, {Blue, Arrowheads[Large], AbsoluteThickness[4], Arrow[{{0, 0}, v1}]}}, {{GrayLevel[1/2, 1/4], AbsolutePointSize[12], Point[v2]}, {Green, Arrowheads[Large], AbsoluteThickness[4], Arrow[{{0, 0}, v2}]}}, With[{iv = NestList[A.# &, v, n]}, {Pink, AbsoluteDashing[{2, 4}], Arrowheads[Medium], AbsolutePointSize[6], Point[Most[iv]], Arrow[iv]}]}, Axes -> True, PlotRange -> {{-1, 5}, {-1, 5}}]]], {{v1, {1, 1/2}}, Locator, Appearance -> None}, {{v2, {1/2, 1}}, Locator, Appearance -> None}, {{v, {2, 3}}, Locator, Appearance -> None}, {{n, 1}, 1, 20, 1}]

iterated product demo

The slider for n determines how many iterates of $\mathbf A^n\mathbf x$ to take.

Here is how it looks like for the case of a matrix with complex eigenvalues:

complex eigenvalue case

With[{A = {{1, 3}, {4, 2}}/4}, Manipulate[LocatorPane[Dynamic[p, (p = Normalize[#]) &], Legended[Graphics[{FaceForm[], {EdgeForm[Blue], Disk[], Blue, Arrow[{{0, 0}, Dynamic[p]}]}, {EdgeForm[Green], TransformedRegion[Disk[], AffineTransform[A]], Green, Arrow[{{0, 0}, Dynamic[A.p]}]}}], LineLegend[{Blue, Green}, {"x", "Ax"}]], Appearance -> None], {{p, {1, 0}}, ControlType -> None}]]

eigenvector demo

With[{A = {{1, 3}, {4, 2}}/4}, Manipulate[LocatorPane[Dynamic[p, (p = Normalize[#]) &], Legended[Graphics[{FaceForm[], {EdgeForm[Blue], Disk[], Blue, Arrow[{{0, 0}, Dynamic[p]}]}, {EdgeForm[Green], TransformedRegion[Disk[],  AffineTransform[A]], Green, Arrow[{{0, 0}, Dynamic[A.p]}]}}], LineLegend[{Blue, Green}, {"x", "Ax"}]], Appearance -> None], {{p, {1, 0}}, ControlType -> None}]]

eigenvector demo

As a further extension, I just did the demonstration with the repeated matrix-vector products by straightforwardly modifying my initial implementation:

Manipulate[With[{A = Transpose[{v1, v2}]}, Panel[Graphics[{With[{ev = Eigenvectors[A]}, If[MatrixQ[ev, Internal`RealValuedNumberQ], {Gray, AbsoluteThickness[6], InfiniteLine[{0, 0}, #] & /@ ev}, {}]], {{GrayLevel[1/2, 1/4], AbsolutePointSize[12], Point[v1]}, {Blue, Arrowheads[Large], AbsoluteThickness[4], Arrow[{{0, 0}, v1}]}}, {{GrayLevel[1/2, 1/4], AbsolutePointSize[12], Point[v2]}, {Green, Arrowheads[Large], AbsoluteThickness[4], Arrow[{{0, 0}, v2}]}}, With[{iv = NestList[A.# &, v, n]}, {Pink, AbsoluteDashing[{2, 4}], Arrowheads[Medium], AbsolutePointSize[6], Point[Most[iv]], Arrow[iv]}]}, Axes -> True, PlotRange -> {{-1, 5}, {-1, 5}}]]], {{v1, {1, 1/2}}, Locator, Appearance -> None}, {{v2, {1/2, 1}}, Locator, Appearance -> None}, {{v, {2, 3}}, Locator, Appearance -> None}, {{n, 1}, 1, 20, 1}]

iterated product demo

The slider for n determines how many iterates of $\mathbf A^n\mathbf x$ to take.

Here is how it looks like for the case of a matrix with complex eigenvalues:

complex eigenvalue case

Source Link
J. M.'s missing motivation
J. M.'s missing motivation
  • 126.6k
  • 11
  • 411
  • 590

Many months ago, I was asked if I could write a Mathematica version of the MATLAB function eigshow(). Here is what I came up with:

With[{A = {{1, 3}, {4, 2}}/4}, Manipulate[LocatorPane[Dynamic[p, (p = Normalize[#]) &], Legended[Graphics[{FaceForm[], {EdgeForm[Blue], Disk[], Blue, Arrow[{{0, 0}, Dynamic[p]}]}, {EdgeForm[Green], TransformedRegion[Disk[], AffineTransform[A]], Green, Arrow[{{0, 0}, Dynamic[A.p]}]}}], LineLegend[{Blue, Green}, {"x", "Ax"}]], Appearance -> None], {{p, {1, 0}}, ControlType -> None}]]

eigshow, Mathematica version

Here, the blue arrow corresponds to a unit vector (which traces out a circle), and the green arrow corresponds to the transformed unit vector (which traces out an ellipse). If you can make the blue and green arrows parallel to each other, then the green arrow corresponds to an eigenvector of A.

I had also implemented one of the simpler demonstrations in the page linked in the OP; I also happened to find that neat webpage after I went looking for other demos similar to eigshow():

Manipulate[With[{A = Transpose[{v1, v2}]}, Row[{Panel[ Graphics[{{Gray, AbsoluteThickness[6], InfiniteLine[{0, 0}, #] & /@ Eigenvectors[A]}, {{GrayLevel[1/2, 1/4], AbsolutePointSize[12], Point[v1]}, {Blue, Arrowheads[Large], AbsoluteThickness[4], Arrow[{{0, 0}, v1}]}}, {{GrayLevel[1/2, 1/4], AbsolutePointSize[12], Point[v2]}, {Green, Arrowheads[Large], AbsoluteThickness[4], Arrow[{{0, 0}, v2}]}}, {Pink, AbsoluteDashing[{10, 15}], Arrowheads[Small], AbsolutePointSize[8], Point[v], Arrow[{v, A.v}]}}, Axes -> True, PlotRange -> {{0, 5}, {0, 5}}]], Grid[{{"A:", MatrixForm[A]}, {"x:", v}, {"Ax:", A.v}}, Alignment -> {Left, Center}]}, Spacer[10]]], {{v1, {1, 1/2}}, Locator, Appearance -> None}, {{v2, {1/2, 1}}, Locator, Appearance -> None}, {{v, {2, 3}}, Locator, Appearance -> None}]

eigenvector demo