r - 有没有办法将 `across` 与 `group_by` 和 `mutate` 一起使用？

Question

我有一个包含四分位数列的数据集

library(dplyr)
library(glue)

set.seed(234)
df = 
tibble(x1 = sample(1:100, size = 100), # simulate data
       y1 = sample(1:100, size = 100),
       z1 = sample(1:100, size = 100)) %>% 
  mutate(across(ends_with("1"), ~factor(ntile(.x, 4)), # assign to quartiles
                                        .names = "{.col}_q"))
  
head(df)         
#> # A tibble: 6 × 6
#>      x1    y1    z1 x1_q  y1_q  z1_q 
#>   <int> <int> <int> <fct> <fct> <fct>
#> 1    97    94     9 4     4     1    
#> 2    31    66    66 2     3     3    
#> 3    34    43    62 2     2     3    
#> 4    46    57    41 2     3     2    
#> 5    98     3    38 4     1     2    
#> 6    18    37    40 1     2     2

对于这些四分位数列中的每一个，我想附加四分位数的最小值和最大值，如下所示:

df %>% 
  group_by(x1_q) %>% 
  mutate(x1_q = glue("Q{x1_q} ({min(x1)} - {max(x1)})")) %>% 
  head()
#> # A tibble: 6 × 6
#> # Groups:   x1_q [3]
#>      x1    y1    z1 x1_q          y1_q  z1_q 
#>   <int> <int> <int> <glue>        <fct> <fct>
#> 1    97    94     9 Q4 (76 - 100) 4     1    
#> 2    31    66    66 Q2 (26 - 50)  3     3    
#> 3    34    43    62 Q2 (26 - 50)  2     3    
#> 4    46    57    41 Q2 (26 - 50)  3     2    
#> 5    98     3    38 Q4 (76 - 100) 1     2    
#> 6    18    37    40 Q1 (1 - 25)   2     2

^{由 reprex package 创建于 2022-04-29 (v2.0.1)}

我是否可以将此 group_by mutate 模式应用于我所有的四分位数列？

Answer 1

这是一种方法 - 循环 across _q 列，通过从列中删除子字符串后缀来提取没有 _q 的相应列name，get 值 ('tmp')，然后使用其中一个格式化函数将列值与 min 和 max

library(dplyr)
library(stringr)
df %>%
    mutate(across(ends_with("_q"),  ~ 
       {
        tmp <- get(str_remove(cur_column(), "_q"))
        str_c("Q", .x, " (", ave(tmp, .x, FUN = min), " - ", 
                 ave(tmp, .x, FUN = max), ")")
        }
  ))

-输出

# A tibble: 100 × 6
      x1    y1    z1 x1_q          y1_q          z1_q         
   <int> <int> <int> <chr>         <chr>         <chr>        
 1    97    94     9 Q4 (76 - 100) Q4 (76 - 100) Q1 (1 - 25)  
 2    31    66    66 Q2 (26 - 50)  Q3 (51 - 75)  Q3 (51 - 75) 
 3    34    43    62 Q2 (26 - 50)  Q2 (26 - 50)  Q3 (51 - 75) 
 4    46    57    41 Q2 (26 - 50)  Q3 (51 - 75)  Q2 (26 - 50) 
 5    98     3    38 Q4 (76 - 100) Q1 (1 - 25)   Q2 (26 - 50) 
 6    18    37    40 Q1 (1 - 25)   Q2 (26 - 50)  Q2 (26 - 50) 
 7    56     4    98 Q3 (51 - 75)  Q1 (1 - 25)   Q4 (76 - 100)
 8     1    17    27 Q1 (1 - 25)   Q1 (1 - 25)   Q2 (26 - 50) 
 9    68    99    73 Q3 (51 - 75)  Q4 (76 - 100) Q3 (51 - 75) 
10    92    65    16 Q4 (76 - 100) Q3 (51 - 75)  Q1 (1 - 25)  
# … with 90 more rows

---

或者遍历map2中的names

library(purrr)
map2_dfc(names(df)[4:6], names(df)[1:3], 
    ~ df %>%
          group_by(across(all_of(.x))) %>%
          transmute(!! .x := glue::glue("Q{.data[[.x]]} ({min(.data[[.y]])} - {max(.data[[.y]])})")) %>% ungroup ) %>% bind_cols(df[1:3], .)
# A tibble: 100 × 6
      x1    y1    z1 x1_q          y1_q          z1_q         
   <int> <int> <int> <glue>        <glue>        <glue>       
 1    97    94     9 Q4 (76 - 100) Q4 (76 - 100) Q1 (1 - 25)  
 2    31    66    66 Q2 (26 - 50)  Q3 (51 - 75)  Q3 (51 - 75) 
 3    34    43    62 Q2 (26 - 50)  Q2 (26 - 50)  Q3 (51 - 75) 
 4    46    57    41 Q2 (26 - 50)  Q3 (51 - 75)  Q2 (26 - 50) 
 5    98     3    38 Q4 (76 - 100) Q1 (1 - 25)   Q2 (26 - 50) 
 6    18    37    40 Q1 (1 - 25)   Q2 (26 - 50)  Q2 (26 - 50) 
 7    56     4    98 Q3 (51 - 75)  Q1 (1 - 25)   Q4 (76 - 100)
 8     1    17    27 Q1 (1 - 25)   Q1 (1 - 25)   Q2 (26 - 50) 
 9    68    99    73 Q3 (51 - 75)  Q4 (76 - 100) Q3 (51 - 75) 
10    92    65    16 Q4 (76 - 100) Q3 (51 - 75)  Q1 (1 - 25)  
# … with 90 more rows