4
$\begingroup$

I am trying to plot a discrete dynamical system of the form $$\vec{x}_{k+1} = A \vec{x}_k$$ where $A$ is a $2\times 2$ matrix in the form $$\begin{pmatrix}a&b\\c&d\end{pmatrix}$$ where $a$, $b$ and $c$ are real numbers. It has an initial value in the form $$\begin{pmatrix}e \\f\end{pmatrix}$$

I would like to create a plot similar to that in: Creating an image of a discrete dynamical system But am at a loss to get the function plotted as I have tried both VectorPlot and ListPlot with little success. Any advice would be much appreciated :-)

The exact problem I am working on is: $$\begin{align*} &\vec{x}_k = \begin{pmatrix}2ba-a-b&ba-a-b\\2(a+b-ab)&2(a+b)-ab\end{pmatrix}\vec{x},&\vec{x}_0 = \begin{pmatrix}2\\1/3\end{pmatrix}. \end{align*}$$ I am looking at the plots created by different values for $a$ and $b$ such as $1$ and $1/2$.

I tried the following:

a = 1; b = 1/2;
A = {{2*b*a-a-b,b*a-a-b},{2(a+b-a*b),2(a+b)-ab}};
x0 = {1, 1/3};
pts = NestList[A.# &, x0, 15];
ListPlot[pts, Joined -> True, AspectRatio -> Automatic]

enter image description here

$\endgroup$
2
  • 5
    $\begingroup$ More details please! Give us values for a,b,c,d,e,f. Show us the attempts you’ve made with VectorPlot and ListPlot. $\endgroup$ – MarcoB Jan 1 at 18:52
  • 1
    $\begingroup$ You'd do well to look up MatrixPower[]. $\endgroup$ – J. M.'s torpor Jan 3 at 14:48
10
$\begingroup$

Use the sliders to modify matrix entries. Click and drag locators (small disks) to modify initial points; ALT+Click to add/remove locators.

Manipulate[ListLinePlot[Transpose @ NestList[#.{{a, b}, {c, d}} &, pt, 100],
   PlotStyle -> PointSize[Medium], PlotRange -> 5 {{-1, 1}, {-1, 1}}, 
   BaseStyle -> Arrowheads[{0., .05, 0.}], AspectRatio -> Automatic, 
   PlotLegends -> Placed[LineLegend[Defer /@ pt, LegendLabel -> "{x0,y0}", 
      LegendFunction -> Panel], Right], 
   Epilog -> {AbsolutePointSize[10], 
        {ColorData[97]@#, Point@pt[[#]]} & /@ Range[Length[pt]]}, 
   ImageSize -> 400, Frame -> True] /. Line -> Arrow,
 Spacer[10], Spacer[10], Spacer[10], 
 Grid[{{Item[Labeled[Control@{{a, .8, Style["a", 18]}, 0, 1, Slider, 
        ImageSize -> Small}, Style[Dynamic[a], 20], Top], 
     Background -> (Dynamic @ ColorData[{"Rainbow", {-1, 1}}][a])], 
    Item[Labeled[Control@{{b, .0, Style["b", 18]}, -1, 1, Slider, 
        ImageSize -> Small}, Style[Dynamic[b], 20], Top], 
     Background -> (Dynamic @ ColorData[{"Rainbow", {-1, 1}}][b])]}, 
    {Item[Labeled[Control@{{c, .0, Style["c", 18]}, -1, 1, Slider, 
        ImageSize -> Small}, Style[Dynamic[c], 20], Top], 
     Background -> (Dynamic@ColorData[{"Rainbow", {-1, 1}}][c])], 
    Item[Labeled[Control@{{d, .4, Style["d", 18]}, 0, 1, Slider, 
        ImageSize -> Small}, Style[Dynamic[d], 20], Top], 
     Background -> (Dynamic@ColorData[{"Rainbow", {-1, 1}}][d])]}}, 
  Alignment -> {Center, Center}, ItemSize -> {15, 15}, Dividers -> All],
 {{pt, 3 {{1, 1}, {-1, 1}, {1, -1}}}, Locator, 
    Appearance -> None, LocatorAutoCreate -> {1, 10}}, 
 Alignment -> Center, ControlPlacement -> Left]

enter image description here

An alternative implementation using Graphics:

Manipulate[Legended[Graphics[{AbsolutePointSize[10], ColorData[97]@#, 
    Arrowheads[.03], Point @ pt[[#]], 
    Arrow[Partition[NestList[{{a, b}, {c, d}}.# &, pt[[#]], t - 1], 2, 1]]} & /@ 
     Range[Length[pt]], 
   ImageSize -> 400, Frame -> True, Axes -> True, 
   PlotRange -> 5 {{-1, 1}, {-1, 1}}], 
  Placed[LineLegend[ColorData[97] /@ Range[Length @ pt], Defer /@ pt, 
    LegendLabel -> "{x0,y0}", LegendFunction -> Panel], Right]],
 Spacer[10], Spacer[10], Spacer[10], 
 Grid[{{Item[Labeled[Control @ {{a, .8, Style["a", 18]}, 0, 1, Slider, 
        ImageSize -> Small}, Style[Dynamic[a], 20], Top], 
     Background -> (Dynamic @ ColorData[{"Rainbow", {-1, 1}}][a])], 
    Item[Labeled[Control @ {{b, .0, Style["b", 18]}, -1, 1, Slider, 
         ImageSize -> Small}, Style[Dynamic[b], 20], Top], 
       Background -> (Dynamic @ ColorData[{"Rainbow", {-1, 1}}][b])]},
    {Item[Labeled[Control @ {{c, .0, Style["c", 18]}, -1, 1, Slider, 
         ImageSize -> Small}, Style[Dynamic[c], 20], Top], 
       Background -> (Dynamic @ ColorData[{"Rainbow", {-1, 1}}][c])], 
    Item[Labeled[Control @ {{d, .4, Style["d", 18]}, 0, 1, Slider, 
         ImageSize -> Small}, Style[Dynamic[d], 20], Top], 
       Background -> (Dynamic @ ColorData[{"Rainbow", {-1, 1}}][d])]}}, 
  Alignment -> {Center, Center}, ItemSize -> {16, 16}, Dividers -> All],
  {{pt, 3 {{1, 1}, {-1, 1}, {1, -1}}}, Locator, 
     Appearance -> None, LocatorAutoCreate -> {1, 10}},
  Spacer[10],
  {{t, 1}, 1, 80, 1, Animator, AnimationRunning -> False, DisplayAllSteps -> True}, 
 Alignment -> Center, ControlPlacement -> Left]

enter image description here

Update: Modification of the second method for the example in OP's update:

ClearAll[a, b, aA, x0] aA[a_, b_] := {{2 a b - a - b, a b - a - b}, {2 (a + b - a b), 2 ( a + b) - a b}} x0 = {1, 1/3};

Manipulate[Graphics[{AbsolutePointSize[10], ColorData[97]@1, Arrowheads[.03], 
   Point@x0, 
   Arrow[Partition[NestList[aA[a, b].# &, x0, t - 1], 2, 1]]}, 
  AspectRatio -> 1, ImageSize -> 400, Frame -> True, Axes -> True, 
  PlotRange -> All], Spacer[10], Spacer[10], Spacer[10], 
 Grid[{{Item[Labeled[Control@{{a, 1, Style["a", 18]}, -1, 1, Slider, 
        ImageSize -> Small}, Style[Dynamic[a], 20], Top], 
     Background -> (Dynamic@ColorData[{"Rainbow", {-1, 1}}][a])], 
    Item[Labeled[Control@{{b, .5, Style["b", 18]}, -1, 1, Slider, 
        ImageSize -> Small}, Style[Dynamic[b], 20], Top], 
     Background -> (Dynamic@ColorData[{"Rainbow", {-1, 1}}][b])]}}, 
  Alignment -> {Center, Center}, ItemSize -> {16, 16}, Dividers -> All], 
 Spacer[10], 
 {{t, 1}, 1, 15, 1, Animator, AnimationRunning -> False, DisplayAllSteps -> True}, 
 Alignment -> Center, ControlPlacement -> Left]

enter image description here

If you want to control the starting point with a Locator:

Manipulate[Labeled[Graphics[{AbsolutePointSize[10], ColorData[97]@#, 
      Arrowheads[.03], Point@pt[[#]], 
      Arrow[Partition[NestList[aA[a, b].# &, pt[[#]], t - 1], 2, 1]]} & /@ 
        Range[Length[pt]], ImageSize -> 400, Frame -> True, 
   Axes -> True, PlotRange -> All, AspectRatio -> 1], 
  Dynamic[pt[[1]]], Top], Spacer[10], Spacer[10], Spacer[10], 
 Grid[{{Item[Labeled[Control@{{a, 1, Style["a", 18]}, 0, 1, Slider, 
        ImageSize -> Small}, Style[Dynamic[a], 20], Top], 
     Background -> (Dynamic@ColorData[{"Rainbow", {-1, 1}}][a])], 
    Item[Labeled[Control@{{b, .5, Style["b", 18]}, -1, 1, Slider, 
        ImageSize -> Small}, Style[Dynamic[b], 20], Top], 
     Background -> (Dynamic@ColorData[{"Rainbow", {-1, 1}}][b])]}}, 
  Alignment -> {Center, Center}, ItemSize -> {16, 16}, Dividers -> All], 
  {{pt, {x0}}, Locator, Appearance -> None,  LocatorAutoCreate -> False}, 
 Spacer[10], 
 {{t, 1}, 1, 15, 1, Animator, AnimationRunning -> False, DisplayAllSteps -> True}, 
  Alignment -> Center, ControlPlacement -> Left]

enter image description here

$\endgroup$
2
  • $\begingroup$ Very interesting code. The problem I am working on is the following $$\begin{align*} &\vec{x}_k = \left( \begin{array}{ccc}2ba-a-b&ba-a-b\\2(a+b-ab)&2(a+b)-ab\end{array} \right) \vec{x},&\vec{x}_0 = \left( \begin{array}{c}2\\1/3\end{array} \right). \end{align*}$$ Where I will be inestigating the trajectories of different a and b values such as 1 and 1/2. I have tried evaluating some of these and putting them in to your code. I am just wondering how to change the x0 values? $\endgroup$ – FFerreira Jan 3 at 10:53
  • 1
    $\begingroup$ @FFerreira, please see the update re modification of the second method for your example. $\endgroup$ – kglr Jan 3 at 15:39
7
$\begingroup$

Edit

We can change x0 by Locator and change {a,b} by Slide2D.

A[{a_, b_}] := {{2*b*a - a - b, b*a - a - b}, {2 (a + b - a*b), 
    2 (a + b) - a*b}};
Manipulate[
 ListPlot[NestList[A[ab] . # &, x0, 15], Joined -> True, 
  PlotRange -> {{-10, 10}, {-10, 10}}, 
  AspectRatio -> 1], {{ab, {1, 1/2}, 
   Dynamic["{a,b}=" <> 
     ToString[ab, TraditionalForm]]}, {.8, .4}, {1.2, .6}}, 
 Dynamic["x0=" <> ToString[x0, TraditionalForm]], {{x0, {2, 1/3}}, 
  Locator}, ControlPlacement -> Right]

Original

A = {{Cos[π/3], -Sin[π/3] - .1}, {Sin[π/3], Cos[π/3]}};
x0 = {1, 1};
pts = NestList[A . # &, x0, 15];
ListPlot[pts, Joined -> True, AspectRatio -> Automatic]

enter image description here

Or

A = {{Cos[π/3], -Sin[π/3] - .1}, {Sin[π/3], Cos[π/3]}};
x0 = {1, 1};
pts = NestList[A . # &, x0, 15];
Graphics[Arrow[Partition[pts, 2, 1]]]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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