时间戳

首页 > 解决方案 > 多列的“就地”组加权平均值

r - 多列的“就地”组加权平均值

问题描述

我想为几列中的每一列计算分组加权平均值，但要“就地”执行此操作，我的意思是最终得到与我开始时相同的行数，而不是总结。即，如果有两行属于同一组，则它们每一个都将具有相同的加权平均值，以重复的形式呈现，而不是这些被折叠成代表它们两者的一行。

我有这个版本可以在基础 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 行。

我从这个 SO 答案中看到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()

我的理想答案是在基本 R 中运行的快速运行解决方案，以最大程度地减少依赖关系。实际上，速度并不是最重要的——如果内存使用率保持足够低以至于不会崩溃，那么运行速度有点慢是可以容忍的。

我的第二个最爱是 tidyverse，因为我对它有点熟悉，并且在我的代码的其他地方使用它。通过搜索似乎相对接近我的目标的答案，我发现 data.table 经常被提及；我从来没有使用过，所以我不想进入它，但愿意说服。

我继承的代码恰好将所有内容存储为单独的对象：有一个（数字）权重向量，一个包含每个分组变量作为单独因子对象的列表，以及一个包含每个 x 变量作为列的矩阵。但我很乐意将它们组合到一个数据框中，或者将它们作为单独的对象传递给执行此操作的代码，或者任何最方便的方法。

在返回的对象中，无论它是什么，我都希望每个“x”变量的列与其输入的名称相同。

标签： rdplyr

解决方案

对您的代码稍作调整即可。它会产生您想要的结果吗？

library(dplyr, warn.conflicts = FALSE)

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))

# Now runs
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()

temp_means_by_groups_2
#> # A tibble: 6 x 5
#>      x1    x2 g1    g2        w
#>   <dbl> <dbl> <chr> <chr> <dbl>
#> 1  1.67  9.33 Yes   Yes     0.5
#> 2  1.67  9.33 Yes   Yes     1  
#> 3  3     8    Yes   No      1.5
#> 4  4.67  6.33 No    No      0.5
#> 5  4.67  6.33 No    No      1  
#> 6  6     5    No    Yes     1.5

由reprex 包于 2021-07-12 创建 (v2.0.0 )

这是一个dtplyr版本：

library(dplyr, warn.conflicts = FALSE)
library(dtplyr)
library(data.table)
#> 
#> Attaching package: 'data.table'
#> The following objects are masked from 'package:dplyr':
#> 
#>     between, first, last

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)) %>%
  as.data.table() %>%
  lazy_dt(immutable = FALSE)

# Now runs
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()

temp_means_by_groups_2
#> Source: local data table [6 x 5]
#> Call:   `_DT1`[, `:=`(x1 = weighted.mean(x1, w = w), x2 = weighted.mean(x2, 
#>     w = w)), by = .(g1, g2)]
#> 
#>      x1    x2 g1    g2        w
#>   <dbl> <dbl> <chr> <chr> <dbl>
#> 1  1.67  9.33 Yes   Yes     0.5
#> 2  1.67  9.33 Yes   Yes     1  
#> 3  3     8    Yes   No      1.5
#> 4  4.67  6.33 No    No      0.5
#> 5  4.67  6.33 No    No      1  
#> 6  6     5    No    Yes     1.5
#> 
#> # Use as.data.table()/as.data.frame()/as_tibble() to access results

由reprex 包创建于 2021-07-13 (v2.0.0 )

推荐阅读