упростить несколько пар к одной парной агрегировке

Question

Я бы хотел рассчитать среднее значение для нескольких парных агрегатов. Например, у меня есть data.frame ниже. Я хотел бы, чтобы вычислить среднее значение для столбца для b1 по sym & a1 и b2 по sym & a2 одновременно.

sym a1 a2 b1 b2 
1 a 1 2 1 1 
2 a 2 2 2 2 
3 a 1 2 3 3 
4 a 2 2 4 4 
5 b 1 1 5 5 
6 b 2 1 6 6 
7 b 1 1 7 7 
8 b 2 1 8 8 

Вот мой код, который использует lapply для итерации по каждой паре. Есть ли более эффективный способ, чем это?

df <- data.frame(sym=c(rep('a', 4), rep('b', 4)), a1=rep(1:2, 4), 
       a2=rep(2:1, each=4), b1=rep(1:8), b2=rep(1:8)) 

tmp <- ddply(df, "sym", function(x) { 

    temp.ls <- lapply(1:2, function(i) { 
    t2 <- aggregate(x = x[3+i], by=x[1+i], FUN=function(.){mean(., na.rm = T)}) 
    colnames(t2) <- c("a", "b") 
    t2 
    }) 
    temp.all <- Reduce(function(x, y) merge(x, y, by=c("a"), all=T, sort=T), 
        temp.ls) 
}) 

Answer 1

dplyr делает это довольно просто:

library(dplyr) 
inner_join(df %>% group_by(sym, a1) %>% summarise(b1.mean=mean(b1)), 
      df %>% group_by(sym, a2) %>% summarise(b2.mean=mean(b2))) 

# Joining by: "sym" 
# Source: local data frame [4 x 5] 
# Groups: sym 
# 
# sym a1 b1.mean a2 b2.mean 
# 1 a 1  2 2  2.5 
# 2 a 2  3 2  2.5 
# 3 b 1  6 1  6.5 
# 4 b 2  7 1  6.5 

Если вы хотите один столбец для a, и хотите, чтобы заполнить не явившейся комбинации с NA, как в вашем примере решения, то left_join вариант :

left_join(df %>% group_by(sym, a=a1) %>% summarise(b1.mean=mean(b1)), 
      df %>% group_by(sym, a=a2) %>% summarise(b2.mean=mean(b2)), 
      by=c('sym', 'a')) 

# Source: local data frame [4 x 4] 
# Groups: sym 
# 
# sym a b1.mean b2.mean 
# 1 a 1  2  NA 
# 2 a 2  3  2.5 
# 3 b 1  6  6.5 
# 4 b 2  7  NA 

Hat-наконечник, чтобы @beginnerR за напоминание мне о dplyrjoin операций.

---

EDIT

В ответ на замечания, если у вас есть более двух группировок, и хотите присоединиться все результирующие таблицы вместе, то вот один из способов сделать это:

# Example data 
set.seed(1) 
(d <- data.frame(sym=sample(letters[1:4], 10, replace=T), 
      a1=sample(5, 10, replace=TRUE), 
      a2=sample(5, 10, replace=TRUE), 
      a3=sample(5, 10, replace=TRUE), 
      b1=runif(10), b2=runif(10), b3=runif(10))) 

# sym a1 a2 a3  b1   b2   b3 
# 1 b 2 5 3 0.8209463 0.47761962 0.91287592 
# 2 b 1 2 3 0.6470602 0.86120948 0.29360337 
# 3 c 4 4 3 0.7829328 0.43809711 0.45906573 
# 4 d 2 1 1 0.5530363 0.24479728 0.33239467 
# 5 a 4 2 5 0.5297196 0.07067905 0.65087047 
# 6 d 3 2 4 0.7893562 0.09946616 0.25801678 
# 7 d 4 1 4 0.0233312 0.31627171 0.47854525 
# 8 c 5 2 1 0.4772301 0.51863426 0.76631067 
# 9 c 2 5 4 0.7323137 0.66200508 0.08424691 
# 10 a 4 2 3 0.6927316 0.40683019 0.87532133 

L <- mapply(function(x, y) { 
    grpd <- eval(substitute(group_by(d, sym, a=x), list(x=as.name(x)))) 
    eval(substitute(summarise(grpd, mean(y)), list(y=as.name(y)))) 
}, paste0('a', 1:3), paste0('b', 1:3), SIMPLIFY=FALSE) 

Reduce(function(...) left_join(..., all=T), L) 

# Source: local data frame [9 x 5] 
# Groups: sym 
# 
# sym a mean(b1) mean(b2) mean(b3) 
# 1 a 4 0.6112256   NA   NA 
# 2 b 1 0.6470602   NA   NA 
# 3 b 2 0.8209463 0.86120948   NA 
# 4 c 2 0.7323137 0.51863426   NA 
# 5 c 4 0.7829328 0.43809711 0.08424691 
# 6 c 5 0.4772301 0.66200508   NA 
# 7 d 2 0.5530363 0.09946616   NA 
# 8 d 3 0.7893562   NA   NA 
# 9 d 4 0.0233312   NA 0.36828101