1
$\begingroup$

I have downloaded some data from the Federal Reserve of St Louis:

fred = ServiceConnect["FederalReserveEconomicData"];

StartDate = "2000-01-01";
EndDate = "2022-12-01";

rate = fred["SeriesData", "ID" -> {"FEDFUNDS"}, "Date" -> {StartDate, EndDate}];
recession = fred["SeriesData", "ID" -> {"USREC"}, "Date" -> {StartDate, EndDate}];

Since you might not have access to the data, I provide a minimal subset of the data:

Normal[rate]
{{DateObject[{2007, 8, 1, 0, 0, 0}, "Instant", "Gregorian",0.], 5.02},{DateObject[{2007, 9, 1, 0, 0, 0}, "Instant","Gregorian", 0.], 4.94}, {DateObject[{2007, 10, 1, 0, 0, 0}, "Instant", "Gregorian",0.], 4.76}, {DateObject[{2007, 11, 1, 0, 0, 0}, "Instant","Gregorian", 0.], 4.49}, {DateObject[{2007, 12, 1, 0, 0, 0},"Instant", "Gregorian",0.], 4.24}, {DateObject[{2008, 1, 1, 0, 0, 0}, "Instant","Gregorian", 0.], 3.94}, {DateObject[{2008, 2, 1, 0, 0, 0},"Instant", "Gregorian",0.], 2.98}, {DateObject[{2008, 3, 1, 0, 0, 0}, "Instant","Gregorian", 0.], 2.61}, {DateObject[{2008, 4, 1, 0, 0, 0},"Instant", "Gregorian",0.], 2.28}, {DateObject[{2008, 5, 1, 0, 0, 0}, "Instant","Gregorian", 0.], 1.98}, {DateObject[{2008, 6, 1, 0, 0, 0},"Instant", "Gregorian", 0.], 2.}, {DateObject[{2008, 7, 1, 0, 0, 0}, "Instant", "Gregorian",0.], 2.01}, {DateObject[{2008, 8, 1, 0, 0, 0}, "Instant","Gregorian", 0.], 2.}, {DateObject[{2008, 9, 1, 0, 0, 0}, "Instant", "Gregorian", 0.], 1.81}, {DateObject[{2008, 10, 1, 0, 0, 0},"Instant", "Gregorian",0.], 0.97}, {DateObject[{2008, 11, 1, 0, 0, 0}, "Instant","Gregorian", 0.], 0.39}, {DateObject[{2008, 12, 1, 0, 0, 0},"Instant", "Gregorian",0.], 0.16}, {DateObject[{2009, 1, 1, 0, 0, 0}, "Instant","Gregorian", 0.], 0.15}, {DateObject[{2009, 2, 1, 0, 0, 0},"Instant", "Gregorian",0.], 0.22}, {DateObject[{2009, 3, 1, 0, 0, 0}, "Instant","Gregorian", 0.], 0.18}, {DateObject[{2009, 4, 1, 0, 0, 0},"Instant", "Gregorian",0.], 0.15}, {DateObject[{2009, 5, 1, 0, 0, 0}, "Instant","Gregorian", 0.], 0.18}, {DateObject[{2009, 6, 1, 0, 0, 0},"Instant", "Gregorian",0.], 0.21}, {DateObject[{2009, 7, 1, 0, 0, 0}, "Instant","Gregorian", 0.], 0.16}, {DateObject[{2009, 8, 1, 0, 0, 0},"Instant", "Gregorian",0.], 0.16}, {DateObject[{2009, 9, 1, 0, 0, 0}, "Instant","Gregorian", 0.], 0.15}}
Normal[recession]
{{DateObject[{2007, 8, 1, 0, 0, 0}, "Instant", "Gregorian",0.], 0.}, {DateObject[{2007, 9, 1, 0, 0, 0}, "Instant", "Gregorian",0.], 0.}, {DateObject[{2007, 10, 1, 0, 0, 0}, "Instant","Gregorian", 0.], 0.}, {DateObject[{2007, 11, 1, 0, 0, 0},"Instant", "Gregorian",0.], 0.}, {DateObject[{2007, 12, 1, 0, 0, 0}, "Instant","Gregorian", 0.], 0.}, {DateObject[{2008, 1, 1, 0, 0, 0}, "Instant", "Gregorian", 0.], 1.}, {DateObject[{2008, 2, 1, 0, 0, 0},"Instant", "Gregorian", 0.], 1.}, {DateObject[{2008, 3, 1, 0, 0, 0}, "Instant", "Gregorian",0.], 1.}, {DateObject[{2008, 4, 1, 0, 0, 0}, "Instant", "Gregorian",0.], 1.}, {DateObject[{2008, 5, 1, 0, 0, 0}, "Instant","Gregorian", 0.], 1.}, {DateObject[{2008, 6, 1, 0, 0, 0}, "Instant", "Gregorian", 0.], 1.}, {DateObject[{2008, 7, 1, 0, 0, 0},"Instant", "Gregorian", 0.], 1.}, {DateObject[{2008, 8, 1, 0, 0, 0}, "Instant", "Gregorian",0.], 1.}, {DateObject[{2008, 9, 1, 0, 0, 0}, "Instant", "Gregorian",0.], 1.}, {DateObject[{2008, 10, 1, 0, 0, 0}, "Instant","Gregorian", 0.], 1.}, {DateObject[{2008, 11, 1, 0, 0, 0},"Instant", "Gregorian",0.], 1.}, {DateObject[{2008, 12, 1, 0, 0, 0}, "Instant","Gregorian", 0.], 1.}, {DateObject[{2009, 1, 1, 0, 0, 0}, "Instant", "Gregorian", 0.], 1.}, {DateObject[{2009, 2, 1, 0, 0, 0},"Instant", "Gregorian", 0.], 1.}, {DateObject[{2009, 3, 1, 0, 0, 0}, "Instant", "Gregorian",0.], 1.}, {DateObject[{2009, 4, 1, 0, 0, 0}, "Instant", "Gregorian",0.], 1.}, {DateObject[{2009, 5, 1, 0, 0, 0}, "Instant","Gregorian", 0.], 1.}, {DateObject[{2009, 6, 1, 0, 0, 0}, "Instant", "Gregorian", 0.], 1.}, {DateObject[{2009, 7, 1, 0, 0, 0},"Instant", "Gregorian", 0.], 0.}, {DateObject[{2009, 8, 1, 0, 0, 0}, "Instant", "Gregorian",0.], 0.}, {DateObject[{2009, 9, 1, 0, 0, 0}, "Instant", "Gregorian",0.], 0.}}

