Needs["DiscreteMath`RSolve`"]

Needs["Graphics`Graphics3D`"]

Needs["Graphics`PlotField3D`"]

Question 8

Although this question asks to use a spreadsheet, we shall here use Mathematica to plot the trajectories. First we solve for the equilibrium values of the instrumental variables, r and g.

Solve[{r == -3.925 + 0.5  g, r == 7.958 + 0.186  g}, {r, 
        g}]

First we shall simply list the computations for g[t] and r[t] for each of the initial conditions. This requires us to solve the systems of difference equations for each initial condition. We do this for ten periods.

(a)

sol81 = 
      RSolve[{g[t + 1] == g[t] - 0.5 (g[t] - 37.8439), 
          r[t + 1] == r[t] - 0.75 (r[t] - 14.997), g[0] == 20, 
          r[0] == 12}, {g[t], r[t]}, t]

path81 = 
        Table[{t, sol81[[1, 1, 2]], sol81[[1, 2, 2]]}, {t, 0, 
            10}];
TableForm[path81, 
      TableHeadings -> {{}, {"t", "g[t]", "r[t]"}}]

(b)

sol82 = 
      RSolve[{g[t + 1] == g[t] - 0.5 (g[t] - 37.8439), 
          r[t + 1] == r[t] - 0.75 (r[t] - 14.997), g[0] == 20, 
          r[0] == 20}, {g[t], r[t]}, t]

path82 = 
        Table[{t, sol82[[1, 1, 2]], sol82[[1, 2, 2]]}, {t, 0, 
            10}];
TableForm[path82, 
      TableHeadings -> {{}, {"t", "g[t]", "r[t]"}}]

(c)

sol83 = 
      RSolve[{g[t + 1] == g[t] - 0.5 (g[t] - 37.8439), 
          r[t + 1] == r[t] - 0.75 (r[t] - 14.997), g[0] == 50, 
          r[0] == 10}, {g[t], r[t]}, t]

path83 = 
        Table[{t, sol83[[1, 1, 2]], sol83[[1, 2, 2]]}, {t, 0, 
            10}];
TableForm[path83, 
      TableHeadings -> {{}, {"t", "g[t]", "r[t]"}}]

(d)

sol84 = 
      RSolve[{g[t + 1] == g[t] - 0.5 (g[t] - 37.8439), 
          r[t + 1] == r[t] - 0.75 (r[t] - 14.997), g[0] == 50, 
          r[0] == 20}, {g[t], r[t]}, t]

path84 = 
        Table[{t, sol84[[1, 1, 2]], sol84[[1, 2, 2]]}, {t, 0, 
            10}];
TableForm[path84, 
      TableHeadings -> {{}, {"t", "g[t]", "r[t]"}}]

It is already apparent from each of these tables that the trajectories converge on the equilibrium values. To show this more clearly we place each of the trajectories in the (g,r)-space along with the "target lines".

(a)

points81 = 
        Table[{sol81[[1, 1, 2]], sol81[[1, 2, 2]]}, {t, 0, 
            10}];

traj81 = 
        ListPlot[points81, PlotJoined -> True, 
          DisplayFunction -> Identity];

(b)

points82 = 
        Table[{sol82[[1, 1, 2]], sol82[[1, 2, 2]]}, {t, 0, 
            10}];

traj82 = 
        ListPlot[points82, PlotJoined -> True, 
          DisplayFunction -> Identity];

(c)

points83 = 
        Table[{sol83[[1, 1, 2]], sol83[[1, 2, 2]]}, {t, 0, 
            10}];

traj83 = 
        ListPlot[points83, PlotJoined -> True, 
          DisplayFunction -> Identity];

(d)

points84 = 
        Table[{sol84[[1, 1, 2]], sol84[[1, 2, 2]]}, {t, 0, 
            10}];

traj84 = 
        ListPlot[points84, PlotJoined -> True, 
          DisplayFunction -> Identity];

targetlines = 
        Plot[{-3.925 + 0.5  g, 7.958 + 0.186  g}, {g, 0, 50}, 
          DisplayFunction -> Identity, 
          PlotStyle -> {RGBColor[1, 0, 0]}];

Show[{traj81, traj82, traj83, traj84, targetlines}, 
        AxesLabel -> {"g", "r"}, 
        DisplayFunction -> $DisplayFunction];

Question 9

If interest rates are set to achieve internal balance and government spending to achieve external balance, then the set of equations are:
	\(TraditionalForm
      \`g\_\(t + 1\) = \(-21.3925\) + 0.5  g\_t + 2.688  r\_t\)\(TraditionalForm
      \`r\_\(t + 1\) = \(-2.94375\) + 0.375  g\_t + 0.25  r\_t\)

(a) Four initial points, one in each quadrant.

We consider four initial points as follows:
	((Subscript[g, 0]), (Subscript[r, 0])) = (20, 20)	Quadrant I
	((Subscript[g, 0]), (Subscript[r, 0])) = (50, 20)	Quadrant II
	((Subscript[g, 0]), (Subscript[r, 0])) = (20, 40)	Quadrant III
	((Subscript[g, 0]), (Subscript[r, 0])) = (20, 10)	Quadrant IV
which are determined by the following two target lines:
	r = -3.925 + 0.5  gg = -42.785 + 5.376  r
and equilibrium points:

Solve[{r == -3.925 + 0.5  g, g == -42.785 + 5.376  r}, {g, 
        r}]

targetlines = 
        Plot[{-3.925 + 
              0.5  g, (42.785/5.376) + (1/5.376) g}, {g, -40, 
            100}];

result1 = 
      RSolve[{g[t + 1] == -21.3925 + 0.5  g[t] + 2.688  r[t], 
          r[t + 1] == -2.94375 + 0.375  g[t] + 0.25  r[t], g[0] == 20, 
          r[0] == 20}, {g[t], r[t]}, t]

points91 = 
        Table[{result1[[1, 1, 2]], result1[[1, 2, 2]]}, {t, 0, 
            10}];

\(\(traj91 = 
        ListPlot[points91, PlotJoined -> True, 
          DisplayFunction -> Identity, 
	
          PlotStyle -> {RGBColor[1, 0, 0]}];\)\)

Show[{targetlines, traj91}, DisplayFunction -> $DisplayFunction, 
        AxesLabel -> {"g", "r"}];

result2 = 
      RSolve[{g[t + 1] == -21.3925 + 0.5  g[t] + 2.688  r[t], 
          r[t + 1] == -2.94375 + 0.375  g[t] + 0.25  r[t], g[0] == 50, 
          r[0] == 20}, {g[t], r[t]}, t]

points92 = 
        Table[{result2[[1, 1, 2]], result2[[1, 2, 2]]}, {t, 0, 
            10}];

\(\(traj92 = 
        ListPlot[points92, PlotJoined -> True, 
          DisplayFunction -> Identity, 
	
          PlotStyle -> {RGBColor[1, 0, 0]}];\)\)

Show[{targetlines, traj92}, DisplayFunction -> $DisplayFunction, 
        AxesLabel -> {"g", "r"}];

result3 = 
      RSolve[{g[t + 1] == -21.3925 + 0.5  g[t] + 2.688  r[t], 
          r[t + 1] == -2.94375 + 0.375  g[t] + 0.25  r[t], g[0] == 40, 
          r[0] == 5}, {g[t], r[t]}, t]

points93 = 
        Table[{result3[[1, 1, 2]], result3[[1, 2, 2]]}, {t, 0, 
            10}];

\(\(traj93 = 
        ListPlot[points93, PlotJoined -> True, 
          DisplayFunction -> Identity, 
	
          PlotStyle -> {RGBColor[1, 0, 0]}];\)\)

Show[{targetlines, traj93}, DisplayFunction -> $DisplayFunction, 
        AxesLabel -> {"g", "r"}];

result4 = 
      RSolve[{g[t + 1] == -21.3925 + 0.5  g[t] + 2.688  r[t], 
          r[t + 1] == -2.94375 + 0.375  g[t] + 0.25  r[t], g[0] == 20, 
          r[0] == 10}, {g[t], r[t]}, t]

points94 = 
        Table[{result4[[1, 1, 2]], result4[[1, 2, 2]]}, {t, 0, 
            10}];

\(\(traj94 = 
        ListPlot[points94, PlotJoined -> True, 
          DisplayFunction -> Identity, 
	
          PlotStyle -> {RGBColor[1, 0, 0]}];\)\)

Show[{targetlines, traj94}, DisplayFunction -> $DisplayFunction, 
        AxesLabel -> {"g", "r"}];

(b) Sectors I and III

We shall consider just two points in each of the two sectors as follows:
	((Subscript[g, 0]), (Subscript[r, 0])) = (20, 30)	((Subscript[g, 0]), (Subscript[r, 0])) = (40, 40)	for Sector I
	((Subscript[g, 0]), (Subscript[r, 0])) = (40, 5)	((Subscript[g, 0]), (Subscript[r, 0])) = (80, 5)	for Sector III

result5 = 
      RSolve[{g[t + 1] == -21.3925 + 0.5  g[t] + 2.688  r[t], 
          r[t + 1] == -2.94375 + 0.375  g[t] + 0.25  r[t], g[0] == 20, 
          r[0] == 30}, {g[t], r[t]}, t]

points95 = 
        Table[{result5[[1, 1, 2]], result5[[1, 2, 2]]}, {t, 0, 
            10}];

\(\(traj95 = 
        ListPlot[points95, PlotJoined -> True, 
          DisplayFunction -> Identity, 
	
          PlotStyle -> {RGBColor[1, 0, 0]}];\)\)

result6 = 
      RSolve[{g[t + 1] == -21.3925 + 0.5  g[t] + 2.688  r[t], 
          r[t + 1] == -2.94375 + 0.375  g[t] + 0.25  r[t], g[0] == 40, 
          r[0] == 40}, {g[t], r[t]}, t]

points96 = 
        Table[{result6[[1, 1, 2]], result6[[1, 2, 2]]}, {t, 0, 
            10}];

\(\(traj96 = 
        ListPlot[points96, PlotJoined -> True, 
          DisplayFunction -> Identity, 
	
          PlotStyle -> {RGBColor[0, 0, 1]}];\)\)

Show[{targetlines, traj95, traj96}, 
        DisplayFunction -> $DisplayFunction, 
        AxesLabel -> {"g", "r"}];

result7 = 
      RSolve[{g[t + 1] == -21.3925 + 0.5  g[t] + 2.688  r[t], 
          r[t + 1] == -2.94375 + 0.375  g[t] + 0.25  r[t], g[0] == 40, 
          r[0] == 5}, {g[t], r[t]}, t]

points97 = 
        Table[{result7[[1, 1, 2]], result7[[1, 2, 2]]}, {t, 0, 
            10}];

\(\(traj97 = 
        ListPlot[points97, PlotJoined -> True, 
          DisplayFunction -> Identity, 
	
          PlotStyle -> {RGBColor[1, 0, 0]}];\)\)

result8 = 
      RSolve[{g[t + 1] == -21.3925 + 0.5  g[t] + 2.688  r[t], 
          r[t + 1] == -2.94375 + 0.375  g[t] + 0.25  r[t], g[0] == 80, 
          r[0] == 5}, {g[t], r[t]}, t]

points98 = 
        Table[{result8[[1, 1, 2]], result8[[1, 2, 2]]}, {t, 0, 
            10}];

\(\(traj98 = 
        ListPlot[points98, PlotJoined -> True, 
          DisplayFunction -> Identity, 
	
          PlotStyle -> {RGBColor[0, 0, 1]}];\)\)

Show[{targetlines, traj97, traj98}, 
        DisplayFunction -> $DisplayFunction, 
        AxesLabel -> {"g", "r"}];

(c) A point on the stable arm

The stable and unstable arms of the saddle point can be obtained from the Eigenvectors of the system defined by the following matrix:
	(({{0.5, 2.688}, {0.375, 0.25}}))

matrixA9=(({{0.5, 2.688}, {0.375, 0.25}}))

Eigenvalues[matrixA9]

Eigenvectors[matrixA9]

Taking a unit value in the g-direction, we obtain the following values for r. These values represent points on the stable and unstable arms, where the positive value is on the unstable arm and the negative value on the stable arm, as can be seen in terms of Figure 5.17 (p.242) of the text.

{{1, 0.313283/0.94966}, {1, -0.389498/0.921027}}

The equation for the stable arm is then,
	14.9985 - 0.422895 (g - 37.847)
We shall consider two points, one in quadrant I and a second in quadrant III. The first is determined by g = 20 and the second by g = 50

targetlines2 = 
        Plot[{-3.925 + 0.5  g, (42.785/5.376) + (1/5.376) g}, {g, 
            0, 80}];

{{20, 14.9985 - 0.422895 (20 - 37.847)}, {50, 
        14.9985 - 0.422895 (50 - 37.847)}}

result9 = 
      RSolve[{g[t + 1] == -21.3925 + 0.5  g[t] + 2.688  r[t], 
          r[t + 1] == -2.94375 + 0.375  g[t] + 0.25  r[t], g[0] == 20, 
          r[0] == 22.5459}, {g[t], r[t]}, t]

points99 = 
        Table[{result9[[1, 1, 2]], result9[[1, 2, 2]]}, {t, 0, 
            10}];

\(\(traj99 = 
        ListPlot[points99, PlotJoined -> True, 
          DisplayFunction -> Identity, 
	
          PlotStyle -> {RGBColor[1, 0, 0]}];\)\)

result10 = 
      RSolve[{g[t + 1] == -21.3925 + 0.5  g[t] + 2.688  r[t], 
          r[t + 1] == -2.94375 + 0.375  g[t] + 0.25  r[t], g[0] == 50, 
          r[0] == 9.85906}, {g[t], r[t]}, t]

points910 = 
        Table[{result10[[1, 1, 2]], result10[[1, 2, 2]]}, {t, 0, 
            10}];

\(\(traj910 = 
        ListPlot[points910, PlotJoined -> True, 
          DisplayFunction -> Identity, 
	
          PlotStyle -> {RGBColor[0, 0, 1]}];\)\)

Show[{targetlines2, traj99, traj910}, 
        DisplayFunction -> $DisplayFunction, 
        AxesLabel -> {"g", "r"}];

Question 10

We have the system of equations:
	\(TraditionalForm
      \`g\_\(t + 1\) = \(-1.875\) + 0.25  g\_t + 0.375  S\_t\)(Subscript[S, t + 1]) = 10 - 2  (Subscript[g, t]) + 0.2  (Subscript[S, t])
and we have the target equilibrium lines:
	\(TraditionalForm\`\(g\_t\%*\) = \(-2.5\) + 0.5  S\_t\)\(TraditionalForm\`\(S\_t\%*\) = 20 - 4  g\_t\)

(a)

result10 = 
      RSolve[{g[t + 1] == -1.875 + 0.25  g[t] + 0.375  s[t], 
          s[t + 1] == 10 - 2  g[t] + 0.2  s[t], g[0] == 2.5, 
          s[0] == 12}, {g[t], s[t]}, t]

points101 = 
        Table[{result10[[1, 1, 2]], result10[[1, 2, 2]]}, {t, 0, 
            10}];

traj101 = 
        ListPlot[points101, PlotJoined -> True, 
          DisplayFunction -> Identity];

(b)

result102 = 
      RSolve[{g[t + 1] == -1.875 + 0.25  g[t] + 0.375  s[t], 
          s[t + 1] == 10 - 2  g[t] + 0.2  s[t], g[0] == 3, 
          s[0] == 10}, {g[t], s[t]}, t]

points102 = 
        Table[{result102[[1, 1, 2]], result102[[1, 2, 2]]}, {t, 0, 
            10}];

traj102 = 
        ListPlot[points102, PlotJoined -> True, DisplayFunction -> Identity, 
          PlotStyle -> {RGBColor[1, 0, 0]}];

(c)

result103 = 
      RSolve[{g[t + 1] == -1.875 + 0.25  g[t] + 0.375  s[t], 
          s[t + 1] == 10 - 2  g[t] + 0.2  s[t], g[0] == 1, s[0] == 5}, {g[t], 
          s[t]}, t]

points103 = 
        Table[{result103[[1, 1, 2]], result103[[1, 2, 2]]}, {t, 0, 
            10}];

traj103 = 
        ListPlot[points103, PlotJoined -> True, DisplayFunction -> Identity, 
          PlotStyle -> {RGBColor[0, 1, 0]}];

(d)

result104 = 
      RSolve[{g[t + 1] == -1.875 + 0.25  g[t] + 0.375  s[t], 
          s[t + 1] == 10 - 2  g[t] + 0.2  s[t], g[0] == 1, 
          s[0] == 12}, {g[t], s[t]}, t]

points104 = 
        Table[{result104[[1, 1, 2]], result104[[1, 2, 2]]}, {t, 0, 
            10}];

traj104 = 
        ListPlot[points104, PlotJoined -> True, DisplayFunction -> Identity, 
          PlotStyle -> {RGBColor[0, 0, 1]}];

targetlines10 = 
        Plot[{5 + 2  g, 20 - 4  g}, {g, 0, 5}, 
          DisplayFunction -> Identity];

Show[{targetlines10, traj101, traj102, traj103, traj104}, 
        AxesLabel -> {"g", "S"}, 
        DisplayFunction -> $DisplayFunction];

This plot readily shows all trajectories converging on the equilibrium - but very slowly.

Question 11

mA := {{2, 3}, {1, -2}}

mB := {{4, -2}, {1, -1}}

mC := {{3, 2, 1}, {-1, 0, 3}}

mA . mB  // MatrixForm

Tr[mA . mB]

Det[mA . mB]

Transpose[mA . mC]  // MatrixForm

Inverse[mB]  // MatrixForm

Eigenvalues[mA]

Eigenvalues[mB]

Eigenvectors[mA]

Eigenvectors[mB]

CharacteristicPolynomial[mA, λ]

Question 12

Solve the following system
	(Subscript[x, t + 1]) = -5 + (Subscript[x, t]) - 2  (Subscript[y, t])
(Subscript[y, t + 1]) = 4 + (Subscript[x, t]) - (Subscript[y, t])
(Subscript[x, 0]) = 1,  (Subscript[y, 0]) = 2

Solve[{x == -5 + x - 2  y, y == 4 + x - y}, {x, 
        y}]

sol = 
      RSolve[{x[t + 1] == -5 + x[t] - 2  y[t], 
          y[t + 1] == 4 + x[t] - y[t], x[0] == 1, 
          y[0] == 2}, {x[t], y[t]}, t]

solx = -9 + (5 + (I/2)) (((-I))^t) + (5 - (I/2)) (I^t)

soly = ((1/4) + (I/4)) ((-5 + 
                5 I) + (10 + I) (((-I))^t) - (1 + 
                  10 I) (I^t))

dataset = Table[{solx, soly}, {t, 0, 10}]

ListPlot[dataset, PlotJoined -> True];

Question 13

mA := {{1, -2}, {1, -1}}

{V, 
        J}=JordanDecomposition[{{1, -2}, {1, -1}}]

MatrixForm  /@  {V, J}

Inverse[V] . mA . V

Question 14

We have already solved for the fixed point in question 12 and shown that for this model the system is cyclical. The question is specifically to set up the problem on a spreadsheet to show that the same cyclical pattern results.

Question 15

Clear[mA, V, J]

Solve[{x == 5.6 - 0.4  x, y == 3.5 + 0.4  x - 0.5  y}, {x, 
        y}]

mA := {{-0.4, 0}, {0.4, -0.5}}

{V, J} = JordanDecomposition[mA]

MatrixForm  /@  {V, J}

Inverse[V] . mA . V

Even if we evaluate

V . mA . Inverse[V]

We do not arrive at the matrix J. There appears to be a flaw in the JordanDecomposition programme of Mathematica. The correct matrix V is

newV := {{1, 0}, {4, -4}}

To verify this

Inverse[newV] . mA . newV

We shall pursue the answer with newV.

u0 := {{2}, {1}}

Inverse[newV] . u0

Eigenvalues[mA]

ustar := {{4}, {3.4}}

u0Minusustar = u0 - ustar

Inverse[newV] . u0Minusustar

Although the question requires the problem to be set up on a spreadsheet, we shall here use Mathematica to set out the plots of the original system and its canonical form.

sol15 = 
      RSolve[{x[t] == 5.6 - 0.4  x[t - 1], 
          y[t] == 3.5 + 0.4  x[t - 1] - 0.5  y[t - 1], x[0] == 2, 
          y[0] == 1}, {x[t], y[t]}, t]

\(solx = \(-2.5`\)\ \((0.7999999999999998`\ \((\(-0.4`\))\)\^t - 
            1.5999999999999996`\ 0.9999999999999999`\^t)\)\)

\(soly = \(-5.`\)\ \((2.133333333333333`\ \((\(-0.5000000000000001`\))\)\^t - 1.885714285714285`\ \((\(-0.4`\))\)\^t - 
            0.44761904761904764`\ 1.`\^t + 
            2.44`\ If[
                t ≥ 
                  2, \(-1.3333333333333324`\)\ \((\(-0.5000000000000001`\))\)\^t + 1.4285714285714277`\ \((\(-0.4`\))\)\^t - 0.09523809523809523`\ 1.`\^t, 
                0])\)\)

dataset1 = Table[{solx, soly}, {t, 0, 10}]

ListPlot[dataset1, PlotJoined -> True];

dataset2 = 
      Table[{(((-0.4))^t) 2, (((-0.5))^t) 1.75}, {t, 0, 
          10}]

ListPlot[dataset2, PlotJoined -> True];

Both the original plot and the canonical form indicates that the system is asmptotically stable.