Блог

Главная - Вопросы по программированию - использование cumsum с условиями для сброса, два сценария

использование cumsum с условиями для сброса, два сценария

#r #datetime #cumsum

#r #дата и время #cumsum

Вопрос:

У меня есть фрейм данных, в котором я пытаюсь найти две вещи: 1) начало события и 2) конец события. Начало события основано на пороге кумулятивной суммы, тогда как конец события зависит от наличия 5 строк с 0 значениями между последней строкой со значением больше 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

Например, в приведенном выше коде событие начнется в 2012-08-31 21:00:00 из-за совокупной суммы b = 12. Кроме того, хотя 2012-08-31 22:00:00 имеет cumsum равный 14, это не начало события, поскольку событие началось за час до него (исходя из условия начала события, когда cumsum => 10).

Мне также нужно найти конец события, и здесь я застрял. Завершение события произойдет по истечении 5 часов без каких-либо значений (т.Е. 5 строк с 0 в столбце b). Затем я хотел бы создать фрейм данных, который состоит только из событий (т. Е. Даты / времени начала события с соответствующей датой / временем окончания того же события). Это будет выглядеть как (ручной, поддельный пример):

 # 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

Ответ №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 amp; lag(b) == 0 amp; lag(b, 2) == 0 amp; lag(b, 3) == 0 amp; lag(b, 4) == 0 amp; lag(b, 5) != 0, FALSE),
    cumsum = cumsum(b) - cummax(is_end * cumsum(b)),
    is_event = cumsum >= 10,
    start = is_event amp; !lag(is_event),
    end = !is_event amp; 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 amp; 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 amp; !lag(is_event),
    end = !is_event amp; 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

Комментарии:

1. Есть ли другой способ определить is_end, помимо ручного ввода 5 аргументов lag() ? Если я изменил свое условие так, чтобы я хотел, чтобы is_end основывался на 20 строках со значениями 0.0 в столбце b, кажется неэффективным вводить lag() 20 раз.

2. @joedes18 смотрите мою правку для метода, который позволяет избежать ручного ввода задержек.