代码优化——data.table，当前for循环多引用优化成data.table

【问题标题】：Code Optimization - data.table, current for loop with multiple reference to be optimized into data.table代码优化——data.table，当前for循环多引用优化成data.table
【发布时间】：2019-01-11 05:31:27
【问题描述】：

我有一个要求，我有一个包含大约 200 万 条记录的庞大数据库，其中我需要根据来自另一个数据框的信息为某些特定变量创建带有代码的新变量。所以情况是——

  1. 有一个参考数据库，其中包含 IBD (inter1) 变量的截止值
  2. 有一个向量，其中包含需要根据截止值创建代码的变量列表 (v0int)
  3. 需要在其上创建具有基于截止值的代码的新变量的主数据库 (smpl)

例如，对于 IBD 5 和变量 var1a，请考虑 inter1 文件中的以下信息 -

IBD var1a
5    11
5    18
5    30
5    63

基于上述信息，我想在 smpl 数据框中创建一个新变量，这样 -

if smpl$var1a <= 11 then var1a_INT = 1
if smpl$var1a > 11 & smpl$var1a <= 18 then var1a_INT = 2
if smpl$var1a > 18 & smpl$var1a <= 30 then var1a_INT = 3
if smpl$var1a > 30 & smpl$var1a <= 63 then var1a_INT = 4
if smpl$var1a > 63 then var1a_INT = 5

由于这需要通过 IBD 为多个变量完成，因此我使用 for 循环 编写了我的代码。我的示例代码如下 -

    set.seed(1200)

    IBD <- sort(rep(1:10,4))

    var1a <- c()
    var2a <- c()
    var3a <- c()
    var4a <- c()
    var5a <- c()

    j=10
    for (i in 1:10){
      set.seed(1200)+(j*i)
      var1 <- sort(sample(1:(10*i),4))
      var2 <- sort(sample(11:(15*i),4))
      var3 <- sort(sample(10:(17*i),4))
      var4 <- sort(sample(11:(19*i),4))
      var5 <- sort(sample(10:(16*i),4))

      var1a <- c(var1a,var1)
      var2a <- c(var2a,var2)
      var3a <- c(var3a,var3)
      var4a <- c(var4a,var4)
      var5a <- c(var5a,var5)
    }

    inter1 <- data.frame(IBD,var1a,var2a,var3a,var4a,var5a)

    sm=5000

    ID <- seq(1:sm)
    IBD <- sample(1:10,sm,replace = T)
    CELL <- sample(1001:9999,sm)
    var1a <- sample(1:150,sm,replace = T)
    var2a <- sample(1:200,sm,replace = T)
    var3a <- sample(1:200,sm,replace = T)
    var4a <- sample(1:350,sm,replace = T)
    var5a <- sample(1:250,sm,replace = T)
    var6a <- sample(1:150,sm,replace = T)
    var7a <- sample(1:250,sm,replace = T)
    var8a <- sample(1:350,sm,replace = T)
    var9a <- sample(1:450,sm,replace = T)
    loc <- sample(1:20,sm,replace = T)
    bill <- sample(1:2,sm,replace = T)

        smpl <- data.frame(ID,IBD,CELL,var1a,var2a,var3a,var4a,var5a,var6a,var7a,var8a,var9a,loc,bill)



    v0int <- c("var1a","var2a","var3a","var4a","var5a")

    df_smpl <- data.frame(matrix(NA,nrow = 0,ncol = ncol(smpl)))

    #l=1
    start_time <- Sys.time()

        for (l in (unique(inter1$IBD))){
      df1 <- subset(smpl,IBD == l)
      for (k in 1:length(v0int)){
        #k=1
        q0 <- v0int[k]
        q1 <- sort(inter1[inter1$IBD == l,q0])
        for (m in 1:nrow(df1)){
          #print(q0)
          #print(l)
          #print(m)
          if (length(q1) == 0){
            df1[m,paste0(q0,"_INT")]=NA
          } else if(length(q1) == 1){
            if(!is.null(df1[m,q0]) & df1[m,"IBD"]==l & df1[m,q0] <= q1[1]) df1[m,paste0(q0,"_INT")]=1
            if(!is.null(df1[m,q0]) & df1[m,"IBD"]==l & df1[m,q0] > q1[1]) df1[m,paste0(q0,"_INT")]=2
          } else if(length(q1) == 2){
            if(!is.null(df1[m,q0]) & df1[m,"IBD"]==l & df1[m,q0] <= q1[1]) df1[m,paste0(q0,"_INT")]=1
            if(!is.null(df1[m,q0]) & df1[m,"IBD"]==l & df1[m,q0] > q1[1] & df1[m,q0] <= q1[2]) df1[m,paste0(q0,"_INT")]=2
            if(!is.null(df1[m,q0]) & df1[m,"IBD"]==l & df1[m,q0] > q1[2]) df1[m,paste0(q0,"_INT")]=3
          } else if(length(q1) == 3) {
            if(!is.null(df1[m,q0]) & df1[m,"IBD"]==l & df1[m,q0] <= q1[1]) df1[m,paste0(q0,"_INT")]=1
            if(!is.null(df1[m,q0]) & df1[m,"IBD"]==l & df1[m,q0] > q1[1] & df1[m,q0] <= q1[2]) df1[m,paste0(q0,"_INT")]=2
            if(!is.null(df1[m,q0]) & df1[m,"IBD"]==l & df1[m,q0] > q1[2] & df1[m,q0] <= q1[3]) df1[m,paste0(q0,"_INT")]=3
            if(!is.null(df1[m,q0]) & df1[m,"IBD"]==l & df1[m,q0] > q1[3]) df1[m,paste0(q0,"_INT")]=4
          } else if(length(q1) == 4) {
            if(!is.null(df1[m,q0]) & df1[m,"IBD"]==l & df1[m,q0] <= q1[1]) df1[m,paste0(q0,"_INT")]=1
            if(!is.null(df1[m,q0]) & df1[m,"IBD"]==l & df1[m,q0] > q1[1] & df1[m,q0] <= q1[2]) df1[m,paste0(q0,"_INT")]=2
            if(!is.null(df1[m,q0]) & df1[m,"IBD"]==l & df1[m,q0] > q1[2] & df1[m,q0] <= q1[3]) df1[m,paste0(q0,"_INT")]=3
            if(!is.null(df1[m,q0]) & df1[m,"IBD"]==l & df1[m,q0] > q1[3] & df1[m,q0] <= q1[4]) df1[m,paste0(q0,"_INT")]=4
            if(!is.null(df1[m,q0]) & df1[m,"IBD"]==l & df1[m,q0] > q1[4]) df1[m,paste0(q0,"_INT")]=5
          }
        }
        #q1 <- NULL
      }
      df_smpl <- rbind(df_smpl,df1)
      #q0 <- NULL
    }


    time_taken <- as.numeric(difftime(Sys.time(), start_time, units = 'secs'))

