根据 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'：读取 == "T"、框 == "out" 或框 == "draft"，以及 ID == ""

我想在发生以下情况时创建一个 "endtime"： Read == "T", Box == "out" OR Box == "draft", and ID == "" 并且所需条件之间的差距小于 30 秒。

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

但是，当这些条件中的任何一个不成立时，或者如果时间戳之间的时间超过 30 秒，将创建一个结束时间。因此，例如，在第 17 行创建了一个开始时间： 10/2/2019 10:00:00 AM 和结束时间将在第 20 行创建：10/2/2019 10:00:25 AM

下一个开始时间将在：10/2/2019 10:02:00 AM 创建，因为时间戳之间的时间超过 30 秒。我不确定我是否需要在此代码中加入一个阈值来满足这个要求？我只是不确定如何实现它。任何建议表示赞赏。

  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 秒过去了，我将假设一个新的周期开始，这意味着之前的最后一个有效时间戳标志着上一个周期的结束。

这个方法没有循环。它将时间分成 "valid" 次的连续运行（即满足条件的那些），然后如果间隔超过 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 日创建

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

Creating columns based on multiple, semi-complex filtering conditions within R (dplyr, stringr, lubridate)

r

lubridate

stringr

dplyr

tidyverse