Code R idiomatique pour partitionner un vecteur par un index et effectuer une opération sur cette partition
j'essaie de trouver la façon idiomatique dans R pour diviser un vecteur numérique par un vecteur d'indice, trouver la somme de tous les nombres dans cette partition et puis diviser chaque entrée individuelle par cette somme de partition. En d'autres termes, si je commence avec ceci:
df <- data.frame(x = c(1,2,3,4,5,6), index = c('a', 'a', 'b', 'b', 'c', 'c'))
je veux que la sortie de créer un vecteur (z):
c(1/(1+2), 2/(1+2), 3/(3+4), 3/(3+4), 5/(5+6), 6/(5+6))
Si je devais le faire, c'est SQL et pourrait utiliser les fonctions de la fenêtre, je ferais ceci:
select
x / sum(x) over (partition by index) as z
from df
et si j'utilisais plyr, je ferait quelque chose comme ceci:
ddply(df, .(index), transform, z = x / sum(x))
mais je voudrais savoir comment le faire en utilisant les outils de programmation fonctionnelle standard R comme mapply / aggregate etc.
3 réponses
une autre option est ave. Pour une bonne mesure, j'ai recueilli les réponses ci-dessus, essayé de mon mieux de faire leur équivalent de sortie (un vecteur), et fourni des temps plus de 1000 passes en utilisant vos données d'exemple comme une entrée. Tout d'abord, ma réponse à l'aide de ave:ave(df$x, df$index, FUN = function(z) z/sum(z)). Je montre aussi un exemple en utilisant data.table package car il est généralement assez rapide, mais je sais que vous êtes à la recherche de solutions de base, donc vous pouvez ignorer que si vous voulez.
Et maintenant un tas de minutage:
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() solution semble gagner dans cette affaire, et data.table() est étonnamment lente. Voyons comment cette échelle à un plus grand problème d'agrégation:
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
cela semble plus cohérent avec ce que je m'attends.
En résumé, vous avez beaucoup de bonnes options. Trouvez une ou deux méthodes qui fonctionnent avec votre modèle mental de la façon dont les tâches d'agrégation devraient fonctionner et maîtriser cette fonction. Plusieurs façons de dépecer un chat.
Modifier - et un exemple avec 1e7 lignes
Probablement pas assez grand pour Matt, mais aussi grande que mon ordinateur portable peut gérer sans s'écraser:
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
Si vous êtes d'exploitation uniquement sur un seul vecteur et seulement besoin d'un seul vecteur d'indexation puis tapply est assez rapide
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
Trois autres approches ainsi:
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)})