11
$\begingroup$

I've recently stumbled upon this very nice interactive visualization of eigenvectors of two-dimensional matrices, and how powers $A^k$ act on various vectors.

How can this sort of visualization be realized with Mathematica, leveraging its dynamical capabilities?

$\endgroup$
1
  • $\begingroup$ Maybe not what you want, but there are interactive examples at demonstrations.wolfram.com, such as this and this $\endgroup$ Nov 10, 2018 at 15:55

2 Answers 2

19
$\begingroup$

The following is an attempt to recreate a similar sort of interactive visualization, showing the eigenvectors (when real), and how the various points of the unit circle are transformed by the matrix.

The matrix can be chosen by moving its two column vectors using the mouse. I used EventHandler for this, instead of Locators, for greater customizability and a more natural look.

To ease code readability and modularity, the components of the graphical object are defined separately in a private context, and injected into the final DynamicModule object.

Here is the full code:

BeginPackage["eigenvectorRepresentation`"];
dynamicalEigenvectorsRepresentation;
Begin["`Private`"];

Attributes[hold] = HoldAllComplete;
ClearAll@injectAndRelease;
Attributes[injectAndRelease] = HoldAllComplete;
injectAndRelease[x_, replacementRules_, hold_: hold] := 
  Hold@x /. replacementRules /. {hold[s__] :> s} // ReleaseHold;

redPoint = hold@{
    Red, If[TrueQ[movingPointIndex == 1], [email protected], 
     [email protected]],
    Point@v1, Arrow@{{0, 0}, v1}
    };

greenPoint = hold@{
    Green, 
    If[TrueQ[movingPointIndex == 2], [email protected], [email protected]],
    Point@v2, Arrow@{{0, 0}, v2}
    };

bluePointAndArrows = 
  hold@Dynamic@{Blue, [email protected], Point@v3, [email protected],
     Arrow /@ 
      Partition[NestList[Dot[matrix, #] &, v3, numOfIterations], 2, 
       1]
     };

showEigenvectors = hold@Dynamic@With[{eigs = Eigenvectors@N@matrix},
     If[MatchQ[eigs, {{__Real} ..}], {Purple, [email protected], 
       InfiniteLine@{-#, #} & /@ eigs}, {}]
     ];

principalAxes = hold@With[
    {singularVectors = {Transpose@#[[1]], #[[3]]} &@
       SingularValueDecomposition@matrix},
    {Map[{Thick, Orange, Arrow@{{0, 0}, #}} &, singularVectors[[1]]],
     Map[{Thick, Cyan, Arrow@{{0, 0}, #}} &, singularVectors[[2]]]}
    ];

additionalInfo = hold[
   Column@{
     "PlotRange",
     VerticalSlider[Dynamic@frameSize, {1, 10, 0.01}, 
      Appearance -> "Labeled"]
     }, "   ",
   Column@{
     "Number of iterations",
     VerticalSlider[Dynamic@numOfIterations, {1, 40, 1}, 
      Appearance -> "Labeled"]
     }
   ];

eigenvaluesDisplay = hold[
   "   ",
   Dynamic@With[{eigvals = Eigenvalues@matrix},
     Graphics[{Circle[], Point@{0, 0}, Thick,
       Arrow@{{0, 0}, ReIm@eigvals[[1]]},
       Arrow@{{0, 0}, ReIm@eigvals[[2]]}
       }, Axes -> True, PlotRangePadding -> 0.1, 
      PlotRange -> {{-1, 1}, {-1, 1}}, ImageSize -> 200, 
      PlotLabel -> "Eigenvalues"]
     ]
   ];

arrowRepresentationActionMatrix[matrix_] := 
  With[{pts = MeshCoordinates@DiscretizeRegion@Region@Circle[]},
   With[{finalPts = Dot[matrix, #] & /@ pts},
    Graphics[{
      [email protected], Point@finalPts,
      Arrow /@ Thread@{pts, finalPts}
      }]
    ]];

Options[dynamicalEigenvectorsRepresentation] = {
   "ShowBluePointAndArrows" -> True,
   "ShowEigenvectorsWhenReal" -> True,
   "ShowEigenvalues" -> True,
   "ShowPrincipalAxes" -> True
   };
dynamicalEigenvectorsRepresentation[OptionsPattern[]] := DynamicModule[
    {v1 = {0.7, -0.6}, v2 = {0.6, 0.6}, v3 = {1, 1}, movingPointIndex,
      matrix, frameSize = 1.5, numOfIterations = 30},
    Row[{
      EventHandler[
       Dynamic[
        matrix = Transpose@{v1, v2};
        Show[
         arrowRepresentationActionMatrix@matrix,
         Graphics[{
           [email protected], Circle[], Point@{0, 0},
           "RedPoint", "GreenPoint", "BluePoint",
           "ConditionallyShowEigenvectors",
           "PrincipalAxes"
           }],
         Frame -> True, 
         PlotRange -> Dynamic[{{-#, #}, {-#, #}} &@frameSize], 
         ImageSize -> 500
         ]
        ],
       {"MouseDown" :> With[{mp = MousePosition["Graphics"]},

          movingPointIndex = 
           Position[{v1, v2, v3}, First@Nearest[{v1, v2, v3}, mp]][[1,
             1]]
          ],
        "MouseUp" :> (movingPointIndex = 0),
        "MouseDragged" :> ReleaseHold[

          Hold[Set][Hold[v1, v2, v3][[{movingPointIndex}]], 
           MousePosition["Graphics"]]
          ]}
       ],
      "AdditionalInfoSlot",
      "EigenvaluesDisplay"
      }]
    ]~injectAndRelease~{
    "RedPoint" -> redPoint, "GreenPoint" -> greenPoint,
    "BluePoint" -> 
     If[OptionValue@"ShowBluePointAndArrows" === True, 
      bluePointAndArrows, {}],
    "AdditionalInfoSlot" -> additionalInfo,
    "EigenvaluesDisplay" -> 
     Sequence @@ 
      If[OptionValue@"ShowEigenvalues" === 
        True, {eigenvaluesDisplay}, {}],
    "ConditionallyShowEigenvectors" -> 
     If[OptionValue@"ShowEigenvectorsWhenReal" === True, 
      showEigenvectors, {}],
    "PrincipalAxes" -> 
     Sequence @@ 
      If[OptionValue@"ShowPrincipalAxes" === True, {principalAxes}, {}]
    };

End[];
EndPackage[];

Then to create the representation just use

dynamicalEigenvectorsRepresentation[
  "ShowEigenvectorsWhenReal" -> True,
  "ShowBluePointAndArrows" -> True,
  "ShowEigenvalues" -> True,
  "ShowPrincipalAxes" -> False
]

and this is the result:

enter image description here

$\endgroup$
1
  • 2
    $\begingroup$ This is really cool $\endgroup$
    – ktm
    Nov 9, 2018 at 1:03
4
$\begingroup$

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


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

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.