performance - 加快 R 中的循环操作

Question

我在 R 中有一个很大的性能问题。我编写了一个迭代data.frame对象的函数。它只是向 a 添加一个新列data.frame并积累一些东西。（操作简单）。有data.frame大约 850K 行。我的电脑仍在工作（现在大约 10 小时），我不知道运行时。

dayloop2 <- function(temp){
    for (i in 1:nrow(temp)){    
        temp[i,10] <- i
        if (i > 1) {             
            if ((temp[i,6] == temp[i-1,6]) & (temp[i,3] == temp[i-1,3])) { 
                temp[i,10] <- temp[i,9] + temp[i-1,10]                    
            } else {
                temp[i,10] <- temp[i,9]                                    
            }
        } else {
            temp[i,10] <- temp[i,9]
        }
    }
    names(temp)[names(temp) == "V10"] <- "Kumm."
    return(temp)
}

任何想法如何加快此操作？

score 454 · Accepted Answer

最大的问题和无效的根源是索引 data.frame，我的意思是你使用的所有这些行temp[,]。
尽量避免这种情况。我拿走了你的功能，改变了索引，这里是version_A

dayloop2_A <- function(temp){
    res <- numeric(nrow(temp))
    for (i in 1:nrow(temp)){    
        res[i] <- i
        if (i > 1) {             
            if ((temp[i,6] == temp[i-1,6]) & (temp[i,3] == temp[i-1,3])) { 
                res[i] <- temp[i,9] + res[i-1]                   
            } else {
                res[i] <- temp[i,9]                                    
            }
        } else {
            res[i] <- temp[i,9]
        }
    }
    temp$`Kumm.` <- res
    return(temp)
}

如您所见，我创建res了收集结果的向量。最后我把它加进去data.frame，我不需要弄乱名字。那么它有多好呢？

data.frame我用nrow1,000 到 10,000 x 1,000运行每个函数，并用system.time

X <- as.data.frame(matrix(sample(1:10, n*9, TRUE), n, 9))
system.time(dayloop2(X))

结果是

您可以看到您的版本以指数方式依赖于nrow(X). 修改版具有线性关系，简单lm模型预测 850,000 行计算需要 6 分 10 秒。

矢量化的力量

正如 Shane 和 Calimo 在他们的回答中所说，矢量化是提高性能的关键。从您的代码中，您可以移出循环：

调理
结果的初始化（它们是temp[i,9]）

这导致了这段代码

dayloop2_B <- function(temp){
    cond <- c(FALSE, (temp[-nrow(temp),6] == temp[-1,6]) & (temp[-nrow(temp),3] == temp[-1,3]))
    res <- temp[,9]
    for (i in 1:nrow(temp)) {
        if (cond[i]) res[i] <- temp[i,9] + res[i-1]
    }
    temp$`Kumm.` <- res
    return(temp)
}

比较此函数的结果，这次是nrow从 10,000 到 100,000 x 10,000。

调音调

另一个调整是在循环索引中temp[i,9]更改res[i]（在第 i 次循环迭代中完全相同）。这又是索引向量和索引 a 之间的区别data.frame。
第二件事：当您查看循环时，您可以看到不需要遍历 all i，而只针对符合条件的那些。
所以我们开始

dayloop2_D <- function(temp){
    cond <- c(FALSE, (temp[-nrow(temp),6] == temp[-1,6]) & (temp[-nrow(temp),3] == temp[-1,3]))
    res <- temp[,9]
    for (i in (1:nrow(temp))[cond]) {
        res[i] <- res[i] + res[i-1]
    }
    temp$`Kumm.` <- res
    return(temp)
}

您获得的性能高度取决于数据结构。准确地说 -TRUE条件中值的百分比。对于我的模拟数据，在一秒以下的 850,000 行中需要计算时间。

我希望你能走得更远，我看到至少有两件事可以做：

写一个C代码来做条件cumsum

如果您知道在您的数据中最大序列不大，那么您可以将循环更改为矢量化 while，例如

while (any(cond)) {
    indx <- c(FALSE, cond[-1] & !cond[-n])
    res[indx] <- res[indx] + res[which(indx)-1]
    cond[indx] <- FALSE
}

用于模拟和数字的代码可在 GitHub 上找到。

score 136 · Accepted Answer

加速 R 代码的一般策略

首先，找出缓慢的部分到底在哪里。没有必要优化运行缓慢的代码。对于少量代码，简单地思考一下就可以了。如果失败，RProf 和类似的分析工具可能会有所帮助。

一旦你找出瓶颈，考虑更有效的算法来做你想做的事。如果可能，计算应该只运行一次，所以：

存储结果并访问它们，而不是重复重新计算
将非循环相关的计算从循环中取出
避免不必要的计算（例如，不要使用带有固定搜索的正则表达式）

使用更高效的函数可以产生中等或较大的速度增益。例如，paste0产生较小的效率增益，但.colSums()其相关的增益会更显着。 mean特别慢。

然后你可以避免一些特别常见的麻烦：

cbind会很快减慢你的速度。
初始化你的数据结构，然后填充它们，而不是每次都扩展它们。
即使使用预分配，您也可以切换到按引用传递的方法而不是按值传递的方法，但这可能不值得麻烦。
看看R Inferno 来避免更多的陷阱。

尝试更好的矢量化，这通常但并不总是有帮助。在这方面，固有的矢量化命令（如ifelse、diff等）将提供比apply命令系列更多的改进（在编写良好的循环上几乎没有速度提升）。

您还可以尝试为 R 函数提供更多信息。例如，使用vapply而不是sapply，并colClasses在读取基于文本的数据时指定。速度增益将根据您消除多少猜测而变化。

接下来，考虑优化包：data.table在数据操作和读取大量数据时，包可以在可能的情况下产生巨大的速度提升（fread）。

接下来，尝试通过更有效的调用 R 方法来提高速度：

编译你的 R 脚本。或者使用Ra和jit包一起使用进行即时编译（Dirk 在这个演示文稿中有一个示例）。
确保您使用的是优化的 BLAS。这些提供了全面的速度增益。老实说，R 没有在安装时自动使用最高效的库，这很遗憾。希望Revolution R 将他们在这里所做的工作贡献给整个社区。
Radford Neal 做了很多优化，其中一些被 R Core 采用，还有许多被分叉到pqR中。

最后，如果以上所有方法仍然不能让您达到您需要的速度，您可能需要为慢速代码片段迁移到更快的语言。Rcpp和这里的组合inline使得用 C++ 代码仅替换算法中最慢的部分变得特别容易。例如，这是我第一次尝试这样做，它甚至击败了高度优化的 R 解决方案。

如果你在这一切之后仍然有麻烦，你只需要更多的计算能力。研究并行化( http://cran.r-project.org/web/views/HighPerformanceComputing.html ) 甚至基于 GPU 的解决方案 ( gpu-tools)。

其他指南的链接

http://www.noamross.net/blog/2013/4/25/faster-talk.html

score 37 · Accepted Answer

如果您使用for循环，您很可能将 R 编码为 C 或 Java 或其他东西。正确矢量化的 R 代码非常快。

以这两个简单的代码位为例，按顺序生成一个包含 10,000 个整数的列表：

第一个代码示例是如何使用传统的编码范例对循环进行编码。完成需要 28 秒

system.time({
    a <- NULL
    for(i in 1:1e5)a[i] <- i
})
   user  system elapsed 
  28.36    0.07   28.61

通过预分配内存的简单操作，您可以获得近 100 倍的改进：

system.time({
    a <- rep(1, 1e5)
    for(i in 1:1e5)a[i] <- i
})

   user  system elapsed 
   0.30    0.00    0.29

但是使用使用冒号运算符的基本 R 向量操作，:这个操作实际上是瞬时的：

system.time(a <- 1:1e5)

   user  system elapsed 
      0       0       0

score 17 · Accepted Answer

这可以通过使用索引或嵌套ifelse()语句跳过循环来加快速度。

idx <- 1:nrow(temp)
temp[,10] <- idx
idx1 <- c(FALSE, (temp[-nrow(temp),6] == temp[-1,6]) & (temp[-nrow(temp),3] == temp[-1,3]))
temp[idx1,10] <- temp[idx1,9] + temp[which(idx1)-1,10] 
temp[!idx1,10] <- temp[!idx1,9]    
temp[1,10] <- temp[1,9]
names(temp)[names(temp) == "V10"] <- "Kumm."

score 8 · Accepted Answer

正如 Ari 在他的回答末尾提到的那样，Rcppandinline包让事情变得非常容易。例如，试试这个inline代码（警告：未测试）：

body <- 'Rcpp::NumericMatrix nm(temp);
         int nrtemp = Rccp::as<int>(nrt);
         for (int i = 0; i < nrtemp; ++i) {
             temp(i, 9) = i
             if (i > 1) {
                 if ((temp(i, 5) == temp(i - 1, 5) && temp(i, 2) == temp(i - 1, 2) {
                     temp(i, 9) = temp(i, 8) + temp(i - 1, 9)
                 } else {
                     temp(i, 9) = temp(i, 8)
                 }
             } else {
                 temp(i, 9) = temp(i, 8)
             }
         return Rcpp::wrap(nm);
        '

settings <- getPlugin("Rcpp")
# settings$env$PKG_CXXFLAGS <- paste("-I", getwd(), sep="") if you want to inc files in wd
dayloop <- cxxfunction(signature(nrt="numeric", temp="numeric"), body-body,
    plugin="Rcpp", settings=settings, cppargs="-I/usr/include")

dayloop2 <- function(temp) {
    # extract a numeric matrix from temp, put it in tmp
    nc <- ncol(temp)
    nm <- dayloop(nc, temp)
    names(temp)[names(temp) == "V10"] <- "Kumm."
    return(temp)
}

有一个类似的过程#include，你只需传递一个参数

inc <- '#include <header.h>

到 cxx 函数，如include=inc. 真正酷的是它为你完成了所有的链接和编译，所以原型设计真的很快。

免责声明：我不完全确定 tmp 的类应该是数字而不是数字矩阵或其他东西。但我基本确定。

编辑：如果您在此之后仍然需要更快的速度，OpenMP是一种适用于C++. 我还没有尝试使用它inline，但它应该可以工作。这个想法是，在n核心的情况下，循环迭代k由k % n. 在 Matloff 的The Art of R Programming中找到了合适的介绍，可在此处获得，在第 16 章诉诸 C中。

score 8 · Accepted Answer

我不喜欢重写代码...当然 ifelse 和 lapply 是更好的选择，但有时很难做到这一点。

我经常使用 data.frames 就像使用列表一样df$var[i]

这是一个虚构的例子：

nrow=function(x){ ##required as I use nrow at times.
  if(class(x)=='list') {
    length(x[[names(x)[1]]])
  }else{
    base::nrow(x)
  }
}

system.time({
  d=data.frame(seq=1:10000,r=rnorm(10000))
  d$foo=d$r
  d$seq=1:5
  mark=NA
  for(i in 1:nrow(d)){
    if(d$seq[i]==1) mark=d$r[i]
    d$foo[i]=mark
  }
})

system.time({
  d=data.frame(seq=1:10000,r=rnorm(10000))
  d$foo=d$r
  d$seq=1:5
  d=as.list(d) #become a list
  mark=NA
  for(i in 1:nrow(d)){
    if(d$seq[i]==1) mark=d$r[i]
    d$foo[i]=mark
  }
  d=as.data.frame(d) #revert back to data.frame
})

数据帧版本：

   user  system elapsed 
   0.53    0.00    0.53

列表版本：

   user  system elapsed 
   0.04    0.00    0.03

使用向量列表比使用 data.frame 快 17 倍。

关于为什么内部 data.frames 在这方面如此缓慢的任何评论？人们会认为它们像列表一样运作......

对于更快的代码，请执行此操作class(d)='list'而不是d=as.list(d)andclass(d)='data.frame'

system.time({
  d=data.frame(seq=1:10000,r=rnorm(10000))
  d$foo=d$r
  d$seq=1:5
  class(d)='list'
  mark=NA
  for(i in 1:nrow(d)){
    if(d$seq[i]==1) mark=d$r[i]
    d$foo[i]=mark
  }
  class(d)='data.frame'
})
head(d)

score 5 · Accepted Answer

这里的答案很棒。未涵盖的一个小方面是问题指出“我的电脑仍在工作（现在大约 10 小时），我不知道运行时”。在开发时，我总是将以下代码放入循环中，以了解更改似乎如何影响速度以及监控完成所需的时间。

dayloop2 <- function(temp){
  for (i in 1:nrow(temp)){
    cat(round(i/nrow(temp)*100,2),"%    \r") # prints the percentage complete in realtime.
    # do stuff
  }
  return(blah)
}

也适用于 lapply。

dayloop2 <- function(temp){
  temp <- lapply(1:nrow(temp), function(i) {
    cat(round(i/nrow(temp)*100,2),"%    \r")
    #do stuff
  })
  return(temp)
}

如果循环中的函数非常快，但循环的数量很大，那么请考虑每隔一段时间打印一次，因为打印到控制台本身会产生开销。例如

dayloop2 <- function(temp){
  for (i in 1:nrow(temp)){
    if(i %% 100 == 0) cat(round(i/nrow(temp)*100,2),"%    \r") # prints every 100 times through the loop
    # do stuff
  }
  return(temp)
}

score 2 · Accepted Answer

在 R 中，您通常可以通过使用族函数来加速循环处理apply（在您的情况下，它可能是replicate）。查看plyr提供进度条的包。

另一种选择是完全避免循环并用矢量化算法替换它们。我不确定你在做什么，但你可能可以一次将你的函数应用于所有行：

temp[1:nrow(temp), 10] <- temp[1:nrow(temp), 9] + temp[0:(nrow(temp)-1), 10]

这会快得多，然后您可以根据您的条件过滤行：

cond.i <- (temp[i, 6] == temp[i-1, 6]) & (temp[i, 3] == temp[i-1, 3])
temp[cond.i, 10] <- temp[cond.i, 9]

矢量化算术需要更多时间和思考问题，但有时您可以节省几个数量级的执行时间。

score 2 · Accepted Answer

看一下accumulate()函数{purrr}：

dayloop_accumulate <- function(temp) {
  temp %>%
    as_tibble() %>%
     mutate(cond = c(FALSE, (V6 == lag(V6) & V3 == lag(V3))[-1])) %>%
    mutate(V10 = V9 %>% 
             purrr::accumulate2(.y = cond[-1], .f = function(.i_1, .i, .y) {
               if(.y) {
                 .i_1 + .i
               } else {
                 .i
               }
             }) %>% unlist()) %>%
    select(-cond)
}

score 1 · Accepted Answer

处理data.table是一个可行的选择：

n <- 1000000
df <- as.data.frame(matrix(sample(1:10, n*9, TRUE), n, 9))
colnames(df) <- paste("col", 1:9, sep = "")

library(data.table)

dayloop2.dt <- function(df) {
  dt <- data.table(df)
  dt[, Kumm. := {
    res <- .I;
    ifelse (res > 1,             
      ifelse ((col6 == shift(col6, fill = 0)) & (col3 == shift(col3, fill = 0)) , 
        res <- col9 + shift(res)                   
      , # else
        res <- col9                                 
      )
     , # else
      res <- col9
    )
  }
  ,]
  res <- data.frame(dt)
  return (res)
}

res <- dayloop2.dt(df)

m <- microbenchmark(dayloop2.dt(df), times = 100)
#Unit: milliseconds
#       expr      min        lq     mean   median       uq      max neval
#dayloop2.dt(df) 436.4467 441.02076 578.7126 503.9874 575.9534 966.1042    10

如果忽略条件过滤可能带来的好处，它会非常快。显然，如果您可以对数据子集进行计算，它会有所帮助。

performance - 加快 R 中的循环操作

10 回答 10

矢量化的力量

调音调

Related

Reference