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?

Improve this question
$\endgroup$

5 Answers 5

Reset to default
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

Improve this answer
$\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$ Commented Jan 31, 2021 at 18:22
  • $\begingroup$ I have added a y-range calculation. $\endgroup$ Commented 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$ Commented 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

Improve this answer
$\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

Improve this answer
$\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]
Improve this answer
$\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

Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.