быстрый/элегантный способ построения сводной таблицы среднего/дисперсии

Я могу выполнить эту задачу, но я чувствую, что должен быть «лучший» (самый гладкий, самый компактный, самый понятный код, самый быстрый?) способ сделать это, и до сих пор не понял...

Для указанного набора категориальных факторов я хочу построить таблицу средних и отклонений по группам.

создать данные:

set.seed(1001)
d <- expand.grid(f1=LETTERS[1:3],f2=letters[1:3],
                 f3=factor(as.character(as.roman(1:3))),rep=1:4)
d$y <- runif(nrow(d))
d$z <- rnorm(nrow(d))

желаемый результат:

  f1 f2  f3    y.mean      y.var
1  A  a   I 0.6502307 0.09537958
2  A  a  II 0.4876630 0.11079670
3  A  a III 0.3102926 0.20280568
4  A  b   I 0.3914084 0.05869310
5  A  b  II 0.5257355 0.21863126
6  A  b III 0.3356860 0.07943314
... etc. ...

используя aggregate/merge:

library(reshape)
m1 <- aggregate(y~f1*f2*f3,data=d,FUN=mean)
m2 <- aggregate(y~f1*f2*f3,data=d,FUN=var)
mvtab <- merge(rename(m1,c(y="y.mean")),
      rename(m2,c(y="y.var")))

используя ddply/summarise (возможно, лучше всего, но не удалось заставить его работать):

mvtab2 <- ddply(subset(d,select=-c(z,rep)),
                .(f1,f2,f3),
                summarise,numcolwise(mean),numcolwise(var))

приводит к

Error in output[[var]][rng] <- df[[var]] : 
  incompatible types (from closure to logical) in subassignment type fix

используя melt/cast (может быть лучше?)

mvtab3 <- cast(melt(subset(d,select=-c(z,rep)),
          id.vars=1:3),
     ...~.,fun.aggregate=c(mean,var))
## now have to drop "variable"
mvtab3 <- subset(mvtab3,select=-variable)
## also should rename response variables

Не будет (?) работать в reshape2. Объяснить ...~. кому-то может быть сложно!


person Ben Bolker    schedule 16.09.2011    source источник


Ответы (8)


Я немного озадачен. Это не работает:

mvtab2 <- ddply(d,.(f1,f2,f3),
            summarise,y.mean = mean(y),y.var = var(y))

Это дает мне что-то вроде этого:

   f1 f2  f3    y.mean       y.var
1   A  a   I 0.6502307 0.095379578
2   A  a  II 0.4876630 0.110796695
3   A  a III 0.3102926 0.202805677
4   A  b   I 0.3914084 0.058693103
5   A  b  II 0.5257355 0.218631264

Это в правильной форме, но похоже, что значения отличаются от указанных вами.

Изменить

Вот как заставить работать вашу версию с numcolwise:

mvtab2 <- ddply(subset(d,select=-c(z,rep)),.(f1,f2,f3),summarise,
                y.mean = numcolwise(mean)(piece),
                y.var = numcolwise(var)(piece)) 

Вы забыли передать фактические данные в numcolwise. А еще есть маленькая ddply хитрость, заключающаяся в том, что каждая часть внутри называется piece. (На что Хэдли указывает в комментариях, не следует полагаться, так как это может измениться в будущих версиях plyr.)

person joran    schedule 16.09.2011
comment
проблема со значениями заключается в том, что я на самом деле не сделал set.seed там, где я утверждал, - добавил его позже (упс, исправлено сейчас, поэтому ваш комментарий о другом больше не имеет смысла - извините). Похоже, это работает. Мне нужно выяснить, что случилось с numcolwise - я думал, что он автоматически обработает тот факт, что во фрейме данных осталась только одна числовая переменная, но, возможно, я запутался в этом. - person Ben Bolker; 16.09.2011
comment
сложный вызов, который нужно принять, но это был первый ответ, и мне нравится элегантность (без определения анонимных функций), даже если он медленнее. - person Ben Bolker; 17.09.2011
comment
Вы не должны полагаться на использование каких-либо внутренних переменных - это сломается, когда я, наконец, выясню, как исправить область видимости в plyr. - person hadley; 17.09.2011
comment
@Хэдли Баммер! Я на самом деле думал, что этот маленький трюк был очень удобен во многих случаях. - person joran; 17.09.2011
comment
Если вы обнаружите, что делаете это, вероятно, это признак того, что вам не следует использовать резюме. Однако мне нужно больше думать о местоимениях. - person hadley; 17.09.2011

Вот решение с использованием data.table

library(data.table)
d2 = data.table(d)
ans = d2[,list(avg_y = mean(y), var_y = var(y)), 'f1, f2, f3']
person Ramnath    schedule 16.09.2011

