Charts produced from the neoclassical growth model

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

Utilities

Plotting

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

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

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"]}]]

calendarplot[timefunction_,options_:{}]:=DateListPlot[timefunctiontocalendartime[timefunction,{2007,12,1}],
Sequence@@options,ImageSize->500,Frame->{{True,False},{True,False}},
FrameTicks->{{#,DateString[#,{"MonthNameShort"," ","YearShort"}]}&/@(DateObject@{2007,12,1}+Quantity[1,"Months"]+Quantity[Range[0,9],"Years"]),Automatic}]

dummyseries=TimeSeries@{{DateObject@{2021,1,1},1},{DateObject@{2021,2,1},1}};

plopts={PlotStyle->{{Red,Thickness[1/150]},{Darker@Green,Thickness[1/150]},{Blue,Thickness[1/150]}},PlotLegends->f14/@{"No recovery","Partial recovery","Full recovery"},
PlotRange->{{DateObject@{2007,12,1},DateObject@{2013,12,31}},Automatic},
ImageSize->500,Frame->{{True,False},{True,False}},
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]},{Blue,Thickness[1/150]},{Black,PointSize[1/50]}},
Joined->{True,True,True,False},PlotLegends->f14/@{"No recovery","Partial recovery","Full recovery","Actual"},FrameLabel->tr14/@{"","Ratio to 2007 avg., detrended"},
plopts};

pctfmt[expr_?NumberQ,decplaces_:0]:=Row[{Round[100expr,(10^(-decplaces))],"%"}]

TimeSeries

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"]]})

