The investment-distortion model

for Mulligan, Casey B.  “Expectations, Means-tested Subsidies, and Economic Performance during the Recession.”  Journal of Mathematical Finance.  2017.

Setup

NGM tastes and technology

f[k_,n_,a_]:=a (k^(1-α))(n^α)

u[c_,n_,m_]:=(σ/(σ-1))(c^((σ-1)/σ))-γn(η/(η+1))(((n-β m))^((η+1)/η))-γm(η/(η+1))(m^((η+1)/η))

eqresourceconstraint=k'[t]==f[k[t],n[t],a]-c[t]-δ k[t];

eqlaborfoc=-((Derivative[0,1][u][c[t],n[t]])/(Derivative[1,0][u][c[t],n[t]]))==(1-τ[t]) Derivative[0,1,0][f][k[t],n[t],a]//FullSimplify

nofck[c_,k_,τ_]:=(((((1-τ)/γ)((α (k^(1-α)))/(c^(1/σ)))a))^(η/(1+(1-α)η)))

Normalize (Subscript[k, ss]) and (Subscript[n, ss]) to one

rnorma={a->((δ+ρ)/(1-α))};

rnormγ[τ_]={γ->(((1-α))^(-1+(1/σ))) α (δ+ρ) (((α δ+ρ))^(-1/σ)) (1-τ)};

Tools for solving the investment-distortion model

