映射列并应用自定义函数答案

【问题标题】：map over columns and apply custom function映射列并应用自定义函数
【发布时间】：2020-01-14 12:47:03
【问题描述】：

这里缺少一些小东西，并且难以将列传递给函数。我只想在列上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

一个仅用于过滤和计算数据集中剩余唯一 ID 的函数：

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))

有什么建议吗？谢谢

【问题讨论】：

标签： r dplyr purrr

【解决方案1】：

我不确定是否有直接的 tidyeval 方法可以使用 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" 等）。一种方法是获取您想要的列名向量，为其命名以便您可以在 map_dfr 中添加一个 ID 列，然后删除额外的列，因为它们主要是 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

更好的方法是调用函数，然后在reshaping后绑定。

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

或者（也许更好/更具可扩展性）是在函数定义中重命名列。

【讨论】：

【解决方案2】：

这是一个使用 lapply 的基本 R 解决方案。棘手的一点是您的函数实际上并没有在单列上运行。它也使用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

【讨论】：

【解决方案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

【讨论】：