(Я голосовал за Джошуа.) Вот решение Hmisc::summary.formula. Преимущество этого для меня в том, что он хорошо интегрирован с выходным «каналом» Hmisc::latex.

summary(y ~ interaction(f3,f2,f1), data=d, method="response", 
                    fun=function(y) c(mean.y=mean(y) ,var.y=var(y) ))
#-----output----------
y    N=108

+-----------------------+-------+---+---------+-----------+
|                       |       |N  |mean.y   |var.y      |
+-----------------------+-------+---+---------+-----------+
|interaction(f3, f2, f1)|I.a.A  |  4|0.6502307|0.095379578|
|                       |II.a.A |  4|0.4876630|0.110796695|

вырезанный вывод, чтобы показать вывод латекса -> PDF -> png:

введите здесь описание изображения

person IRTFM    schedule 16.09.2011

@joran попал в точку с ответом ddply. Вот как бы я сделал это с aggregate. Обратите внимание, что я избегаю интерфейса формул (он медленнее).

aggregate(d$y, d[,c("f1","f2","f3")], FUN=function(x) c(mean=mean(x),var=var(x)))
person Joshua Ulrich    schedule 16.09.2011

Я немного пристрастился к сравнениям скоростей, хотя в данной ситуации они для меня не имеют большого значения...

joran_ddply <- function(d) ddply(d,.(f1,f2,f3),
                                 summarise,y.mean = mean(y),y.var = var(y))
joshulrich_aggregate <- function(d) {
  aggregate(d$y, d[,c("f1","f2","f3")],
            FUN=function(x) c(mean=mean(x),var=var(x)))
}

formula_aggregate <- function(d) {
  aggregate(y~f1*f2*f3,data=d,
            FUN=function(x) c(mean=mean(x),var=var(x)))
}
library(data.table)
d2 <- data.table(d)
ramnath_datatable <- function(d) {
  d[,list(avg_y = mean(y), var_y = var(y)), 'f1, f2, f3']
}


library(Hmisc)
dwin_hmisc <- function(d) {summary(y ~ interaction(f3,f2,f1), 
                   data=d, method="response", 
                   fun=function(y) c(mean.y=mean(y) ,var.y=var(y) ))
                         }


library(rbenchmark)
benchmark(joran_ddply(d),
          joshulrich_aggregate(d),
          ramnath_datatable(d2),
          formula_aggregate(d),
          dwin_hmisc(d))

aggregate самый быстрый (даже быстрее, чем data.table, что для меня неожиданно, хотя с большей таблицей для агрегирования все может быть иначе), даже с использованием интерфейса формул...)

                     test replications elapsed relative user.self sys.self
5           dwin_hmisc(d)          100   1.235 2.125645     1.168    0.044
4    formula_aggregate(d)          100   0.703 1.209983     0.656    0.036
1          joran_ddply(d)          100   3.345 5.757315     3.152    0.144
2 joshulrich_aggregate(d)          100   0.581 1.000000     0.596    0.000
3   ramnath_datatable(d2)          100   0.750 1.290878     0.708    0.000

(Теперь мне просто нужно, чтобы Дирк выступил и опубликовал решение Rcpp, которое в 1000 раз быстрее, чем что-либо еще...)

person Ben Bolker    schedule 16.09.2011
comment
Я проверил большие таблицы с 2700 строками и обнаружил, что data.table превосходит решение на основе aggregate в 1,5 раза. - person Ramnath; 17.09.2011
comment
@Ramnath Если таблицы больше, улучшение вашего решения в 21 раз быстрее, чем совокупность Джошуа. - person marbel; 16.01.2014
comment
Неудивительно, учитывая, насколько оптимизирован data.table. Полная заслуга Мэтта Доула и Аруна :) - person Ramnath; 16.01.2014

Я обнаружил, что в пакете doBy есть очень удобные функции для таких вещей, как это. Например, очень удобна функция ?summaryBy. Рассмотреть возможность:

> summaryBy(y~f1+f2+f3, data=d, FUN=c(mean, var))
   f1 f2  f3    y.mean       y.var
1   A  a   I 0.6502307 0.095379578
2   A  a  II 0.4876630 0.110796695
3   A  a III 0.3102926 0.202805677
4   A  b   I 0.3914084 0.058693103
5   A  b  II 0.5257355 0.218631264
6   A  b III 0.3356860 0.079433136
7   A  c   I 0.3367841 0.079487973
8   A  c  II 0.6273320 0.041373836
9   A  c III 0.4532720 0.022779672
10  B  a   I 0.6688221 0.044184575
11  B  a  II 0.5514724 0.020359289
12  B  a III 0.6389354 0.104056229
13  B  b   I 0.5052346 0.138379070
14  B  b  II 0.3933283 0.050261804
15  B  b III 0.5953874 0.161943989
16  B  c   I 0.3490460 0.079286849
17  B  c  II 0.5534569 0.207381592
18  B  c III 0.4652424 0.187463143
19  C  a   I 0.3340988 0.004994589
20  C  a  II 0.3970315 0.126967554
21  C  a III 0.3580250 0.066769484
22  C  b   I 0.7676858 0.124945402
23  C  b  II 0.3613772 0.182689385
24  C  b III 0.4175562 0.095933470
25  C  c   I 0.3592491 0.039832864
26  C  c  II 0.7882591 0.084271963
27  C  c III 0.3936949 0.085758343

