如何计算两个POSIXct日期数组之间特定工作日的数量并返回另一个数值数组？

Question

我根据工作日计算算法编写了一个公式（在Stackexchange中也可以找到，很棒的工作人员。这是代码片段：

countwd <- function(start, end, day){
  x <- seq(start, end, by=1)
  y <- weekdays(x, TRUE)
  sum(y==day)
}
x$OFFDAY <- NULL
for(i in 1:nrow(x)){
  x$OFFDAY[i] <- countwd(x$PICK_DATE[i], x$SHIP_DATE[i], "Mon")
}

这太慢了（循环继续像每秒2-4行!!!!），我每个月有数百万条目。

这是函数的矢量化：

x$OFFDAY <- countwd(x$PICK_DATE, x$SHIP_DATE, "Mon")

显示此错误：

seq.POSIXt中的错误（start，end，by = 1）：'from'必须长度为1

在这种情况下我无法理解如何应用“apply”系列函数，因为我有两个要比较的向量（是的，我对此很新）。

样本数据：

PICK_DATE   SHIP_DATE
01-APR-2017 00:51   02-APR-2017 06:55 AM
01-APR-2017 00:51   02-APR-2017 12:11 PM
01-APR-2017 00:51   02-APR-2017 12:11 PM
01-APR-2017 00:51   02-APR-2017 09:39 AM

我已将这些转换为POSIXct，并且该公式适用于单个值（但返回第二个值，不知道为什么。但是，我可以解决这个问题）：

>countwd(x$PICK_DATE[1], x$SHIP_DATE[1], "Mon")
[1] 0

Answer 1

向量化多个变化输入函数的简单方法是使用mapply ：

mapply(countwd, x$SHIP_DATE, x$PICK_DATE, "Mon")

或者，您可以使用sapply并传递一系列索引作为第一个参数（这种方式的语法非常类似于for循环：

sapply(1:nrow(x), function(i) countwd(x$SHIP_DATE[i], x$PICK_DATE[i], "Mon"))

然而，你的情况下主要的低效率来自countwd函数。 请注意，您正在将POSIXt向量传递给函数。 因此，当在函数的第一行中调用seq时， by参数被认为是秒而不是几天！ 这导致产生不必要的大向量（详情请参见?seq.POSIXt ）。

以下列方式更改countwd应该可以大大提高性能：

countwd <- function(start, end, day) {
    x <- seq(start, end, by="day")
    y <- weekdays(x, TRUE)
    sum(y==day)
}

另请注意， weekdays是特定于语言环境的，可能无法按预期工作，具体取决于您的语言环境设置。

Answer 2

根据@ demirev的回答和我上面的评论，这是一个使用改进的countwd函数和mapply的工作示例。 我使用lubridate输入了几个辅助列来检查解决方案，并更改了一些日期以将值返回到非零的df$off_days 。

library(lubridate)

df <- data.frame(pick_date = c(rep("01-APR-2017 00:51", 4)), ship_date = c("05-APR-2017 06:55", "09-APR-2017 12:11", "30-APR-2017 12:11", "02-MAY-2017 12:11"))

df$pick_date <- lubridate::dmy_hm(df$pick_date)
df$ship_date <- lubridate::dmy_hm(df$ship_date)

df$pick_day <- wday(df$pick_date, label = T)
df$ship_day <- wday(df$ship_date, label = T)
df$days_between <- interval(df$pick_date, df$ship_date) %/% days()

countwd <- function(start, end, day) {
    x <- seq(start, end, by="day")
    y <- weekdays(x, TRUE)
    sum(y==day)
}

df$off_days <- mapply(countwd, df$pick_date, df$ship_date, "Mon")
df

            pick_date           ship_date pick_day ship_day days_between off_days
1 2017-04-01 00:51:00 2017-04-05 06:55:00      Sat      Wed            4        1
2 2017-04-01 00:51:00 2017-04-09 12:11:00      Sat      Sun            8        1
3 2017-04-01 00:51:00 2017-04-30 12:11:00      Sat      Sun           29        4
4 2017-04-01 00:51:00 2017-05-02 12:11:00      Sat     Tues           31        5