Início / coding / Perguntas / 79529904
Accepted
qdread
Asked: 2025-03-24 08:11:29 +0800 CST

Maneira programática de aplicar lista de funções a lista de colunas em dplyr summary

  • 772

Tenho cerca de 40 colunas que quero resumir por grupo usando dplyr::summarize(). Mas cada coluna será resumida com uma função diferente: algumas com mean(), algumas com sum(), algumas com min()e algumas com max(). Apenas uma função será aplicada a cada coluna. Tenho uma tabela de consulta para corresponder cada nome de coluna com a função apropriada. Qual é a melhor maneira de fazer isso dplyr::summarize()sem ter que escrever cada declaração individualmente?

Aqui está um exemplo de tabela de consulta usando mtcars. O código abaixo não fornece o resultado desejado. Ele aplica todas as dez funções de resumo a todas as dez colunas para um total de 100 resumos, onde eu quero apenas dez resumos, um para cada coluna.

library(dplyr)

lookup_table <- tibble(
  variable = c('mpg', 'disp', 'hp', 'drat', 'wt', 'qsec', 'vs', 'am', 'gear', 'carb'),
  summ_fn = list(mean, max, min, sum, mean, mean, median, mean, sum, max)
)

mtcars %>%
  group_by(cyl) %>%
  summarize(across(all_of(lookup_table$variable), .fns = lookup_table$summ_fn))

