R:data.table 按组计算多个变量的加权平均值，每个变量具有多个权重变量

Question

我对 data.table 还是个新手。我的问题类似于 this one 和 this one 。不同之处在于，我想按组计算多个变量的加权均值，但每个均值使用多个权重。

考虑以下data.table(实际要大得多):

library(data.table)

set.seed(123456)

mydata <- data.table(CLID = rep("CNK", 10),
                     ITNUM = rep(c("First", "Second", "First", "First", "Second"), 2),
                     SATS = rep(c("Always", "Amost always", "Sometimes", "Never", "Always"), 2),
                     ASSETS = rep(c("0-10", "11-25", "26-100", "101-200", "MORE THAN 200"), 2),
                     AVGVALUE1 = rnorm(10, 10, 2),
                     AVGVALUE2 = rnorm(10, 10, 2),
                     WGT1 = rnorm(10, 3, 1),
                     WGT2 = rnorm(10, 3, 1),
                     WGT3 = rnorm(10, 3, 1))

#I set the key of the table to the variables I want to group by,
#so the output is sorted
setkeyv(mydata, c("CLID", "ITNUM", "SATS", "ASSETS"))

我想要实现的是按 ITNUM 定义的组计算 AVGVALUE1 和 AVGVALUE2(可能还有更多变量)的加权平均值, SATS, ASSETS 使用每个权重变量 WGT1, WGT2, WGT3(可能还有更多)。因此，对于我想要计算加权均值的每个变量，我将按组(或任何权重数)获得三个加权均值。

我可以分别为每个变量做这件事，例如:

all.weights <- c("WGT1", "WGT2", "WGT3")
avg.var <- "AVGVALUE1"
split.vars <- c("ITNUM", "SATS", "ASSETS")

mydata[ , Map(f = weighted.mean, x = .(get(avg.var)), w = mget(all.weights),
na.rm = TRUE), by = c(key(mydata)[1], split.vars)]

我在 by 中添加了第一个键变量，尽管它是一个常量，因为我想将它作为输出中的一列。我得到:

   CLID  ITNUM         SATS        ASSETS       V1       V2       V3
1:  CNK  First       Always          0-10 11.66824 11.66819 11.66829
2:  CNK  First        Never       101-200 11.37378 12.21008 11.60182
3:  CNK  First    Sometimes        26-100 12.43004 13.13450 12.01330
4:  CNK Second       Always MORE THAN 200 12.32265 11.81613 12.56786
5:  CNK Second Amost always         11-25 10.76556 11.34669 10.52458

但是，对于实际的 data.table，我有更多的列来计算加权平均值(以及要使用的更多的权重)，这样做会很麻烦逐个。我想象的是一个函数，其中每个变量(AVGVALUE1、AVGVALUE2 等等)的平均值是用每个权重变量(WGT1、WGT2、WGT3 等)，并将计算加权平均值的每个变量的输出添加到列表中。我想列表是最好的选择，因为如果所有估计都在同一个输出中，列数可能是无穷无尽的。所以像这样:

[[1]]
   CLID  ITNUM         SATS        ASSETS       V1       V2       V3
1:  CNK  First       Always          0-10 11.66824 11.66819 11.66829
2:  CNK  First        Never       101-200 11.37378 12.21008 11.60182
3:  CNK  First    Sometimes        26-100 12.43004 13.13450 12.01330
4:  CNK Second       Always MORE THAN 200 12.32265 11.81613 12.56786
5:  CNK Second Amost always         11-25 10.76556 11.34669 10.52458

[[2]]
   CLID  ITNUM         SATS        ASSETS        V1        V2        V3
1:  CNK  First       Always          0-10  9.132899  9.060045  9.197005
2:  CNK  First        Never       101-200 12.896584 13.278680 13.000772
3:  CNK  First    Sometimes        26-100 10.972260 11.215390 10.828431
4:  CNK Second       Always MORE THAN 200 11.704404 11.611072 11.749586
5:  CNK Second Amost always         11-25  8.086409  8.225030  8.028928

到目前为止我尝试了什么:

