Question

我有两个日期字段，act_dt总是有一个日期，cl_dt不会总是有一个日期。我需要根据这两个字段来计算有多少未完成的工作。我尝试了几种方法，但是我并不精通许多可能使此任务更容易的窗口功能或滚动功能。

cl_dt字段表示工作结束的日期。因此，要计算待处理的cl_dt必须大于act_dt或NA。一旦cl_dt == act_dt，则该行将不再计入待处理状态。

act_dt <- c("2018-10-01", "2018-10-02", "2018-10-03", "2018-10-04")
cl_dt <- c("2018-10-04", NA, "2018-10-03", "2018-10-04")
method_test <- data.frame(cbind(act_dt, cl_dt))
method_test$act_dt <- as.Date(method_test$act_dt)
method_test$cl_dt <- as.Date(method_test$cl_dt)

# Expected Output
      act_dt      cl_dt pending
1 2018-10-01 2018-10-04       1
2 2018-10-02       <NA>       2
3 2018-10-03 2018-10-03       2
4 2018-10-04 2018-10-04       1

我尝试过不必要地在dplyr中传递ifelse语句，但没有成功。

Answer 1

不幸的是，这很容易将其向量化，因为只有在cl_dt通过时，您实际上需要将一行视为完整的。这是一个分解为n乘n矩阵的解决方案（n是行数），所以我希望您不要在二十年的每日数据中这样做。 ..

m <- with(method_test, outer(act_dt, cl_dt, function(a,b) is.na(b) | a<b))
rowSums(m & lower.tri(m, diag=TRUE))
# [1] 1 2 2 1

此“爆炸”是因为它在比较

"2018-10-01" with c("2018-10-04", NA, "2018-10-03", "2018-10-04")
"2018-10-02" with c("2018-10-04", NA, "2018-10-03", "2018-10-04")
"2018-10-03" with c("2018-10-04", NA, "2018-10-03", "2018-10-04")
"2018-10-04" with c("2018-10-04", NA, "2018-10-03", "2018-10-04")

从而产生平方矩阵：

m
#       [,1] [,2]  [,3]  [,4]
# [1,]  TRUE TRUE  TRUE  TRUE
# [2,]  TRUE TRUE  TRUE  TRUE
# [3,]  TRUE TRUE FALSE  TRUE
# [4,] FALSE TRUE FALSE FALSE

由于我们对向后看不感兴趣，因此我们使用较低的三角形（和对角线）来减小它：

m & lower.tri(m, diag=TRUE)
#       [,1]  [,2]  [,3]  [,4]
# [1,]  TRUE FALSE FALSE FALSE
# [2,]  TRUE  TRUE FALSE FALSE
# [3,]  TRUE  TRUE FALSE FALSE
# [4,] FALSE  TRUE FALSE FALSE

这是说什么，看看列：

"2018-10-04"

第二列（F，T，T，T）在第一行上没有生效（因为它尚未开始... ergo lower.tri），但是因为其cl_dt是NA，它将保留为TRUE;
第三列和第四列全为错误，因为它们在同一天打开/关闭

另一种不会破坏矩阵的尝试将涉及逐行迭代，寻找正确的间隔：

colSums(with(method_test, sapply(act_dt, function(x) {
  x >= act_dt & (is.na(cl_dt) | x < cl_dt)
})))
# [1] 1 2 2 1

第一个要比第二个快一点，但是只有在数据量较小的情况下……较大的数据可能具有不同的相对性能：

library(microbenchmark)
microbenchmark(
  a = {
    m <- with(method_test, outer(act_dt, cl_dt, function(a,b) is.na(b) | a<b))
    rowSums(m & lower.tri(m, diag=TRUE))
  },
  b = {
    colSums(with(method_test, sapply(act_dt, function(x) {
      x >= act_dt & (is.na(cl_dt) | x < cl_dt)
    })))
  }
)
# Unit: microseconds
#  expr min  lq mean median  uq max neval
#     a  55  58   64     61  65 126   100
#     b 174 178  187    180 184 379   100

修改

如果数据具有用于分组的附加列，则可以将此代码放在do(...)块中：

library(dplyr)
# sample data, slightly-different
method_test2 <- bind_rows(mutate(method_test, id=1L), mutate(method_test, id=2L)[c(1,2,4),])
method_test2 %>%
  group_by(id) %>%
  do({
    dat <- .
    m <- with(dat, outer(act_dt, cl_dt, function(a,b) is.na(b) | a<b))
    dat$pending <- rowSums(m & lower.tri(m, diag=TRUE))
    dat
  })

基于两个日期的运行计数

1 个答案: