加速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 

因此，這些方法是相同的速度。任何真正的改進都會來自使用更好的算法，而不僅僅是簡單的循環和複製來創建中間結果。