Добавление 15 рабочих дней в lubridate

Question

У меня есть длинный список дат начала определенной процедуры. Правила требуют, чтобы процедура была завершена не более, чем через 6 рабочих дней. Я хочу рассчитать предельный срок.

Использование lubridate в R, я могу получить шесть-дневный срок, таким образом,

> library(lubridate) 
> date.in <- dmy(c("30-8-2001", "12-1-2003", "28-2-2003", "20-5-2004")) 
> date.in 
[1] "2001-08-30 UTC" "2003-01-12 UTC" "2003-02-28 UTC" "2004-05-20 UTC" 
> deadline.using.days <- date.in + days(6) 
> deadline.using.days 
[1] "2001-09-05 UTC" "2003-01-18 UTC" "2003-03-06 UTC" "2004-05-26 UTC" 

Есть простой способ добавить шесть рабочих дней --- то есть, пропустив субботу и воскресенье? Спасибо.

Answer 1

В timeDate есть отличная функция isBizday, которая сделала это более увлекательным, чем казалось на первый взгляд.

date.in <- dmy(c("30-8-2001", "12-1-2003", "28-2-2003", "20-5-2004")) 

Это функция для выполнения работы. Было разумно выбрать 1:10 в течение дней, чтобы смотреть в будущее, но это, конечно, можно скорректировать.

deadline <- function(x) { 
    days <- x + 1:10 
    Deadline <- days[isBizday(as.timeDate(days))][6] 
    data.frame(DateIn = x, Deadline, DayOfWeek = weekdays(Deadline), 
       TimeDiff = difftime(Deadline, x)) 
} 

И вот результат:

library(timeDate) 
Reduce(rbind, Map(deadline, as.Date(date.in))) 
#  DateIn Deadline DayOfWeek TimeDiff 
# 1 2001-08-30 2001-09-07 Friday 8 days 
# 2 2003-01-12 2003-01-20 Monday 8 days 
# 3 2003-02-28 2003-03-10 Monday 10 days 
# 4 2004-05-20 2004-05-28 Friday 8 days 

Answer 2

Попробуйте

library(chron) 

date.in <- dmy(c("30-8-2001", "12-1-2003", "28-2-2003", "20-5-2004")) 
do.call(rbind, lapply(date.in, function(x) { 
        x1 <-seq(as.Date(x)+1, length.out=15, by='1 day') 
          data.frame(Start=x,End=x1[!is.weekend(x1)][6])})) 

#  Start  End 
#1 2001-08-30 2001-09-07 
#2 2003-01-12 2003-01-20 
#3 2003-02-28 2003-03-10 
#4 2004-05-20 2004-05-28 

Вы также можете проверить library(bizdays), чтобы найти все рабочие дни. Здесь критерии рабочего дня не ясны, поскольку они могут варьироваться в зависимости от страны.

Answer 3

Вот @ ричард-трусливое решение --- это занимает, кроме выходных праздников во внимание, что является плюсом --- обобщается на переменную количество рабочих дней.

library(lubridate) 
library(timeDate) 
bizDeadline <- function(x, nBizDys = 6){ 
    output <- Reduce(rbind, Map((function(x, howMuch = 15){ 
     x <- as.Date(x) 
     days <- x + 1:(howMuch*2) 
     Deadline <- days[isBizday(as.timeDate(days))][howMuch] 
     data.frame(DateIn = x, Deadline, DayOfWeek = weekdays(Deadline), 
        TimeDiff = difftime(Deadline, x)) # useful to get more info, if so wished 
    }), x, howMuch = nBizDys)) 
    output$Deadline 
} 
# example 
date.in <- dmy(c("30-8-2001", "12-1-2003", "28-2-2003", "20-5-2004")) 
bizDeadline(date.in, nBizDys=31) 
# [1] "2001-10-12" "2003-02-24" "2003-04-14" "2004-07-02" 

(интересно расширение:.?. Как изменить по умолчанию = holidayNYSE с не расфасованными праздниками в пакете timeDate (например, чилийская http://www.feriadoschilenos.cl/) Но это другой вопрос)

Спасибо за вашу помощь!

Answer 4

В пакете bizdays есть функция offset, которая компенсирует заданные даты на количество рабочих дней. Он зависит от выбранного вами календаря и, конечно же, вы можете определить календарь, в котором выходные дни являются единственными нерабочими днями.

Здесь следует пример:

library(lubridate) 
library(bizdays) 
cal <- Calendar(weekdays=c('saturday', 'sunday')) 
date.in <- dmy(c("30-8-2001", "12-1-2003", "28-2-2003", "20-5-2004")) 
bizdays::offset(date.in, 6, cal) 

# [1] "2001-09-07" "2003-01-21" "2003-03-10" "2004-05-28" 

Answer 5

Вот небольшая функция инфикс, которая добавляет смещение по будням:

`%+wday%` <- function (x, i) { 
    if (!inherits(x, "Date")) 
     stop("x must be of class 'Date'") 
    if (!is.integer(i) && !is.numeric(i) && !all(i == as.integer(i))) 
     stop("i must be coercible to integer") 
    if ((length(x) != length(i)) && (length(x) != 1) && length(i) != 
     1) 
     stop("'x' and 'i' must have equal length or lenght == 1") 
    if (!is.integer(i)) 
     i = as.integer(i) 
    wd = lubridate::wday(x) 
    saturdays <- wd == 7 
    sundays <- wd == 1 
    if (any(saturdays) || any(sundays)) 
     warning("weekend dates are coerced to the previous Friday before applying weekday shift") 
    x <- (x - saturdays * 1) 
    x <- (x - sundays * 2) 
    wd <- wd - saturdays * 1 + sundays * 5 
    x + 7 * (i%/%5) + i%%5 + 2 * (wd - 2 > 4 - i%%5) 
} 

Использование:

Sys.Date() %+wday% + 1:7