Вопрос по r – Идиоматический код R для разделения вектора по индексу и выполнения операции над этим разделом

18

Я пытаюсь найти идиоматический способ в 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 / aggregate и т. д.

Ваш Ответ

3   ответа
8

Три других подхода:

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

Еще один вариант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

это кажется более совместимым с тем, что я ожидал.

Таким образом, у вас есть много хороших вариантов. Найдите один или два метода, которые работают с вашей ментальной моделью того, как должны работать задачи агрегации, и освоите эту функцию. Много способов снять шкуру с кошки.

Edit - and an example with 1e7 rows

Вероятно, недостаточно большой для Мэтта, но такой большой, как мой ноутбук может выдержать без сбоев:

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
Error: User Rate Limit ExceededbenchmarkError: User Rate Limit ExceededreplicationsError: User Rate Limit Exceededdata.table.
Error: User Rate Limit Exceeded1e8Error: User Rate Limit Exceeded1e9Error: User Rate Limit Exceeded1e10Error: User Rate Limit ExceededsomeoneError: User Rate Limit Exceeded
Error: User Rate Limit Exceeded1e5Error: User Rate Limit Exceededdata.tableError: User Rate Limit Exceeded1e6,1e7Error: User Rate Limit Exceeded1e8Error: User Rate Limit Exceededave()Error: User Rate Limit ExceedednumericError: User Rate Limit Exceeded1e8Error: User Rate Limit Exceededave()Error: User Rate Limit Exceededdata.tableError: User Rate Limit Exceeded
Error: User Rate Limit ExceededlargerError: User Rate Limit Exceededdata.table()Error: User Rate Limit Exceeded
Error: User Rate Limit Exceeded John Horton
8

Если вы работаете только с одним вектором и вам нужен только один индексный вектор, тогда процесс 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 

Похожие вопросы