在lubridate增加15个工作日

时间:2014-11-05 03:42:00

标签: r lubridate

我有一长串某个程序的开始日期。规则要求程序最多在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"

是否有一种简单的方法可以增加六个工作日 - 即跳过周六和周日? 谢谢。

5 个答案:

答案 0 :(得分:5)

isBizday包中有一个漂亮的功能timeDate,使其比初看起来更有趣。

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

答案 1 :(得分:4)

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年更新

Calendar中的bizdays功能已重命名为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 :(得分:2)

尝试

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

答案 3 :(得分:1)

这里有一个小的中缀功能,可以按工作日添加补偿:

<head>
  <script src="https://ajax.googleapis.com/ajax/libs/jquery/1.8/jquery.min.js"></script>
  <script>
      $(document).ready(function() {
        $('.video').each(function() {
          $(this).on("mouseover", function(e) { hoverVideo(e); });
          $(this).on("mouseout", function(e) { hideVideo(e); });
        });
      });
      function hoverVideo(i) {
          i.target.play();
      }
      function hideVideo(i) {
          i.target.pause();
      }
  </script>
</head>
<body>
  <div class="main">
    <h3>Title</h3>
    <p>
      *Hover over each frame to see the story.
    </p>
  </div>
  <div class="main">
    <div class="firstrow">
      <div class="video" id="one" >
        <video class="thevideo" loop>
          <source src="Resources/1.mp4" type='video/mp4' />
        </video>
      </div>
      <div class="video" id="one" >
        <video class="thevideo" loop>
          <source src="Resources/2.mp4" type='video/mp4' />
        </video>
      </div>
      <div class="video" id="one" >
        <img src="Resources/text/tap.svg"  />
      </div>
    </div>
  </div>
</body>

用法:

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

答案 4 :(得分:0)

以下是@ 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"

(有趣的扩展:如何在包timeDate中更改default = holidayNYSE与非预先包装的假期(例如,智利&#39; s http://www.feriadoschilenos.cl/)?但这是另一个问题。)

感谢您的帮助!