Personal Increasing Returns

by Casey B. Mulligan
Supporting materials for March 2022 NBER working paper

Load Economicreasoning package only if it is not already loaded

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

Load other tools by clicking on extras and/or evaluating below

If[Not@MemberQ[$ContextPath,"OtherTools`"],
Get["http://othertools.economicreasoning.com"]]

Setup

mrs[x_,y_]:=((Derivative[0,1][u][x,y])/(Derivative[1,0][u][x,y]))

SignConditions={Derivative[0,1][u][x,q]>0,Derivative[1,0][u][x,q]>0,QuasiConcaveFunctionQ[u[x,q],strictly->True]}/.x->y-e[q];

SignConditionsp={p[h]>0,p'[h]<0,p''[h]>0};

foc=mrs[y-e[q],q]==e'[q];

bothstagefoc=FullSimplify[Grad[u[y-h-p[h]q,q],{h,q}]==0/.q p[h]->e[q]-h//Thread,SignConditions[[2]]]

DefineElasticities={(1/(ϵd))==q D[Log[mrs[y-e[q],q]],q],(1/(ϵs))==q D[Log[e'[q]],q]};

IncomeSubstitutionCancel=e[q]((Derivative[1,0][mrs][y-e[q],q])/(e'[q]))==-1;

Symbolic Results

h and q are complements

TheoryGuru[{Rest@SignConditionsp,q>0,Dt[First@bothstagefoc,q]},
Dt[h,q]>0]

Envelope theorem for e[q]

TheoryGuru[{Dt[e[q]==h+p[h]q,q],First@bothstagefoc,First@SignConditionsp},
e'[q]==p[h]>0]

TheoryGuru[{Dt[e'[q]==p[h],q],Rest@SignConditionsp,Dt[First@bothstagefoc,q],First@bothstagefoc},
e''[q]==p'[h]Dt[h,q]<0]

Confirm FOC

TheoryGuru[{D[u[y-e[q],q],q]==0,SignConditions[[2]]},
foc]

Confirm relation between SOC and elasticity signs

TheoryGuru[{D[u[y-e[q],q],q,q]<0,foc,DefineElasticities,Most@SignConditions,e''[q]<0,q>0},
ϵs<ϵd<0∧
((ϵs)/(ϵd-ϵs))<0∧
D[((ϵs)/(ϵd-ϵs)),ϵd]>0(* ϵd and ((ϵs)/(ϵd-ϵs)) get more negative together *) ∧
D[((ϵs)/(ϵd-ϵs)),ϵs]<0(* ϵs and ((ϵs)/(ϵd-ϵs)) get more negative together *) ]

TheoryOverlap[{foc,DefineElasticities,SignConditions,e''[q]<0,q>0},
D[u[y-e[q],q],q,q]<0,
ϵs<ϵd]

Implications of quasiconcavity: demand slopes down

But not necessarily more than supply does

TheoryOverlap[{Most@SignConditions,mrs[y-e[q],q]==e'[q]>0},
D[mrs[y-e[q],q],q]<0,
Last@SignConditions]

TheoryOverlap[{Most@SignConditions,First@DefineElasticities,mrs[y-e[q],q]==e'[q]>0,q>0},
ϵd<0,
Last@SignConditions]

Comparative statics

(q^(1/ϵd))+m==a (q^(1/ϵs));
Dt[Log[q],m]==((ϵd ϵs)/( ϵd- ϵs))(1/p)/.First@Solve[Dt[%,m]//.{Dt[ϵd,m]|Dt[ϵs,m]|Dt[a,m]->0,(q^(1/(ϵs))) a ->p,(q^(1/(ϵd)))->p},Dt[q,m]]

foca=mrs[y-a e[q],q]==a e'[q];

{Dt[foca,a],foca}/.
{Dt[q,a]->Dt[q,aa],Dt[y,a]->Dt[y,aa]}/.{a->1,Dt[q,aa]->Dt[q,a],Dt[y,aa]->Dt[y,a]};
TheoryGuru[{%,DefineElasticities,e'[q]>0,ϵs<ϵd<0},
e[q]((Derivative[1,0][mrs][y-e[q],q])/(e'[q]))((Dt[y,a])/(e[q]))+((ϵs -ϵd)/( ϵd ϵs))Dt[Log[q],a]==1+e[q]((Derivative[1,0][mrs][y-e[q],q])/(e'[q]))]
TheoryGuru[{%%,IncomeSubstitutionCancel,DefineElasticities,e'[q]>0,ϵs<ϵd<0},
((ϵs -ϵd)/( ϵd ϵs))Dt[Log[q],a]==((Dt[y,a])/(e[q]))]
TheoryGuru[{%%%,IncomeSubstitutionCancel,DefineElasticities,e'[q]>0>e[q],ϵs<ϵd<0,q>0},
SameSign[Dt[q,a],Dt[y,a]]]

i.e., any change in the marginal tax rate changes leisure (q) and unemployment income in the same direction.  Moreover, -((Dt[y,s])/(e[q])) is a replacement rate

Nonlinear example

Setup

SignConditions={Derivative[0,1][u][x,q]>0,Derivative[1,0][u][x,q]>0,QuasiConcaveFunctionQ[u[x,q],strictly->True]}/.x->y-p q;

uff[x_,q_]=Sqrt[x q]

marshff[p_,y_]:=(y/(2 p))

hicksff[p_,ulev_]:=(ulev/(Sqrt[p]))

mrsff[q_,y_,p_]:=(y/q)-p

mrsff2[q_,y_]:=((y-cff2[q])/q)

invmrs[m_,y_,p_]:=(y/(m+p))

Confirm Hicksian & Marshallian demand

FullSimplify[(x/q)==p∧ulev==uff[x,q]/.{q->hicksff[p,ulev],x->(Sqrt[p]) ulev},ulev>=0]

foc/.{u->uff,q->marshff[p,y]}

mrsff[marshff[p,y],y,p]==p

mrsff[invmrs[m,y,p],y,p]==m

Confirm sign conditions

TheoryGuru[{q>0,y>p q>0},
SignConditions/.u->uff]

Marshallian is more elastic than Hicksian, which is tangent to (inverse) MRS

TheoryGuru[{q==marshff[p,y],ulev==uff[y-p q,q](* looking at slopes where all three intersect *),y>0},
Derivative[1,0][marshff][p,y]<(1/(Derivative[1,0,0][mrsff][q,y,p]))== Derivative[1,0][hicksff][p,ulev]<0]

Polynomial for the first-stage cost function

cff2[q_]:=-(3/8)+((67 q)/12)-((47 (q^2))/8)+((59 (q^3))/24)-((q^5)/6)

qlow=(NumericalApproximation[Root, (RowDefault["0.290", FEExpressionsNumericalApproximationElider]), Root[-9+141 ((#1)^2)-118 ((#1)^3)+16 ((#1)^5)&,3], ]);qhi=(NumericalApproximation[Root, (RowDefault["1.09", FEExpressionsNumericalApproximationElider]), Root[141-177 #1+40 ((#1)^3)&,2], ]);hhi=-(3/8)+(47/8) (qhi^2)-(59/12) (qhi^3)+(2/3) (qhi^5);

cff2left[q_]:=(cff2[qlow]-qlow cff2'[qlow])+
cff2'[qlow]q

cff2right[q_]:=(cff2[qhi]-qhi cff2'[qhi])+
cff2'[qhi]q

confirm strictly increasing, concave, and positive

except the left and right pieces are linear

TheoryGuru[{qlow<=q<qhi},
cff2''[q]<0<cff2'[q]∧
cff2[q]>0]

cff2left''[q]==0<cff2left'[q]
cff2right''[q]==0<cff2right'[q]

TheoryGuru[{0<=q<qlow},
SameSign[cff2left[q],q]]

TheoryGuru[{q>=qhi},
cff2right[q]>0]

confirm continuity

cff2[qlow]==cff2left[qlow]∧
cff2'[qlow]==cff2left'[qlow]∧
cff2[qhi]==cff2right[qhi]∧
cff2'[qhi]==cff2right'[qhi]//Simplify

Find pricing and policy functions that rationalize cff2 as the first-stage cost function

hofq[q_]=cff2[q]-q cff2'[q]//Simplify
Expand@%

qofh[h_]=q/.Solve[h==hofq[q],q][[3]]

pofh[h_]=cff2'[qofh[h]]//Simplify

Confirm that cff2 is the expenditure function

FullSimplify[cff2[q]==hofq[q]+pofh[hofq[q]]q,
qlow<q<qhi]

Confirm that h ≥ 0 binds below qlow

FullSimplify[D[h+p[h]q,h]>=0/.p->pofh/.h->0,0<q<qlow]

Confirm that h == hhi above qhi, where p[h]==p[hhi]

D[h+p[hhi]q,h]>=0

Confirm that, on qlow ≤ q ≤ qhi, hofq is the policy function minimizing expenditure

D[h+p[h]q,h]==0/.p->pofh//Simplify(* FOC for assumed functional form *)
h==hofq[q]/.First@Quiet@Solve[%,h](* confirm that hofq is the policy function for assumed p[h] *)
hofq[qhi]==hhi//Simplify

FullSimplify[D[h+p[h]q,h,h]>0/.p->pofh,q>0]
First@%
Plot[%,{h,0,hofq[qhi]}](* confirm that SOC is satisfied everywher in the relevant range *)

The policy function hofq is strictly increasing and concave

FullSimplify[hofq[q]>0∧hofq'[q]>0,qlow<q<qhi]

Two optimal solutions

u[2-cff2[1],1]==u[2-cff2[(1/2)],(1/2)]∧
mrs[2-cff2[1],1]==cff2'[1]∧
mrs[2-cff2[(1/2)],(1/2)]==cff2'[(1/2)]/.u->uff

D[u[2-cff2[q],q],q,q]<0/.{u->uff,q->1}
D[u[2-cff2[q],q],q,q]<0/.{u->uff,q->(1/2)}

cff2'[1]==(3/8)∧cff2'[(1/2)]==(3/2)

2-cff2[1]==(3/8)∧2-cff2[(1/2)]==(3/4)

Plots

Utilities

f14[expr_]:=Style[expr,FontSize->14]

tr14[expr_]:=Style[f14@expr,Black,FontFamily->"Times New Roman"]

plopts={ImageSize->500,
TicksStyle->Directive[14,Black,FontFamily->"Times New Roman"],
FrameTicksStyle->Directive[14,Black,FontFamily->"Times New Roman"]};

Figures A1 and A2

qb=(NumericalApproximation[Root, (RowDefault["0.739", FEExpressionsNumericalApproximationElider]), Root[57-97 #1+18 ((#1)^2)+12 ((#1)^3)&,2], ]);

mrsff2[qb,2]==cff2'[qb]∧
uff[2-cff2[qb],qb]<uff[2-cff2[1],1]//Simplify(* cross but B is not an optimum *)

ulevplot=uff[2-cff2[1],1];
pcommon=mrs[2-cff2[1],1]/.u->uff;
Row@{Show@@{ContourPlot[{uff[x,q]==uff[2-cff2[1],1],
x+cff2[q]==2},{q,(1/3),(5/4)},{x,(1/5),1},
PlotLabel->Style["Figure A1. Indifference Curve and Budget Set",Black,FontFamily->"Times New Roman",FontSize->16],
FrameLabel->tr14/@{"q","All other goods"},
ContourStyle->{{Blue,Thickness[1/150]},{Darker@Green,Thickness[1/150]}},
PlotLegends->Placed[tr14/@{"Indifference curve","Budget constraint"},{.8,.5}],
Evaluate@plopts],
ListPlot[{Labeled[#,tr14@"C",#+{.01,.03}]&@{(1/2),2-cff2[(1/2)]},
Labeled[{1,2-cff2[1]},tr14@"A",Above]},PlotStyle->{Black,PointSize[.02]}]},"   ",
Show@@{ParametricPlot[{
{hicksff[p,ulevplot],
mrsff2[hicksff[p,ulevplot],2]},
{hicksff[p,ulevplot],cff2'[hicksff[p,ulevplot]]}},{p,0,5},
PlotLabel->Style["Figure A2.  Demand and Supply",Black,FontFamily->"Times New Roman",FontSize->16],
PlotRange->{{(1/3),qhi},{0,2}},AspectRatio->1,
PlotStyle->{{Blue,Thickness[1/150]},{Darker@Green,Thickness[1/150]}},ImageSize->500,
PlotLegends->Placed[tr14/@{"Demand: M(y-E(q),q)","Supply: E'(q)"},{.8,.5}],
AxesLabel->tr14/@{"Quantity","Price"},
Evaluate@plopts],
ListPlot[{Labeled[#,tr14@"C",#+{.02,.03}]&@{(1/2),mrsff2[(1/2),2]},
Labeled[{qb,mrsff2[qb,2]},tr14@"B",Above],
Labeled[{1,mrsff2[1,2]},tr14@"A",Above]},PlotStyle->{Black,PointSize[.02]}]}}

Figure A3

Show@@{ParametricPlot[{{hicksff[p,ulevplot],p-mrsff2[hicksff[p,ulevplot],2]},
{hicksff[p,ulevplot],
mrsff2[hicksff[p,ulevplot],2]-mrsff2[hicksff[p,ulevplot],2]},
{hicksff[p,ulevplot],cff2'[hicksff[p,ulevplot]]-mrsff2[hicksff[p,ulevplot],2]}},{p,0,5},
PlotLabel->Style["Figure A3.  Vertical gaps between demand and supply\n",Black,FontFamily->"Times New Roman",FontSize->16],
PlotRange->{{(1/3),qhi},{-.05,.1}},AspectRatio->1,
PlotStyle->{{Black,Thickness[1/150]},{Blue,Thickness[1/150]},{Darker@Green,Thickness[1/150]}},ImageSize->500,
PlotLegends->Placed[tr14/@{"Hicksian inv demand - MRS","MRS - MRS = 0","E'(q) - MRS"},{.5,.85}],
AxesLabel->tr14/@{"Quantity","Vertical distance\nabove M(y-E(q),q)"},
Evaluate@plopts],
ListPlot[{Labeled[#,tr14@"C",#+{-.015,.01}]&@{(1/2),0},
Labeled[#,tr14@"B",#+{-.012,-.01}]&@{qb,0},
Labeled[#,tr14@"A",#+{-.015,.01}]&@{1,0}},
PlotStyle->{Black,PointSize[.02]}]}

Others

Show@@{ParametricPlot[{{hicksff[p,ulevplot],p},
{hicksff[p,ulevplot],
mrsff2[hicksff[p,ulevplot],2]},
{hicksff[p,ulevplot],cff2'[hicksff[p,ulevplot]]}},{p,0,5},
PlotRange->{{(1/3),qhi},{0,2}},AspectRatio->1,
PlotStyle->{Black,Blue,Darker@Green},ImageSize->500,
PlotLegends->{Hicksian,MRS,MC},AxesLabel->tr14/@{"Quantity","Price or MRS or MC"}],
Graphics[{Disk[{(1/2),mrsff2[(1/2),2]},{.01,.025}]}],
Graphics[{Disk[{1,mrsff2[1,2]},{.01,.025}]}]}

Show@{Plot[2-cff2left[q],{q,0,qlow},PlotStyle->Darker@Green,PlotRange->{{0,2},{0,2}},AxesLabel->{"q","c"}],
Plot[2-cff2[q],{q,qlow,qhi},PlotStyle->Darker@Green,PlotRange->{{0,2},{0,2}}],
Plot[2-cff2right[q],{q,qhi,2},PlotStyle->Darker@Green,PlotRange->{{0,2},{0,2}}]}

Show@{Plot[cff2left'[q],{q,0,qlow},PlotStyle->Darker@Green,PlotRange->{{0,2},{0,4}}],
Plot[cff2'[q],{q,qlow,qhi},PlotStyle->Darker@Green,PlotRange->{{0,2},{0,4}}],
Plot[cff2right'[q],{q,qhi,2},PlotStyle->Darker@Green,PlotRange->{{0,2},{0,4}}]}

Show@{Plot[pofh[h],{h,0,hofq[qhi]},PlotStyle->Red,PlotRange->{{0,2},{0,4}},AxesLabel->{h,p}],
Plot[pofh[hofq[qhi]],{h,hofq[qhi],2},PlotStyle->Red,PlotRange->{{0,2},{0,4}}]}