如何计算两个 POSIXct 日期数组和 return 另一个数值数组之间的特定工作日数?

How to calculate the number of a specific weekday between two POSIXct date arrays and return another numerical array?

我写了一个基于工作日计算算法的公式(也在 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")

显示此错误:

Error in seq.POSIXt(start, end, by = 1) : 'from' must be of length 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,并且该公式适用于单个值(returns 第二个值,不知道为什么。但是,我可以解决这个问题):

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

向量化多个不同输入的函数的一种简单方法是使用 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 是特定于区域设置的,根据您的区域设置可能无法按预期工作。

根据@demirev 的回答和我上面的评论,这是一个使用改进的 countwd 函数和 mapply 的有效示例。我使用 lubridate 放入了一些辅助列来检查解决方案,并将一些日期更改为 return 值到 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