Adding 15 business days in lubridate

前端 未结 5 1548
别那么骄傲
别那么骄傲 2020-12-10 06:32

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.

相关标签:
5条回答
  • 2020-12-10 06:54

    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 讨论(0)
  • 2020-12-10 06:55

    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.

    0 讨论(0)
  • 2020-12-10 07:02

    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"
    
    0 讨论(0)
  • 2020-12-10 07:02

    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!

    0 讨论(0)
  • 2020-12-10 07:03

    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
    
    0 讨论(0)
提交回复
热议问题