对于 5000 条记录的样本数据，这在我的机器上需要 5.859623 秒，它有 16GB RAM SSD HDD 和 2 核。

当尝试处理具有 500000 条记录的数据时，这需要 752.7261 秒。

我的实际数据有 200 万 条记录，我需要以迭代方式多次运行它，因此所需时间会大大增加。

在进行一些搜索时，我了解到 data.table 速度更快，并且可以节省大量时间。我不太了解 data.table，希望在这方面寻求您的帮助。

如果我们可以优化这段代码，那将是一个巨大的帮助和节省大量的时间。

【问题讨论】：

  • 您好，我认为您需要提供有关您当前环境的更多信息 - 目前数据在哪里？
  • @MandyShaw，感谢您对此进行调查。数据以 csv 格式本地存在于我的机器中。
  • @Roland，请您指导一下您是如何正确发布帖子的。我的意思是我缩进了我的代码，它不允许我发布，而且你似乎编辑了几行。你到底做了什么，它起作用了
  • 嗨，我自己（不是 R 人）无法查看它，但知道数据在哪里无疑会对其他人有所帮助。但即使我可以看到在 csv 文件中处理大量数据肯定会很慢，您将需要一个专门的数据存储。
  • 你可以看到what I did，但是不知道哪部分解决了你报告的问题。可能删除多余的反引号？

标签： r performance for-loop optimization data.table


【解决方案1】：

有两种替代方法，滚动连接和在非等值连接中更新。对于给定的样本数据集，两者都比minem's solution 快四到五倍，并且内存消耗更少。

非等值连接

它需要创建start - end 间隔，最好以长格式完成

# create intervals in long format
long <- setDT(melt(inter1, "IBD", variable.name = "var"))
long <- rbind(long,
              long[, CJ(IBD = IBD, var = var, 
                        value = c(-.Machine$integer.max, .Machine$integer.max), 
                        unique = TRUE)])[
                          order(IBD, var, value)]
long <- long[, .(start = head(value, -1L), 
         end = tail(value, -1L),
         INT = 1:(.N - 1L)), 
     by = .(IBD, var)]
long

     IBD   var       start        end INT
  1:   1 var1a -2147483647          2   1
  2:   1 var1a           2          4   2
  3:   1 var1a           4          8   3
  4:   1 var1a           8          9   4
  5:   1 var1a           9 2147483647   5
 ---                                     
246:  10 var5a -2147483647         29   1
247:  10 var5a          29         44   2
248:  10 var5a          44         45   3
249:  10 var5a          45         80   4
250:  10 var5a          80 2147483647   5

请注意，使用最大整数而不是 Inf 以避免从整数强制转换为双精度。

现在，我们遍历指定的列并对每一列进行非等连接。每次迭代都会添加一个新的结果列：

v0int <- c("var1a","var2a","var3a","var4a","var5a")
setDT(smpl)
for (col in v0int) {
  smpl[long[var == col], 
       on = c("IBD", paste0(col, ">start"), paste0(col, "<=end")), 
       paste0(col, "_INT") := i.INT]
}


smpl[]

        ID IBD CELL var1a var2a var3a var4a var5a var6a var7a var8a var9a loc bill var1a_INT var2a_INT var3a_INT var4a_INT var5a_INT
   1:    1   7 6849    93    38   151   203    63    70    35     8     7  17    2         5         1         5         5         4
   2:    2   9 2517   109   130    97   296    15    97    79   267   422   4    2         5         5         1         5         1
   3:    3  10 9322    65    18   160   156    80   132    33    41   387   8    1         5         1         5         4         4
   4:    4  10 7377   105     8    87   263   101   110   207   224   331  11    2         5         1         1         5         5
   5:    5   4 6991    72   144   187   144   117   125   123    84    60   3    1         5         5         5         5         5
  ---                                                                                                                               
4996: 4996   6 5129    56   188    21    74   105   133   192    45   284   5    1         5         5         1         3         5
4997: 4997   2 2657     8    50   127     6   119    81    60   250   209   3    2         2         5         5         1         5
4998: 4998   2 1473   128    90   156    74   203     5   198    63    10  17    1         5         5         5         5         5
4999: 4999   9 2120    66   141   170   256   151    68   205    97     8   9    2         5         5         5         5         5
5000: 5000   2 4555   109   102    92    98    11   107   104   210   266  14    2         5         5         5         5         1

请注意，连接条件 (on =) 是作为字符串动态创建的。

滚动加入

Frank has pointed out 滚动连接 也适用于此处，因为间隔中没有间隙。

OP 已指定右闭区间，例如，

if smpl$var1a > 11 & smpl$var1a <= 18 then var1a_INT = 2

因此，我们需要一个向后滚动连接，它使用间隔的end 值。

在常规连接中，连接参数必须完全匹配。在向后滚动连接中，如果没有完全匹配，使得值落在两个 end 值之间的间隙中，则 下一个观察值向后进行 (NOCB)。

long <- setDT(melt(inter1, "IBD", variable.name = "var", value.name = "end"))
long <- rbind(long,
              long[, CJ(IBD = IBD, var = var, end = .Machine$integer.max, 
                        unique = TRUE)])
setorder(long, IBD, var, end)
long[, INT := rowid(IBD, var)]

v0int <- c("var1a","var2a","var3a","var4a","var5a")
setDT(smpl)
for (col in v0int) {
  smpl[, paste0(col, "_INT") := long[var == col][
    smpl, on = c("IBD", paste0("end==", col)), 
    roll = -Inf, x.INT]]
}

