基于 R 中的多个半复杂过滤条件创建列（dplyr、stringr、lubridate）

Question

我有一个数据集，df

 Read      Box       ID      Time                            
 T         out               10/1/2019 9:00:01 AM
 T         out               10/1/2019 9:00:02 AM             
 T         out               10/1/2019 9:00:03 AM            
 T         out               10/1/2019 9:02:59 AM             
 T         out               10/1/2019 9:03:00 AM
 F                           10/1/2019 9:05:00 AM
 T         out               10/1/2019 9:06:00 AM             
 T         out               10/1/2019 9:06:02 AM             
 T         in                10/1/2019 9:07:00 AM
 T         in                10/1/2019 9:07:02 AM
 T         out               10/1/2019 9:07:04 AM
 T         out               10/1/2019 9:07:05 AM             
 T         out               10/1/2019 9:07:06 AM             
 T         out    hello      10/1/2019 9:07:08 AM
 F         in                10/1/2019 9:08:10 AM
 F         in                10/1/2019 9:08:11 AM
 T         draft             10/2/2019 10:00:00 AM
 T         draft             10/2/2019 10:00:05 AM
 T         draft             10/2/2019 10:00:20 AM
 T         draft             10/2/2019 10:00:25 AM
 T         draft             10/2/2019 10:02:00 AM
 T         draft             10/2/2019 10:02:20 AM

基于此数据集中的某些条件，我想创建一个 starttime 列和一个 endtime 列。

我想在发生以下情况时创建一个“开始时间”： Read == "T", Box == "out" OR Box == "draft", ID == ""

我想在发生以下情况时创建一个“结束时间”： 读取 == "T"、Box == "out" OR Box == "draft" 和 ID == "" 并且所需条件之间的差距小于 30 秒。

当这种情况的第一个实例发生时，将生成一个开始时间。例如对于这个数据集，开始时间将是 10/1/2019 9:00:01 AM，因为这是我们看到所需条件的地方 Read = T, Box = "out" or Box == "draft" and ID = " "

但是，如果这些条件中的任何一个不成立，或者时间戳之间的时间超过 30 秒，则会创建一个结束时间。例如，在第 17 行创建了一个开始时间： 2019 年 10 月 2 日上午 10:00:00，将在第 20 行创建结束时间：2019 年 10 月 2 日上午 10:00:25

由于时间戳之间的时间超过 30 秒，下一个开始时间将创建于：2019 年 10 月 2 日上午 10:02:00。 我不确定是否需要在此代码中加入一个 thresh 来满足这一点？我只是不确定如何实现这一点。 任何建议表示赞赏。

  starttime                    endtime                     duration

  10/1/2019 9:00:01 AM        10/1/2019 9:03:00 AM         179 secs
  10/1/2019 9:06:00 AM        10/1/2019 9:06:02 AM         2 secs
  10/1/2019 9:07:05 AM        10/1/2019 9:07:06 AM         1 secs
  10/2/2019 10:00:00 AM       10/2/2019 10:00:25 AM        25 secs
  10/2/2019 10:02:00 AM       10/2/2019 10:02:20 AM        20 secs

输入：

  structure(list(Read = c(TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, 
  TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, 
  TRUE, TRUE, TRUE, TRUE, TRUE, TRUE), Box = structure(c(4L, 4L, 
  4L, 4L, 4L, 1L, 4L, 4L, 3L, 3L, 4L, 4L, 4L, 4L, 3L, 3L, 2L, 2L, 
  2L, 2L, 2L, 2L), .Label = c("", "draft", "in", "out"), class = "factor"), 
  ID = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
  1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("", 
  "hello"), class = "factor"), Time = structure(1:22, .Label = c("10/1/2019 9:00:01 AM", 
  "10/1/2019 9:00:02 AM", "10/1/2019 9:00:03 AM", "10/1/2019 9:02:59 AM", 
  "10/1/2019 9:03:00 AM", "10/1/2019 9:05:00 AM", "10/1/2019 9:06:00 AM", 
  "10/1/2019 9:06:02 AM", "10/1/2019 9:07:00 AM", "10/1/2019 9:07:02 AM", 
  "10/1/2019 9:07:04 AM", "10/1/2019 9:07:05 AM", "10/1/2019 9:07:06 AM", 
  "10/1/2019 9:07:08 AM", "10/1/2019 9:08:10 AM", "10/1/2019 9:08:11 AM", 
  "10/2/2019 10:00:00 AM", "10/2/2019 10:00:05 AM", "10/2/2019 10:00:20 AM", 
  "10/2/2019 10:00:25 AM", "10/2/2019 10:02:00 AM", "10/2/2019 10:02:20 AM"
   ), class = "factor")), class = "data.frame", row.names = c(NA, 
  -22L))

我还想在此代码中加入 Box == "draft" 以及 >30 秒阈值

  library(dplyr)



  Thresh <- 30  (seconds)


  df1<-df %>%
  mutate(Time = lubridate::mdy_hms(Time), 
     cond = Read == "True" & Box == "out"|Box == "draft" & ID == "" , 
     grp = cumsum(!cond)) %>%
  filter(cond) %>%
  group_by(grp) %>%
  summarise(starttime = first(Time), 
        endtime = last(Time), 
        duration = difftime(endtime, starttime, units = "secs")) %>%
  select(-grp)

Answer 1

问题中给出的示例中规则的应用方式似乎不一致。目前尚不清楚，当距离上一个时间戳已经过去 30 秒时，这应该标志着新时期的开始还是前一个时期的结束。示例中都使用了两者。

如果 30 秒过去了，我将假设一个新的周期开始，这意味着在此之前的最后一个有效时间戳标志着上一个周期的结束。

此方法无需循环即可工作。它将时间拆分为连续运行的“有效”时间（即符合标准的时间），然后如果间隔超过 30 秒，则进一步拆分这些时间。然后它简单地提取每个子组中的最小和最大时间。

library(lubridate)

df$Time <- dmy_hms(df$Time)
valid   <- df$Read == TRUE & df$ID == "" & (df$Box == "out" | df$Box == "draft")
groups  <- rep(seq_along(rle(valid)$lengths), rle(valid)$lengths)
dflist  <- lapply(split(df[valid, ], groups[valid]), function(x) {
                    y <- as.numeric(difftime(x$Time, lag(x$Time)))
                    split(x, cumsum(is.na(y) | y > 30))
                  })

start   <- lapply(dflist, function(x) lapply(x, function(y) as.character(min(y$Time))))
end     <- lapply(dflist, function(x) lapply(x, function(y) as.character(max(y$Time))))
start   <- as.POSIXct(unlist(start))
end     <- as.POSIXct(unlist(end))

data.frame(start = start, end = end, duration = difftime(end, start))
#>                   start                 end duration
#> 1.0 2019-01-10 09:00:01 2019-01-10 09:03:00 179 secs
#> 3.0 2019-01-10 09:06:00 2019-01-10 09:06:02   2 secs
#> 5.0 2019-01-10 09:07:04 2019-01-10 09:07:06   2 secs
#> 7.0 2019-02-10 10:00:00 2019-02-10 10:02:20 140 secs

^{由reprex package (v0.3.0) 于 2020 年 2 月 20 日创建}