加速R循环

Question

使用apply系列中的函数可以轻松地加快R中的循环。我如何在下面的代码中使用apply函数来加速它？请注意，在循环内，每次迭代时，对一列进行置换，并将函数应用于新数据帧（即置换一列的初始数据帧）。我似乎无法申请工作，因为新的数据框必须在循环内部构建。

#x <- data.frame(a=1:10,b=11:20,c=21:30) #small example 
x <- data.frame(matrix(runif(50*100),nrow=50,ncol=100)) #larger example 
y <- rowMeans(x) 

start <- Sys.time() 

totaldiff <- numeric() 

for (i in 1:ncol(x)){ 
    x.after <- x 

    x.after[,i] <- sample(x[,i]) 

    diff <- abs(y-rowMeans(x.after)) 

    totaldiff[i] <- sum(diff) 

} 

colnames(x)[which.max(totaldiff)] 

Sys.time() - start 

Answer 1

应用函数不一定会加速R中的循环，有时它们甚至可以减慢它们的速度。没有理由相信将其转变为适用的家庭功能会加速其显着的数量。

另外，这段代码看起来像是一个毫无意义的努力。它只是要选择一个随机列。首先，我可以得到相同的结果。也许这是嵌套在一个更大的循环寻找分布？

Answer 2

通过这一点，对方答复工作后，优化策略（和近似加速），这里似乎是

• （30X）选择适当的数据表示 - 矩阵，而不是data.frame
• （1.5倍）减少不必要的数据副本 - 列差异，而不是rowMeans的
• 结构for循环作为*apply函数（强调码结构，简化存储器管理，以及提供类型一致性）
• （2×） H oist矢量操作外部循环 - abs和列上的总和变为矩阵上的abs和colSums

整体加速大约100x。对于代码的这种大小和复杂性，编译器或并行包的使用将不会有效。

我把你的代码放到一个函数

f0 <- function(x) { 
    y <- rowMeans(x) 
    totaldiff <- numeric() 
    for (i in 1:ncol(x)){ 
     x.after <- x 
     x.after[,i] <- sample(x[,i]) 
     diff <- abs(y-rowMeans(x.after)) 
     totaldiff[i] <- sum(diff) 
    } 
    which.max(totaldiff) 
} 

，并在这里我们有

x <- data.frame(matrix(runif(50*100),nrow=50,ncol=100)) #larger example 
set.seed(123) 
system.time(res0 <- f0(x)) 
## user system elapsed 
## 1.065 0.000 1.066 

您的数据可以表示为一个矩阵，R上的矩阵操作比上data.frames快。

m <- matrix(runif(50*100),nrow=50,ncol=100) 
set.seed(123) 
system.time(res0.m <- f0(m)) 
## user system elapsed 
## 0.036 0.000 0.037 
identical(res0, res0.m) 
##[1] TRUE 

这可能是最大的加速。但对于这里的具体操作，我们并不需要从洗牌一列

f1 <- function(x) { 
    y <- rowMeans(x) 
    totaldiff <- numeric() 
    for (i in 1:ncol(x)){ 
     diff <- abs(sample(x[,i]) - x[,i])/ncol(x) 
     totaldiff[i] <- sum(diff) 
    } 
    which.max(totaldiff) 
} 

的for循环没有按照正确的方式填充计算更新矩阵，只是在平均变化的行手段结果向量totaldiff（你想“预先分配和填充”，所以totaldiff <- numeric(ncol(x))），但我们可以使用sapply并让R担心（这种内存管理是使用apply系列函数的优势之一）

f2 <- function(x) { 
    totaldiff <- sapply(seq_len(ncol(x)), function(i, x) { 
     sum(abs(sample(x[,i]) - x[,i])/ncol(x)) 
    }, x) 
    which.max(totaldiff) 
} 
set.seed(123); identical(res0, f1(m)) 
set.seed(123); identical(res0, f2(m)) 

时间是

> library(microbenchmark) 
> microbenchmark(f0(m), f1(m), f2(m)) 
Unit: milliseconds 
    expr  min  lq median  uq  max neval 
f0(m) 32.45073 33.07804 33.16851 33.26364 33.81924 100 
f1(m) 22.20913 23.87784 23.96915 24.06216 24.66042 100 
f2(m) 21.02474 22.60745 22.70042 22.80080 23.19030 100 

@flodel指出vapply可以更快（并提供类型安全）

