为什么我在润滑日期上的功能如此缓慢？答案

【问题标题】：Why are my functions on lubridate dates so slow?为什么我在润滑日期上的功能如此缓慢？
【发布时间】：2018-02-13 06:17:29
【问题描述】：

我写了这个我一直使用的函数：

# 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 表示 M-F，-1 表示 Sat，-2 表示 Sun。
（我对 lubridate 一无所知，但是...）as_date 可能需要猜测格式，因为您没有传递其他参数。因为您选择在循环中运行它（使用sapply）而不是使用矢量化函数，所以它一定会很慢。此外，:: 有一些开销。
@Frank 我坚持使用::，因为它在一个包中
我现在意识到previous_business_date_if_weekend 是我的瓶颈。编辑问题以删除对EOMonth 的任何引用。
@Frank :: 增加了几微秒的惩罚，这仅在重复调用函数时才有意义（就像这里使用 sapply() 一样）。恕我直言，调试命名空间冲突或维护函数来源不清楚的代码的痛苦要高得多。当然，您的里程可能会有所不同。

标签： r date lubridate

【解决方案1】：

您正在遍历每一行。它很慢并不奇怪。您基本上可以进行一次替换操作，而不是从每个日期获取固定差异：0 表示 M-F，-1 表示 Sat，-2 表示 Sun。

# '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

【讨论】：

OP 可能以字符向量或其他东西开头（因此全部使用 as_date）。我想这只会让你的函数成为一个两行函数，或者让它期待更理智的输入。
@Frank - 我对此表示怀疑，因为他们在没有任何转换的情况下使用weekdays(my_date)
快多了！非常感谢！
值得指出的是，weekdays 是特定于区域设置的：日期名称将取决于计算机的语言设置。

【解决方案2】：

根据我的经验，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

另请注意，此解决方案中花费最多时间的部分可能是从字符串中提取日期，如果您对此感到担忧，可以将它们重新格式化为整数格式。

【讨论】：

通过我的快速测试，与使用 match 的时间几乎相同。
@thelatemail 确实如此，请参阅新解决方案 :)
Matt, lubridate 总体上并不像你写的那样慢。 lubridate::ymd() 在我的基准测试中是第二快的。

【解决方案3】：

只是添加另一种可能性：纯 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

【讨论】：

【解决方案4】：

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 之间的日期，因此必须修改示例数据的创建，以便创建包含 10 万个日期的示例数据集。

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() 比不调用时快十倍。
fasttime::fastPOSIXct() 确实是最快的。即使从POSIXct 到Date 的额外转换，它也比第二快的lubridate::ymd() 快四倍。

【讨论】：

使用双冒号运算符::的惩罚

将字符日期转换为日期类

使用双冒号运算符`::`的惩罚