7
$\begingroup$

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

enter image description here

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?

$\endgroup$

5 Answers 5

5
$\begingroup$

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

enter image description here

$\endgroup$
3
  • $\begingroup$ Very good! Is there any way, to detect automatically the limits of the polygons, so as not to insert by hand e.g., -50, 200? $\endgroup$
    – Vaggelis_Z
    Jan 31, 2021 at 18:22
  • $\begingroup$ I have added a y-range calculation. $\endgroup$ Jan 31, 2021 at 18:48
  • 1
    $\begingroup$ The method from this answer can be adapted so that computing $y$-ranges is not necessary: Prolog -> {LightOrange, Rectangle[Scaled[{0, -1}, {p1, 0}], Scaled[{0, 1}, {p2, 0}]], Rectangle[Scaled[{0, -1}, {p3, 0}], Scaled[{0, 1}, {p4, 0}]]} (cc @Vaggelis) $\endgroup$ Feb 1, 2021 at 6:46
4
$\begingroup$

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

enter image description here

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

enter image description here

$\endgroup$
1
$\begingroup$
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]

enter image description here

$\endgroup$
0
$\begingroup$

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]
$\endgroup$
0
$\begingroup$

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

Result

$\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.