5 respostas

  1. Best Answer

    Em vez de um tibble, inicie sua tabela de consulta em uma lista nomeada onde os nomes são as colunas (por exemplo, lookup_table <- list("mpg" = mean, "disp" = max,...). Então você pode usar dplyr::curr_columnpara indexar a função para a coluna atual:

    (Observe que, como eu estava com um pouco de preguiça e você (felizmente) forneceu a tabela de consulta, eu apenas setNamesatribuí os nomes.)

    lookup_table <- setNames(list(mean, max, min, sum, mean, mean, median, mean, sum, max),
                         c('mpg', 'disp', 'hp', 'drat', 'wt', 'qsec', 'vs', 'am', 'gear', 'carb'))

mtcars %>%
  summarize(across(names(lookup_table), 
                   ~ lookup_table[[cur_column()]](.)),
            .by = cyl)

    Como @G. Grothendieck aponta nos comentários, se você já tem a tabela de consulta em formato tibble, você pode criar uma pequena função auxiliar e atingir o mesmo objetivo:

    lookup <- function(x) {
  with(lookup_table, summ_fn[[match(x, variable)]]) 
  }

mtcars %>% 
  summarize(across(all_of(lookup_table$variable), 
                   ~ lookup(cur_column())(.)), 
            .by = cyl)

    Saída (para ambas as abordagens):

    #   cyl      mpg  disp  hp  drat       wt     qsec vs        am gear carb
# 1   6 19.74286 258.0 105 25.10 3.117143 17.97714  1 0.4285714   27    6
# 2   4 26.66364 146.7  52 44.78 2.285727 19.13727  1 0.7272727   45    2
# 3   8 15.10000 472.0 150 45.21 3.999214 16.77214  0 0.1428571   46    8
    • 7

  2. Você pode criar uma lista de expressões desativadas e injetá-la summarize()usando o operador de injeção !!!.

    lookup_table <- setNames(list('mean', 'max', 'min', 'sum', 'mean', 'mean', 'median', 'mean', 'sum', 'max'),
                         c('mpg', 'disp', 'hp', 'drat', 'wt', 'qsec', 'vs', 'am', 'gear', 'carb'))

exprs <- Map(\(x, y) call(x, as.name(y)), lookup_table, names(lookup_table))

# $mpg
# mean(mpg)
# 
# $disp
# max(disp)
# .
# .
# .

mtcars %>%
  summarize(!!!exprs, .by = cyl)

#   cyl      mpg  disp  hp  drat       wt     qsec vs        am gear carb
# 1   6 19.74286 258.0 105 25.10 3.117143 17.97714  1 0.4285714   27    6
# 2   4 26.66364 146.7  52 44.78 2.285727 19.13727  1 0.7272727   45    2
# 3   8 15.10000 472.0 150 45.21 3.999214 16.77214  0 0.1428571   46    8
    • 5

  3. Sem dplyr, usando mapplydiretamente.

    > mapply(\(f, x) tapply(mtcars[[x]], mtcars$cyl, f), lookup_table, names(lookup_table))
       mpg  disp  hp  drat       wt     qsec vs        am gear carb
4 26.66364 146.7  52 44.78 2.285727 19.13727  1 0.7272727   45    2
6 19.74286 258.0 105 25.10 3.117143 17.97714  1 0.4285714   27    6
8 15.10000 472.0 150 45.21 3.999214 16.77214  0 0.1428571   46    8
    • 5

  4. Aqui está uma variação que complementa o seu original lookup_table:

    library(dplyr)
library(rlang)
library(purrr)

summ_by <- function(fun, var, by) {
  exec(fun, filter(mtcars, cyl==x) %>% pull(var))
}

Reduce(inner_join, 
       map(unique(mtcars[,'cyl']), \(by) {
         lookup_table %>%
           rowwise() %>%
           mutate("cyl_{{by}}":=summ_by(summ_fn, variable, by))})
)

    Dando

    # A tibble: 10 × 5
# Rowwise: 
   variable summ_fn   cyl_6   cyl_4   cyl_8
   <chr>    <list>    <dbl>   <dbl>   <dbl>
 1 mpg      <fn>     19.7    26.7    15.1  
 2 disp     <fn>    258     147.    472    
 3 hp       <fn>    105      52     150    
 4 drat     <fn>     25.1    44.8    45.2  
 5 wt       <fn>      3.12    2.29    4.00 
 6 qsec     <fn>     18.0    19.1    16.8  
 7 vs       <fn>      1       1       0    
 8 am       <fn>      0.429   0.727   0.143
 9 gear     <fn>     27      45      46    
10 carb     <fn>      6       2       8

    Para passar uma variável diferente para agrupar por (em vez de "cyl"):

    summarize_by <- function(data, by, lookup) {
  library(purrr)
  
  summ_by <- function(f, var, by, x) 
    exec(f, filter(data, !!sym(by)==x) %>% pull(var))

  by <- deparse(substitute(by))
  
  Reduce(inner_join, 
         map(unique(data[,by]), \(x) {
           varname <- paste0(by, "_", x)
           lookup %>%
             rowwise() %>%
             mutate(!!varname:=summ_by(summ_fn, variable, by, x))}))
  }

Call this function:

    summarize_by(mtcars, cyl, lookup_table)
# As above

summarize_by(mtcars, am, lookup_table)
# A tibble: 10 × 4
# Rowwise: 
   variable summ_fn   am_1   am_0
   <chr>    <list>   <dbl>  <dbl>
 1 mpg      <fn>     24.4   17.1 
 2 disp     <fn>    351    472   
 3 hp       <fn>     52     62   
 4 drat     <fn>     52.6   62.4 
 5 wt       <fn>      2.41   3.77
 6 qsec     <fn>     17.4   18.2 
 7 vs       <fn>      1      0   
 8 am       <fn>      1      0   
 9 gear     <fn>     57     61   
10 carb     <fn>      8      4

    E sem nenhum group_by, podemos simplesmente fazer:

    lookup_table %>%
  rowwise() %>%
  mutate(result=exec(summ_fn, mtcars[,variable]))

# A tibble: 10 × 3
# Rowwise: 
   variable summ_fn  result
   <chr>    <list>    <dbl>
 1 mpg      <fn>     20.1  
 2 disp     <fn>    472    
 3 hp       <fn>     52    
 4 drat     <fn>    115.   
 5 wt       <fn>      3.22 
 6 qsec     <fn>     17.8  
 7 vs       <fn>      0    
 8 am       <fn>      0.406
 9 gear     <fn>    118    
10 carb     <fn>      8
    • 3

  5. Aqui está outra opção base R, usando by+Map

    with(
  lookup_table,
    do.call(
      rbind,
      by(
        mtcars[variable],
        mtcars$cyl,
        \(x) as.data.frame(
          Map(\(f, y) f(y), summ_fn, x),
          col.names = variable
      )
    ),
  )
)

    o que dá

           mpg  disp  hp  drat       wt     qsec vs        am gear carb
4 26.66364 146.7  52 44.78 2.285727 19.13727  1 0.7272727   45    2
6 19.74286 258.0 105 25.10 3.117143 17.97714  1 0.4285714   27    6
8 15.10000 472.0 150 45.21 3.999214 16.77214  0 0.1428571   46    8
    • 1

relate perguntas