dplyr按行汇总，按列求和，按名称分组

Question

让我们考虑这个简单的数据集

set.seed(12345)
df <- data.frame(a1 = rnorm(5), a2 = rnorm(5), a3 = rnorm(5), 
                 b1 = rnorm(5), b2 = rnorm(5), b3 = rnorm(5),
                 c1 = rnorm(5), c2 = rnorm(5), c3 = rnorm(5))

看起来像这样

          a1         a2         a3         b1         b2         b3        c1          c2         c3
1  0.5855288 -1.8179560 -0.1162478  0.8168998  0.7796219  1.8050975 0.8118732  0.49118828  1.1285108
2  0.7094660  0.6300986  1.8173120 -0.8863575  1.4557851 -0.4816474 2.1968335 -0.32408658 -2.3803581
3 -0.1093033 -0.2761841  0.3706279 -0.3315776 -0.6443284  0.6203798 2.0491903 -1.66205024 -1.0602656
4 -0.4534972 -0.2841597  0.5202165  1.1207127 -1.5531374  0.6121235 1.6324456  1.76773385  0.9371405
5  0.6058875 -0.9193220 -0.7505320  0.2987237 -1.5977095 -0.1623110 0.2542712  0.02580105  0.8544517

现在，我想要获取以特定字母开头的列的平均值，这些字母在向量中指定。

例如，如果我有

cols <- c("a", "c")

我想输出一个包含两列（a和c）的数据框，分别包含a1/a2/a3和c1/c2/c3列的平均值。

            a          c
1 -0.449558319  0.8105241
2  1.052292204 -0.1692037
3 -0.004953185 -0.2243752
4 -0.072480153  1.4457733
5 -0.354655514  0.3781747

我一直在尝试使用starts_with和row_wise，但是我还没有找到正确的语法。

- nico

Answer 1

select 选择以 a 或 c 开头的列，然后使用 split.default 分割这些列，并在每个组上应用 rowMeans：

library(dplyr)
library(purrr)
select(df, starts_with(cols)) %>% 
  split.default(gsub("\\d", "", names(.))) %>% 
  map_dfc(rowMeans)

         a      c
1 -0.450    0.811
2  1.05    -0.169
3 -0.00495 -0.224
4 -0.0725   1.45 
5 -0.355    0.378

请注意，gsub 部分可能需要根据您的列名结构进行更改。

- Maël

---

太棒了，它像魔法一样运行！我不知道 split.default，谢谢。 - nico

Answer 2

计算所有列组的平均值，然后进行子集化：

data.frame(lapply(split.default(df, gsub("\\d", "", colnames(df))), rowMeans))[, cols]

根据实际数据，获取平均值然后进行子集操作可能更有效率。

---

编辑：对于更大的数据，子集然后获取平均值更快。

ix <- gsub("\\d", "", colnames(df)) %in% cols
x1 <- data.frame(lapply(split.default(df[, ix], gsub("\\d", "", colnames(df)[ ix ])), rowMeans))

- zx8754

Answer 3

您可以在 mutate() 调用中遍历选择器值：

library(dplyr)
library(purrr)

df %>%
  mutate(map_df(set_names(cols), ~ rowMeans(across(starts_with(.x)))), .keep = "none")

             a          c
1 -0.449558319  0.8105241
2  1.052292204 -0.1692037
3 -0.004953185 -0.2243752
4 -0.072480153  1.4457733
5 -0.354655514  0.3781747

- Ritchie Sacramento

Answer 4

基准测试

数据：

library(dplyr)
library(purrr)

n = 100000 * 10 * 10
set.seed(12345); df <- data.frame(matrix(runif(n), ncol = 100))
colnames(df) <- make.unique(rep(letters[1:10], each = 10), sep = "")
cols <- letters[c(1,3,7,9)]

基准测试:

microbenchmark::microbenchmark(
  base1 = {
    ix <- gsub("\\d", "", colnames(df)) %in% cols
    data.frame(lapply(split.default(df[, ix], gsub("\\d", "", colnames(df)[ ix ])), rowMeans))
  },
  base2 = {
    data.frame(lapply(split.default(df, gsub("\\d", "", colnames(df))), rowMeans))[, cols]    
  },
  tidy1 = {
    select(df, starts_with(cols)) %>% 
      split.default(gsub("\\d", "", names(.))) %>% 
      map_dfc(rowMeans)
  },
  tidy2 = {
    split.default(df, gsub("\\d", "", names(df))) %>% 
      map_dfc(rowMeans) %>% 
      select({{cols}})
  },
  tidy3 = {
    df %>%
      mutate(map_df(set_names(cols), ~ rowMeans(across(starts_with(.x)))), .keep = "none")
  },
  check = "equivalent"
)
  
# Unit: milliseconds
#  expr     min       lq      mean   median       uq      max neval
# base1 26.8613 29.42070  36.75314 33.28410  40.9296 114.7524   100
# base2 67.9460 80.95455  94.08483 86.47900 100.4189 200.9891   100
# tidy1 33.8004 36.53475  44.94198 44.44600  49.8111  76.5831   100
# tidy2 73.4420 89.79525 101.52422 97.48275 108.5292 294.6857   100
# tidy3 39.8900 44.37110  53.25316 52.23770  56.4041  99.9845   100

- zx8754

Answer 5

cbind.data.frame(df %>% select(starts_with("a")) %>% 
  rowMeans() %>% 
  cbind.data.frame() %>% 
  rename("a"="."),
  df %>% select(starts_with("b")) %>% 
                       rowMeans() %>% 
                       cbind.data.frame()%>% 
                     rename("b"=".")) 

- chris jude

---

当我们有10组列的子集时，这种方法无法很好地扩展。 - zx8754