Rich Nations, Poor Nations: How much can multiple equilibria explain? (STABILITY FIGURES)
Bryan Graham, University of California - Berkeley
Jon Temple, Bristol University

This Mathematica notebook includes the code required to replicate Figures 1 and 6 in Graham and Temple (2004). These are the figures that accompany our discussion of equilibrium stability in the main text and Appendix A of the paper. The code was executed in Mathematica 3.0. Please report any errors or suggestions for improvement to me by e-mail at:

bgraham@econ.berkeley.edu
or by mail at:

Department of Economics
University of California - Berkeley
549 Evans Hall #3880
Berkeley, CA 94720

I regret that I cannot provide any support to potential users. However, feel free to modify and use the code as you wish for any noncommerical purposes, just please cite our paper.

Thanks,

Bryan Graham

SetDirectory["c:\BSG_WORK\Research\RichPoorPaper"]

Basic dynamic and stability properties of the forward looking model (Figure 6)

This set of commands leads up to a reproduction of Figure 6 of Appendix A in the paper.

\(<< \ Graphics`ImplicitPlot`
<< Graphics`PlotField`\)

$TextStyle = {FontFamily -> "Courier"}

aw[α_, β_, K_, NT_, Aa_, H_, C_, L_] := 
      (1 - α - β) (((K - C))^α) (L^β) 
        ((( Aa*H*(NT - M)))^(1 - α - β - 1))ar[α_, β_, K_, NT_, Aa_, H_, C_, L_] := 
      α  (((K - C))^(α - 1)) (L^β) 
        (((Aa*H*(NT - M)))^((1 - α - β)))

\(mw[γ_, λ_, Am_, H_, C_, L_] := 
      \((1 - γ)\) 
        \((\(C\^γ\) 
              \((Am*H*M)\)\^\(1 - γ - 1\/\(1 + λ\)\))\)\^\(1 + 
            λ\)
\)mr[γ_, λ_, Am_, H_, C_, L_] := 
      ((γ 
          ((((C^γ) (((Am*H*M))^((1 - γ)))))^(1 + 
              λ)))/C)

Set parameter values for numerical simulation.

\(α = 0.4; 
β = 0.2; 
γ = 0.35; 
λ = 0.3; 
    
η1 = 25; 
η2 = 200; 
Aa = 1.0; 
Am = 1.0; 
K = 20; 

    NT = 100; 
L = 5; 
σ = 0.1; 
F = 2400; 
H = 1; \)

en[η1_, η2_, F_] := 
      η1 μ - η(1/η)2 (M + F)eμ[α_, β_, γ_, λ_, K_, NT_, Aa_, Am_, 
        H_, σ_, C_, L_] := 
      σ μ - 
        ((1 - γ) 
              ((((C^γ) 
                    (((Am*H*M))^(1 - γ - (1/(1 + λ)))))
                  )^(1 + λ)) - 
            (1 - α - β) (((K - C))^α) 
              (L^β) 
              ((( Aa*H*(NT - M)))^(1 - α - β - 1)))

FC[M_, α_, β_, K_, NT_, Aa_, H_, γ_, λ_, 
        Am_, L_] := 
      C  /.  FindRoot[
          α  (((K - C))^(α - 1)) (L^β) 
              (((Aa*H*(NT - M)))^((1 - α - β))) == 
            ((γ 
                ((((C^γ) (((Am*H*M))^((1 - γ)))))^(1 + 
                    λ)))/C), {C, 0.5}, WorkingPrecision -> 15, 
          MaxIterations -> 1000]

Approximate phase diagram isoclines with a 5th order polynomial. Figure below shows that the approximation is good.

ApproximationData = 
      Table[If[j == 2,  
          C  /.  FindRoot[{
                ar[α, β, K, NT, Aa, H, C, L] == 
                  mr[γ, λ, Am, H, C, L]}, {C, 0.5}, 
              WorkingPrecision -> 15, MaxIterations -> 1000], M], {M, 1, 77, 
          0.01}, {j, 1, 2, 1}];

\(TAppC = 
      Fit[ApproximationData, {1, M[t], M[t]\^2, M[t]\^3, M[t]\^4, M[t]\^5}, 
        M[t]]; 
AppC = 
      Fit[ApproximationData, {1, M, M\^2, M\^3, M\^4, M\^5}, M]; 


    MK1 := Plot[AppC, {M, 0.1, 79.9999}, PlotStyle -> RGBColor[1, 0, 0]]\)

MK2 := 
      ImplicitPlot[{
          ar[α, β, K, NT, Aa, H, C, L] == 
            mr[γ, λ, Am, H, C, L]}, {M, 0.0001, 79.9999}, {C, 
          0.0001, 19.9999}, PlotPoints -> 250, AspectRatio -> 1, 
        PlotStyle -> RGBColor[0, 0, 1]]

