logo标签列表

R：使用data.table按组计算多个变量的加权平均值，每个变量都有多个权重变量

rlistdata.tableweighted-average
3
我还不太熟悉data.table。我的问题类似于这个和这个。区别在于，我想按组计算多个变量的加权平均值，但对于每个平均值，使用多个权重。
考虑以下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"))

我想要实现的是，通过对每一个权重变量WGT1、WGT2和WGT3（或更多变量）进行分组计算，对于ITNUM、SATS和ASSETS定义的组，计算AVGVALUE1和AVGVALUE2（以及可能的其他变量）的加权平均值。因此，对于每个变量，我想要按组计算三个加权平均值（或任何权重数）。
我可以将其分别应用于每个变量，例如：
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. Using 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. Using 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 "."

有人能帮忙吗？

2个回答
2
我们可以使用 outer（对两个输入向量中的值的所有组合执行函数）作用于矢量化加权平均数函数。通过在数据表的范围内定义由 outer 使用的函数，我们可以使 get 评估为数据表列：
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 将其重塑为一个数据表，在该表中，avg.var 是长的，但所有权重是宽的：
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
1
I. lapply解决方案
all.weights <- c("WGT1", "WGT2", "WGT3")
avg.vars    <- c("AVGVALUE1", "AVGVALUE2")
split.vars  <- c("ITNUM", "SATS", "ASSETS")

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

  return(tmp) # totally optional, a habit from using C and Java
}

lapply(avg.vars, myfun)

优点：

  • 使用了*apply函数
  • 避免了循环
  • 比逐个处理要快得多

缺点：

  • 返回一个列表
[[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

二. for 循环解决方案

使用简单的 for 循环，例如当 avg.vars 有 2 个值时：

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

result <- data.frame(matrix(nrow=0,ncol=7))
for(i in avg.vars){
  tmp <- 
    mydata[ , Map(f = weighted.mean, 
                x = .(get(i)), 
                w = mget(all.weights),
                na.rm = TRUE), 
          by = c(key(mydata)[1], split.vars)]  

  result <- rbind(result,tmp,use.names=F)
}
colnames(result) <- c("CLID", "ITNUM", "SATS", "ASSETS", "V1", "V2", "V3")
result

    CLID  ITNUM         SATS        ASSETS        V1        V2        V3
 1:  CNK  First       Always          0-10 11.668243 11.668192 11.668287
 2:  CNK  First        Never       101-200 11.373780 12.210083 11.601819
 3:  CNK  First    Sometimes        26-100 12.430039 13.134499 12.013299
 4:  CNK Second       Always MORE THAN 200 12.322651 11.816135 12.567860
 5:  CNK Second Amost always         11-25 10.765557 11.346688 10.524583
 6:  CNK  First       Always          0-10  9.132899  9.060045  9.197005
 7:  CNK  First        Never       101-200 12.896584 13.278680 13.000772
 8:  CNK  First    Sometimes        26-100 10.972260 11.215390 10.828431
 9:  CNK Second       Always MORE THAN 200 11.704404 11.611072 11.749586
10:  CNK Second Amost always         11-25  8.086409  8.225030  8.028928

优点：

  • 在示例中立即完成
  • 可扩展到任意列数，无需进行其他数据处理/编码
  • 比逐一操作节省大量时间
  • 返回一个漂亮的data.table
  • 如果您实际上想要一个列表，可以通过将return初始化为一个列表（return <- list()），创建一个计数器变量（n <- 1），然后将rbind语句替换为return[n] <- tmp并在循环内增加计数器（n <- n + 1）来获得。

缺点：

  • 如果您的数据非常大（例如，行数> 100,000，且avg.var有几十个或更多个值），则使用任何循环或带有循环的函数的性能都会很差。
谢谢，但我发现在lapply(我更喜欢这个)和for循环的解决方案中都存在问题。如果您向mydata添加另一列以计算平均值(例如CRMVAR = rnorm(10, 10, 2))，然后将其添加到avg.vars(avg.vars <- c("AVGVALUE1", "AVGVALUE2", "CRMVAR"))中，该函数将返回所需的3个组件的列表。但是前两个组件的值将与上面的输出不同。因此，输出将取决于您尝试计算平均值的列数。在这种情况下，似乎lapply在内部出了些问题。如何解决？ - panman
@panman 这很奇怪。您能否更新问题并提供新的示例和期望输出，以便我可以重现并修复问题？ - Hack-R
哦，抱歉，这完全是我的错误。我在帖子开头使用了原始语法将新变量（CRMVAR）添加到mydt中，尽管我使用了相同的种子，但其余变量的值发生了变化（我在Linux中使用R 3.3.1），但我正在将这些值与我已经发布的示例输出进行比较。一切都没问题，对于造成的混淆我感到抱歉。 - panman
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接