[英]R data.table set new column with logical value if a weekday is between a date range
我有一个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
,如果星期三在[from, to]
的范围内,则返回TRUE
。
这是我的尝试:
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)
变大,它将花费更多时间。
我的问题是: 还有更好的方法吗? 在速度和代码可读性方面更好(我相信我的代码根本不直观)。
这是一种方法:
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表示。
您也可以尝试使用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
这是我的示例:
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处理器上的100k行仅需15秒。 希望这可以帮助。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.