Generating the Figures in Chapter 7 of Otto and Day

Inputs (Enter first)

<< Graphics`ImplicitPlot`

<< Graphics`PlotField`

<< Graphics`Graphics`

<< Graphics`MultipleListPlot`

<< Graphics`Arrow`

Off[General::"spell"]

Off[General::"spell1"]

Figure 7.1

DisplayTogether[
PlotVectorField[{1 x1, 
          2 x2}, {x1, -1, 1}, {x2, -1, 1}, Axes -> True, 
        ScaleFactor ->  .45, AspectRatio -> 1, 
        PlotRange -> {{-1, 1}, {-1, 1}}], 
      Plot[{1000000000000000 x, 0}, {x, -1, 1}, 
        PlotRange -> {{-1, 1}, {-1, 1}}, 
        PlotStyle -> {{Dashing[{0}], Thickness[ .0075]}, {Dashing[{0}], 
              Thickness[ .0075]}}]
]

DisplayTogether[
PlotVectorField[{1 x1, -1 x2}, {x1, -1, 1}, {x2, -1, 1}, Axes -> True, 
        ScaleFactor ->  .45, AspectRatio -> 1, 
        PlotRange -> {{-1, 1}, {-1, 1}}], 
      Plot[{1000000000000000 x, 0}, {x, -1, 1}, 
        PlotRange -> {{-1, 1}, {-1, 1}}, 
        PlotStyle -> {{Dashing[{0}], Thickness[ .0075]}, {Dashing[{0}], 
              Thickness[ .0075]}}]
]

DisplayTogether[
PlotVectorField[{-1 x1, -1.5 x2}, {x1, -1, 1}, {x2, -1, 1}, Axes -> True, 
        ScaleFactor ->  .45, AspectRatio -> 1, 
        PlotRange -> {{-1, 1}, {-1, 1}}]
, 
      Plot[{1000000000000000 x, 0}, {x, -1, 1}, 
        PlotRange -> {{-1, 1}, {-1, 1}}, 
        PlotStyle -> {{Dashing[{0}], Thickness[ .0075]}, {Dashing[{0}], 
              Thickness[ .0075]}}]
]

Figure 7.2

Plot[{((-1)/2) n1, (1/3) n1}, {n1, -1, 1}, 
      PlotRange -> {-1, 1}]

Figure 7.3

a = 2; b = 1; c =  .5; d = 1;
DisplayTogether[
Plot[{(1/(-((-a + d + (Sqrt[(a^2) + 4 b c - 2 a d + (d^2)]))/(2 c)))) x, 
          (1/(-((-a + d - (Sqrt[(a^2) + 4 b c - 2 a d + (d^2)]))/(2 c)))) x}, {x, -1, 1}, AspectRatio -> 1, 
        PlotRange -> {{-1, 1}, {-1, 1}}, 
        PlotStyle -> {{Dashing[{0}], Thickness[ .0075]}, {Dashing[{0}], 
              Thickness[ .0075]}}], 
PlotVectorField[{a x1 + b x2, c x1 + d x2}, {x1, -1, 1}, {x2, -1, 1}, Axes -> True, 
        ScaleFactor ->  .45, AspectRatio -> 1, 
        PlotRange -> {{-1, 1}, {-1, 
              1}}]
]

a = -2; b = -1; c =  .5; d = 1;
DisplayTogether[
Plot[{(1/(-((-a + d + (Sqrt[(a^2) + 4 b c - 2 a d + (d^2)]))/(2 c)))) x, 
          (1/(-((-a + d - (Sqrt[(a^2) + 4 b c - 2 a d + (d^2)]))/(2 c)))) x}, {x, -1, 1}, AspectRatio -> 1, 
        PlotRange -> {{-1, 1}, {-1, 1}}, 
        PlotStyle -> {{Dashing[{0}], Thickness[ .0075]}, {Dashing[{0}], 
              Thickness[ .0075]}}], 
PlotVectorField[{a x1 + b x2, c x1 + d x2}, {x1, -1, 1}, {x2, -1, 1}, Axes -> True, 
        ScaleFactor ->  .45, AspectRatio -> 1, 
        PlotRange -> {{-1, 1}, {-1, 
              1}}]
]

a = -2; b = -1; c = - .5; 
    d = -1;