rootforc[c_,i_,k_]=eqresourceconstraint/.{n[t]->nofck[c[t],k[t],0],k'[t]->δ i[t]-δ k[t]}/.{x_[t]->x}//PowerExpand//FullSimplify

quarterlycapitalinteration=Values@Collect[Expand@First@First@DSolve[{k'[t]==(* i normalized to 1 in ss; i.e., no time units *)δ i-δ k[t],k[0]==k0},k[t],t],i]/.{t->1/4,k0->#1,i->#2(* constant in the interval *)}

capitalseries[investmentseries_]:=FoldList[Evaluate@quarterlycapitalinteration&,1,investmentseries]

conslabor[k_,i_,paramrule_]:=Module[{rfc=rootforc[c,i,k]/.paramrule},
{c/.#,
nofck[c,k,0]/.paramrule/.#}&@First@NSolve[{rfc,c≥0},c,Reals]
]

Examples

Column@capitalseries@{1,i2,i3}

conslabor[1,1,{a->1,α->7/10,δ->1/20,η->1,σ->1,γ->1}]

TimeSeries Utilities

lagoneqtr[series_TemporalData]:=TimeSeriesShift[series,{1,"Quarter"}]

lagonemonth[series_TemporalData]:=TimeSeriesShift[series,{1,"Month"}]

DetrendNormalize[series_TemporalData]:=((100#)/(Mean@Values@TimeSeriesWindow[#,DateObject/@{{2007,1,1},{2007,12,1}}]))&@(series*TimeSeries@Transpose@{series["Dates"],N@Exp[(-.0075(* annual rate.  negative removes uptrend *))*QuantityMagnitude@DateDifference[series["FirstDate"],series["Dates"],"Year"]]})

timefunctiontocalendartime[timefunction_,startdate_List]:=timefunctiontocalendartime[timefunction,DateObject@startdate]

timefunctiontocalendartime[timefunction_,startdate_DateObject]:=
timefunctiontocalendartime[timefunction,startdate,120]

timefunctiontocalendartime[timefunction_,startdate_DateObject,gridsperyear_Integer]/;SameQ[Head@Head@timefunction,InterpolatingFunction]:=Module[{startgentime=Part[timefunction,0,1,1,1],
endgentime=Part[timefunction,0,1,1,-1],gentimes},
gentimes=Range[startgentime,endgentime,((endgentime-startgentime)/gridsperyear)];
TimeSeries[(timefunction/.t->#)&/@gentimes,{startdate+Quantity[gentimes,"Years"]}]]

timefunctiontocalendartime[timefunction_,startdate_DateObject,gridsperyear_Integer]:=Module[{startgentime=0,
endgentime=9,gentimes},
gentimes=Range[startgentime,endgentime,((endgentime-startgentime)/gridsperyear)];
TimeSeries[(timefunction/.t->#)&/@gentimes,{startdate+Quantity[gentimes,"Years"]}]]

Plotting

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

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

plopts={PlotStyle->{{Red,Thickness[1/150]},{Darker@Green,Thickness[1/150]},{Blue,Thickness[1/150]}},PlotLegends->f14/@{"Benchmark parameters","Elasticities doubled","Actual"},
PlotRange->{{DateObject@{2007,12,1},DateObject@{2013,12,1}},Automatic},
ImageSize->500,Frame->{{True,False},{True,False}},FrameLabel->tr14/@{"","Ratio to 2007 avg., detrended"},
FrameTicksStyle->Directive[14,Black,FontFamily->"Times New Roman"],
FrameTicks->{{#,DateString[#,{"MonthNameShort"," ","YearShort"}]}&/@(DateObject@{2007,12,1}+Quantity[1,"Months"]+Quantity[Range[0,9],"Years"]),Automatic}};

pldataopts={ Joined->False,Frame->{{True,False},{True,False}},PlotStyle->Black};

plcombinedopts=Flatten@{PlotStyle->{{Red,Thickness[1/150]},{Darker@Green,Thickness[1/150]},{Black,PointSize[1/50]}},
Joined->{True,True,False},PlotLegends->Placed[f14/@{"Benchmark parameters","Elasticities doubled","Actual"},{.5,.45}],
plopts};

FRED data

fredextract=Last@Sort@LocalSymbol[NotebookDirectory[]<>"JMFFRED"];

hrsperadultindex="hrsperadultindex"/.fredextract;

privatepublicQindex="privatepublicQindex"/.fredextract;

quarterlypop="quarterlypop"/.fredextract;

laborproductivity="laborproductivity"/.fredextract;

privatepublicinvqindex="privatepublicinvqindex"/.fredextract;

privatepublicinvqindexwohousing="privatepublicinvqindexwohousing"/.fredextract;

{invseriesaslist,dates}=TimeSeriesWindow[(1/100)DetrendNormalize@(privatepublicinvqindex/quarterlypop),{DateObject@{2007,10,1},DateObject@{2017,1,1}}]/@{"Values","Dates"}

Simulate the investment-distortion model

rcalibration@"RR"=Flatten@Join[#,{rnormγ[0],rnorma}/.#]&@{η->3/4,σ->135/100,α->7/10,δ->(7/100)+((35/10000)/(7/10))//Simplify,ρ->1/200,nonprimesh->(1/10)}

rcalibration@"double"=Flatten@Join[#,{rnormγ[0],rnorma}/.#]&@{η->2 3/4,σ->2 135/100,α->7/10,δ->(7/100)+((35/10000)/(7/10))//Simplify,ρ->1/200,nonprimesh->(1/10)}

utilizations={0.86,0.76,0.66};

actualk=capitalseries@invseriesaslist/.rcalibration@"RR"

First@Transpose@{invseriesaslist,Most@actualk}
{First@%,Last@%,rcalibration@"RR"}

{sim@c,sim@n}=TimeSeries@Transpose@{dates,#}&/@Transpose[(conslabor@@{First@#,Last@#,rcalibration@"RR"})&/@Transpose@{Most@actualk,invseriesaslist}];

sim@y=TimeSeries@Transpose@{dates,
Apply[f[#1,#2,a]&,Transpose@{Most@actualk,Values@sim@n},{1}]/.rcalibration@"RR"};

sim@w=TimeSeries@Transpose@{dates,
Apply[Derivative[0,1,0][f][#1,#2,a]&,Transpose@{Most@actualk,Values@sim@n},{1}]/.rcalibration@"RR"};

{simdbl@c,simdbl@n}=TimeSeries@Transpose@{dates,#}&/@Transpose[(conslabor@@{First@#,Last@#,rcalibration@"double"})&/@Transpose@{Most@actualk,invseriesaslist}];

simdbl@y=TimeSeries@Transpose@{dates,
Apply[f[#1,#2,a]&,Transpose@{Most@actualk,Values@simdbl@n},{1}]/.rcalibration@"double"};

simdbl@w=TimeSeries@Transpose@{dates,
Apply[Derivative[0,1,0][f][#1,#2,a]&,Transpose@{Most@actualk,Values@simdbl@n},{1}]/.rcalibration@"double"};

Figures 10a,b,c

DateListPlot[{((lagonemonth@sim@n)/(Last@conslabor[1,1,rcalibration@"RR"])),
((lagonemonth@simdbl@n)/(Last@conslabor[1,1,rcalibration@"double"])),
TimeSeriesWindow[hrsperadultindex,{DateObject@{2007,12,1},DateObject@{2017,10,1}}]},
PlotLabel->(Row[Style[#,16,FontFamily->"Times New Roman"]&/@{Style["Figure 10a.  ",Bold],"Labor usage from the investment-distortion model"}]),
PlotRange->{9/10,1},Evaluate@plcombinedopts]

DateListPlot[{((lagonemonth[sim@c+α sim@y (nonprimesh/(1-nonprimesh))])/(First@conslabor[1,1,rcalibration@"RR"]+α f[1,1,a](nonprimesh/(1-nonprimesh))))/.rcalibration@"RR",
((lagonemonth[simdbl@c+α simdbl@y (nonprimesh/(1-nonprimesh))])/(First@conslabor[1,1,rcalibration@"double"]+α f[1,1,a](nonprimesh/(1-nonprimesh))))/.rcalibration@"double",
TimeSeriesWindow[(1/100)lagonemonth@DetrendNormalize@(privatepublicQindex/quarterlypop),{DateObject@{2007,12,1},DateObject@{2017,10,1}}]},
PlotLabel->(Row[Style[#,16,FontFamily->"Times New Roman"]&/@{Style["Figure 10b.  ",Bold],"Consumption from the investment-distortion model"}]),
PlotRange->Automatic,Evaluate@plcombinedopts]

Beginning in 2008-Q1, from meanstestedtransfers.xlsx

subsidydata={1.122428811,
1.171706901,
1.268664621,
1.400932509,
1.600727169,
1.797413892,
2.002283761,
1.973533319,
2.122748418,
2.05701207,
1.95970077,
1.940010009,
1.890067423};

subsidyts=TimeSeries@Transpose@{Join@@Table[{yr,mo,1},{yr,2008,2011},{mo,1,10,3}]//Most//Most//Most,
subsidydata};

DateListPlot[Join[List@lagonemonth@subsidyts,(((1-(lagonemonth@sim@n/Last@conslabor[1,1,rcalibration@"RR"])nssgamma)/(1-nssgamma))(sim@w/(Derivative[0,1,0][f][1,1,a]/.rcalibration@"RR"))/.nssgamma->#)&/@utilizations//Evaluate],
PlotRange->{1,2.2},
PlotStyle->{{Black,PointSize[1/50]},{Dashing@{.005,.02},Blue,Thickness[1/150]},{Dashing@1,Red,Thickness[1/150]},{Dashing@{.04,.03},Blue,Thickness[1/150]}},
PlotLabel->(Row[Style[#,16,FontFamily->"Times New Roman"]&/@{Style["Figure 10c.  ",Bold],"Subsidy expenditure from the investment-distortion model\n"}]),
Joined->{False,True,True,True},
PlotLegends->Placed[{"Actual","Utilization + 10 %pts","Benchmark","Utilization - 10 %pts"},{.83,0.35}],
Evaluate@plcombinedopts]