使用带有条件的cumsum进行重置，两种情况

Question

我有一个数据框，我试图在其中找到两件事：1）事件的开始，2）事件的结束。事件的开始基于累积和阈值，而事件的结束取决于值大于 0 的最后一行与当前时间之间存在 5 行 0 值。

示例数据如下

# hourly time series
a <- seq(from=as.POSIXct("2012-06-01 0:00", tz="UTC"),
         to=as.POSIXct("2012-09-01 00:00", tz="UTC"),
         by="hour")  

# mock data 
b <- sample.int(10, 2209, replace = TRUE)*sample(c(0,1), replace=TRUE, size=2209)

# mock time series data table
c <- data.table(a,b)
                        a b
   1: 2012-06-01 00:00:00 0
   2: 2012-06-01 01:00:00 0
   3: 2012-06-01 02:00:00 0
   4: 2012-06-01 03:00:00 7
   5: 2012-06-01 04:00:00 0
  ---                      
2205: 2012-08-31 20:00:00 8
2206: 2012-08-31 21:00:00 4
2207: 2012-08-31 22:00:00 2
2208: 2012-08-31 23:00:00 0
2209: 2012-09-01 00:00:00 0
---

我想根据累积总和 10 的阈值（在 b 列中）识别时间序列中的事件。因此，当某个日期/时间的累积总和为 10 或更多时，事件就会开始。

c$cumsum <- with(c, ave(b, cumsum(b == 0), FUN = cumsum))

                        a b cumsum
   1: 2012-06-01 00:00:00 0      0
   2: 2012-06-01 01:00:00 0      0
   3: 2012-06-01 02:00:00 0      0
   4: 2012-06-01 03:00:00 7      7
   5: 2012-06-01 04:00:00 0      0
  ---                             
2205: 2012-08-31 20:00:00 8      8
2206: 2012-08-31 21:00:00 4     12
2207: 2012-08-31 22:00:00 2     14
2208: 2012-08-31 23:00:00 0      0
2209: 2012-09-01 00:00:00 0      0

例如，在上面的代码中，由于 b = 12 的累积和，事件将在 2012-08-31 21:00:00 开始。此外，虽然 2012-08-31 22:00:00 有一个 14 的 cumsum，它不是一个事件的开始，因为该事件在它之前的一小时开始（基于事件开始时 cumsum => 10 的条件）。

我还需要找到事件的结束，这就是我卡住的地方。事件结束将在 5 小时过去后发生，没有任何值（即 b 列中有 0 的 5 行）。然后我想创建一个数据框，它只包含事件（即事件开始的日期/时间，以及同一事件结束的相应日期/时间）。这看起来像（手动，假的例子）：

# dataframe for event start, and the corresponding cumsum of b
              event_start cumsum_b
   1: 2012-06-01 00:00:00 12
   2: 2012-06-09 11:00:00 11
   3: 2012-06-15 02:00:00 10

# dataframe for event end
              event_end   b
   1: 2012-06-01 00:7:00  0
   2: 2012-06-09 18:00:00 0
   3: 2012-06-15 12:00:00 0

Answer 1

library(tidyverse)

df <- tibble(
  a = seq.Date(from = as.Date('2020-01-01'), length.out = 20, by = "days"),
  b = c(0, 0, 0, 7, 0, 8, 12, 0, 0, 0, 0, 0, 0, 14, 3, 0, 0, 0, 0, 0)
)

我们可以使用lag 找到结尾。然后使用cumsum和cummax创建重置累积和。

events <-
  df %>%
  mutate(
    is_end = coalesce(b == 0 & lag(b) == 0 & lag(b, 2) == 0 & lag(b, 3) == 0 & lag(b, 4) == 0 & lag(b, 5) != 0, FALSE),
    cumsum = cumsum(b) - cummax(is_end * cumsum(b)),
    is_event = cumsum >= 10,
    start = is_event & !lag(is_event),
    end = !is_event & lag(is_event)
  )