DisplayTogether[
Plot[{(1/(-((-a + d + (Sqrt[(a^2) + 4 b c - 2 a d + (d^2)]))/(2 c)))) x, 
          (1/(-((-a + d - (Sqrt[(a^2) + 4 b c - 2 a d + (d^2)]))/(2 c)))) x}, {x, -1, 1}, AspectRatio -> 1, 
        PlotRange -> {{-1, 1}, {-1, 1}}, 
        PlotStyle -> {{Dashing[{0}], Thickness[ .0075]}, {Dashing[{0}], 
              Thickness[ .0075]}}], 
PlotVectorField[{a x1 + b x2, c x1 + d x2}, {x1, -1, 1}, {x2, -1, 1}, Axes -> True, 
        ScaleFactor ->  .45, AspectRatio -> 1, 
        PlotRange -> {{-1, 1}, {-1, 
              1}}]
]

Figure 7.4-NA

Figure 7.5

Plot[{Sin[x], Sin[2 x]}, {x, -2 π, 
        2  π}, 
PlotStyle -> {Dashing[{0}], 
          Dashing[{ .01}]}, 
Ticks -> {{#, 
                TraditionalForm[#]} & /@ {-2 π, -π, 
              0, π, 
              2  π}, {#, TraditionalForm[#]} & /@ {-1, -1/2, 
              0, 1/2, 1}}
]

Figure 7.6

a = -2; b = -1; c = 1; d = -2;
PlotVectorField[{a x1 + b x2, c x1 + d x2}, {x1, -1, 
        1}, {x2, -1, 1}, Axes -> True, ScaleFactor ->  .45, 
      AspectRatio -> 1, 
      PlotRange -> {{-1, 1}, {-1, 1}}]

a = 2; b = -1; c = 1; d = 2;
PlotVectorField[{a x1 + b x2, c x1 + d x2}, {x1, -1, 
        1}, {x2, -1, 1}, Axes -> True, ScaleFactor ->  .45, 
      AspectRatio -> 1, 
      PlotRange -> {{-1, 1}, {-1, 1}}]

PlotVectorField[{a x1 + b x2, c x1 + d x2}, {x1, -1, 
        1}, {x2, -1, 1}, Axes -> True, ScaleFactor ->  .45, 
      AspectRatio -> 1, 
      PlotRange -> {{-1, 1}, {-1, 1}}]

Figure 7.7a

mat1 = {{0.1, 0.5}, {0.6, 0.3}};
Eigenvalues[mat1] // N

tab1 = Table[MatrixPower[mat1, i] . {1, 1}, {i, 0, 15}];

DisplayTogether[
      ListPlot[tab1, 
        Epilog -> {Arrow[{0, -0.4} + {1, 1}, {0, -0.4} + 
                mat1 . mat1 . mat1 . {1, 1}]}, 
        PlotStyle -> PointSize[0.02]], 
      ListPlot[tab1, 
        PlotJoined -> 
          True], 
PlotRange -> {{-3, 3}, {-3, 
            3}}, Ticks -> None, AspectRatio -> 0.7]

mat2 = {{1.15, 0.5}, {-1, 0.25}};
Eigenvalues[mat2] // N
Abs[%]

tab2 = Table[MatrixPower[mat2, i] . {1, 1}, {i, 0, 15}];

DisplayTogether[
      ListPlot[tab2, 
        Epilog -> {Arrow[{0.3, 0} + {1, 1}, {0.3, 0} + mat2 . {1, 1}]}, 
        PlotStyle -> PointSize[0.02]], 
      ListPlot[tab2, 
        PlotJoined -> 
          True], 
PlotRange -> {{-3, 3}, {-3, 
            3}}, Ticks -> None, AspectRatio -> 0.7]

mat3 = {{0.75, 0.5}, {-1, 0.75}};
Eigenvalues[mat3] // N
Abs[%]

tab3 = Table[MatrixPower[mat3, i] . {1, 1}, {i, 0, 15}];

DisplayTogether[
      ListPlot[tab3, 
        Epilog -> {Arrow[{-0.3, 0} + {1, 1}, {-0.3, 0} + 
                mat3 . {1, 1}]}, PlotStyle -> PointSize[0.02]], 
      ListPlot[tab3, 
        PlotJoined -> 
          True], 
PlotRange -> {{-3, 3}, {-3, 
            3}}, Ticks -> None, AspectRatio -> 0.7]

mat4 = {{0.75, 0.5}, {0.4, 0.75}};
Eigenvalues[mat4] // N
Abs[%]

tab4 = Table[MatrixPower[mat4, i] . {1, 1}, {i, 0, 15}];

DisplayTogether[
      ListPlot[tab4, 
        Epilog -> {Arrow[{0, 0.5} + {1, 1}, {0, 0.5} + 
                mat4 . mat4 . {1, 1}]}, PlotStyle -> PointSize[0.02]], 
      ListPlot[tab4, 
        PlotJoined -> 
          True], 
PlotRange -> {{-3, 3}, {-3, 
            3}}, Ticks -> None, AspectRatio -> 0.7]

Figure 7.7b

mat1 = {{0.1, -0.1}, {-0.01, 
            0.03}};
Eigensystem[mat1] // N

a =  .1; b = -0.1; c = -0.01; 
    d = 0.03;
zinit = 1; pinit = 1;
tmax = 100;
result = 
        NDSolve[{z'[t] == a z[t] + b p[t], p'[t] == 
              c z[t] + d p[t], z[0] == zinit, 
            p[0] == pinit}, {z, p}, {t, 0, tmax}, 
          MaxSteps -> 100000];
DisplayTogether[
ParametricPlot[
        Evaluate[{z[t], p[t]} /. result], {t, 0, tmax}, 
        AspectRatio -> Automatic, 
        PlotRange -> {{-3, 3}, {-3, 3}}, 
        PlotStyle -> Thickness[ .01], Ticks -> None, 
        AspectRatio -> 0.7]
]

mat2 = {{-0.1, -0.1}, {-0.1, -0.2}};
Eigenvalues[mat2] // N

a = - .1; b = -0.1; c = -0.1; 
    d = -0.2;
zinit = 1; pinit = 1;
tmax = 100;
result = 
        NDSolve[{z'[t] == a z[t] + b p[t], p'[t] == 
              c z[t] + d p[t], z[0] == zinit, 
            p[0] == pinit}, {z, p}, {t, 0, tmax}, 
          MaxSteps -> 100000];
DisplayTogether[
ParametricPlot[
        Evaluate[{z[t], p[t]} /. result], {t, 0, tmax}, 
        AspectRatio -> Automatic, 
        PlotRange -> {{-3, 3}, {-3, 3}}, 
        PlotStyle -> Thickness[ .01], Ticks -> None, 
        AspectRatio -> 0.7]
]

mat3 = {{-0.05, 
            0.1}, {-0.3, -0.05}};
Eigenvalues[mat3] // N
Re[%]

a = - .05; b = 0.1; c = -0.3; 
    d = -0.05;
zinit = 1; pinit = 1;
tmax = 100;
result = 
        NDSolve[{z'[t] == a z[t] + b p[t], p'[t] == 
              c z[t] + d p[t], z[0] == zinit, 
            p[0] == pinit}, {z, p}, {t, 0, tmax}, 
          MaxSteps -> 100000];
DisplayTogether[
ParametricPlot[
        Evaluate[{z[t], p[t]} /. result], {t, 0, tmax}, 
        AspectRatio -> Automatic, 
        PlotRange -> {{-3, 3}, {-3, 3}}, 
        PlotStyle -> Thickness[ .01], Ticks -> None, 
        AspectRatio -> 0.7]
]

mat4 = {{0.01, 0.1}, {-0.3, 0.01}};
Eigenvalues[mat4] // N
Re[%]

a =  .01; b = 0.1; c = -0.3; d = 0.01;
zinit = 1; pinit = 1;
tmax = 50;
result = 
        NDSolve[{z'[t] == a z[t] + b p[t], p'[t] == 
              c z[t] + d p[t], z[0] == zinit, 
            p[0] == pinit}, {z, p}, {t, 0, tmax}, 
          MaxSteps -> 100000];
DisplayTogether[
ParametricPlot[
        Evaluate[{z[t], p[t]} /. result], {t, 0, tmax}, 
        AspectRatio -> Automatic, 
        PlotRange -> {{-3, 3}, {-3, 3}}, 
        PlotStyle -> Thickness[ .01], Ticks -> None, 
        AspectRatio -> 0.7]
]

Figure 7.8-NA

Figure 7.9

a =  .8; gz =  .5; gp =  .4; B =  .2; c =  .9; b =  .5; 
    tmax = 100;
zinit = -7.55; pinit = 7.55;
tmax = 100;
result = 
        NDSolve[{z'[t] == 
              gz (-c z[t] + a p[t]) - B (b p[t]), p'[
                t] == 
              B (-c z[t] + a p[t]) - gp (b p[t]), 
            z[0] == zinit, p[0] == pinit}, {z, p}, {t, 0, tmax}, 
          MaxSteps -> 100000];
