r语言 - 给定工作日的子集日期,如果缺少工作日,请选择下一个日期



我能够在SO上找到很多关于处理某个工作日的子集日期的信息(例如,从R中的一年中获取某个工作日的日期(。 但是,我找不到任何实现我想要的回退逻辑。 具体来说,如果给定的工作日在给定的一周中不存在,我想抓住下一个可用日期,不包括星期六和星期日。

例如,从日期向量中,我想选择与星期四对应的所有日期。但是,在缺少星期四的几周内,我应该选择下一个工作日的日期。在下面的示例中,这是第二天,即星期五。

library(lubridate)
# Create some dates
dates <- seq.Date(as.Date("2017-11-16"), as.Date("2017-11-24"), by = 1)
# Remove Thursday, November 23
dates <- dates[dates != as.Date("2017-11-23")]
# Get all Thursdays in dates
dates[wday(dates) == 5]
# [1] "2017-11-16"
# Desired Output:
# Because Thursday 2017-11-23 is missing in a week,
# we roll over and select Friday 2017-11-24 instead  
# [1] "2017-11-16" "2017-11-24"

注1:对于缺少星期四和星期五的给定一周,我想滚动到星期一。从本质上讲,对于找不到星期四的几周,请在可用日期中获取下一个日期。

注意 2:我想在没有任何外部依赖项的情况下完成此操作,除了常见的 R 包(例如,不依赖于 c++ 库(之外。

我相信我可以写一些东西来做我想做的事,但我很难找到一些简短而优雅的东西。

带有findInterval的替代方案。

创建一个日期序列("tmp"(,从min"日期"的一周中的焦点工作日("wd"(到max"日期"。

选择与焦点工作日("wds"(对应的日期。

从"日期"("dates_1_5"(中选择工作日。

使用findInterval将"wds"滚动到"dates_1_5"中最接近的可用工作日。

f <- function(wd, dates){
tmp <- seq(as.Date(paste(format(min(dates), "%Y-%W"), wd, sep = "-"),
format = "%Y-%W-%u"),
max(dates), by = 1)
wds <- tmp[as.integer(format(tmp, "%u")) == wd]
dates_1_5 <- dates[as.integer(format(dates, "%u")) %in% 1:5]
dates_1_5[findInterval(wds, dates_1_5, left.open = TRUE) + 1]
}

一些例子:

d <- seq.Date(as.Date("2017-11-16"), as.Date("2017-11-24"), by = 1)
dates <- d[d != as.Date("2017-11-23")]
f(wd = 4, dates)
# [1] "2017-11-16" "2017-11-24"
dates <- d[d != as.Date("2017-11-16")]
f(wd = 4, dates)
# [1] "2017-11-17" "2017-11-23"
dates <- d[!(d %in% as.Date(c("2017-11-16", "2017-11-17", "2017-11-21", "2017-11-23")))]
f(wd = 2, dates)
# [1] "2017-11-20" "2017-11-22"

使用data.table滚动连接稍微紧凑一些:

library(data.table)
wd <- 2
# using 'dates' from above
d1 <- data.table(dates)
d2 <- data.table(dates = seq(as.Date(paste(format(min(dates), "%Y-%W"), wd, sep = "-"),
format = "%Y-%W-%u"),
max(dates), by = 1))
d1[wday(dates) %in% 2:6][d2[wday(dates) == wd + 1],
on = "dates", .(x.dates), roll = -Inf]

。或非等值联接:

d1[wday(dates) %in% 2:6][d2[wday(dates) == wd + 1],
on = .(dates >= dates), .(x.dates), mult = "first"]

如果需要,只需包装在上面的函数中即可。

我打破了您"无外部依赖项"的条件,但由于您已经使用了lubridate(这是一个依赖项;-(,因此我将为您提供一个利用lead的解决方案,并从dplyrlag。你可以自己写,看看来源,如果这真的是一个困难的条件。

我正在做的是通过计算一种运行天数的差异来确定"跳过"在序列中的位置。一旦我们知道跳过在哪里,我们只需滚动到序列中的下一个数据,不管那是什么。现在,很可能这不是星期五,而是星期六。在这种情况下,你将不得不弄清楚你是否仍然想要下一个星期五,即使中间有一个星期四。

library(dplyr)
rollover_to_next <- function(dateseq, the_day = 5) {
day_diffs <- lead(wday(dateseq) - lag(wday(dateseq))) %% 7
skips <- which(day_diffs > 1) 
sort(c(dateseq[wday(dateseq) == the_day], dateseq[skips + 1]))
}
dates <- seq.Date(as.Date("2017-11-16"), as.Date("2017-11-24"), by = 1)
dates <- dates[dates != as.Date("2017-11-23")]
rollover_to_next(dates)

输出:

[1] "2017-11-16" "2017-11-24"

您可能需要考虑idx + 1元素不存在的边缘情况,但我会将其留给您来处理。

可能不是最优雅的方式,但我认为它应该:)

library(lubridate)

dates <- seq.Date(as.Date("2017-11-16"), as.Date("2017-11-30"), by = 1) #your dates
dates <- dates[dates != as.Date("2017-11-23")] # thursday
dates <- dates[dates != as.Date("2017-11-24")] # friday
dates <- dates[dates != as.Date("2017-11-25")] # satureday
dates <- dates[dates != as.Date("2017-11-26")] # sunday
dates <- dates[dates != as.Date("2017-11-27")] # monday
dates <- dates[dates != as.Date("2017-11-28")] # tuesday
#dates <- dates[dates != as.Date("2017-11-29")] # wednesday
dates_shall_be <- seq.Date(min(dates)-wday(min(dates))+1, max(dates), by = 1) # create a shall-be list of days within your date-range
# min(dates)-wday(min(dates))+1 shiftback mindate to get missing thursdays in week one
thuesdays_shall = dates_shall_be[wday(dates_shall_be) == 5] # get all thuesdays that should be in there
for(i in 1:6) # run threw all possible followup days till wednesday next week 
{
thuesdays_shall[!thuesdays_shall %in% dates] = thuesdays_shall[!thuesdays_shall %in% dates] + 1 # if date is not present in your data add another day to it
}
thuesdays_shall[!thuesdays_shall %in% dates] = NA # if date is still not present in the data after 6 shifts, this thursday + the whole followup days till next thursday are missing and NA is taken
thuesdays_shall

最新更新