代码之家  ›  专栏  ›  技术社区  ›  Neal Barsch

提高r中data.table中两列的粘贴速度(可复制)

  •  4
  • Neal Barsch  · 技术社区  · 6 年前

    我有这样的数据:

    library(data.table)
    NN = 10000000
    set.seed(32040)
    DT <- data.table(
      col = 1:10000000,
      timestamp = 1521872652 + sample(7000001, NN, replace = TRUE)
    )
    

    有一个有效的当前解决方案(如下),但速度很慢 从日期列唯一粘贴周和年的部分。日期的创建使用 anytime 包装和牵引 week year lubridate 仍然很快。有人能帮我加快速度吗?谢谢!

    我的慢代码(有效,但我想加快速度) 以下内容:

    library(anytime)
    library(lubridate)
    tz<-"Africa/Addis_Ababa"
    DT$localtime<-  anytime(DT$timestamp, tz=tz) ###Lightning fast
    DT$weekuni <- paste(year(DT$localtime),week(DT$localtime),sep="") ###super slow
    

    我的测试显示是 paste 真让我受不了:

    很快 任何时候 转换到日期:

    system.time(DT$localtime<-  anytime(DT$timestamp, tz=tz)) ###Lightning fast
           user  system elapsed 
          0.264   0.417   0.933 
    

    润滑 从日期开始的周和年转换,但很慢 粘贴 以下内容:

    > system.time(DT$weekuni1 <- week(DT$localtime)) ###super slow
       user  system elapsed 
      1.203   0.188   1.400 
    > system.time(DT$weekuni2 <- year(DT$localtime))
       user  system elapsed 
      1.229   0.189   1.427 
    > system.time(DT$weekuni <- paste0(DT$weekuni1,dt$weekuni2))
       user  system elapsed 
     14.652   0.344  15.483
    
    2 回复  |  直到 6 年前
        1
  •  5
  •   MichaelChirico    6 年前

    我让你的代码运行速度提高了50% format 而不是 paste 是的。

    首先,我不确定 anytime 对于您的用例,因为我们可以将时间戳放入 POSIXct 结构几乎立即:

    DT[ , localtime := .POSIXct(timestamp, tz = tz)]
    

    接下来,我四处搜寻 ?strptime 对于要获取的基于ISO周的格式代码:

    DT[ , weekuni := format(localtime, format = '%G%V')]
    

    我不是百分之百确定这会一直和 paste(year, week) ,但这是为了你的测试数据;如果有的话 他们之间的区别在于,你应该问问这对你是否真的重要。

    我唯一能想到的可能更快的方法是在时间戳本身上使用整数运算。如果 Africa/Addis_Ababa 非洲/亚的斯亚贝巴 观察夏时制时间,因此UTC偏移量在2&3小时之间变化,使得整数算术方法变得非常困难)


    作为记录,使用 data.table::year data.table::week 和这里使用的方法一样快, 但是 它对“年”和“周”的定义不同于 lubridate (默认使用ISO年/周 %G%V 以上所述)。

    data.table 还没有 isoyear 实施,以及 data.table::isoweek 大大慢于 lubridate::week 是的。

        2
  •  3
  •   Hugh    6 年前

    如果您只想根据日期定义一年中的一周,那么您可以得到一个速度快20倍的解决方案:

    library(data.table)
    NN = 10000000
    # NN = 1e4
    set.seed(32040)
    DT <- data.table(
      col = seq_len(NN),
      timestamp = 1521872652 + sample(7000001, NN, replace = TRUE)
    )
    DT1 <- copy(DT)
    
    DT2 <- copy(DT)
    tz <- "Africa/Addis_Ababa"
    
    old <- function(DT) {
      DT$localtime<-  anytime::anytime(DT$timestamp, tz=tz) ###Lightning fast
      DT$weekuni <- paste(lubridate::year(DT$localtime), lubridate::week(DT$localtime), sep="")
      DT[, timestamp := NULL]
      DT[, .(col, localtime, weekuni)]
    }
    
    new <- function(DT) {
      DT[ , localtime := anytime::anytime(timestamp, tz = tz)]
      DT[, Date := as.Date(localtime)]
      DT[, weekuni := paste0(lubridate::year(.BY[[1L]]), lubridate::week(.BY[[1L]])),
         keyby = "Date"]
      DT[, Date := NULL]
      # DT[, timestamp := NULL]
      DT[order(col), .(col, localtime, weekuni)]
    }
    
    bench::mark(old(DT1), new(DT2), check = FALSE, filter_gc = FALSE)
    #> # A tibble: 2 x 10
    #>   expression     min    mean median    max `itr/sec` mem_alloc  n_gc n_itr
    #>   <chr>      <bch:t> <bch:t> <bch:> <bch:>     <dbl> <bch:byt> <dbl> <int>
    #> 1 old(DT1)    22.39s  22.39s 22.39s 22.39s    0.0447    2.28GB     5     1
    #> 2 new(DT2)     1.13s   1.13s  1.13s  1.13s    0.888   878.12MB     1     1
    #> # ... with 1 more variable: total_time <bch:tm>
    

    于2018年6月23日由 reprex package (第0.2.0版)。

    即使你没有,你仍然可以通过使用 paste 每天一次:

    library(data.table)
    NN = 1e7
    # NN = 1e4
    set.seed(32040)
    DT <- data.table(
      col = seq_len(NN),
      timestamp = 1521872652 + sample(7000001, NN, replace = TRUE)
    )
    DT1 <- copy(DT)
    
    DT2 <- copy(DT)
    DT3 <- copy(DT)
    tz <- "Africa/Addis_Ababa"
    
    old <- function(DT) {
      DT$localtime<-  anytime::anytime(DT$timestamp, tz=tz) ###Lightning fast
      DT$weekuni <- paste(lubridate::year(DT$localtime), lubridate::week(DT$localtime), sep="")
      DT[, timestamp := NULL]
      DT[, .(col, weekuni)]
    }
    
    new <- function(DT) {
      DT[ , Date := anytime::anydate(timestamp, tz = tz)]
      DT[, weekuni := paste0(lubridate::year(.BY[[1L]]), lubridate::week(.BY[[1L]])),
         keyby = "Date"]
      DT[, Date := NULL]
      # DT[, timestamp := NULL]
      setorderv(DT[, .(col, weekuni)], "col")
    }
    
    
    bench::mark(old(DT1), new(DT2), check = TRUE, filter_gc = FALSE)
    #> # A tibble: 2 x 10
    #>   expression     min    mean median    max `itr/sec` mem_alloc  n_gc n_itr
    #>   <chr>      <bch:t> <bch:t> <bch:> <bch:>     <dbl> <bch:byt> <dbl> <int>
    #> 1 old(DT1)     22.2s   22.2s  22.2s  22.2s    0.0450    2.21GB     4     1
    #> 2 new(DT2)      2.8s    2.8s   2.8s   2.8s    0.357     1.42GB     3     1
    #> # ... with 1 more variable: total_time <bch:tm>