events
#> # A tibble: 20 x 7
#>   a               b  is_end  cumsum is_event start end  
#>   <date>      <dbl>  <lgl>   <dbl>  <lgl>    <lgl> <lgl>
#> 1 2020-01-01      0  FALSE   0      FALSE    FALSE NA   
#> 2 2020-01-02      0  FALSE   0      FALSE    FALSE FALSE
#> 3 2020-01-03      0  FALSE   0      FALSE    FALSE FALSE
#> 4 2020-01-04      7  FALSE   7      FALSE    FALSE FALSE
#> 5 2020-01-05      0  FALSE   7      FALSE    FALSE FALSE
#> 6 2020-01-06      8  FALSE   15     TRUE     TRUE  FALSE
#> 7 2020-01-07     12  FALSE   27     TRUE     FALSE FALSE
#> 8 2020-01-08      0  FALSE   27     TRUE     FALSE FALSE
#> 9 2020-01-09      0  FALSE   27     TRUE     FALSE FALSE
#> 10 2020-01-10     0  FALSE   27     TRUE     FALSE FALSE
#> 11 2020-01-11     0  FALSE   27     TRUE     FALSE FALSE
#> 12 2020-01-12     0  TRUE    0      FALSE    FALSE TRUE 
#> 13 2020-01-13     0  FALSE   0      FALSE    FALSE FALSE
#> 14 2020-01-14    14  FALSE   14     TRUE     TRUE  FALSE
#> 15 2020-01-15     3  FALSE   17     TRUE     FALSE FALSE
#> 16 2020-01-16     0  FALSE   17     TRUE     FALSE FALSE
#> 17 2020-01-17     0  FALSE   17     TRUE     FALSE FALSE
#> 18 2020-01-18     0  FALSE   17     TRUE     FALSE FALSE
#> 19 2020-01-19     0  FALSE   17     TRUE     FALSE FALSE
#> 20 2020-01-20     0  TRUE    0      FALSE    FALSE TRUE 

然后，拉出开始日期和结束日期。

tibble(
  event_start = events %>% filter(start) %>% pull(a),
  event_end = events %>% filter(end) %>% pull(a)
)
#> # A tibble: 2 x 2
#>   event_start event_end 
#>   <date>      <date>    
#> 1 2020-01-06  2020-01-12
#> 2 2020-01-14  2020-01-20

---

如果您不想手动指定滞后时间

find_end <- function(x, n) {
  is_n_consecutive_zeros <-
    map(0:(n-1), ~lag(x, .)) %>%
    pmap_lgl(function(...) all(c(...) == 0))

  coalesce(is_n_consecutive_zeros & lag(x, n) != 0, FALSE)
}

df %>%
  mutate(
    is_end = find_end(b, 5),
    cumsum = cumsum(b) - cummax(is_end * cumsum(b)),
    is_event = cumsum >= 10,
    start = is_event & !lag(is_event),
    end = !is_event & lag(is_event)
  )
#> # A tibble: 20 x 7
#>    a              b is_end cumsum is_event start end  
#>    <date>     <dbl> <lgl>   <dbl> <lgl>    <lgl> <lgl>
#>  1 2020-01-01     0 FALSE       0 FALSE    FALSE NA   
#>  2 2020-01-02     0 FALSE       0 FALSE    FALSE FALSE
#>  3 2020-01-03     0 FALSE       0 FALSE    FALSE FALSE
#>  4 2020-01-04     7 FALSE       7 FALSE    FALSE FALSE
#>  5 2020-01-05     0 FALSE       7 FALSE    FALSE FALSE
#>  6 2020-01-06     8 FALSE      15 TRUE     TRUE  FALSE
#>  7 2020-01-07    12 FALSE      27 TRUE     FALSE FALSE
#>  8 2020-01-08     0 FALSE      27 TRUE     FALSE FALSE
#>  9 2020-01-09     0 FALSE      27 TRUE     FALSE FALSE
#> 10 2020-01-10     0 FALSE      27 TRUE     FALSE FALSE
#> 11 2020-01-11     0 FALSE      27 TRUE     FALSE FALSE
#> 12 2020-01-12     0 TRUE        0 FALSE    FALSE TRUE 
#> 13 2020-01-13     0 FALSE       0 FALSE    FALSE FALSE
#> 14 2020-01-14    14 FALSE      14 TRUE     TRUE  FALSE
#> 15 2020-01-15     3 FALSE      17 TRUE     FALSE FALSE
#> 16 2020-01-16     0 FALSE      17 TRUE     FALSE FALSE
#> 17 2020-01-17     0 FALSE      17 TRUE     FALSE FALSE
#> 18 2020-01-18     0 FALSE      17 TRUE     FALSE FALSE
#> 19 2020-01-19     0 FALSE      17 TRUE     FALSE FALSE
#> 20 2020-01-20     0 TRUE        0 FALSE    FALSE TRUE