在日期向量上使用 sapply:功能非常慢。为什么?

Using sapply on a vector of dates: Function very slow. Why?

我有一个非常简单的函数,它接受一个 POSIXct 日期,提取年份,如果日期早于 6 月 1 日则减去 1。

library(lubridate)
DetermineWaterYear <- function(date, 
                               return.interval=FALSE){
  wy <- year(date) + ifelse(month(date)>=6, 0, -1)
  if(return.interval==FALSE){
    return(wy)
  } else {
    interval <- interval(ymd(cat(wy),'06-01', sep=''), ymd(cat(wy+1),'05-31', sep=''))
    return(interval)
  }
}

当我尝试使用 sapply() 对约 190k 日期的向量执行此函数时,它需要永远。

sapply(temp$date, DetermineWaterYear)

此外,我使用以下代码对长度为 10000 到 190000 的向量子集执行 sapply 计时:

tempdates <- rep(ymd('1956-01-01'), 190000)


index <- seq(10000,190000,10000)
for(i in 1:length(index)){
  times[i] <- system.time(sapply(tempdates[1:index[i]], DetermineWaterYear))[3]
}

疯狂的是,随着日期向量变长,每条记录的处理时间大大增加……处理 190k 个日期所需的时间是 10k 个日期所需时间的 238 倍。我有足够的可用内存。

为什么运行如此缓慢?我该如何优化它?

正如评论中所指出的,将日期向量直接传递给函数要快得多。此外,ifelse 有大量开销,因此将 ifelse(month(date)>=6, 0, -1) 替换为 floor((x/5.6) - (x^2)*0.001) - 1L 会快得多。

DetermineWaterYearNew <- function(date, return.interval=FALSE){
    x <- month(date)
    wy <- year(date) + floor((x/5.6) - (x^2)*0.001) - 1L
    if(return.interval==FALSE){
        return(wy)
    } else {
        interval <- interval(ymd(cat(wy),'06-01', sep=''), ymd(cat(wy+1),'05-31', sep=''))
        return(interval)
    }
}

这里有一些基准:

microbenchmark(NewVectorized=DetermineWaterYearNew(tempdates[1:1000]),
               OldVectorized=DetermineWaterYear(tempdates[1:1000]),
               NonVectorized=sapply(tempdates[1:1000],DetermineWaterYear))
Unit: microseconds
         expr       min         lq       mean     median         uq       max neval
NewVectorized   341.954   364.1215   418.7311   395.7300   460.7955   602.627   100
OldVectorized   417.077   437.3970   496.0585   462.8485   545.1555   802.954   100
NonVectorized 42601.719 45148.3070 46452.6843 45902.4100 47341.2415 62898.476   100

仅在我们拥有的所有日期范围内比较矢量化解决方案:

microbenchmark(NewVectorized=DetermineWaterYearNew(tempdates[1:190000]),
               OldVectorized=DetermineWaterYear(tempdates[1:190000]))
Unit: milliseconds
         expr      min       lq     mean   median       uq      max neval
NewVectorized 26.30660 27.26575 28.97715 27.84169 29.19391 102.1697   100
OldVectorized 38.98637 40.78153 44.07461 42.55287 43.77947 114.9616   100