As you can see, the variable recession has the same monthly frequency as the variable rate but only takes values in $\{0,1\}$.

Next, I plot the time series rate:

DateListPlot[{rate}]

enter image description here

I would like to add to this graph shaded regions corresponding to the points where recession takes the value of 1. More precisely, for the given sample data, I would expect the shaded region to start in January 2008 and finish in June 2009. But the procedure should be sufficiently general to produce another shaded area when the variable recession takes again the value of 1. How can I do it? I have attempted to follow this post but it does not cover my case where the shaded region is dictated by an indicator variable.

$\endgroup$
2
  • $\begingroup$ Please provide (mock) data (or a minimal subset of the OP data) as access to the service requires credentials/API key. $\endgroup$
    – Syed
    Dec 13, 2022 at 7:08
  • $\begingroup$ I added a minimal subset of the data as suggested. I also added more details to the question. $\endgroup$
    – NC520
    Dec 13, 2022 at 10:18

2 Answers 2

2
$\begingroup$

You can show another plot over the top with a Filling, hide the line, and use InterpolationOrder -> 0 to prevent the line from sloping:

minrate = Min[rate[[All, 2]]];
Show[
 DateListPlot[TimeSeriesMap[# &, rate], PlotRange -> {minrate, 6}],
 DateListPlot[TimeSeriesMap[#*10 + minrate &, recession],
  Filling -> Bottom,
  PlotStyle -> None,
  InterpolationOrder -> 0]
 ]

recessions

$\endgroup$
5
  • $\begingroup$ Thanks. How can I make it fill the whole region up to the bottom axis? In other words, how can I remove the white space at the bottom? $\endgroup$
    – NC520
    Dec 13, 2022 at 10:36
  • 1
    $\begingroup$ @NC520 Add a PlotRange to the first plot so it becomes: DateListPlot[rate, PlotRange -> {0, 5}], $\endgroup$
    – flinty
    Dec 13, 2022 at 10:40
  • $\begingroup$ This doesn't work as expected because the series rates can become negative but the shaded region always starts at zero. $\endgroup$
    – NC520
    Dec 13, 2022 at 10:42
  • $\begingroup$ I should have asked a different question: how can I modify the code so that the shaded region is allowed to go below zero? $\endgroup$
    – NC520
    Dec 13, 2022 at 10:45
  • 1
    $\begingroup$ @NC520 you just need to add the minimum rate to deal with that. I updated my answer. $\endgroup$
    – flinty
    Dec 13, 2022 at 10:52
2
$\begingroup$

With rate and recession as defined in the OP, define a third plot as the one that will be used for Filling.

rdata = Select[
  Transpose[{rate[[All, 1]], rate[[All, 2]] recession[[All, 2]]}], 
  Last@# != 0 &]

Using DateListStepPlot and optionally changing the PlotRange:

DateListStepPlot[{rate, recession, rdata}, 
 PlotStyle -> {ColorData[97][1], ColorData[97][2], None}, 
 Filling -> {3 -> Bottom}, PlotRange -> {-2, 6}]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.