通过索引对矢量进行分区并在该分区上执行操作的习惯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)})