Laffer curve example

TheoryGuru applications

Load Economicreasoning package only if it is not already loaded

If[Length@Names["PLTools`*"]<10,
Get["http://economicreasoning.com"]]

Setup

basicassumptions={0<(Subscript[τ, L])<(Subscript[τ, H])<1,(Subscript[w, L])>0,(Subscript[w, H])>0,(Subscript[n, L])>0,(Subscript[n, H])>0,(Subscript[c, L])>0,(Subscript[c, H])>0,
(Subscript[τ, L])(Subscript[n, L])(Subscript[w, L])==(Subscript[τ, H])(Subscript[n, H])(Subscript[w, H]),
((Subscript[c, L])-(Subscript[c, H]))((Subscript[n, L])-(Subscript[n, H]))>0,((Subscript[w, L])-(Subscript[w, H]))((Subscript[n, L])-(Subscript[n, H]))≤0,((Subscript[n, L])-(Subscript[n, H]))(Subscript[w, L])≤(Subscript[c, L])-(Subscript[c, H])≤((Subscript[n, L])-(Subscript[n, H]))(Subscript[w, H]),
(Subscript[u, L])>(Subscript[u, Lb]),((Subscript[u, Lb])-(Subscript[u, H]))((Subscript[c, Lb])-(Subscript[c, H]))>0,(Subscript[c, L])-(Subscript[c, Lb])==((Subscript[n, L])-(Subscript[n, H]))(1-(Subscript[τ, L]))(Subscript[w, L]),
(Subscript[u, H])>(Subscript[u, Hb]),((Subscript[u, Hb])-(Subscript[u, L]))((Subscript[c, Hb])-(Subscript[c, L]))>0,(Subscript[c, H])-(Subscript[c, Hb])==((Subscript[n, H])-(Subscript[n, L]))(1-(Subscript[τ, H]))(Subscript[w, H])};

mrsassumptions={(Subscript[m, L])==(1-(Subscript[τ, L]))(Subscript[w, L]),(Subscript[m, H])==(1-(Subscript[τ, H]))(Subscript[w, H])};

ldemandiselastic=((Subscript[w, L])(Subscript[n, L])-(Subscript[w, H])(Subscript[n, H]))((Subscript[n, L])-(Subscript[n, H]))≥ 0;

bothnormalgoods=((Subscript[m, L])-(Subscript[m, H]))((Subscript[n, L])-(Subscript[n, H]))>0;

basicassumptions are the assumptions/assertions necessary for the queries posed in this notebook.  Other queries, e.g., with (Subscript[τ, L])==(Subscript[τ, H]) may require additional assumptions.  See the Laffer-curve section of MultipleorUniqueEquilibrium.nb (pdf here) for a more extensive assumption specification for this model.

Analytical Results

The high-tax equilibrium could have more work and utility

TheoryGuru[basicassumptions,(Subscript[n, L])>(Subscript[n, H])]

TheoryGuru[basicassumptions,(Subscript[u, L])>(Subscript[u, H])]

Restrictions that guarantee more utility at low tax

TheoryGuru[{basicassumptions,mrsassumptions,bothnormalgoods},(Subscript[n, L])>(Subscript[n, H])&&(Subscript[u, L])>(Subscript[u, H])]

TheoryGuru[{basicassumptions,ldemandiselastic},(Subscript[n, L])>(Subscript[n, H])&&(Subscript[u, L])>(Subscript[u, H])]

Variable interpretations

Numerical Example

Preferences

u[c_,n_]:=(3/4)Log[c]-(n/50)-(2/3)(((-1+2c))^2) (n^3)+1

mrs[c_,n_]:=-((Derivative[0,1][u][c,n])/(Derivative[1,0][u][c,n]))

Technology (kinked production function)

a0=1/5;a2=4/5;

a1=a/.First@NSolve[mrs[a +a0,1]==a,a]

f[n_]:=Min[a1 n+a0,a2 n]

utilcut=u[f[(a0/(a2-a1))],(a0/(a2-a1))]

Plot entire Laffer curve for the numerical example