DisplayTogether[
PlotVectorField[{(-gz c) z + (gz a - b B) p, (-B c) z + (-gp b + 
                  a B) p}, {z, -10, 10}, {p, -10, 10}, 
        Axes -> True, ScaleFactor -> 5, AspectRatio -> 1, 
        PlotRange -> {{-10, 10}, {-10, 
              10}}], 
ParametricPlot[
        Evaluate[{z[t], p[t]} /. result], {t, 0, tmax}, 
        AspectRatio -> Automatic, 
        PlotRange -> {{-10, 10}, {-10, 10}}, 
        PlotStyle -> Thickness[ .01]]
]

a =  .8; gz =  .5; gp =  .4; B =  .2; c =  .9; b =  .5; 
    zinit = -7.55; pinit = 7.55; tmax = 100;
result = 
      NDSolve[{z'[t] == 
            gz (-c z[t] + a p[t]) - B (b p[t]), p'[
              t] == 
            B (-c z[t] + a p[t]) - gp (b p[t]), 
          z[0] == zinit, p[0] == pinit}, {z, p}, {t, 0, tmax}, 
        MaxSteps -> 100000]
Plot[Evaluate[{z[t], p[t]} /. result], {t, 0, tmax}, 
      PlotRange -> {{0, 20}, {-10, 10}}, 
      PlotStyle -> {Dashing[{0}], Dashing[{ .01}]}]

