I have a long list of start dates of a certain procedure. Rules require the procedure to be completed in, at most, 6 business days. I wish to compute the deadline.
Here's a little infix function that adds offsets in terms of weekdays:
`%+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)
}
Usage:
Sys.Date() %+wday% + 1:7
Try
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
You may also check library(bizdays)
to find all the business days. Here, the criteria of business day is not clear as it could vary based on country.
The package bizdays has the function offset
which offsets the given dates by a number of business days.
It relies on the calendar you define and of course you can define a calendar where weekends are the only nonworking days.
Here is an example:
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"
2018 Update
The function Calendar
in bizdays
has been renamed to create.calendar
,
but (in April 2018) a warning is no longer issued.
The code should now be slightly different:
library(lubridate)
library(bizdays)
create.calendar(name="mycal", 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, "mycal")
# [1] "2001-09-07" "2003-01-21" "2003-03-10" "2004-05-28"
Here is the @richard-craven solution --- it takes holidays other than weekends into account, which is a plus --- generalized to a variable number of business days.
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"
(Interesting extension: How do you change default=holidayNYSE with non-prepackaged holidays in package timeDate (eg., Chile's http://www.feriadoschilenos.cl/)? But that is another question.)
Thanks for your help!
There's a nifty function isBizday
in the timeDate
package that made this more fun than it seemed on first glance.
date.in <- dmy(c("30-8-2001", "12-1-2003", "28-2-2003", "20-5-2004"))
Here's a function to do the work. It seemed reasonable to choose 1:10
for the days to look ahead, but that can be adjusted of course.
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))
}
And here's the result:
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