сопоставить столбцы и применить пользовательскую функцию

Question

Пропустил что-то маленькое здесь и изо всех сил пытался передать столбцы для работы. Я просто хочу map (или lapply) над столбцами и выполнять пользовательские функции для каждого из столбцов. Минимальный пример здесь:

library(tidyverse)
set.seed(10)
df <- data.frame(id = c(1,1,1,2,3,3,3,3),
                    r_r1 = sample(c(0,1), 8, replace =  T),
                    r_r2 = sample(c(0,1), 8, replace =  T),
                    r_r3 = sample(c(0,1), 8, replace =  T))
df
#   id r_r1 r_r2 r_r3
# 1  1    0    0    1
# 2  1    0    0    1
# 3  1    1    0    1
# 4  2    1    1    0
# 5  3    1    0    0
# 6  3    0    0    1
# 7  3    1    1    1
# 8  3    1    0    0

функция только для фильтрации и подсчета уникальных идентификаторов, оставшихся в наборе данных:

cnt_un <-  function(var) {
  df %>% 
    filter({{var}} == 1) %>% 
    group_by({{var}}) %>% 
    summarise(n_uniq = n_distinct(id)) %>% 
    ungroup()
}

она работает вне карты

cnt_un(r_r1)
# A tibble: 1 x 2
   r_r1 n_uniq
  <dbl>  <int>
1     1      3

Я хочу применить функцию ко всем r_r столбцам, чтобы получить что-то вроде:

df2
#      y n_uniq
# 1 r_r1      3
# 2 r_r2      2
# 3 r_r3      2

Я думал, что следующее будет работать, но не

map(dplyr::select(df, matches("r_r")), ~ cnt_un(.x))

какие-либо предложения? спасибо

Answer 1

Я не уверен, есть ли прямой способ сделать это с чем-то вроде map. Проблема, с которой вы сталкиваетесь, заключается в том, что при вызове map(df, *whatever_function*) функция вызывается для каждого столбца df как вектор, тогда как ваша функция ожидает пустое имя столбца в стиле tidyeval. Чтобы убедиться, что:

map(df, class)

вернет "numeric" для каждого столбца.

Альтернативой является перебор имен столбцов в виде строк и преобразование их в символы; это займет всего одну дополнительную строку в функции.

library(dplyr)
library(tidyr)
library(purrr)

cnt_un_name <- function(varname) {
  var <- ensym(varname)
  df %>% 
    filter({{var}} == 1) %>% 
    group_by({{var}}) %>% 
    summarise(n_uniq = n_distinct(id)) %>% 
    ungroup()
}

Вызов функции немного неловкий, потому что он сохраняет только имена соответствующих столбцов (вызов "r_r1" возвращает столбцы "r_r1" и "n_uniq", и др c). Одним из способов является получение нужного вектора имен столбцов, присвойте ему имя, чтобы можно было добавить столбец идентификатора в map_dfr и удалить дополнительные столбцы, поскольку они будут в основном NA.

grep("^r_r\\d+", names(df), value = TRUE) %>%
  set_names() %>%
  map_dfr(cnt_un_name, .id = "y") %>%
  select(y, n_uniq)
#> # A tibble: 3 x 2
#>   y     n_uniq
#>   <chr>  <int>
#> 1 r_r1       3
#> 2 r_r2       2
#> 3 r_r3       2

Лучший способ - вызвать функцию, а затем выполнить привязку после изменения формы.

grep("^r_r\\d+", names(df), value = TRUE) %>%
  map(cnt_un_name) %>%
  map_dfr(pivot_longer, 1, names_to = "y") %>%
  select(y, n_uniq)
# same output as above

В качестве альтернативы (и, возможно, лучше / более масштабируемой) можно было бы сделать переименование столбца внутри определения функции.

Answer 2

Вот базовое решение R, которое использует lapply. Сложность в том, что ваша функция на самом деле не работает на отдельных столбцах; он также использует id, поэтому вы не можете использовать стандартные функции, которые выполняют итерации по столбцам.

do.call(rbind, lapply(grep("r_r", colnames(df), value = TRUE), function(i) {

  X <- subset(df, df[,i] == 1)

  row <- data.frame(y = i, n_uniq = length(unique(X$id)), stringsAsFactors = FALSE)

}))

     y n_uniq
1 r_r1      2
2 r_r2      3
3 r_r3      2

Answer 3

Вот еще одно решение. Я изменил синтаксис вашей функции. Теперь вы указываете шаблон столбцов, которые хотите выбрать.

cnt_un <-  function(var_pattern) {
  df %>%
    pivot_longer(cols = contains(var_pattern), values_to = "vals", names_to = "y") %>%
    filter(vals == 1) %>%
    group_by(y) %>%
    summarise(n_uniq = n_distinct(id)) %>% 
    ungroup()
}

cnt_un("r_r")
#> # A tibble: 3 x 2
#>   y     n_uniq
#>   <chr>  <int>
#> 1 r_r1       2
#> 2 r_r2       3
#> 3 r_r3       2