a = 5; gz =  .5; gp =  .4; B =  .2; c =  .9; b =  .5; zinit = - .1; 
    pinit =  .1; tmax = 100;
result = 
        NDSolve[{z'[t] == 
              gz (-c z[t] + a p[t]) - B (b p[t]), p'[
                t] == 
              B (-c z[t] + a p[t]) - gp (b p[t]), 
            z[0] == zinit, p[0] == pinit}, {z, p}, {t, 0, tmax}, 
          MaxSteps -> 100000];
DisplayTogether[
ParametricPlot[
        Evaluate[{z[t], p[t]} /. result], {t, 0, tmax}, 
        AspectRatio -> Automatic, 
        PlotRange -> {{-10, 10}, {-10, 10}}, 
        PlotStyle -> 
          Thickness[ .01]], 
PlotVectorField[{(-gz c) z + (gz a - b B) p, (-B c) z + (-gp b + 
                  a B) p}, {z, -10, 10}, {p, -10, 10}, 
        Axes -> True, ScaleFactor -> 5, AspectRatio -> 1, 
        PlotRange -> {{-10, 10}, {-10, 
              10}}]
]

a = 5; gz =  .5; gp =  .4; B =  .2; c =  .9; b =  .5; zinit = - .1; 
    pinit =  .1; tmax = 100;
result = 
      NDSolve[{z'[t] == 
            gz (-c z[t] + a p[t]) - B (b p[t]), p'[
              t] == 
            B (-c z[t] + a p[t]) - gp (b p[t]), 
          z[0] == zinit, p[0] == pinit}, {z, p}, {t, 0, tmax}, 
        MaxSteps -> 100000]
Plot[Evaluate[{z[t], p[t]} /. result], {t, 0, tmax}, 
      PlotRange -> {{0, 50}, {-500, 2000}}, 
      PlotStyle -> {Dashing[{0}], Dashing[{ .01}]}]

Figure 7.10-NA

Figure 7.1.1

a = 2; b = 1; c = 1; d = -1;
DisplayTogether[
Plot[{(-a/b)*
            x, (-c/d)*x}, {x, -1, 1}, AspectRatio -> 1, 
        PlotRange -> {{-1, 1}, {-1, 1}}, 
        PlotStyle -> {{Dashing[{ .025}], 
              Thickness[ .0075]}, {Dashing[{ .025}], 
              Thickness[ .0075]}}], 
Plot[{(1/(-((-a + d + (Sqrt[(a^2) + 4 b c - 2 a d + (d^2)]))/(2 c)))) x, 
          (1/(-((-a + d - (Sqrt[(a^2) + 4 b c - 2 a d + (d^2)]))/(2 c)))) x}, {x, -1, 1}, AspectRatio -> 1, 
        PlotRange -> {{-1, 1}, {-1, 1}}, 
        PlotStyle -> {{Dashing[{0}], Thickness[ .0075]}, {Dashing[{0}], 
              Thickness[ .0075]}}], 
PlotVectorField[{a x1 + b x2, c x1 + d x2}, {x1, -1, 1}, {x2, -1, 1}, Axes -> True, 
        ScaleFactor ->  .45, AspectRatio -> 1, 
        PlotRange -> {{-1, 1}, {-1, 
              1}}]
]