Código Idiomatic R para particionar un vector por un índice y realizar una operación en esa partición

Question

Estoy tratando de encontrar la forma idiomática en R para dividir un vector numérico por algún vector de índice, encontrar la suma de todos los números en esa partición y luego divide cada entrada individual por esa suma de partición. En otras palabras, si comienzo con esto:

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

Quiero la salida para crear un vector (vamos a llamarlo z):

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

Si estuviera haciendo esto es SQL y podría utilizar la ventana funciones, me gustaría hacer esto:

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

y si estuviera usando plyr, me gustaría hacer algo como esto:

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

pero me gustaría saber cómo hacerlo usando las herramientas de programación funcional estándar R como mapply/agregado etc.

Answer 1

Sin embargo, otra opción es ave. Para una buena medida, he recopilado las respuestas anteriores, hice todo lo posible para hacer que su salida sea equivalente (un vector), y proporcioné intervalos de más de 1000 ejecuciones usando sus datos de ejemplo como entrada. Primero, mi respuesta usando ave: ave(df$x, df$index, FUN = function(z) z/sum(z)). También muestro un ejemplo usando el paquete data.table, ya que generalmente es bastante rápido, pero sé que estás buscando soluciones básicas, por lo que puedes ignorarlo si quieres.

Y ahora un montón de tiempos:

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 

la solución lapply() parece ganar en este caso y data.table() es sorprendentemente lento. Veamos cómo esto se adapta a un problema de agregación más grande:

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 

que parece más consistente con lo que esperaría.

En resumen, tienes muchas buenas opciones. Encuentre uno o dos métodos que funcionen con su modelo mental de cómo deberían funcionar las tareas de agregación y domine esa función. Muchas maneras de despellejar a un gato.

Editar - y un ejemplo con filas 1E7

Probablemente no lo suficientemente grande como para Matt, pero tan grande como mi portátil puede manejar sin que se caiga:

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

Si sólo está operando en un solo vector y sólo necesita un único vector de indexación entonces tapply es bastante rápido otras

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

Tres enfoques así:

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