更高效地使用 fasttime答案

【问题标题】：More performant use of fasttime更高效地使用 fasttime
【发布时间】：2016-01-02 07:52:44
【问题描述】：

我有一个大型数据表，（10 亿行 × 50 列）类似于来自library(nycflights13) 的flights，其中多个列可以组合形成一个日期。

我目前用于创建此日期时间列的代码是：

library(data.table)
library(nycflights13)
library(fasttime)

flights <- as.data.table(flights)

flights[,DepDateTime := fastPOSIXct(paste0(year, 
                                           "-",
                                           formatC(month, width = 2, format = "d", flag = "0"),
                                           "-",
                                           formatC(day, width = 2, format = "d", flag = "0"), 
                                           " ",
                                           # replace e.g. 903 with '09:03:00'
                                           gsub("([0-9]{2})([0-9]{2})", "\\1:\\2:00", 
                                                formatC(dep_time, width = 4, 
                                                        format = "d", flag = "0")))
                                           )]

对于flights 数据，这大约需要 0.6 秒。有什么办法可以提高这种性能吗？我主要对时间感兴趣；内存使用是次要问题。

这是一个候选数据表：

flights.big <- 
data.table(year = sample(1980:2015, size = 1e9, replace = TRUE),
           month = sample(1:12, size = 1e9, replace = TRUE), 
           day = sample(1:28, size = 1e9, replace = TRUE),
           hour = sample(1:12, size = 1e9, replace = TRUE),
           minute = sample(0:59, size = 1e9, replace = TRUE)
           )

【问题讨论】：

对于 10 亿行，还有哪些可以接受的改进？
目前大约需要 15 分钟才能完成。 5分钟可以吗？或者我应该尝试获得更好的硬件（当前运行 64 Gb RAM 机器）
啊，我的印象是您的数据集（和航班）需要 0.6 秒。如果你能模拟一个模仿你的数据集，这样时间就可以比较，那就太好了。
我认为通过使用sub 而不是gsub 和perl = TRUE 并用sprintf 替换formatC 使用"%02d"，你可以期待一些轻微的性能改进 - 特别是在摆脱paste 并在 sprintf 调用中连接，类似于 sprintf("%d-%02d-%02d %s", year, month, day, sub("([0-9]{2})([0-9]{2})", "\\1:\\2:00", sprintf("%04d", dep_time), perl = TRUE))
fastPOSIXct 似乎可以正确处理即将成为“日期”“字符”向量中缺少的 0 和无意义的分隔符；这样您就可以避免多次致电formatC/sub/etc。例如。 identical(fastPOSIXct("2013-05-24 05:04:21"), fastPOSIXct("2013-5-24-5-4-21"))。顺便说一句，由于您已经拥有 y/m/d/h/m 的数字向量，您可以搜索其他方法来转换为“日期”，从而避免中间的“字符”转换。

标签： r performance datetime data.table

【解决方案1】：

我使用 lubridate 和 stringr 将航班数据的性能提升了大约 25%。不幸的是，我目前没有使用可以处理与您的全套一样大的数据集的计算机，因此希望它可以扩展。

library(data.table)
library(nycflights13)
library(fasttime)
library(microbenchmark)
library(lubridate)
library(stringr)

flights <- as.data.table(flights)

op1 <- microbenchmark(
  flights[,DepDateTime := fastPOSIXct(paste0(year, 
                                             "-",
                                             formatC(month, width = 2, format = "d", flag = "0"),
                                             "-",
                                             formatC(day, width = 2, format = "d", flag = "0"), 
                                             " ",
                                             # replace e.g. 903 with '09:03:00'
                                             gsub("([0-9]{2})([0-9]{2})", "\\1:\\2:00", 
                                                  formatC(dep_time, width = 4, 
                                                          format = "d", flag = "0")))
  )],
  times=50L)

op2 <- microbenchmark(
  flights[,DepDateTime := ymd_hm(paste(year, 
                                       month, 
                                       day, 
                                       str_pad(dep_time,
                                               width = 4,
                                               side = "left",
                                               pad = "0"), 
                                       sep = "-"))],
  times=50L)

我电脑上的基准测试是

 >op1
      min       lq     mean   median       uq      max neval
 3.385542 3.526347 3.739545 3.679273 3.855418 4.594314    50
>op2
      min       lq     mean   median       uq      max neval
 2.536882 2.589711 2.733829 2.715038 2.835111 3.194575    50

【讨论】：

【解决方案2】：

通过在函数 (create_fn) 中使用连接和 sprintf 可以显着提高速度。对于较小的数据集，增加幅度较小：

library(data.table)
library(nycflights13)
library(fasttime)
library(microbenchmark)
library(ggplot2) # for autoplot

create_DepDateTime <- function(DT){
  setkey(DT, year, month, day, dep_time)
  unique_dates <- unique(DT[,list(year, month, day, dep_time)])
  unique_dates[,DepDateTime := fastPOSIXct(sprintf("%d-%02d-%02d %s", year, 
                                                   month, 
                                                   day, 
                                                   sub("([0-9]{2})([0-9]{2})", 
                                                       "\\1:\\2:00",
                                                       sprintf("%04d", dep_time), 
                                                       perl = TRUE)), 
                                           tz = "GMT")]
  DT[unique_dates]
}

flights <- as.data.table(flights)

BENCHMARK <- function(){
  flights[,DepDateTime := fastPOSIXct(paste0(year, 
                                             "-",
                                             formatC(month, width = 2, 
                                                     format = "d", flag = "0"),
                                             "-",
                                             formatC(day, width = 2, 
                                                     format = "d", flag = "0"), 
                                             " ",
                                             # replace e.g. 903 with '09:03:00'
                                             gsub("([0-9]{2})([0-9]{2})", 
                                                  "\\1:\\2:00", 
                                                  formatC(dep_time, 
                                                          width = 4, 
                                                          format = "d", 
                                                          flag = "0")))
  )]
}

NGaffney_lubridate <- function(){
  flights[,DepDateTime := lubridate::ymd_hm(paste(year, 
                                                  month, 
                                                  day, 
                                                  stringr::str_pad(dep_time,
                                                                   width = 4,
                                                                   side = "left",
                                                                   pad = "0"), 
                                                  sep = "-"))]
}
create_fn <- function(){
  flights <- create_DepDateTime(flights)
}

autoplot(
  microbenchmark(
  BENCHMARK(),
  NGaffney_lubridate(),
  create_fn(),
  times=50L
  )
)

【讨论】：