Question

我可以找到很多有关将子日期设置为某个工作日的信息（例如Get Dates of a Certain Weekday from a Year in 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包（如lubridate等）（例如，不依赖c ++库）之外，我想在没有任何外部依赖的情况下完成此操作。

我相信我可以写点东西做自己想做的事，但是我很难找到一个简短而优雅的东西。

Answer 1

使用findInterval的替代方法。

创建一个日期序列（'tmp'），从min'dates'所在星期的焦点工作日（'wd'）到max'dates'。

选择与重点工作日（'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"]

如果需要，只需包装上面的函数即可。

Answer 2

可能不是最优雅的方式，但我认为它应该可以工作：）

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

Answer 3

我打破了“没有外部依赖关系”的条件，但是由于您已经在使用lubridate（这是一个依赖关系；-），因此，我将为您提供一个利用lead的解决方案和lag中的dplyr。如果确实很困难，您可以自己写这些，看看源代码。

我正在做的事情是通过计算连续几天的时间来弄清楚序列中“跳过”的位置。知道跳过的位置后，无论如何，我们都将跳到序列中的下一个数据。现在，这很可能不是星期五，而是星期六。在这种情况下，即使中间有一个星期四，您也必须弄清楚是否还要下一个星期五。

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元素的极端情况，但我将由您自行处理。

子集日期为给定的工作日，如果缺少工作日则选择下一个日期

3 个答案: