加快R中的循环操作


193

我在R中遇到很大的性能问题。我编写了一个遍历data.frame对象的函数。它只是向中添加了一个新列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)
}

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

Answers:


432

最大的问题和无效的根源是索引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.framenrow1,000到10,000 x 10,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
第二件事:当您查看循环时,您会发现不需要循环全部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代码来做条件累加
  • 如果您知道最大数据序列中的序列不大,则可以将循环更改为矢量化,例如

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

GitHub上提供了用于仿真和图形的代码。


2
由于我找不到私下询问Marek的方式,这些图是如何生成的?
carbontwelve

@carbontwelve您是否在询问数据或图表?用格子包装制作图。如果我有时间,可以将代码放在网络上的某个地方,然后通知您。
Marek

@carbontwelve糟糕,我错了:)这是标准绘图(来自基R)。
Marek

@Gregor不幸的是没有。它是累积性的,因此您无法向量化它。简单示例:res = c(1,2,3,4)and cond是all TRUE,那么最终结果应该是:13(原因1+2),6(因为第二个现在是3,第三个3也是),106+4)。做简单的求和你有1357
力克

啊,我应该仔细考虑一下。感谢您向我展示错误。
格里戈尔·托马斯

132

加快R代码的一般策略

首先,找出最慢的部分在哪里。无需优化运行缓慢的代码。对于少量的代码,只需仔细考虑即可。如果失败,RProf和类似的分析工具可能会有所帮助。

找到瓶颈后,请考虑使用更有效的算法来执行所需的操作。如果可能的话,计算只能运行一次,因此:

使用更有效的功能可以产生中等或较大的速度增益。例如,paste0会产生很小的效率增益,但是.colSums()其亲戚会产生一些更为明显的增益。 mean特别慢

然后,您可以避免一些特别常见的麻烦

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

尝试更好的向量化,这通常可以但并非总是有帮助。在这一点上,诸如ifelsediff和之类的固有矢量化命令将比apply命令族(在编写良好的循环中几乎没有甚至没有提高速度)提供更多的改进。

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

接下来,考虑优化的程序包:在data.table可能的情况下,程序包可以在数据操作和读取大量数据(fread)中产生巨大的速度提升。

接下来,尝试通过更有效的调用R提高速度:

  • 编译您的R脚本。或将Rajit包一起用于即时编译(Dirk在此演示文稿中提供了一个示例)。
  • 确保您使用的是优化的BLAS。这些提供了全面的速度提升。老实说,R并不会在安装时自动使用最有效的库,这是一个遗憾。希望Revolution R将他们在这里所做的工作贡献给整个社区。
  • Radford Neal已经做了很多优化,其中一些优化被R Core采纳,许多其他优化被派生到pqR中

最后,如果上述所有方法仍然无法让您获得所需的速度,则可能需要针对速度较慢的代码段使用更快的语言。的组合Rcppinline这里使仅更换用C ++代码算法的最慢的部分特别容易。例如,这是我的第一个尝试,它甚至吹散了高度优化的R解决方案。

如果这一切仍然给您带来麻烦,那么您只需要更多的计算能力。研究并行化http://cran.r-project.org/web/views/HighPerformanceComputing.html)甚至是基于GPU的解决方案(gpu-tools)。

链接到其他指南


35

如果使用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 

+1,尽管我认为您的第二个示例令人信服,因为a[i]它没有改变。但是system.time({a <- NULL; for(i in 1:1e5){a[i] <- 2*i} }); system.time({a <- 1:1e5; for(i in 1:1e5){a[i] <- 2*i} }); system.time({a <- NULL; a <- 2*(1:1e5)})有类似的结果。
亨利

@Henry,坦率的评论,但正如您所指出的,结果是相同的。我修改了示例以将初始化为rep(1, 1e5)-时间是相同的。
Andrie

17

通过使用索引或嵌套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."

感谢你的回答。我试图理解您的陈述。第4行:“ temp [idx1,10] <-temp [idx1,9] + temp [which(idx1)-1,10]”引起错误,因为较长对象的长度不是对象长度的倍数。较短的对象。“ temp [idx1,9] = num [1:11496]”和“ temp [which(idx1)-1,10] = int [1:11494]”,因此缺少2行。
凯,2010年

如果您提供数据样本(使用dput()并包含几行),那么我将为您修复它。由于which()-1位,索引不相等。但是您应该从这里了解它的工作原理:不需要任何循环或应用;只需使用向量化函数。
Shane 2010年

1
哇!我刚刚将嵌套的if..else函数块和mapply更改为嵌套的ifelse函数,并获得了200倍的加速!
詹姆斯

您的一般建议是正确的,但是在代码中您错过了一个事实,即i-th值取决于i-1-th,因此无法以您的方式设置它们(使用which()-1)。
Marek 2010年

8

我不喜欢重写代码...当然,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
})

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)class(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)

1
这可能要归功于的开销[<-.data.frame,当您这样做时会以某种方式调用它d$foo[i] = mark,并且最终可能会在每次<-修改时为可能是整个data.frame的向量制作一个新副本。这将对SO提出一个有趣的问题。
弗兰克,

2
@Frank(i)必须确保修改后的对象仍然是有效的data.frame,并且(ii)afaik至少复制一个副本,可能会复制多个副本。众所周知,数据帧子分配速度很慢,而且如果您查看冗长的源代码,这也就不足为奇了。
罗兰

@弗兰克,@罗兰:df$var[i]符号是否通过相同的[<-.data.frame功能?我注意到确实很长。如果没有,它将使用什么功能?
克里斯

我相信@Chris d$foo[i]=mark可以大致翻译成d <- `$<-`(d, 'foo', `[<-`(d$foo, i, mark)),但可以使用一些临时变量。
蒂姆·古德曼

7

正如Ari在回答的结尾提到的那样,Rcppinline包使快速处理变得异常容易。例如,请尝试以下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>

改为cxxfunction include=inc。真正有趣的是它为您完成了所有链接和编译,因此原型制作非常快。

免责声明:我不太确定tmp的类应该是数字,而不是数字矩阵或其他东西。但我大部分都可以确定。

编辑:如果此后您仍然需要更高的速度,则OpenMP是一个适合的并行化工具C++。我没有尝试从中使用它inline,但是它应该可以工作。在n内核的情况下,其想法是使循环迭代k由进行k % n。合适的引进Matloff发现是- [R编程的艺术,可在这里,在第16章,诉诸到C


3

这里的答案很好。一个未涵盖的小问题是,该问题指出“ 我的PC仍在运行(现在大约10h),而我对运行时一无所知 ”。在开发时,我总是将以下代码放入循环中,以了解更改似乎如何影响速度,并监视完成所需的时间。

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)
}

一个类似的选项,打印分数i / n。我总是有类似的东西,cat(sprintf("\nNow running... %40s, %s/%s \n", nm[i], i, n))因为我通常循环遍历已命名的事物(名称在中nm)。
弗兰克

2

在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]

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


14
您发现矢量函数将比循环或apply()快,但apply()比循环快是不正确的。在许多情况下,apply()只是将循环从用户中抽象出来,但仍然循环。看到这个前面的问题:stackoverflow.com/questions/2275896/...
JD龙

0

使用处理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

如果您忽略了条件过滤可能带来的收益,那将非常快。显然,如果您可以对数据子集进行计算,则将有所帮助。


2
您为什么要重复使用data.table的建议?在先前的答案中已经进行了多次。
IRTFM '16
By using our site, you acknowledge that you have read and understand our Cookie Policy and Privacy Policy.
Licensed under cc by-sa 3.0 with attribution required.