Fill regions in DateListPlot

Question

Let's use some sample date data

Clear["Global`*"];

data1 = TimeSeries[{1, 2, 1, 3, 0, 0, 0, 2, 22, 14, 21, 7, 11, 5, 10, 
18, 73, 38, 103, 21, 35, 31, 46, 31, 35, 94, 71, 48, 78, 71, 74, 
95, 95, 56, 102, 101, 129, 69, 60, 62, 20, 77, 52, 71, 56, 70, 33,
31, 25, 22, 15, 17, 11, 3, 7, 156, 7, 55, 27, 16, 11, 17, 32, 10,
15, 21}, {"Feb 26, 2020"}];

dticks1 = System`DateListPlotDump`DateTicks[data1 /@ {"FirstDate", "LastDate"}, 10, {"Day", "/", "Month"}];

plot = DateListPlot[data1, FrameTicks -> {{Automatic, Automatic}, {dticks1, dticks1}}, 
       FrameTicksStyle -> {{Automatic, Automatic}, {Automatic, FontOpacity -> 0}}, 
       Mesh -> All, PlotRange -> All, ImageSize -> 500]

which produces

Now I want the following: fill with a color (e.g., red) the rectangular regions on the plot from

• March 7 to March 25 and
• April 3 to April 26

Any suggestions?

Answer 1

Could use Prolog

{p1, p2, p3, p4} = AbsoluteTime /@
   {{2020, 3, 7}, {2020, 3, 25}, {2020, 4, 3}, {2020, 4, 26}};

{ymin, ymax} = Through[{Min, Max}[data1[[2, 1]]]];
range = ymax - ymin;
{ymin, ymax} += {-range, range}/10;

plot = DateListPlot[data1,
  FrameTicks -> {{Automatic, Automatic}, {dticks1, dticks1}},
  FrameTicksStyle -> {{Automatic, Automatic}, {Automatic, FontOpacity -> 0}},
  Mesh -> All, PlotRange -> All, ImageSize -> 500,
  Prolog -> {LightOrange,
    Polygon[{{p1, ymin}, {p1, ymax}, {p2, ymax}, {p2, ymin}}], 
    Polygon[{{p3, ymin}, {p3, ymax}, {p4, ymax}, {p4, ymin}}]}]

Answer 2

Update: Using a single DateListPlot with multiple data sets:

minmax = {-5, 10} + MinMax@data1;

DateListPlot[Join[{data1}, {data1}, Thread[{#, 0}] & /@ dateintervals],
 Joined -> {True, False, True, True},
 FrameTicks -> {{Automatic, Automatic}, {dticks1, dticks1}},
 FrameTicksStyle -> {{Automatic, Automatic}, {Automatic, 
    FontOpacity -> 0}},
 PlotRange -> All, ImageSize -> 500,
 PlotStyle -> {ColorData[97]@1, ColorData[97]@1, None, None},
 Filling -> Tuples[{3, 4} -> minmax], 
 PlotLegends -> {Placed[LineLegend[{ColorData[97]@1}, {"data1"}, 
     LegendMarkerSize -> 25, LegendMarkers -> {Automatic, 12}], Right],
   Placed[SwatchLegend[Opacity[.3, ColorData[97]@#] & /@ {3, 4},
     Row[DateObject /@ #, "-"] & /@ dateintervals, 
     LegendMarkerSize -> 25], Right]}]

Original answer:

dlp = DateListPlot[data1, 
   FrameTicks -> {{Automatic, Automatic}, {dticks1, dticks1}}, 
   FrameTicksStyle -> {{Automatic, Automatic}, {Automatic, FontOpacity -> 0}},
   Mesh -> All,  PlotRange -> All, ImageSize -> 500];

dateintervals = {{{2020, 3, 7}, {2020, 3, 25}}, {{2020, 4, 3}, {2020, 4, 26}}};

Get the vertical plot range of dlp (inclusive of paddings):

pr = Charting`get2DPlotRange[dlp][[2]];

Construct a new data set using dateintervals and pr and use it with DateListPlot with desired FillingStyle:

dlp2 = DateListPlot[Thread[{#, 1.1 pr[[2]]}] & /@ dateintervals, 
   Filling -> pr[[1]], FillingStyle -> Opacity[.5, LightRed]];

Show the main plot dlp using the graphics primitives from dlp2 as Prolog (so that main plot primitives are not occluded):

Show[dlp, Prolog -> dlp2[[1]]]

Answer 3

dateintervals = {{{2020, 3, 7}, {2020, 3, 25}}, {{2020, 4, 3}, {2020, 4, 26}}};

Use dateintervals with TimeSeriesWindow to create additional data sets to append to data1 and plot them using a single DateListPlot:

DateListPlot[Join[{data1}, TimeSeriesWindow[data1, #] & /@ dateintervals], 
 PlotStyle -> ColorData[97][1], 
 Filling -> Tuples[{2, 3} -> {-2, 2} Max[data1]],
 FillingStyle -> Opacity[.5, LightRed], 
 FrameTicks -> {{Automatic, Automatic},
  {dticks1, {AbsoluteTime@#, DateString[#, {"Day", "/", "Month"}]} & /@ 
   (Join @@ dateintervals)}},
 PlotRange -> All, ImageSize -> 500]

Answer 4

Using Epilog etc seems to refuse to cooperate, so the other option is to use Show:

tags=data1["Times"]//Map[DateString[#,{"Day","/","Month"}]&];
tgs={"07/03","25/03","03/04","26/04"};
pos=Position[tags,#]&/@tgs;
dts=Extract[data1["Times"],pos]//Flatten;
{mn,mx}=Through[{Min,Max}[data1]];
rects={dts,{mn,mx,mn,mx}}//Transpose/*(Partition[#,2]&)/*(Apply[Rectangle,#,1]&);
grphs=Graphics/@Prepend[rects,FaceForm[{Red,Opacity[0.1]}]];

Show[plot,grphs]

Answer 5

I adapted @kglr answer to fit generalize number of regions. I omitted the doting requirements and others.

DatePlotRegions[data1_, dateintervals_] := 
 DateListPlot[
  Join[ {data1}, {data1}, 
   Thread[{#, Max[data1]*70}] & /@ dateintervals], 
  Filling -> 
   Tuples[Range[3, Length[dateintervals] + 3] -> {Top, Bottom}], 
  FillingStyle -> Opacity[.3], 
  PlotLegends -> {Placed[
     SwatchLegend[
      Opacity[.3, ColorData[97]@#] & /@ 
       Range[3, Length[dateintervals] + 3], 
      Row[DateObject /@ #, "-"] & /@ dateintervals, 
      LegendMarkerSize -> 10], Right]}, 
  PlotRange -> {{MinDate[#], MaxDate[#]} &@
     data1, (MinMax@data1) + {(-0.12)*
       Abs[Max[Min[data1], Max[data1] - Min[data1]]], 
      0.12*Abs[Max[Max[data1], Max[data1] - Min[data1]]]}  }]