对多列按组“就地”加权平均值
我想要计算几列中的每一列的分组加权平均值，但要“就地”计算，我的意思是结束时的行数与开始时相同，而不是汇总。也就是说，如果有两行属于同一组，则它们将各自具有相同的加权平均值作为重复，而不是将它们折叠成代表它们的一行。
我有一个在base R中工作的版本，但对于我的实际大型数据集来说，它非常慢(并且在某些大小下似乎崩溃而没有产生结果，我认为是由于内存耗尽)：
# Some dummy data
test_w <- c(0.5, 1, 1.5, 0.5, 1, 1.5)
test_g <- list(g1 = c("Yes", "Yes", "Yes", "No", "No", "No"),
g2 = c("Yes", "Yes", "No", "No", "No", "Yes"))
test_x <- matrix(c(1, 2, 3, 4, 5, 6,
10, 9, 8, 7, 6, 5),
nrow = 6,
dimnames = list(rows = c(),
cols = c("x1", "x2")))
# Gives desired answers:
temp_means_by_groups_1 <- apply(
test_x, 2,
FUN = function(x) return (
ave(test_w * x, test_g, FUN = sum) /
ave(test_w, test_g, FUN = sum)))我的实际数据集有大约40 'x‘列和大约10,000行。
我从这个答案中看出，weighted.mean()与ave()不能很好地配合：https://stackoverflow.com/a/38509589/4957167
因此，我尝试使用dplyr /tidyverse来做类似的事情：
# A data frame version of the dummy data
test_data <- data.frame(x1 = c(1, 2, 3, 4, 5, 6),
x2 = c(10, 9, 8, 7, 6, 5),
g1 = c("Yes", "Yes", "Yes", "No", "No", "No"),
g2 = c("Yes", "Yes", "No", "No", "No", "Yes"),
w = c(0.5, 1, 1.5, 0.5, 1, 1.5))
# Doesn't run
temp_means_by_groups_2 <- test_data %>%
group_by(across(all_of(c("g1", "g2")))) %>%
mutate(across(all_of(c("x1", "x2")), weighted.mean(w = w))) %>%
ungroup()或者滚动我自己的函数：
weighted_means <- function(x) {
sum(test_w * x) / sum(test_w)
}
w <- test_data$w
# Runs but gives wrong answers (not weighting the means)
temp_means_by_groups_3 <- test_data %>%
group_by(across(all_of(c("g1", "g2")))) %>%
mutate(across(all_of(c("x1", "x2")), weighted_means)) %>%
ungroup()我的理想答案是一个快速运行的解决方案，它在base R中工作，以最小化依赖性。实际上，速度并不是最重要的-如果内存使用率足够低，不会崩溃，那么运行有点慢是可以容忍的。
我的第二个最爱是tidyverse，因为我对它比较熟悉，并且在代码中的其他地方使用它。通过搜索似乎与我的目标相对接近的答案，我发现data.table经常被提及；我从未使用过它，所以我不愿深入讨论它，但我愿意接受说服。
我继承的代码恰好将所有内容存储为单独的对象:有一个权重的(数字)向量，一个包含每个分组变量作为单独因子对象的列表，以及一个包含每个x个变量作为一列的矩阵。但我很乐意将它们组合到单个数据帧中，或者将它们作为单独的对象传递给执行此操作的代码，或者以任何最方便的方式传递。
在返回的对象中，无论它是什么，我都希望每个'x‘变量的列与它们的输入变量具有相同的名称。
回答 1
Stack Overflow用户
发布于 2021-07-12 19:45:03
对于较大的数据集，data.table通常更快，你可以尝试一下。
library(data.table)
cols <- c('x1', 'x2')
setDT(test_data)
test_data[, (cols) := lapply(.SD, weighted.mean, w = w),.(g1,g2), .SDcols = cols]
# x1 x2 g1 g2 w
#1: 1.666667 9.333333 Yes Yes 0.5
#2: 1.666667 9.333333 Yes Yes 1.0
#3: 3.000000 8.000000 Yes No 1.5
#4: 4.666667 6.333333 No No 0.5
#5: 4.666667 6.333333 No No 1.0
#6: 6.000000 5.000000 No Yes 1.5在base R中，您可以使用带有lapply的split -
do.call(rbind, lapply(split(test_data, test_data[c('g1', 'g2')]), function(x) {
x[1:2] <- lapply(x[1:2], weighted.mean, w = x$w)
x
})) -> test_data或者by -
do.call(rbind, by(test_data, test_data[c('g1', 'g2')], function(x) {
x[1:2] <- lapply(x[1:2], weighted.mean, w = x$w)
x
})) -> test_datahttps://stackoverflow.com/questions/68346239
复制相似问题
腾讯云开发者
