Как применить функцию, которая принимает фрейм данных в качестве ввода с purrr

Question

С такими данными:

df <- tibble(x = runif(200), y = runif(200, 0, 3), is_active = sample(c(0, 1), size = 200, replace = TRUE, prob = c(0.2, 0.8)), 
             var1 = sample(c(0, 1), 200, TRUE), var2 = sample(c(0, 1), 200, TRUE))

# A tibble: 6 x 5
       x     y is_active  var1  var2
   <dbl> <dbl>     <dbl> <dbl> <dbl>
1 0.0812 2.42          0     0     0
2 0.313  1.61          0     1     1
3 0.241  2.90          1     0     0
4 0.906  1.08          1     0     1
5 0.652  2.86          0     0     0
6 0.231  0.730         1     1     0
...

Я хочу рассчитать долю столбца is_active только для тех наблюдений, где var1==1, а затем для тех, где var2==1 et c. Я написал функцию, которая применима к одной переменной:

f <- function(df, var){
  var <- ensym(var)

  df %>%
    filter(!!var == 1) %>%
    mutate(xcut = cut(x, breaks = 10),
           ycut = cut(y, breaks = 20)) %>%
    group_by(xcut, ycut) %>%
    summarise(!!paste(var, 'proportion', sep = '_') := mean(is_active)) %>%
    ungroup()

}

И вызов ее, как показано ниже, прекрасно работает:

f(df, var1)
f(df, var2)

Проблема в том, что у меня есть сотни столбцов, таких как var1 и var2, и я хотел бы перебрать все из них, рассчитав определенную пропорцию is_active для каждого из них. map_at(df, vars(var1, var2), f) здесь не работает, так как применяется к последующим столбцам (векторам) и не принимает весь фрейм данных в качестве входных данных для каждого вызова. Как мне этого добиться, желательно с пакетом purrr?

Answer 1

Вы можете передать ввод вашей функции в виде строки и немного изменить функцию следующим образом:

library(tidyverse)

f <- function(df, var){

   df %>%
    filter(!!sym(var) == 1) %>%
    mutate(xcut = cut(x, breaks = 10),
           ycut = cut(y, breaks = 20)) %>%
    group_by(xcut, ycut) %>%
    summarise(!!paste(var, 'proportion', sep = '_') := mean(is_active)) %>%
    ungroup()  
}

затем вы можете сделать

map(c('var1', 'var2'), f, df = df)

#[[1]]
# A tibble: 2 x 3
#  xcut          ycut          var1_proportion
#  <fct>         <fct>                   <dbl>
#1 (0.231,0.239] (0.729,0.774]               1
#2 (0.305,0.313] (1.57,1.61]                 0

#[[2]]
# A tibble: 2 x 3
#  xcut          ycut        var2_proportion
#  <fct>         <fct>                 <dbl>
#1 (0.312,0.372] (1.58,1.61]               0
#2 (0.847,0.907] (1.08,1.11]               1

Answer 2

Я бы сделал что-то вроде этого

calc_pct_isactive <- function(df, regex_col = "^var") {
    require(tidyverse)

    df %>% 
        pivot_longer(cols = matches(regex_col)) %>%
        group_by(is_active, name, value) %>%
        tally(name = "count") %>% 
        group_by(is_active, name) %>%
        mutate(base = sum(count,na.rm = TRUE),
             pct = count/base) %>%
        filter(is_active ==1, value ==1)

}
calc_pct_isactive(df)