RetrendNormalize[series_TemporalData,trend_]:=((100#)/(Mean@Values@TimeSeriesWindow[#,DateObject/@{{2007,1,1},{2007,12,1}}]))&@(series*TimeSeries@Transpose@{series["Dates"],N@Exp[(trend(* annual rate *))*QuantityMagnitude@DateDifference[series["FirstDate"],series["Dates"],"Year"]]})

FullWindow[series_TemporalData]:=TimeSeriesWindow[series,DateObject/@{{2007,1,1},{2013,12,31}}]

MergeTimeSeries[tslist_List]:=Normal@Merge[Map[Association@Apply[Rule,#]&,Normal/@tslist,{2}],First@List@#&]/.Rule->List

Other

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

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;

Export for data appendix

fredtoexcel={(* monthly tab *) Normal@hrsperadultindex(* Figure 6b *),

(* quarterly tab *)Flatten/@MergeTimeSeries@{FullWindow@privatepublicQindex//((#)/(Mean@Values@TimeSeriesWindow[#,DateObject/@{{2007,1,1},{2007,12,1}}]))&(* Figure 6c numerator *),
FullWindow@quarterlypop(* Figure 6c denominator *),

(1/100)DetrendNormalize@laborproductivity//FullWindow(* Figure 6d *),

FullWindow@privatepublicinvqindex//((#)/(Mean@Values@TimeSeriesWindow[#,DateObject/@{{2007,1,1},{2007,12,1}}]))&(* Figure 6e numerator *),
FullWindow@privatepublicinvqindexwohousing//((#)/(Mean@Values@TimeSeriesWindow[#,DateObject/@{{2007,1,1},{2007,12,1}}]))&(* Figure 6e numerator w/o housing *)}};

Plots

JMF final

resultslibrary=
(Dataset@LocalSymbol[NotebookDirectory[]<>"JMFsimulations"])[Select[#paperversion=="JMF final"&&
#tastedescription=="RR benchmark"&&
#techndescription=="JMF benchmark"&]]

DateListPlot[Join[timefunctiontocalendartime[#,{2007,12,1}]&/@
(τ[t]/.("equilibrium time paths"/.Normal@resultslibrary)),
List@dummyseries],
PlotLabel->(Row[Style[#,16,FontFamily->"Times New Roman"]&/@{Style["Figure 6a.  ",Bold],"Earnings replacement rates: 3 scenarios for beyond 2009"}]),
PlotRange->{{DateObject@{2007,12,1},DateObject@{2015,12,1}},{0,2/5}},
PlotLegends->Placed[f14/@{"No recovery","Partial recovery","Full Recovery"},
{3/4,3/8}],
FrameTicks->{{#,DateString[#,{"MonthNameShort"," ","YearShort"}]}&/@(DateObject@{2007,12,1}+Quantity[1,"Months"]+Quantity[Range[0,9],"Years"]),{#,pctfmt@#}&/@Range[0,.4,.1]},
Evaluate@plopts]

display3@n=timefunctiontocalendartime[#,{2007,12,1}]&/@
(n[t]/.("equilibrium time paths"/.Normal@resultslibrary));

display3@c=timefunctiontocalendartime[#,{2007,12,1}]&/@
(((c[t]+(1-τ[t])α f[k[t],n[t],a](nonprimesh/(1-nonprimesh)))/.("equilibrium time paths"/.Normal@resultslibrary)//.("tastestechparams"/.First@Normal@resultslibrary))/((css+(1-τ)α f[kss,nss,a](nonprimesh/(1-nonprimesh)))/.("SS corresponding to time 0"/.First@Normal@resultslibrary)//.("tastestechparams"/.First@Normal@resultslibrary)));

DateListPlot[Join[display3@n,List@dummyseries],
PlotLabel->(Row[Style[#,16,FontFamily->"Times New Roman"]&/@{Style["Figure 6b.  ",Bold],"Labor usage: actual compared with 3 scenarios"}]),
FrameLabel->tr14/@{"","Ratio to 2007 avg."},
Evaluate@plcombinedopts]~Show~DateListPlot[hrsperadultindex,Evaluate@pldataopts]

DateListPlot[Join[display3@c,List@dummyseries],
PlotLabel->(Row[Style[#,16,FontFamily->"Times New Roman"]&/@{Style["Figure 6c.  ",Bold],"Consumption: actual compared with 3 scenarios"}]),
Evaluate@plcombinedopts]~Show~DateListPlot[(1/100)lagonemonth@DetrendNormalize@(privatepublicQindex/quarterlypop), Evaluate@pldataopts]

DateListPlot[Join[timefunctiontocalendartime[N@#,{2007,12,1}]&/@
((((f[k[t],n[t],a])/(n[t]))(1+(* value of non-prime labor *)(1-τ[t])α (nonprimesh/(1-nonprimesh)))/.("equilibrium time paths"/.Normal@resultslibrary)//.("tastestechparams"/.First@Normal@resultslibrary))/(((f[kss,nss,a])/nss)(1+(* value of non-prime labor *)(1-τ)α (nonprimesh/(1-nonprimesh)))/.Flatten@{{"SS corresponding to time 0","tastestechparams"}/.First@Normal@resultslibrary})),
List@dummyseries],
PlotRange->{{DateObject@{2007,12,1},DateObject@{2013,12,1}},{Automatic,1.05}},
PlotLabel->(Row[Style[#,16,FontFamily->"Times New Roman"]&/@{Style["Figure 6d.  ",Bold],"Labor productivity: actual compared with 3 scenarios"}]),
Evaluate@plcombinedopts]~Show~DateListPlot[(1/100)lagonemonth@DetrendNormalize@laborproductivity, Evaluate@pldataopts]

DateListPlot[Join[timefunctiontocalendartime[N@#,{2007,12,1}]&/@
((f[k[t],n[t],a]-c[t]/.("equilibrium time paths"/.Normal@resultslibrary)//.("tastestechparams"/.First@Normal@resultslibrary))/(f[kss,nss,a]-css/.Flatten@{{"SS corresponding to time 0","tastestechparams"}/.First@Normal@resultslibrary})),
List@dummyseries,List@dummyseries],
PlotLabel->(Row[Style[#,16,FontFamily->"Times New Roman"]&/@{Style["Figure 6e.  ",Bold],"Investment: actual compared with 3 scenarios"}]),
PlotStyle->{{Red,Thickness[1/150],PointSize[1/1000]},{Darker@Green,Thickness[1/150]},{Blue,Thickness[1/150]},{Black,PointSize[1/50]},{Black,PointSize[1/50]}},
PlotMarkers->{{○,2},{○,2},{○,2},{●,10},{▲,12}},
Joined->{True,True,True,False,False},PlotLegends->{f14/@{"No recovery","Partial recovery","Full Recovery","Actual","Actual w/o housing"}},
PlotRange->{{DateObject@{2007,12,1},DateObject@{2013,12,1}},{.74,1.1}},
Evaluate@plcombinedopts]~Show~DateListPlot[{(1/100)lagonemonth@DetrendNormalize@(privatepublicinvqindex/quarterlypop),
(1/100)lagonemonth@DetrendNormalize@(privatepublicinvqindexwohousing/quarterlypop)}, 
PlotMarkers->{{●,11},{▲,12}},Evaluate@pldataopts]

quarterlylbr=TimeSeriesShift[TimeSeriesShift[TimeSeriesAggregate[hrsperadultindex,"Quarter"],{-1,"Month"}],{-14,"Day"}]

DateListPlot[Join[Inner[Divide,Log@display3@n,Log@display3@c,List],
List@dummyseries],
PlotRange->{{DateObject@{2007,12,1},DateObject@{2013,12,1}},{-1,4}},
PlotLabel->(Row[Style[#,16,FontFamily->"Times New Roman"]&/@{Style["Figure 6f.  ",Bold],"Relative impact: actual compared with 3 scenarios"}]),
FrameLabel->(Style[#,FontFamily->"Times New Roman",FontSize->16]&/@{"",(("Log labor impact")/("Log consumption impact"))}),
Evaluate@plcombinedopts]~Show~DateListPlot[((Log@quarterlylbr)/(Log[(1/100)DetrendNormalize@(privatepublicQindex/quarterlypop)]))//lagonemonth, Evaluate@pldataopts]

fig11aresults=(Dataset@LocalSymbol[$LocalSymbolDefaultDirectory<>"JMFsimulations"])[Select[#paperversion=="JMF final"&&
#techndescription=="JMF benchmark"&&
#taxdescription=="Partial recovery"&]];

DateListPlot[RetrendNormalize[#,.01]&/@(timefunctiontocalendartime[#,{2007,12,1}]&/@
(n[t]/.("equilibrium time paths"/.Normal@fig11aresults))//Reverse),
PlotLabel->(Row[Style[#,16,FontFamily->"Times New Roman"]&/@{Style["Figure 11a.  ",Bold],"Labor usage: sensitivity analysis"}]),
PlotRange->{{DateObject@{2007,12,1},DateObject@{2013,12,1}},Automatic},
PlotLegends->Placed[f14/@{"Smaller elasticities","Benchmark"},
{1/2,3/4}],
FrameLabel->tr14/@{"","Aggregate hours, ratio to 2007 avg."},
FrameTicks->{{#,DateString[#,{"MonthNameShort"," ","YearShort"}]}&/@(DateObject@{2007,12,1}+Quantity[1,"Months"]+Quantity[Range[0,9],"Years"]),Automatic},
Evaluate@plopts]

fig11bresults=(Dataset@LocalSymbol[$LocalSymbolDefaultDirectory<>"JMFsimulations"])[Select[#paperversion=="JMF final"&&
(#tastedescription=="RR benchmark"||#tastedescription=="smaller elasticities")&&
#taxdescription=="Partial recovery"&]];

DateListPlot[(1/100) Inner[RetrendNormalize[#1,#2]&,(timefunctiontocalendartime[#,{2007,12,1}]&/@
Inner[#1//.#2&,((c[t]+(1-τ[t])α f[k[t],n[t],a](nonprimesh/(1-nonprimesh)))/.("equilibrium time paths"/.(Normal@fig11bresults)[[{3,2,1,4}]])),
Association@FilterRules["tastestechparams"/.#,{α,a,nonprimesh}]&/@(Normal@fig11bresults)[[{3,2,1,4}]],List]),
{.005,0,0,-.005}+.0175,List],
PlotLabel->(Row[Style[#,16,FontFamily->"Times New Roman"]&/@{Style["Figure 11b.  ",Bold],"Aggregate consumption: sensitivity analysis"}]),
PlotRange->{{DateObject@{2007,12,1},DateObject@{2013,12,1}},{Automatic,1.15}},
PlotStyle->{{Blue,Thickness[1/150]},{Darker@Green,Thickness[1/150]},{Red,Thickness[1/150]},{Black,Thickness[1/150]}},
PlotLegends->Placed[f14/@{"High TFP growth","Smaller elasticities","Benchmark","Low TFP growth"},
{1/2,3/4}],
FrameLabel->tr14/@{"","Ratio to 2007-Q4"},
FrameTicks->{{#,DateString[#,{"MonthNameShort"," ","YearShort"}]}&/@(DateObject@{2007,12,1}+Quantity[1,"Months"]+Quantity[Range[0,9],"Years"]),Automatic},
Evaluate@plopts]

DateListPlot[(1/100) Inner[RetrendNormalize[#1,#2]&,(timefunctiontocalendartime[#,{2007,12,1}]&/@
Inner[#1//.#2&,( f[k[t],n[t],a](1+(1-τ[t])α(nonprimesh/(1-nonprimesh)))/.("equilibrium time paths"/.(Normal@fig11bresults)[[{3,2,1,4}]])),
Association@FilterRules["tastestechparams"/.#,{α,a,nonprimesh}]&/@(Normal@fig11bresults)[[{3,2,1,4}]],List]),
{.005,0,0,-.005}+.0175,List],
PlotLabel->(Row[Style[#,16,FontFamily->"Times New Roman"]&/@{Style["Figure 11c.  ",Bold],"Aggregate output: sensitivity analysis"}]),
PlotRange->{{DateObject@{2007,12,1},DateObject@{2013,12,1}},{Automatic,1.15}},
PlotStyle->{{Blue,Thickness[1/150]},{Darker@Green,Thickness[1/150]},{Red,Thickness[1/150]},{Black,Thickness[1/150]}},
PlotLegends->Placed[f14/@{"High TFP growth","Smaller elasticities","Benchmark","Low TFP growth"},
{1/2,3/4}],
FrameLabel->tr14/@{"","Ratio to 2007-Q4"},
FrameTicks->{{#,DateString[#,{"MonthNameShort"," ","YearShort"}]}&/@(DateObject@{2007,12,1}+Quantity[1,"Months"]+Quantity[Range[0,9],"Years"]),Automatic},
Evaluate@plopts]