使用 slice() 过滤峰值间隔

Question

考虑以下数据集：

df <- tibble(
  interval = rep(1:10, 4),
  channel = rep(1:2, each = 20),
  date = parse_date(rep(c("2020-07-01", "2020-07-02", "2020-07-03", "2020-07-04"), 
             times = 2, each = 5)), 
  time = parse_time(
    rep(format(seq.POSIXt(as.POSIXct(Sys.Date() + 0.05), 
                          as.POSIXct(Sys.Date() + 0.95), length.out = 5),
               "%H:%M:%S", tz="GMT"), 8), format = "%H:%M:%S"),
  trigger = c(rep(0,5),        # Ch 1, day 1; no max
              0, 2, 0, 2, 0,   # Ch 1, day 2; 2 maxes
              rep(0, 5),       # Ch 1, day 3; no max
              0, 0, 2, 0, 0,   # Ch 1, day 4
              0, 0, 10, 0, 0,  # Ch 2, day 1
              10, rep(0, 4),   # Ch 2, day 2; max at head
              rep(0, 4), 10,   # Ch 2, day 3; max at tail
              4, 10, 4, 10, 0) # Ch 2, day 4; 2 maxes
)
# A tibble: 40 x 5
   interval channel date       time   trigger
      <int>   <int> <date>     <time>   <dbl>
 1        1       1 2020-07-01 01:12        0
 2        2       1 2020-07-01 06:36        0
 3        3       1 2020-07-01 12:00        0
 4        4       1 2020-07-01 17:24        0
 5        5       1 2020-07-01 22:48        0
 6        6       1 2020-07-02 01:12        0
 7        7       1 2020-07-02 06:36        2
 8        8       1 2020-07-02 12:00        0
 9        9       1 2020-07-02 17:24        2
10       10       1 2020-07-02 22:48        0
# ... with 30 more rows

我的数据有 10,000 多行来自传感器的记录，每天记录在一个时间间隔内它被触发了多少次。我想使用 slice() 在每天的峰值触发时间前后过滤 2 小时的时间间隔。我有有效的代码，但它会针对特定情况生成警告，我将在稍后进行解释。尽管警告不会影响结果，但如果没有警告，我会感到更安心。我需要考虑的条件是：

传感器未被触发的时间 > 1 天（触发 = 0）
触发器在一天的开头或结尾达到峰值
触发峰值每天不止一次（不同时间的最大值相同）

我主要使用 tidyverse 和 lubridate 函数进行编码。到目前为止我最好的工作代码如下：

df %>% 
  group_by(date, channel) %>%
  slice(abs(which.max(trigger) + (-1:1))) %>% # Simplifying my interval with 1 row around the peak
  ungroup() %>%
  arrange(channel) %>% 
  print()
# A tibble: 20 x 5
   interval channel date       time   trigger
      <int>   <int> <date>     <time>   <dbl>
 1        1       1 2020-07-01 01:12        0
 2        2       1 2020-07-01 06:36        0
 3        6       1 2020-07-02 01:12        0
 4        7       1 2020-07-02 06:36        2
 5        8       1 2020-07-02 12:00        0
 6        1       1 2020-07-03 01:12        0
 7        2       1 2020-07-03 06:36        0
 8        7       1 2020-07-04 06:36        0
 9        8       1 2020-07-04 12:00        2
10        9       1 2020-07-04 17:24        0
11        2       2 2020-07-01 06:36        0
12        3       2 2020-07-01 12:00       10
13        4       2 2020-07-01 17:24        0
14        6       2 2020-07-02 01:12       10
15        7       2 2020-07-02 06:36        0
16        4       2 2020-07-03 17:24        0
17        5       2 2020-07-03 22:48       10
18        6       2 2020-07-04 01:12        4
19        7       2 2020-07-04 06:36       10
20        8       2 2020-07-04 12:00        4

我想过按间隔而不是峰值来切片，但间隔并不总是连续的；这取决于我什么时候重置我的程序。如果有 2 个或更多峰，我不介意过滤第一个峰。如果我能确定哪里有多个峰值，那就更好了！最后，如果一天没有触发器，我不希望包括那一天。我想我可以 post-过滤掉不活动，但我仍然会收到警告。

快速回顾：

我的目标是过滤峰值触发时间前后的 2 小时间隔。如果您可以推荐 tidyverse/lubridate（或任何真正的！）解决方案，我将不胜感激。谢谢！

Answer 1

您可以编写自定义函数来测试各种条件，这样就不会生成警告。

custom_fun <- function(trigger) {
   #trigger value greater than 0
   inds <- trigger > 0
   #If any value greater than 0
   if(any(inds)) {
    #return the 2-hour interval
    vals <- which.max(trigger) + -1:1
    #remove values during head and tail of the day   
    return(vals[vals > 0 & vals <= length(trigger)])
   }
      #Don't select anything if no trigger > 0
      else return(0)
}

然后为每个 date 和 channel 应用它。

library(dplyr)

df %>% 
  group_by(date, channel) %>%
  #If multiple peaks present.
  mutate(mulitple_peak = sum(trigger == max(trigger)) > 1) %>%
  slice(custom_fun(trigger)) %>%
  ungroup()


# A tibble: 16 x 6
#   interval channel date       time   trigger mulitple_peak
#      <int>   <int> <date>     <time>   <dbl> <lgl>        
# 1        2       2 2020-07-01 06:36        0 FALSE        
# 2        3       2 2020-07-01 12:00       10 FALSE        
# 3        4       2 2020-07-01 17:24        0 FALSE        
# 4        6       1 2020-07-02 01:12        0 TRUE         
# 5        7       1 2020-07-02 06:36        2 TRUE         
# 6        8       1 2020-07-02 12:00        0 TRUE         
# 7        6       2 2020-07-02 01:12       10 FALSE        
# 8        7       2 2020-07-02 06:36        0 FALSE        
# 9        4       2 2020-07-03 17:24        0 FALSE        
#10        5       2 2020-07-03 22:48       10 FALSE        
#11        7       1 2020-07-04 06:36        0 FALSE        
#12        8       1 2020-07-04 12:00        2 FALSE        
#13        9       1 2020-07-04 17:24        0 FALSE        
#14        6       2 2020-07-04 01:12        4 TRUE         
#15        7       2 2020-07-04 06:36       10 TRUE         
#16        8       2 2020-07-04 12:00        4 TRUE

使用 slice() 过滤峰值间隔

Using slice() to filter for peak intervals

r

slice

lubridate

tidyverse