基准测试

将非相等联接和滚动联接与minem's answer 的两个最快变体进行比较，这两个变体通过引用更新smpl 以避免重复调用rbind()。

结果是相同的，只是行的顺序不同。

由于所有解决方案都通过引用更新 smpl，所有基准测试运行都从原始数据集的新 copy() 开始。

library(bench)
my_check <- function(x, y) {
  all.equal(x[order(ID)], y[order(ID)])
}

v0int <- c("var1a","var2a","var3a","var4a","var5a")
bm <- mark(
  rj = {
    smpl <- copy(smpl0)
    long <- setDT(melt(inter1, "IBD", variable.name = "var", value.name = "end"))
    long <- rbind(long,
                  long[, CJ(IBD = IBD, var = var, end = .Machine$integer.max, 
                            unique = TRUE)])
    setorder(long, IBD, var, end)
    long[, INT := rowid(IBD, var)]
    setDT(smpl)
    for (col in v0int) {
      smpl[, paste0(col, "_INT") := long[var == col][
        smpl, on = c("IBD", paste0("end==", col)), 
        roll = -Inf, x.INT]]
    }
    smpl[]
  },
  nej = {
    smpl <- copy(smpl0)
    long <- setDT(melt(inter1, "IBD", variable.name = "var"))
    long <- rbind(long,
                  long[, CJ(IBD = IBD, var = var, 
                            value = c(-.Machine$integer.max, .Machine$integer.max), 
                            unique = TRUE)])[
                              order(IBD, var, value)]
    long <- long[, .(start = head(value, -1L), 
                     end = tail(value, -1L),
                     INT = 1:(.N - 1L)), 
                 by = .(IBD, var)]

    setDT(smpl)
    for (col in v0int) {
      smpl[long[var == col], 
           on = c("IBD", paste0(col, ">start"), paste0(col, "<=end")), 
           paste0(col, "_INT") := i.INT]
    }
    smpl[]
  },
  minem1 = {
    smpl <- copy(smpl0)
    setDT(smpl) # convert smpl to data.table
    setkey(smpl, IBD) # setkey on IBD for faster `IBD == l` operation
    for (l in (unique(inter1$IBD))) {
      for (k in 1:length(v0int)) {
        q0 <- v0int[k]
        q1 <- sort(inter1[inter1$IBD == l, q0])
        smpl[IBD == l, paste0(q0, "_INT") := as.integer(cut(get(q0), c(0, q1, Inf)))]
      }
    }
    smpl[]
  },
  minem2 = {
    smpl <- copy(smpl0)
    setDT(smpl) # convert smpl to data.table
    setkey(smpl, IBD) # setkey on IBD for faster `IBD == l` operation
    for (l in (unique(inter1$IBD))) {
      for (k in 1:length(v0int)) {
        q0 <- v0int[k]
        q1 <- sort(inter1[inter1$IBD == l, q0])
        smpl[IBD == l, paste0(q0, "_INT") := cut(get(q0), c(0, q1, Inf), labels = FALSE)]
      }
    }
    smpl[]
  },
  check = my_check, 
  min_time = 1
)

bm

# A tibble: 4 x 14
  expression      min     mean  median     max `itr/sec` mem_alloc  n_gc n_itr total_time result memory time  gc   
  <chr>      <bch:tm> <bch:tm> <bch:t> <bch:t>     <dbl> <bch:byt> <dbl> <int>   <bch:tm> <list> <list> <lis> <lis>
1 rj             20ms   22.5ms    22ms    28ms     44.5     1.73MB     3    41      921ms <data~ <Rpro~ <bch~ <tib~
2 nej          25.3ms   28.3ms  28.6ms  30.9ms     35.4     2.31MB     2    20      566ms <data~ <Rpro~ <bch~ <tib~
3 minem1      106.2ms  113.8ms 110.3ms 129.9ms      8.79     6.4MB     2     7      797ms <data~ <Rpro~ <bch~ <tib~
4 minem2       98.8ms  101.8ms 101.6ms 106.3ms      9.83    5.66MB     3     7      712ms <data~ <Rpro~ <bch~ <tib~

