12

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.

Using lubridate in R, I can get a six-day deadline thus

> 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"

Is there an easy way to add six business days --- i.e., skipping Saturdays and Sundays? Thank you.

0

5 Answers 5

11

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"
6

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
3
  • Thanks @richard-scriven, this works! I am not familiar with the Reduce() and Map() high-order functions. I will attempt to pack all in a single function and respond in a while.
    – emagar
    Nov 5, 2014 at 16:39
  • 1
    @emagar - Reduce and Map in this example are just the same as do.call(rbind, lapply(...)) I like them because they are easy to read. Nov 5, 2014 at 18:29
  • Your solution @richard breaks when a deadline with 31+ days is requested... I have edited my original question with this problem. Any clue? Am I missing something?
    – emagar
    Nov 5, 2014 at 19:45
3

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.

3
  • Problems with 31-day deadline in @akrun (with length.out longer): call returns one NA. Am I missing something?
    – emagar
    Nov 5, 2014 at 18:27
  • @emagar I tried with this code lapply(date.in, function(x) {x1 <- seq(as.Date(x)+1, length.out=60, by='1 day'); x1[!is.weekend(x1)][35]}) didn't get NA here.
    – akrun
    Nov 6, 2014 at 5:10
  • My mistake @akrun when attempting a function with variable days. Thank you!
    – emagar
    Nov 8, 2014 at 3:14
2

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
0

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!

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.