Таким образом, вызов функции прост, удобен и, я бы сказал, элегантен.

Теперь, если вас больше всего беспокоит скорость, кажется, что это было бы разумно — по крайней мере, для задач меньшего размера (обратите внимание, что по какой-то причине я не смог заставить работать функцию ramnath_datatable):

                     test replications elapsed relative user.self 
4           dwin_hmisc(d)          100    0.50    2.778      0.50 
3    formula_aggregate(d)          100    0.23    1.278      0.24 
5       gung_summaryBy(d)          100    0.34    1.889      0.35 
1          joran_ddply(d)          100    1.34    7.444      1.32 
2 joshulrich_aggregate(d)          100    0.18    1.000      0.19 
person gung - Reinstate Monica    schedule 30.05.2013

Я столкнулся с этим вопросом и обнаружил, что тесты выполняются с небольшими таблицами, поэтому трудно сказать, какой метод лучше для 100 строк.

Я также немного изменил данные, чтобы сделать их «несортированными», это было бы более распространенным случаем, например, когда данные находятся в БД. Я добавил еще несколько пробных версий data.table, чтобы заранее убедиться, что установка ключа выполняется быстрее. Здесь кажется, что установка ключа заранее не сильно улучшает производительность, поэтому решение ramnath кажется самым быстрым.

set.seed(1001)
d <- data.frame(f1 = sample(LETTERS[1:3], 30e5, replace = T), f2 = sample(letters[1:3], 30e5, replace = T),
                f3 = sample(factor(as.character(as.roman(1:3))), 30e5, replace = T), rep = sample(1:4, replace = T))

d$y <- runif(nrow(d))
d$z <- rnorm(nrow(d))

str(d)

require(Hmisc)
require(plyr)
require(data.table)
d2 = data.table(d)
d3 = data.table(d)

# Set key of d3 to compare how fast it is if the DT is already keyded
setkey(d3,f1,f2,f3)

joran_ddply <- function(d) ddply(d,.(f1,f2,f3),
                                 summarise,y.mean = mean(y),y.var = var(y))

formula_aggregate <- function(d) {
  aggregate(y~f1*f2*f3,data=d,
            FUN=function(x) c(mean=mean(x),var=var(x)))
}

ramnath_datatable <- function(d) {
  d[,list(avg_y = mean(y), var_y = var(y)), 'f1,f2,f3']
}

key_agg_datatable <- function(d) {
  setkey(d2,f1,f2,f3)
  d[,list(avg_y = mean(y), var_y = var(y)), 'f1,f2,f3']
}

one_key_datatable <- function(d) {
  setkey(d2,f1)
  d[,list(avg_y = mean(y), var_y = var(y)), 'f1,f2,f3']
}

including_3key_datatable <- function(d) {
  d[,list(avg_y = mean(y), var_y = var(y)), 'f1,f2,f3']
}

dwin_hmisc <- function(d) {summary(y ~ interaction(f3,f2,f1), 
                                   data=d, method="response", 
                                   fun=function(y) c(mean.y=mean(y) ,var.y=var(y) ))
}

require(rbenchmark)
benchmark(joran_ddply(d),
          joshulrich_aggregate(d),
          ramnath_datatable(d2),
          including_3key_datatable(d3),
          one_key_datatable(d2),
          key_agg_datatable(d2),
          formula_aggregate(d),
          dwin_hmisc(d)
          )

#                         test replications elapsed relative user.self sys.self
#                dwin_hmisc(d)          100 1757.28  252.121   1590.89   165.65
#         formula_aggregate(d)          100  433.56   62.204    390.83    42.50
# including_3key_datatable(d3)          100    7.00    1.004      6.02     0.98
#               joran_ddply(d)          100  173.39   24.877    119.35    53.95
#      joshulrich_aggregate(d)          100  328.51   47.132    307.14    21.22
#        key_agg_datatable(d2)          100   24.62    3.532     19.13     5.50
#        one_key_datatable(d2)          100   29.66    4.255     22.28     7.34
#        ramnath_datatable(d2)          100    6.97    1.000      5.96     1.01
person marbel    schedule 16.01.2014

А вот решение с использованием новой библиотеки dplyr Хэдли Уикхема.

library(dplyr)
d %>% group_by(f1, f2, f3) %>% 
summarise(y.mean = mean(y), z.mean = mean(z))
person Maiasaura    schedule 10.06.2014