f3 <- function(x) { 
    totaldiff <- vapply(seq_len(ncol(x)), function(i, x) { 
     sum(abs(sample(x[,i]) - x[,i])/ncol(x)) 
    }, numeric(1), x) 
    which.max(totaldiff) 
} 

和

f4 <- function(x) 
    which.max(colSums(abs((apply(x, 2, sample) - x)))) 

仍然较快（ncol(x)是一个常数因子，因此移除） - abs和sum在sapply之外悬挂，可能会增加内存使用量。在评论中编写函数的建议总的来说是很好的;这里有一些进一步的时序

>  microbenchmark(f0(m), f1(m), f1.c(m), f2(m), f2.c(m), f3(m), f4(m)) 
Unit: milliseconds 
    expr  min  lq median  uq  max neval 
    f0(m) 32.35600 32.88326 33.12274 33.25946 34.49003 100 
    f1(m) 22.21964 23.41500 23.96087 24.06587 24.49663 100 
f1.c(m) 20.69856 21.20862 22.20771 22.32653 213.26667 100 
    f2(m) 20.76128 21.52786 22.66352 22.79101 69.49891 100 
f2.c(m) 21.16423 21.57205 22.94157 23.06497 23.35764 100 
    f3(m) 20.17755 21.41369 21.99292 22.10814 22.36987 100 
    f4(m) 10.10816 10.47535 10.56790 10.61938 10.83338 100 

其中“.c”的编译版本和

编译与编写for循环代码特别有帮助，但对量化代码没有做太多;这里显示的是从编译f1的for循环中得到一个小而一致的改进，但不是f2的sapply。

Answer 3

由于您正在寻求效率/优化，请首先使用rbenchmark包进行比较。

重写您的给定示例中为函数（以便它可以被复制并且相比）

forFirst <- function(x) { 
    y <- rowMeans(x) 
    totaldiff <- numeric() 
    for (i in 1:ncol(x)){ 
     x.after <- x 
     x.after[,i] <- sample(x[,i]) 
     diff <- abs(y-rowMeans(x.after)) 
     totaldiff[i] <- sum(diff) 
    } 
    colnames(x)[which.max(totaldiff)] 
} 

应用一些标准优化（预分配totaldiff到合适的大小，消除了仅使用一次的中间变量）给出

forSecond <- function(x) { 
    y <- rowMeans(x) 
    totaldiff <- numeric(ncol(x)) 
    for (i in 1:ncol(x)){ 
     x.after <- x 
     x.after[,i] <- sample(x[,i]) 
     totaldiff[i] <- sum(abs(y-rowMeans(x.after))) 
    } 
    colnames(x)[which.max(totaldiff)] 
} 

没有更多可以做到这一点，我可以看到在循环中改进算法本身。一个更好的算法会是最有帮助的，但是由于这个特定的问题只是一个例子，所以花时间不值得。

应用版本看起来非常相似。

applyFirst <- function(x) { 
     y <- rowMeans(x) 
    totaldiff <- sapply(seq_len(ncol(x)), function(i) { 
     x[,i] <- sample(x[,i]) 
     sum(abs(y-rowMeans(x))) 
     }) 
    colnames(x)[which.max(totaldiff)] 
} 

标杆他们给出了：

> library("rbenchmark") 
> benchmark(forFirst(x), 
+   forSecond(x), 
+   applyFirst(x), 
+   order = "relative") 
      test replications elapsed relative user.self sys.self user.child 
1 forFirst(x)   100 16.92 1.000  16.88  0.00   NA 
2 forSecond(x)   100 17.02 1.006  16.96  0.03   NA 
3 applyFirst(x)   100 17.05 1.008  17.02  0.01   NA 
    sys.child 
1  NA 
2  NA 
3  NA 

它们之间的差别仅仅是噪音。事实上，运行基准测试再次给出了不同的排序：

> benchmark(forFirst(x), 
+   forSecond(x), 
+   applyFirst(x), 
+   order = "relative") 
      test replications elapsed relative user.self sys.self user.child 
3 applyFirst(x)   100 17.05 1.000  17.02  0   NA 
2 forSecond(x)   100 17.08 1.002  17.05  0   NA 
1 forFirst(x)   100 17.44 1.023  17.41  0   NA 
    sys.child 
3  NA 
2  NA 
1  NA 

因此，这些方法是相同的速度。任何真正的改进都会来自使用更好的算法，而不仅仅是简单的循环和复制来创建中间结果。