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