logo标签列表

为什么我的lubridate日期函数运行如此缓慢？

rdatelubridate
13

我写了这个函数，我经常使用它：

# 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)
    }
}

当我将其应用于一个有数千行的数据框中的日期列时，会出现问题。 运行速度极慢。 有任何想法原因是什么？

4
您正在遍历每一行，这就是为什么速度很慢的原因。您可以通过一次替换操作来完成，其中您从每个日期中取出一个固定的差值：工作日为0，周六为-1，周日为-2。 - thelatemail
1
（我对lubridate一无所知，但是...）as_date可能需要猜测格式，因为您没有传递其他参数。因为您选择使用循环（与sapply一起）而不是向量化函数运行它，所以它肯定会很慢。此外，::有一些开销。 - Frank
1
我现在意识到previous_business_date_if_weekend是我的瓶颈。编辑问题，删除所有关于EOMonth的引用。 - lebelinoz
1
我从未开发过一个包，但据我所知，坚持使用::并不是必要的，例如：https://dev59.com/6GAg5IYBdhLWcg3wwdHA/ - Frank
2
@Frank：:: 运算符会增加几微秒的执行时间，但只有在重复调用函数时才会有所影响（就像在这里使用 sapply() 函数一样）。然而，相对于调试命名空间冲突或维护来源不清晰的代码而言，这点延迟算不了什么。当然，个人观点因人而异。 - Uwe
显示剩余3条评论
4个回答
13

OP的问题为什么我的lubridate日期函数如此缓慢？和一些概括性陈述，例如根据我的经验，Lubridate速度较慢表明特定软件包可能是低性能的原因。

我想通过一些基准测试来验证这个问题。

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

Frank在他的评论中提到，使用双冒号运算符::访问命名空间中导出的变量或函数会有一个惩罚。

# 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微秒。

这只有在反复调用函数时才会产生影响（正如在OP的代码中使用sapply()一样）。个人认为，在调试命名空间冲突或维护代码方面，函数来源不清晰的痛苦要高得多。当然，具体情况具体分析。

可以验证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类

有许多软件包处理不同格式的字符日期转换为Date或POSIXct类。其中一些旨在提高性能，其他则旨在提供方便。

这里比较了base、lubridate、anytime、fasttime和data.table（因为其中一个答案中提到了它）。

输入是采用标准明确格式YYYY-MM-DD的字符日期。时区被忽略。

fasttime仅接受1970年至2199年之间的日期，因此必须修改创建示例数据以创建一个包含100K日期的样本数据集。

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怀疑猜测格式可能会增加惩罚，所以尽可能在调用函数时使用给定的格式和不使用格式。所有函数都使用双冒号运算符::调用。

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
计时表明，Frank的怀疑是正确的。猜测格式是代价高昂的。将格式作为参数传递给as.Date()、as_date()和as.IDate()比不带参数调用快十倍。 fasttime::fastPOSIXct()确实是最快的。即使需要将POSIXct转换为Date，它也比第二快的lubridate::ymd()快四倍。
9

您正在遍历每一行。这并不令人惊讶它非常缓慢。您可以实质上进行一次替换操作，其中您从每个日期中取出一个固定差异：M-F为0，Sat为-1，Sun为-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
1
OP可能是从字符向量或其他类似的数据类型开始的（因此一直使用as_date）。我猜这只需要让你的函数变成两行代码或者期望更合理的输入即可。 - Frank
2
@Frank - 我怀疑这个，因为他们没有进行任何转换就执行了 weekdays(my_date)。 - thelatemail
1
非常快！非常感谢！ - lebelinoz
1
值得一提的是，weekdays 是与语言环境相关的：星期几的名称将取决于计算机的语言设置。 - Enrico Schumann
7

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

还要注意的是，在这个解决方案中耗时最长的部分可能是从字符串中提取日期，如果你关心时间，可以将它们重新格式化为整数格式。

1
通过我的快速测试，几乎与使用“match”相同的时间。 - thelatemail
@thelatemail 那是真的，看看新的解决方案 :) - Matt
1
Matt，lubridate通常不会像你所说的那样变慢。在我的基准测试中，lubridate :: ymd()是第二快的。 - Uwe
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
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接