R data.table 如果工作日在日期范围之间，则设置具有逻辑值的新列

Question

我有一个 data.table 对象，它有两个 date 列，from 和 to。我想创建一个新列以确定特定工作日是否在日期范围内。

[数据]

library(data.table)
set.seed(1)
DT <- data.table(from=seq.Date(Sys.Date(), Sys.Date()+100, by="day"))[, to:=from+sample(10, 1), by=1:nrow(DT)][, from_wd:=wday(from)][, to_wd:=wday(to)]

> head(DT)
         from         to from_wd to_wd
1: 2015-08-06 2015-08-10       5     2
2: 2015-08-07 2015-08-10       6     2
3: 2015-08-08 2015-08-18       7     3
4: 2015-08-09 2015-08-16       1     1
5: 2015-08-10 2015-08-13       2     5
6: 2015-08-11 2015-08-13       3     5

[我的做法]

在这种情况下，我想添加一个新的 boolean 列 flag，其中 returns TRUE 如果星期三在 [from, to] 的范围内.

这是我的尝试：

DT[, flag:=0][DT[, .I[4 %in% unique(wday(seq.Date(from, to, by="day")))], by=1:nrow(DT)][[1]], flag:=1]

> table(DT$flag)

 0  1 
21 80

[问题]

代码花了一些时间运行，你可以想象，如果nrow(DT)变大，它会花费更多时间。

我的问题是：有更好的方法吗？ 在速度和代码可读性方面更好（我相信我的代码根本不直观）。

Answer 1

这是我的例子：

library(parallel)

process <- function(){


  from <- seq(as.Date("1950-01-01"), by = "day", length = 100000)
  to <- seq(as.Date("1950-01-04"), by = "day", length = 100000)

  DT <- data.frame(from,to)

  Ncores <- detectCores()

  flagList <- mclapply(1:nrow(DT),function(id){

    4 %in% strftime(seq(as.Date(DT[id,1]), as.Date(DT[id,2]), by="day"), format="%w")

  },mc.cores=Ncores)

  flag <- unlist(flagList)

  return(cbind(DT,flag))

}

在我的 i7 处理器上，10 万行只需要 15 秒。希望这有帮助。

Answer 2

这是一种方法：

next_wday <- function(d,wd=4L){
    wddiff = wd - wday(d)
    d + wddiff + (wddiff < 0L)*7L
} 


DT[, flag2 := +(next_wday(from) <= to)]

# test:
DT[,table(flag,flag2)]
#     flag2
# flag  0  1
#    0 44  0
#    1  0 57

我们的想法是将 to 与下周四进行比较**。替换行可以用多种不同的方式编写。

基准

OP 提到 from 和 to 可能最多相隔 200 天，所以...

set.seed(1)
from <- seq(as.IDate("1950-01-01"), by = "day", length = 1e6)
to   <- from + pmin(200,rpois(length(from),1))
DT   <- data.table(from,to)

system.time(DT[, flag2 := +(next_wday(from) <= to)])
#    user  system elapsed 
#    2.11    0.03    2.14

# David Arenburg's solution
system.time({
    DateDT <- DT[, {
                temp <- seq(min(from), max(to), by = "day")
                temp2 <- temp[wday(temp) == 4L]
                list(from = temp2, to = temp2)
               }
             ]
    indx <- foverlaps(DT, setkey(DateDT), nomatch = 0L, which = TRUE)$xid
    DT[, flag := 0L][indx, flag := 1L]
})  
#    user  system elapsed 
#    6.75    0.14    6.89

# check agreement
DT[,table(flag,flag2)]
#     flag2
# flag      0      1
#    0 714666      0
#    1      0 285334

我正在使用 IDate，因为它是 data.table 包附带的日期格式，并且 (?) 使用起来更快。有几种方法可以使代码更快：

首先，将注意力限制在 to-from 小于 6 的行上可能会更快（因为每个工作日都会有 6 或更大的间隙），例如
```
DT[,flag2:=0L][to-from < 6, flag2 := +(next_wday(from) <= to)]
```
其次，因为计算一次只依赖于一行，并行化可能会带来一些改进，如@grubjesic 的回答所示。
根据真实数据的数据，可能会发现其他改进。

此处未对 OP 的代码进行基准测试，因为它需要按行拆分数据并每行最多枚举 200 个日期，这肯定会很慢。

** 或任何 wday 是 4 的意思。

Answer 3

您也可以尝试 foverlaps 方法

首先将创建从 min(from) 开始到 max(to)

结束的所有星期三的数据集

DateDT <- DT[, {
                temp <- seq(min(from), max(to), by = "day")
                temp2 <- temp[wday(temp) == 4L]
                .(from = temp2, to = temp2)
               }
             ]

然后运行 foverlaps 并提取所需的行

indx <- foverlaps(DT, setkey(DateDT), nomatch = 0L, which = TRUE)$xid

然后通过引用进行简单更新即可

DT[, flag := 0L][indx, flag := 1L]
DT[, table(flag)]
#  0  1 
# 44 57

R data.table 如果工作日在日期范围之间，则设置具有逻辑值的新列

R data.table set new column with logical value if a weekday is between a date range

r

data.table