Show[{MK1, MK2}, Frame -> True, 
      FrameLabel -> {"Manufacturing employment, M", 
          "Manufacturing stock of capital, K", 
          "The C=g(Lm) implicit function and its approximating \
polynomial", ""}]

Draw phase diagram for forward looking model.

dn = 
      M'[t] == 
        η1 μ[t] - η(1/η)2 (M[t] + F)dμ = 
      μ'[t] == 
        σ*μ[t] - 
          ((1 - γ) 
                ((((TAppC^γ) 
                      (((Am*H*M[t]))^(1 - γ - 
                          (1/(1 + λ))))))^(1 + λ)) - 
              (1 - α - β) (((K - TAppC))^α) 
                (L^β) 
                ((( Aa*H*(NT - M[t])))^(1 - α - β - 1)))

figure1a := 
      ImplicitPlot[{en[η1, η2, F] == 0, 
          eμ[α, β, γ, λ, K, NT, Aa, Am, H, 
              σ, 
              FC[M, α, β, K, NT, Aa, H, γ, λ, Am, 
                L], L] == 0}, {M, 0.1, 77}, {μ, 11, 13}, 
        PlotPoints -> 50, AspectRatio -> 0.75, 
        PlotStyle -> {{Thickness[0.005], GrayLevel[0]}}]\(figure2a := 
      PlotVectorField[{en[η1, η2, F], 
          eμ[α, β, γ, λ, K, NT, Aa, Am, H, 
            σ, 
            FC[M, α, β, K, NT, Aa, H, γ, λ, Am, 
              L], L]}, 

        \ \ \ \ \ \ \ \ \ \ \ \ \ {M, 3, 75}, {μ, 11.15, 12.85}, 
        PlotPoints -> 15, ScaleFunction -> \((# + 10&)\)]\)\(Show[{figure1a, figure2a}, Frame -> True, \ 
      FrameLabel -> {\*""Manufacturing employment, (Subscript[L, m])"", 
          "Expected gains from agricultural-manufacturing migration, μ", "", ""}]\)

figure1b = 
      ImplicitPlot[{en[η1, η2, F] == 0, 
          eμ[α, β, γ, λ, K, NT, Aa, Am, H, 
              σ, AppC, L] == 0}, {M, 0.1, 79.9}, {μ, 11, 13}, 
        PlotPoints -> 50, AspectRatio -> 0.75, 
        PlotStyle -> {{Thickness[0.005], GrayLevel[0]}}]\(figure2b = 
      PlotVectorField[{en[η1, η2, F], 
          eμ[α, β, γ, λ, K, NT, Aa, Am, H, 
            σ, AppC, L]}, 

        \ \ \ \ \ \ \ \ \ \ \ \ \ {M, 3, 75}, {μ, 11.15, 12.85}, 
        PlotPoints -> 15, ScaleFunction -> \((# + 10&)\)]\)\(Show[{figure1b, figure2b}, Frame -> True, \ 
      FrameLabel -> {\*""Manufacturing employment, (Subscript[L, m])"", 
          "Expected gains from agricultural-manufacturing migration, μ", "", ""}]\)

Ml =  
      M  /.  First[
          FindRoot[{en[η1, η2, F], 
              eμ[α, β, γ, λ, K, NT, Aa, Am, 
                H, σ, AppC, L]}, {M, 5}, {μ, 2}]]μl =  
      μ  /.  
        Last[FindRoot[{en[η1, η2, F], 
              eμ[α, β, γ, λ, K, NT, Aa, Am, 
                H, σ, AppC, L]}, {M, 5}, {μ, 2}]]

Separatrix[tval_, M0_, μ0_, tmin_, tmax_]:=({M[t], μ[t]} /. First[NDSolve[{dn, dμ, M[0] == M0, μ[0] == μ0},{M[t], μ[t]},{t, tmin, tmax},AccuracyGoal -> 35]]) /. t -> tvalOff[InterpolatingFunction :: dmval]

Mh =  
      M  /.  First[
          FindRoot[{en[η1, η2, F], 
              eμ[α, β, γ, λ, K, NT, Aa, Am, 
                H, σ, AppC, L]}, {M, 75}, {μ, 2}]]μh =  
      μ  /. 
        Last[FindRoot[{en[η1, η2, F], 
              eμ[α, β, γ, λ, K, NT, Aa, Am, 
                H, σ, AppC, L]}, {M, 75}, {μ, 2}]]

\(separatrixPlot1a := 
      ParametricPlot[
        Evaluate[{Separatrix[t, 15.1, 12.2, \(-150\), 0]}], {t, \(-150\), 0}, 
        PlotRange -> {{0, 80.0}, {10, 14}}, 
        PlotStyle -> {{RGBColor[0, 0, 1], Thickness[0.005]}}]; 

    separatrixPlot1b := 
      ParametricPlot[
        Evaluate[{Separatrix[t, 15.1, 12.0, \(-160\), 0]}], {t, \(-160\), 0}, 
        PlotRange -> {{0, 80.0}, {10, 14}}, 
        PlotStyle -> {{RGBColor[0, 0, 1], Thickness[0.005]}}]; \)

\(separatrixPlot2a := 
      ParametricPlot[
        Evaluate[{Separatrix[t, 68, 12.34, \(-150\), 0]}], {t, \(-150\), 0}, 
        PlotRange -> {{0, 80.0}, {10, 14}}, 
        PlotStyle -> {{RGBColor[0, 0, 1], Thickness[0.005]}}]; 

    separatrixPlot2b := 
      ParametricPlot[
        Evaluate[{Separatrix[t, 67.7, 12.34, \(-150\), 0]}], {t, \(-150\), 
          0}, PlotRange -> {{0, 80.0}, {10, 14}}, 
        PlotStyle -> {{RGBColor[0, 0, 1], Thickness[0.005]}}]; \)

\(separatrixPlot2c := 
      ParametricPlot[
        Evaluate[{Separatrix[t, 67.6, 12.33, 0, 165]}], {t, 0, 165}, 
        PlotRange -> {{0, 80.0}, {10, 14}}, 
        PlotStyle -> {{RGBColor[0, 0, 1], Thickness[0.005]}}]; 

    separatrixPlot2d := 
      ParametricPlot[
        Evaluate[{Separatrix[t, 67.8, 12.34, 0, 165]}], {t, 0, 165}, 
        PlotRange -> {{0, 80.0}, {10, 14}}, 
        PlotStyle -> {{RGBColor[0, 0, 1], Thickness[0.005]}}]; \)

\(Show[{figure1b, figure2b, separatrixPlot1a, separatrixPlot1b, 
        separatrixPlot2a, separatrixPlot2b, separatrixPlot2c, 
        separatrixPlot2d}, Frame -> True, \ 
      FrameLabel -> {
          StyleForm[\*""Non-agricultural employment, \!\(L\_N\)"", 
            FontSize -> 14], 
          StyleForm["Expected NPV of gains from migration, q", 
            FontSize -> 14], "", ""}, 
      PlotRange -> {{0, 80.0}, {11, 13}}]\)

Some simple intuition about the source of multiple equilibria  (Figure 1)

This set of commands reproduces Figure 1 of the paper.

\(α = 0.4; 
β = 0.2; 
γ = 0.35; 
λ = 0.3; 
    
Aa = 1.0; 
Am = 1.0; 
K = 150; 
NT1 = 80; 
L1 = 20000; 
H = 1; 
    \)

\(WageCurves1 = 
      Plot[{mw[γ, λ, Am, H, 
            FC[M, α, β, K, NT1, Aa, H, γ, λ, Am, 
              L1], L1], 
          aw[α, β, K, NT1, Aa, H, 
            FC[M, α, β, K, NT1, Aa, H, γ, λ, Am, 
              L1], L1]}, {M, 0.01, 99.99}]; 

    WageCurves2 = 
      Show[{WageCurves1, 
          Graphics[
            Text[StyleForm[\*""\!\(\(L\_n\^*\)\)(low)"", 
                FontSize -> 14], {23, 1}, {\(-1\), 0}]], 
          Graphics[
            Text[StyleForm[\*""\!\(\(L\_n\^*\)\)(high)"", 
                FontSize -> 14], {70, 1}, {1, 0}]], 
          Graphics[
            Text[StyleForm[\*""\!\(w\_a\)(\!\(L\_n\);θ)"", 
                FontSize -> 14], {5, 1.75}, {\(-1\), 0}]], 
          Graphics[
            Text[StyleForm[\*""\!\(w\_n\)(\!\(L\_n\);θ)"", 
                FontSize -> 14], {9, 1}, {\(-1\), 0}]], 
          Show[Graphics[{Dashing[{0.01, 0.01}], 
                Line[{{21.75, 0}, {21.75, 7}}]}]], 
          Show[Graphics[{Dashing[{0.01, 0.01}], 
                Line[{{71.5, 0}, {71.5, 7}}]}]], 
          Show[Graphics[Arrow[{20, 4}, {15, 4}, HeadLength\  -> \ 0.025]]], 
          Show[Graphics[Arrow[{23, 4}, {28, 4}, HeadLength\  -> \ 0.025]]], 
          Show[Graphics[Arrow[{65, 4}, {70, 4}, HeadLength\  -> \ 0.025]]], 
          Show[Graphics[Arrow[{78, 4}, {73, 4}, HeadLength\  -> \ 0.025]]]}, 
        PlotRange -> {{0, 80.0}, {0, 5}}, Frame -> True, \ 
        FrameLabel -> {
            StyleForm[\*""Non-agricultural employment, \!\(L\_n\)"", 
              FontSize -> 14], StyleForm["Wages", FontSize -> 14], 
            "", ""}]\)