添加15个营业日的润湿

我有一个特定程序的开始日期很长的列表。规则要求程序至多在6个工作日内完成。我希望计算截止日期。添加15个营业日的润湿

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"

有一种简单的方法来添加6个营业日---即跳过星期六和星期日？谢谢。

来源

2014-11-05 emagar

有一个漂亮的功能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

来源

2014-11-05 05:32:23

谢谢你@ richard-scriven，这个作品！我不熟悉Reduce（）和Map（）的高阶函数。我将尝试将所有功能打包并在一段时间内响应。 – emagar 2014-11-05 16:39:32

@emagar - 这个例子中的'Reduce'和'Map'与'do.call（rbind，lapply（...））一样''我喜欢它们，因为它们很容易阅读。 – 2014-11-05 18:29:07

您的解决方案@richard在要求提供31天以上的截止日期时解除限制...我已编辑了有关此问题的原始问题。任何线索？我错过了什么吗？ – emagar 2014-11-05 19:45:15

尝试

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

来源

2014-11-05 04:20:18 akrun

感谢@akrun，这也行得通！ – emagar 2014-11-05 16:41:59

@akrun中的31天期限问题（使用'length.out'更长）：调用返回一个NA。我错过了什么吗？ – emagar 2014-11-05 18:27:58

@emagar我试着用这个代码lapply（date.in，function（x）{x1 < - seq（as.Date（x）+1，length.out = 60，by ='1 day'）; x1 [ ！is.weekend（x1）] [35]}）'在这里没有得到NA。 – akrun 2014-11-06 05:10:00

这里是@理查德 - 克雷文的解决方案---它花费的时间比周末等节假日进去，这是一个加---推广到一个变量工作日数。

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"

（有趣的扩展：？如何改变默认= holidayNYSE在包TIMEDATE非预先包装的假期（例如，智利http://www.feriadoschilenos.cl/）但是，这是另一个问题）

感谢您的帮助！

来源

2014-11-08 03:23:46 emagar

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

来源

2015-09-23 17:03:59

下面是增加抵消在平日方面有点缀函数：

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

来源

2017-04-17 22:24:39 Jthorpe

添加15个营业日的润湿

回答

相关问题