1. 使用lapply

   all.weights <- c("WGT1", "WGT2", "WGT3")
   avg.vars <- c("AVGVALUE1", "AVGVALUE2")
   split.vars <- c("ITNUM", "SATS", "ASSETS")
   
   lapply(mydata, function(i) {
   mydata[ , Map(f = weighted.mean, x = mget(avg.vars)[i], w = mget(all.weights),
   na.rm = TRUE), by = c(key(mydata)[1], split.vars)]
   })
   
   Error in weighted.mean.default(x = dots[[1L]][[1L]], w = dots[[2L]][[1L]],  : 
    'x' and 'w' must have the same length
   

2. 使用mapply

   myfun <- function(data, spl.v, avg.v, wgts) {
     data[ , Map(f = weighted.mean, x = mget(avg.v), w = mget(all.weights),
     na.rm = TRUE), by = c(key(data)[1], spl.v)]
   }
   
   mapply(FUN = myfun, data = mydata, spl.v = split.vars, avg.v = avg.vars,
   wgts = all.weights)
   
   Error: value for ‘AVGVALUE2’ not found
   

我试图将 mget(avg.v) 包装为列表 - .(mget(avg.v))，但随后出现另一个错误:

 Error in mapply(FUN = f, ..., SIMPLIFY = FALSE) : 
  could not find function "." 

有人可以帮忙吗？

Answer 1

我们可以使用 outer(对两个输入向量中值的所有组合执行函数)对向量化加权均值函数进行运算。通过在数据表的范围内定义 outer 使用的函数，我们可以让 get 评估 data.table 列:

wmeans = mydata[, {
  f  = function(X,Y) weighted.mean(get(X), get(Y));
  vf = Vectorize(f);
  outer(avg.var, all.weights, vf)},
  by = split.vars]

这将所有方法放入单个列中(即“长”格式)。我们还可以添加更多列来指定每个列指的是哪个值/权重组合:

wmeans[, mean.v := expand.grid(avg.var, all.weights)[,1]]       
wmeans[, mean.w := expand.grid(avg.var, all.weights)[,2]]
head(wmeans)
#    ITNUM   SATS ASSETS        V1    mean.v mean.w
# 1: First Always   0-10 11.668243 AVGVALUE1   WGT1
# 2: First Always   0-10  9.132899 AVGVALUE2   WGT1
# 3: First Always   0-10 11.668192 AVGVALUE1   WGT2
# 4: First Always   0-10  9.060045 AVGVALUE2   WGT2
# 5: First Always   0-10 11.668287 AVGVALUE1   WGT3
# 6: First Always   0-10  9.197005 AVGVALUE2   WGT3

我们可以使用 dcast 将其 reshape 为一个在 avg.var 中很长但在 all.weights 中很宽的 data.table:

wide.wmeans = dcast(wmeans, mean.v+ITNUM+SATS+ASSETS ~ mean.w, value.var = "V1")  
#       mean.v  ITNUM         SATS        ASSETS      WGT1      WGT2      WGT3
# 1: AVGVALUE1  First       Always          0-10 11.668243 11.668192 11.668287
# 2: AVGVALUE1  First        Never       101-200 11.373780 12.210083 11.601819
# 3: AVGVALUE1  First    Sometimes        26-100 12.430039 13.134499 12.013299
# 4: AVGVALUE1 Second       Always MORE THAN 200 12.322651 11.816135 12.567860
# 5: AVGVALUE1 Second Amost always         11-25 10.765557 11.346688 10.524583
# 6: AVGVALUE2  First       Always          0-10  9.132899  9.060045  9.197005
# 7: AVGVALUE2  First        Never       101-200 12.896584 13.278680 13.000772
# 8: AVGVALUE2  First    Sometimes        26-100 10.972260 11.215390 10.828431
# 9: AVGVALUE2 Second       Always MORE THAN 200 11.704404 11.611072 11.749586
#10: AVGVALUE2 Second Amost always         11-25  8.086409  8.225030  8.028928

如果您需要将其作为列表而不是 data.table，您可以使用

将其拆分

lapply(avg.var, function(x) wide.wmeans[mean.v == x])
# [[1]]
#       mean.v  ITNUM         SATS        ASSETS     WGT1     WGT2     WGT3
# 1: AVGVALUE1  First       Always          0-10 11.66824 11.66819 11.66829
# 2: AVGVALUE1  First        Never       101-200 11.37378 12.21008 11.60182
# 3: AVGVALUE1  First    Sometimes        26-100 12.43004 13.13450 12.01330
# 4: AVGVALUE1 Second       Always MORE THAN 200 12.32265 11.81613 12.56786
# 5: AVGVALUE1 Second Amost always         11-25 10.76556 11.34669 10.52458
# 
# [[2]]
#       mean.v  ITNUM         SATS        ASSETS      WGT1      WGT2      WGT3
# 1: AVGVALUE2  First       Always          0-10  9.132899  9.060045  9.197005
# 2: AVGVALUE2  First        Never       101-200 12.896584 13.278680 13.000772
# 3: AVGVALUE2  First    Sometimes        26-100 10.972260 11.215390 10.828431
# 4: AVGVALUE2 Second       Always MORE THAN 200 11.704404 11.611072 11.749586
# 5: AVGVALUE2 Second Amost always         11-25  8.086409  8.225030  8.028928