ParametricPlot[{1-((mrs[f[n],n])/(f'[n])),((f'[n]-mrs[f[n],n])/(f[1]))n},{n,(a0/(a2-a1)),1},
PlotLabel->Style["Figure 4a. The Laffer curve for transfers",{Large,Blue}],AxesLabel->(Style[#,FontSize->16]&/@{"τ","share of\nefficient GDP"}),PlotRange->{{0,1},{0,4/5}},ImageSize->600,PlotStyle->Green]~Show~
ParametricPlot[{1-((mrs[f[n],n])/(f'[n])),((f'[n]-mrs[f[n],n])/(f[1]))n},{n,1/200,(a0/(a2-a1))},PlotRange->{{0,1},{0,4/5}},ImageSize->600,PlotStyle->Red]~Show~Plot[{2,3,2},{tau,19/20,1},PlotStyle->{Green,Black,Red},PlotLegends->{"u(c,n) > (Subscript[u, kink])","u(c,n) = (Subscript[u, kink])","u(c,n) ≤ (Subscript[u, kink])"}]~Show~
ParametricPlot[{1-((mrs[f[(a0/(a2-a1))],(a0/(a2-a1))])/w),((w-mrs[f[(a0/(a2-a1))],(a0/(a2-a1))])/(f[1]))(a0/(a2-a1))},{w,a1,a2},PlotRange->{{0,1},{0,4/5}},ImageSize->600,PlotStyle->Black]

ParametricPlot[{1-((mrs[f[n],n])/(f'[n])),((f'[n]-mrs[f[n],n])/(f[1]))n},{n,(a0/(a2-a1)),1},
PlotLabel->Style["Figure 4b. The Laffer curve for transfers",{Large,Blue}],AxesLabel->(Style[#,FontSize->16]&/@{"τ","share of\nefficient GDP"}),PlotRange->{{19/20,1},{0,4/5}},ImageSize->600,PlotStyle->Green,AspectRatio->1]~Show~ParametricPlot[{1-((mrs[f[n],n])/(f'[n])),((f'[n]-mrs[f[n],n])/(f[1]))n},{n,1/200,(a0/(a2-a1))},
PlotLabel->Style["The Laffer curve for transfers",{Large,Blue}],AxesLabel->(Style[#,FontSize->16]&/@{"τ","share of\nefficient GDP"}),PlotRange->{{19/20,1},{0,4/5}},ImageSize->600,PlotStyle->Red,AspectRatio->1]~Show~Plot[{2,3,2},{tau,19/20,1},PlotStyle->{Green,Black,Red},PlotLegends->{"u(c,n) > (Subscript[u, kink])","u(c,n) = (Subscript[u, kink])","u(c,n) ≤ (Subscript[u, kink])"}]~Show~
ParametricPlot[{1-((mrs[f[(a0/(a2-a1))],(a0/(a2-a1))])/w),((w-mrs[f[(a0/(a2-a1))],(a0/(a2-a1))])/(f[1]))(a0/(a2-a1))},{w,a1,a2},PlotRange->{{0,1},{0,4/5}},ImageSize->600,PlotStyle->Black]

Take a pair equilibria to confirm that
(a) both goods are not normal, 
(b) labor demand is not elastic, 
(c) (Subscript[τ, L])<(Subscript[τ, H]), and
(d) utility is higher at the high tax rate
in that range

examplepairofpoints={(Subscript[m, L])->mrs[(Subscript[c, L]),(Subscript[n, L])],(Subscript[m, H])->mrs[(Subscript[c, H]),(Subscript[n, H])],(Subscript[u, L])->u[(Subscript[c, L]),(Subscript[n, L])],(Subscript[u, H])->u[(Subscript[c, H]),(Subscript[n, H])],(Subscript[c, L])->f[(Subscript[n, L])],(Subscript[c, H])->f[(Subscript[n, H])],(Subscript[w, L])->f'[(Subscript[n, L])],(Subscript[w, H])->f'[(Subscript[n, H])],(Subscript[τ, L])->1-((Subscript[m, L])/(Subscript[w, L])),(Subscript[τ, H])->1-((Subscript[m, H])/(Subscript[w, H])),
(Subscript[n, L])->(2/3)(a0/(a2-a1))(* below production-function kink *),
(Subscript[n, H])->(6/5)(a0/(a2-a1))(* above production-function kink *)};

{Not@bothnormalgoods,Not@ldemandiselastic,(Subscript[τ, L])<(Subscript[τ, H]),SameSign[(Subscript[u, H])-(Subscript[u, L]),(Subscript[τ, H])-(Subscript[τ, L])]}//.examplepairofpoints