通過索引對矢量進行分區並在該分區上執行操作的習慣R代碼

Question

我試圖在R中通過一些索引向量找到分割數字向量的慣用方法，找到該分區中所有數字的總和然後將每個單獨的條目除以該分區總和。換句話說，如果我開始與此：

df <- data.frame(x = c(1,2,3,4,5,6), index = c('a', 'a', 'b', 'b', 'c', 'c')) 

我想要的輸出來創建矢量（姑且稱之爲Z）：

c(1/(1+2), 2/(1+2), 3/(3+4), 3/(3+4), 5/(5+6), 6/(5+6)) 

如果我這樣做是SQL，並可能使用窗口功能，我這樣做：

select 
x/sum(x) over (partition by index) as z 
from df 

，如果我用plyr，我會做這樣的事情：

ddply(df, .(index), transform, z = x/sum(x)) 

，但我想知道如何使用標準的R函數式編程工具，如做mapply /骨料等

Answer 1

另一個選擇是ave。爲了更好的衡量，我已經收集了上面的答案，盡我所能使它們的輸出等效（一個向量），並使用您的示例數據作爲輸入提供超過1000次運行的計時。首先，我的回答使用ave：ave(df$x, df$index, FUN = function(z) z/sum(z))。我還使用data.table包顯示了一個示例，因爲它通常很快，但我知道您正在尋找基本解決方案，因此如果需要，您可以忽略它。

現在一堆定時：

library(data.table) 
library(plyr) 
dt <- data.table(df) 

plyr <- function() ddply(df, .(index), transform, z = x/sum(x)) 
av <- function() ave(df$x, df$index, FUN = function(z) z/sum(z)) 
t.apply <- function() unlist(tapply(df$x, df$index, function(x) x/sum(x))) 
l.apply <- function() unlist(lapply(split(df$x, df$index), function(x){x/sum(x)})) 
b.y <- function() unlist(by(df$x, df$index, function(x){x/sum(x)})) 
agg <- function() aggregate(df$x, list(df$index), function(x){x/sum(x)}) 
d.t <- function() dt[, x/sum(x), by = index] 

library(rbenchmark) 
benchmark(plyr(), av(), t.apply(), l.apply(), b.y(), agg(), d.t(), 
      replications = 1000, 
      columns = c("test", "elapsed", "relative"), 
      order = "elapsed") 
#----- 

     test elapsed relative 
4 l.apply() 0.052 1.000000 
2  av() 0.168 3.230769 
3 t.apply() 0.257 4.942308 
5  b.y() 0.694 13.346154 
6  agg() 1.020 19.615385 
7  d.t() 2.380 45.769231 
1 plyr() 5.119 98.442308 

的lapply()解決辦法似乎在這種情況下取​​勝，data.table()是出奇的慢。讓我們看看這是如何擴展到更大的聚合問題的：

df <- data.frame(x = sample(1:100, 1e5, TRUE), index = gl(1000, 100)) 
dt <- data.table(df) 

#Replication code omitted for brevity, used 100 replications and dropped plyr() since I know it 
#will be slow by comparison: 
     test elapsed relative 
6  d.t() 2.052 1.000000 
1  av() 2.401 1.170078 
3 l.apply() 4.660 2.270955 
2 t.apply() 9.500 4.629630 
4  b.y() 16.329 7.957602 
5  agg() 20.541 10.010234 

這似乎與我所期望的更一致。

總之，你有很多不錯的選擇。找到一個或兩個方法，與您的思維模型一起工作，如何聚合任務應該如何工作並掌握該功能。許多方法去皮膚貓。

編輯 - 與1E7行

也許不是足夠大，馬特，但一樣大，我的筆記本電腦可以處理沒有崩潰的例子：

df <- data.frame(x = sample(1:100, 1e7, TRUE), index = gl(10000, 1000)) 
dt <- data.table(df) 
#----- 
     test elapsed relative 
6  d.t() 0.61 1.000000 
1  av() 1.45 2.377049 
3 l.apply() 4.61 7.557377 
2 t.apply() 8.80 14.426230 
4  b.y() 8.92 14.622951 
5  agg() 18.20 29.83606 

Answer 2

如果你只在單一載體操作，並且只需要一個索引矢量然後tapply是相當快的其他

dat <- 1:6 
lev <- rep(1:3, each = 2) 
tapply(dat, lev, function(x){x/sum(x)}) 
#$`1` 
#[1] 0.3333333 0.6666667 
# 
#$`2` 
#[1] 0.4285714 0.5714286 
# 
#$`3` 
#[1] 0.4545455 0.5454545 
# 
unlist(tapply(dat, lev, function(x){x/sum(x)})) 
#  11  12  21  22  31  32 
#0.3333333 0.6666667 0.4285714 0.5714286 0.4545455 0.5454545 

Answer 3

三種方法還有：

dat <- 1:6 
lev <- rep(1:3, each = 2) 

lapply(split(dat, lev), function(x){x/sum(x)}) 
by(dat, lev, function(x){x/sum(x)}) 
aggregate(dat, list(lev), function(x){x/sum(x)})