частичное самоподключение по группе

Question

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

library('data.table') 
ex <- function(n){ # example data 
    set.seed(123) 
    data.table(id = 1:n, 
      grp = sample(LETTERS[1:3], n, replace = TRUE), 
      wt = sample.int(10, n, replace = TRUE), 
      x = sample.int(100, n, replace = TRUE))[order(grp),] 
} 
(d <- ex(10)) 
#  id grp wt x 
# 1: 1 A 10 89 
# 2: 6 A 9 71 
# 3: 3 B 7 65 
# 4: 7 B 3 55 
# 5: 9 B 4 29 
# 6: 10 B 10 15 
# 7: 2 C 5 70 
# 8: 4 C 6 100 
# 9: 5 C 2 66 
# 10: 8 C 1 60 

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

я понял, как это сделать в dplyr используя full_join():

library('dplyr') 
d <- ex(10) 
unique(
    subset(data.table(full_join(d, d, by='grp')), 
     id.x != id.y)[, .(grp, x = x.x, wt=wt.x, 
          rest_of_grp_wtd_avg = sum(wt.y * x.y)/sum(wt.y)), 
         by=.(id = id.x)][order(grp, id),] 
) # produces desired result 
# id grp x wt rest_of_grp_wtd_avg 
# 1: 1 A 89 10   71.00000 
# 2: 6 A 71 9   89.00000 
# 3: 3 B 65 7   25.35294 
# 4: 7 B 55 3   34.33333 
# 5: 9 B 29 4   38.50000 
# 6: 10 B 15 10   52.57143 
# 7: 2 C 70 5   88.00000 
# 8: 4 C 100 6   67.75000 
# 9: 5 C 66 2   84.16667 
#10: 8 C 60 1   83.23077 

Однако, поскольку full_join возвращает простой data.frame, и потому что я не мог заставить его работать без unique(), я полагаю, что это Wouldn» t быть столь же эффективным в масштабе, как хорошее решение data.table.

Как и в стороне, sqldf(редактирование: сейчас) работы:

library('sqldf') 
sqldf('select a.*, 
    sum(b.wt * b.x)/sum(b.wt) as rest_of_grp_wtd_avg 
    from d as a 
    left outer join d as b on a.grp = b.grp and a.id <> b.id 
    group by a.id') # returns the desired solution 

Я получил чистое data.table решение для работы, но это своего рода уродливых даже data.table стандартов:

setkey(d,id) 
merge(d[CJ(d$id, id2 = d$id),][id != id2, ], 
     d, by.x = c('id2','grp'), by.y=c('id','grp') 
    )[order(grp, id), .(rest_of_grp_wtd_avg = sum(wt.y * x.y)/sum(wt.y)), 
     by=.(id, grp, wt=wt.x, x=x.x)] # returns desired result 

Какой самый элегантный синтаксис для этого вычисления?

Answer 1

Я думаю, что вы усложнять вещи. Добавление новой переменной со средним значением других наблюдений на группу выполняется отлично по вашей формуле rest_of_grp_wtd_avg = (sum(wt*x)-wt*x)/(sum(wt)-wt). Вам нужно только добавить его к d по ссылке с оператором :=. Для чистого `data.table решения вы можете сократить ваш код:

d[, rest_of_grp_wtd_avg := (sum(wt*x)-wt*x)/(sum(wt)-wt), grp] 

, который дает:

> d 
    id grp wt x rest_of_grp_wtd_avg 
1: 1 A 10 89   71.00000 
2: 6 A 9 71   89.00000 
3: 3 B 7 65   25.35294 
4: 7 B 3 55   34.33333 
5: 9 B 4 29   38.50000 
6: 10 B 10 15   52.57143 
7: 2 C 5 70   88.00000 
8: 4 C 6 100   67.75000 
9: 5 C 2 66   84.16667 
10: 8 C 1 60   83.23077 

Это то же самое, как ваш результат:

> all.equal(d, res) 
[1] TRUE 

Где res является построенный:

setkey(d,id) 
res <- merge(d[CJ(d$id, id2 = d$id),][id != id2, ], 
      d, by.x = c('id2','grp'), by.y=c('id','grp'))[order(grp, id), .(rest_of_grp_wtd_avg = sum(wt.y * x.y)/sum(wt.y)), 
                  by=.(id, grp, wt=wt.x, x=x.x)] 

---

Пример, когда вы хотите, чтобы исключить некоторые строки:

d[id < 9, rest_of_grp_wtd_avg := (sum(wt*x)-wt*x)/(sum(wt)-wt), grp] 

, который дает:

> d 
    id grp wt x rest_of_grp_wtd_avg 
1: 1 A 10 89   71.00000 
2: 6 A 9 71   89.00000 
3: 3 B 7 65   55.00000 
4: 7 B 3 55   65.00000 
5: 9 B 4 29     NA 
6: 10 B 10 15     NA 
7: 2 C 5 70   88.00000 
8: 4 C 6 100   67.75000 
9: 5 C 2 66   84.16667 
10: 8 C 1 60   83.23077 

Answer 2

Нет необходимости в самостоятельном подключении. с возможностью dplyr для window functions вы можете рассчитать меры для каждой группы довольно легко:

ex(10) %>% 
    group_by(grp) %>% 
    mutate(rest_of_grp_wtd_avg = (sum(wt*x)-wt*x)/(sum(wt)-wt))