将 summarise(across(..., .fns = ...)) 与多变量函数结合使用

Ale*_*Fox 5 r dplyr purrr tidyverse

我的问题要求我汇总多个列的数据,但每列必须由其他三列的多变量函数进行汇总。

我有一个包含数百列的数据框,其中包含有关数据集的不同统计信息。这是一个结构类似、较小的数据框。

df <- data.frame(a1_Avg = rnorm(10), 
                 a1_Std = runif(10), 
                 a2_Avg = rnorm(10), 
                 a2_Std = runif(10), 
                 Hour = c(1.0, 1.5, 2.0, 2.25, 2.5, 2.75, 3.0, 4.0, 4.5, 5.0),
                 Measurements = c(3, 3, 6, 6, 6, 6, 10, 7, 7, 2)) %>%
Run Code Online (Sandbox Code Playgroud)

数据需要压缩成汇总一小时块的行。总结平均值很容易:我可以简单地对它们进行平均,因为测量次数在一个小时内是一致的。

  group_by(Hour) %>%
  summarize(across(matches("a._Avg"), ~ mean(.x), .names = "combined_{col}"),
Run Code Online (Sandbox Code Playgroud)

但组合标准差比较棘手,因为我需要来自三个单独列的信息来计算它。手动地,我会这样做:

            combined_a1_Std = sqrt((1/n())*sum(a1_Std^2 + (a1_Avg - combined_a1_Avg)^2)),
            combined_a2_Std = sqrt((1/n())*sum(a2_Std^2 + (a2_Avg - combined_a2_Avg)^2)))
Run Code Online (Sandbox Code Playgroud)

但这对于数百列来说是不可行的。

有没有一种简单的方法可以做到这一点?

这是上面的完整代码以及所需的输出:

set.seed(1)
df <- data.frame(a1_Avg = rnorm(10), 
                 a1_Std = runif(10), 
                 a2_Avg = rnorm(10), 
                 a2_Std = runif(10), 
                 Hour = c(1.0, 1.5, 2.0, 2.25, 2.5, 2.75, 3.0, 4.0, 4.5, 5.0),
                 Measurements = c(3, 3, 6, 6, 6, 6, 10, 7, 7, 2)) %>%
  mutate(Hour = floor(Hour)) %>%
  group_by(Hour) %>%
  summarize(across(matches("a._Avg"), ~ mean(.x), .names = "combined_{col}"),
            combined_a1_Std = sqrt((1/n())*sum(a1_Std^2 + (a1_Avg - combined_a1_Avg)^2)),
            combined_a2_Std = sqrt((1/n())*sum(a2_Std^2 + (a2_Avg - combined_a2_Avg)^2)))

df

   Hour combined_a1_Avg combined_a2_Avg combined_a1_Std combined_a2_Std
  <dbl>           <dbl>           <dbl>           <dbl>           <dbl>
1     1         -0.221          -0.0306           0.859           0.859
2     2          0.0672          0.819            1.17            1.17 
3     3          0.487           0.782            0.116           0.116
4     4          0.657          -0.957            0.795           0.795
5     5         -0.305           0.620            0.583           0.583
Run Code Online (Sandbox Code Playgroud)

akr*_*run 7

一个选项是循环遍历一组列,然后get通过替换列名称中的子字符串循环遍历另一组列

library(dplyr)
library(stringr)
out2 <- df %>% 
   mutate(Hour = floor(Hour)) %>%
   group_by(Hour) %>%
   summarize(across(matches("a\\d+_Avg"), ~ mean(.x),
    .names = "combined_{col}"), 
         across(matches('^a\\d+_Avg$'),
     ~ sqrt((1/n())*sum(get(str_replace(cur_column(), "Avg", "Std")) +
                   (. - get(str_c( "combined_", cur_column() )))^2)), 
      .names = "combined_{str_replace(.col, 'Avg', 'Std')}"))
Run Code Online (Sandbox Code Playgroud)

-用OP的手动方法检查

out1 <- df %>%
   mutate(Hour = floor(Hour)) %>%
  group_by(Hour) %>%
  summarize(across(matches("a._Avg"), ~ mean(.x), .names = "combined_{col}"),
            combined_a1_Std = sqrt((1/n())*sum(a1_Std + (a1_Avg - combined_a1_Avg)^2)),
            combined_a2_Std = sqrt((1/n())*sum(a2_Std + (a2_Avg - combined_a2_Avg)^2)))
identical(out1, out2)
[1] TRUE
Run Code Online (Sandbox Code Playgroud)

数据

set.seed(1)
df <- data.frame(a1_Avg = rnorm(10), 
                 a1_Std = runif(10), 
                 a2_Avg = rnorm(10), 
                 a2_Std = runif(10), 
                 Hour = c(1.0, 1.5, 2.0, 2.25, 2.5, 2.75, 3.0, 4.0, 4.5, 5.0),
                 Measurements = c(3, 3, 6, 6, 6, 6, 10, 7, 7, 2))
Run Code Online (Sandbox Code Playgroud)