rolling join 比minem's solutions 快​​五倍，non-equi join 快四倍。此外，分配的内存减少了两到四倍。 

ggplot2::autoplot(bm)

【讨论】：

  • 酷，从未见过时间 + 内存基准测试。 “它需要创建开始 - 结束间隔” - 间隔划分了实线，因此只需指定一个（开始或结束）并进行滚动连接似乎很合适......这似乎应该更有效。
  • @Frank，向后滚动加入添加到答案和基准。速度再提高 25%，分配的内存更少。困难的部分是弄清楚我必须使用向后滚动连接来处理正确的封闭间隔。
  • @Uwe，感谢您的回答和时间调查。虽然它对我来说有点繁重的代码，但我会通过它并理解，以便我可以使用它。我可以看到我可以从你的代码中学到很多东西。再次感谢您！
【解决方案2】：

对于您的示例数据，我使用此循环得到了相同的结果：

for (l in (unique(inter1$IBD))){
  df1 <- subset(smpl, IBD == l)
  for (k in 1:length(v0int)){
    q0 <- v0int[k]
    q1 <- sort(inter1[inter1$IBD == l,q0])
    x <- as.integer(cut(df1[, q0], c(0, q1, Inf)))
    df1[, paste0(q0,"_INT")] <- x
  }
  df_smpl <- rbind(df_smpl, df1)
}

0.42 瑞典克朗 vs 10 瑞典克朗

使用data.table，我们可以轻松地将结果直接添加到原始数据表中。这将比使用rbind 更快。

setDT(smpl) # convert smpl to data.table
setkey(smpl, IBD) # setkey on IBD for faster `IBD == l` operation

start_time <- Sys.time()

for (l in (unique(inter1$IBD))) {
  for (k in 1:length(v0int)) {
    q0 <- v0int[k]
    q1 <- sort(inter1[inter1$IBD == l, q0])
    smpl[IBD == l, paste0(q0, "_INT") := as.integer(cut(get(q0), c(0, q1, Inf)))]
  }
}
smpl # end result data.table

主要区别在于最终结果的行顺序与原始结果不同。

使用这条线应该会更快：

smpl[IBD == l, paste0(q0, "_INT") := cut(get(q0), c(0, q1, Inf), labels = F)]

【讨论】：

  • 非常感谢您的回答。这将节省大量时间。我尝试了它们两个，实际上时间大大减少了……Cut正在发挥作用。带有 rbind 的那个需要 0.05042601 秒，而带有 datatable 的那个需要 0.09625602 秒。所以看起来 rbind 工作得更好。我想听听你对处理 NA 的反馈。 cut 是否也能够处理存在于 inter1 或 smpl 中的 NA。请建议
  • @user1412 您希望如何处理NA？如果 NA 在 smpl 中，那么一切都应该没问题。如果 NA 在 inter1 中，那么我认为应该在 cut 之前实施某种解决方法。
  • @user1412 data.table 对于大型 N（行数）和许多 IBD 组应该更快
  • 如果 NA 在 inter1 中，我们需要取最后一个可用的值，例如，对于 IBD 5 var1a，我们有像 11,18,NA,NA 这样的值，那么在这种情况下我们会有 3 个代码 11 &18 = 代码 3。当前代码是否需要针对这种情况进行一些调整？
  • 我为几个 if 变量添加了一些 NA，并进行了检查，它工作正常。非常感谢。正如您所说的大型数据集 data.table 会更快并且将使用相同的（+1）。再次感谢您！
猜你喜欢
  • 1970-01-01
  • 1970-01-01
  • 2011-10-12
  • 2022-01-10
  • 1970-01-01
  • 1970-01-01
  • 2018-04-27
  • 2014-03-05
  • 2017-01-09
相关资源
最近更新 更多
热门标签
Java Python linux javascript Mysql C# Docker 算法 前端 SpringBoot Redis Vue spring 设计模式 .net core .net kubernetes c++ 数据库 数据结构 大数据 js 机器学习 微服务 Android Go 程序员 面试 JVM ASP.net core 云原生 人工智能 后端 PHP git CSS golang k8s Nginx Django mybatis 深度学习 多线程 React 架构 devops 爬虫 云计算 Spring Boot LeetCode