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.
Something like:
library(dplyr)
dateRanges <- df %>%
mutate(Date2 = lead(Date)) %>%
filter(key == 'Station2', value > 0 | lead(value) > 0, Date2 - Date == 1)
gg1 +
geom_rect(data = dateRanges,
aes(xmin = Date, xmax = Date2, ymin = -Inf, ymax = Inf),
inherit.aes = FALSE,
color = NA,
fill = 'grey20',
alpha = 0.2)
It's easiest to just draw one rect
for per day.
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
<int> <date> <date>
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))