我写了这个我一直用的功能：
# Give the previous day, or Friday if the previous day is Saturday or Sunday.
previous_business_date_if_weekend = function(my_date) {
if (length(my_date) == 1) {
if (weekdays(my_date) == "Sunday") { my_date = lubridate::as_date(my_date) - 2 }
if (weekdays(my_date) == "Saturday") { my_date = lubridate::as_date(my_date) - 1 }
return(lubridate::as_date(my_date))
} else if (length(my_date) > 1) {
my_date = lubridate::as_date(sapply(my_date, previous_business_date_if_weekend))
return(my_date)
}
}
当我将其应用于具有数千行的数据框的日期列时出现问题。它的速度非常慢。 有什么想法？
答案 0 :(得分：10)
OP的问题Why are my functions on lubridate dates so slow?以及像Lubridate is just kind of slow in my experience这样的一些概括性陈述表明某个特定包可能是导致性能低下的原因。
我想用一些基准来验证这一点。
:: Frank mentioned in his comment使用双冒号运算符::来访问命名空间中的导出变量或函数会受到惩罚。
# creating data
n <- 10^1L
fmt <- "%F"
chr_dates <- format(Sys.Date() + seq_len(n), "%F")
# loading lubridate into namespace
library(lubridate)
microbenchmark::microbenchmark(
base1 = r1 <- as.Date(chr_dates),
base2 = r2 <- base::as.Date(chr_dates),
lubr1 = r3 <- as_date(chr_dates),
lubr2 = r4 <- lubridate::as_date(chr_dates),
times = 100L
)
Unit: microseconds expr min lq mean median uq max neval cld base1 87.977 89.1100 92.03587 89.865 90.9980 128.756 100 a base2 94.018 95.7175 100.64848 97.039 99.3045 179.351 100 b lubr1 92.508 94.2070 98.21307 95.151 97.7940 175.954 100 b lubr2 101.569 103.0800 109.98974 104.024 107.9885 258.643 100 c
使用双冒号运算符::的惩罚大约是10微秒。
这仅在重复调用函数时才会起作用（正如使用sapply()在OP的代码中发生的那样）。恕我直言，调试命名空间冲突或维护函数来源不明确的代码的痛苦要高得多。当然，您的里程可能会有所不同。
可以验证n = 100，
Unit: microseconds expr min lq mean median uq max neval cld base1 556.933 561.0855 580.3382 562.9730 590.7250 812.176 100 a base2 564.483 568.2600 588.5695 570.9030 596.2010 989.262 100 a lubr1 562.596 565.9935 587.4443 568.4480 594.8790 1039.480 100 a lubr2 572.036 575.9995 597.1557 578.4545 601.1085 1230.159 100 a
有许多软件包可以处理将不同格式的字符日期转换为类Date或POSIXct。其中一些旨在表现，另一些则是为了方便。
此处，base，lubridate，anytime，fasttime和data.table（因为在其中一个答案中提及）进行了比较。
输入是标准明确格式YYYY-MM-DD中的字符日期。时区被忽略。
fasttime仅接受1970年至2199年之间的日期，因此必须修改样本数据的创建，以便创建100 K日期的样本数据集。
n <- 10^5L
fmt <- "%F"
set.seed(123L)
chr_dates <- format(
sample(
seq(as.Date("1970-01-01"), as.Date("2199-12-31"), by = 1L),
n, replace = TRUE),
"%F")
因为Frank had suspected猜测格式会增加惩罚，所以在可能的情况下使用和不使用给定格式调用函数。使用双冒号运算符::调用所有函数。
microbenchmark::microbenchmark(
base_ = r1 <- base::as.Date(chr_dates),
basef = r1 <- base::as.Date(chr_dates, fmt),
lub1_ = r2 <- lubridate::as_date(chr_dates),
lub1f = r2 <- lubridate::as_date(chr_dates, fmt),
lub2_ = r3 <- lubridate::ymd(chr_dates),
anyt_ = r4 <- anytime::anydate(chr_dates),
idat_ = r5 <- data.table::as.IDate(chr_dates),
idatf = r5 <- data.table::as.IDate(chr_dates, fmt),
fast_ = r6 <- fasttime::fastPOSIXct(chr_dates),
fastd = r6 <- as.Date(fasttime::fastPOSIXct(chr_dates)),
times = 5L
)
# check results
all.equal(r1, r2)
all.equal(r1, r3)
all.equal(r1, c(r4)) # remove tzone attribute
all.equal(r1, as.Date(r5)) # convert IDate to Date
all.equal(r1, as.Date(r6)) # convert POSIXct to Date
Unit: milliseconds expr min lq mean median uq max neval cld base_ 641.799082 645.008517 648.128466 648.791875 649.149444 655.893411 5 d basef 69.377419 69.937371 73.888828 71.403139 76.022083 82.704127 5 b lub1_ 644.199361 645.217696 680.542327 649.855896 652.887492 810.551189 5 d lub1f 69.769726 69.947943 70.944605 70.795234 71.365759 72.844364 5 b lub2_ 18.672495 27.025711 26.990218 28.180730 29.944409 31.127747 5 ab anyt_ 381.870316 384.513758 386.211134 384.992152 385.159043 394.520400 5 c idat_ 643.386808 644.312259 649.385356 648.204359 651.666396 659.356958 5 d idatf 69.844109 71.188673 75.319481 77.142365 78.156923 80.265334 5 b fast_ 4.994637 5.363533 5.748137 5.601031 5.760370 7.021112 5 a fastd 5.230625 6.296157 6.686500 6.345998 6.538941 9.020780 5 a
时间表明
as.Date()，as_date()和as.IDate()的速度比不使用时快10倍。fasttime::fastPOSIXct()是最快的。即使从POSIXct到Date的额外转换，它也比第二快lubridate::ymd()快四倍。答案 1 :(得分：9)
你正在遍历每一行。它很慢并不奇怪。你可以基本上做一个替换操作，而不是从每个日期获取一个固定的差异：0表示M-F，-1表示星期六，-2表示太阳。
# 'big' sample data
x <- Sys.Date() + 0:100000
bizdays <- function(x) x - match(weekdays(x), c("Saturday","Sunday"), nomatch=0)
# since `weekdays()` is locale-specific, you could also be defensive and do:
bizdays <- function(x) x - match(format(x, "%w"), c("6","0"), nomatch=0)
system.time(bizdays(x))
# user system elapsed
# 0.36 0.00 0.35
system.time(previous_business_date_if_weekend(x))
# user system elapsed
# 45.45 0.00 45.57
identical(bizdays(x), previous_business_date_if_weekend(x))
#[1] TRUE
答案 2 :(得分：5)
Lubridate在我的经历中有点慢。我建议使用data.table和iDate。
这样的事情应该非常强大：
library(data.table)
#Make data.table of dates in string format
x = data.table(date = format(Sys.Date() + 0:100000,format='%d/%m/%Y'))
#Convert to IDate (by reference)
set(x, j = "date", value = as.IDate(strptime(x[,date], "%d/%m/%Y")))
#Day zero was a Thursday
originDate = as.IDate(strptime("01/01/1970", "%d/%m/%Y"))
as.integer(originDate)
#[1] 0
weekdays(originDate)
#[1] "Thursday"
previous_business_date_if_weekend_dt = function(x) {
#Adjust dates so that Sat is 1, Sun is 2, and subtract by reference
x[,adjustedDate := date]
x[(as.integer(x[,date]-2) %% 7 + 1)<=2, adjustedDate := adjustedDate - (as.integer(date-2) %% 7 + 1)]
}
bizdays <- function(x) x - match(weekdays(x), c("Saturday","Sunday"), nomatch=0)
system.time(bizdays(y))
# user system elapsed
# 0.22 0.00 0.22
system.time(previous_business_date_if_weekend_dt(x))
# user system elapsed
# 0 0 0
另请注意，在此解决方案中花费最多时间的部分可能是从字符串中提取日期，如果您对此感兴趣，可以将它们重新格式化为整数格式。
答案 3 :(得分：4)
只是为了增加另一种可能性：纯粹的R实现在datetimetutils包中（我是作者）。函数previous_businessday会转换为POSIXlt以提取工作日。
（该代码将函数的结果与thelatemail建议的函数bizdays进行比较。）
library("datetimeutils")
x <- Sys.Date() + 0:100000
system.time(bizdays(x))
## user system elapsed
## 0.25 0.00 0.25
system.time(previous_businessday(x, shift = 0))
## user system elapsed
## 0.03 0.00 0.03
identical(bizdays(x), previous_businessday(x, shift = 0))
## TRUE
previous_businessday的略微简化版本如下所示;它假定x属于Date类。
previous_bd <- function(x) {
tmp <- as.POSIXlt(x)
tmpi <- tmp$wday == 6L
x[tmpi] <- x[tmpi] - 1L
tmpi <- tmp$wday == 0L
x[tmpi] <- x[tmpi] - 2L
x
}
system.time(previous_bd(x))
## user system elapsed
## 0.03 0.00 0.03
identical(bizdays(x), previous_bd(x))
## TRUE