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.

emagar
  • 985
  • 2
  • 14
  • 28

5 Answers5

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"
Wilson Freitas
  • 531
  • 5
  • 10
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
Rich Scriven
  • 97,041
  • 11
  • 181
  • 245
  • 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 05 '14 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. – Rich Scriven Nov 05 '14 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 05 '14 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.

akrun
  • 874,273
  • 37
  • 540
  • 662
  • Problems with 31-day deadline in @akrun (with `length.out` longer): call returns one NA. Am I missing something? – emagar Nov 05 '14 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 06 '14 at 05:10
  • My mistake @akrun when attempting a function with variable days. Thank you! – emagar Nov 08 '14 at 03: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
Jthorpe
  • 9,756
  • 2
  • 49
  • 64
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!

emagar
  • 985
  • 2
  • 14
  • 28