Automatic way to highlight parts of a time series plot that have values higher than a certain threshold?

Question

I\'m looking for an automatic way of highlighting some portions of the plot that have Station2 values greater than a pre-defined threshold which is 0 in this case.

Answer 1

Here's a way using dplyr and tidyr from the tidyverse meta-package to create one rect per positive range of Station2 Flow:

First I isolate Station2's Flow rows, then filter for the zeros before or after positive values, then gather and spread to create a start and end for each contiguous section:

library(tidyverse)
dateRanges <- df %>%
  filter(key == "Station2", grp == "Flow (cfs)") %>%
  mutate(from = value == 0 & lead(value, default = -1) > 0,
         to   = value == 0 &  lag(value, default = -1) > 0,
         highlight_num = cumsum(from)) %>% 
  gather(type, val, from:to) %>%
  filter(val) %>%
  select(type, Date, highlight_num) %>%
  spread(type, Date)

> dateRanges
# A tibble: 2 x 3
  highlight_num from       to        
                    
1             1 2012-02-10 2012-02-23
2             2 2012-01-19 2012-02-04

Note, my range specifications are a bit different here, since it looks like your ranges start from the first positive value but continue to the zero following a positive range. For my code, you'd plot:

...
geom_rect(data = dateRanges, 
            aes(xmin = from, xmax = to, ymin = -Inf, ymax = Inf),
...

---

Edit #2:

The original poster provided a larger sample of data that exposed two edge cases I hadn't considered. 1) NA's in value; easy to filter for. 2) occasions where a single day goes to zero, thus being both the start and end of a range. One approach to deal with this is to define the start and end as the first and last positive values. The code below seemed to work on the larger data.

dateRanges <- df %>%
  filter(!is.na(value)) %>%
  filter(key == "Station2", grp == "Flow (cfs)") %>%
  mutate(positive = value > 0,
         border   = positive != lag(positive, default = TRUE),
         from     = border & positive,
         to       = border & !positive,
         highlight_num = cumsum(from)) %>%
  gather(type, val, from:to) %>% 
  filter(val) %>% 
  select(type, Date, highlight_num) %>%
  spread(type, Date) %>%
  filter(!is.na(from), !is.na(to))