【问题标题】:Adding 15 business days in lubridate在 lubridate 中增加 15 个工作日
【发布时间】:2015-01-01 04:20:21
【问题描述】:

我有一长串特定程序的开始日期。规则要求程序最多在 6 个工作日内完成。我想计算最后期限。

在 R 中使用 lubridate,因此我可以获得六天的截止日期

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

有没有简单的方法来增加六个工作日 --- 即跳过周六和周日? 谢谢你。

【问题讨论】:

    标签: r lubridate


    【解决方案1】:

    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"
    

    2018 年更新

    bizdays中的函数Calendar已重命名为create.calendar, 但是(2018 年 4 月)warning 不再发布。

    代码现在应该略有不同:

    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"
    

    【讨论】:

      【解决方案2】:

      这里有一个小中缀函数,可以根据工作日添加偏移量:

      `%+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
      

      【讨论】:

        【解决方案3】:

        这是@richard-craven 解决方案 --- 它考虑了除周末以外的假期,这是一个优点 --- 概括为可变数量的工作日。

        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"
        

        (有趣的扩展:如何将 default=holidayNYSE 更改为打包 timeDate 中的非预打包假期(例如,智利的http://www.feriadoschilenos.cl/)?但这是另一个问题。)

        感谢您的帮助!

        【讨论】:

          【解决方案4】:

          试试

          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) 以查找所有工作日。在这里,工作日的标准尚不清楚,因为它可能因国家/地区而异。

          【讨论】:

          • @akrun 中的 31 天截止日期问题(length.out 更长):调用返回一个 NA。我错过了什么吗?
          • @emagar 我尝试使用此代码 lapply(date.in, function(x) {x1 &lt;- seq(as.Date(x)+1, length.out=60, by='1 day'); x1[!is.weekend(x1)][35]}) 在这里没有得到 NA。
          • 我在尝试使用可变天数的函数时犯了错误@akrun。谢谢!
          【解决方案5】:

          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
          

          【讨论】:

          • 感谢@richard-scriven,这行得通!我不熟悉 Reduce() 和 Map() 高阶函数。我将尝试将所有内容打包在一个函数中并在一段时间内做出响应。
          • @emagar - 此示例中的ReduceMapdo.call(rbind, lapply(...)) 相同,我喜欢它们,因为它们易于阅读。
          • 当要求 31 天以上的最后期限时,您的解决方案 @richard 会中断......我已经用这个问题编辑了我的原始问题。有什么线索吗?我错过了什么吗?
          猜你喜欢
          • 1970-01-01
          • 1970-01-01
          • 1970-01-01
          • 2020-05-13
          • 1970-01-01
          • 1970-01-01
          • 2021-11-21
          • 1970-01-01
          • 1970-01-01
          相关资源
          最近更新 更多