映射数据框列表并应用自定义变异函数（purrr，dplyr）答案

【问题标题】：Map over list of dataframes and apply custom mutate-function (purrr, dplyr)映射数据框列表并应用自定义变异函数（purrr，dplyr）
【发布时间】：2021-09-06 01:04:13
【问题描述】：

所以我有这个清单：

list(`0` = structure(list(fn = 0L, fp = 34L, tn = 0L, tp = 34L), row.names = c(NA, 
-1L), class = c("tbl_df", "tbl", "data.frame")), `0.1` = structure(list(
    fn = 1L, fp = 26L, tn = 8L, tp = 33L), row.names = c(NA, 
-1L), class = c("tbl_df", "tbl", "data.frame")), `0.2` = structure(list(
    fn = 3L, fp = 22L, tn = 12L, tp = 31L), row.names = c(NA, 
-1L), class = c("tbl_df", "tbl", "data.frame")), `0.3` = structure(list(
    fn = 5L, fp = 7L, tn = 27L, tp = 29L), row.names = c(NA, 
-1L), class = c("tbl_df", "tbl", "data.frame")), `0.4` = structure(list(
    fn = 5L, fp = 3L, tn = 31L, tp = 29L), row.names = c(NA, 
-1L), class = c("tbl_df", "tbl", "data.frame")), `0.5` = structure(list(
    fn = 7L, fp = 1L, tn = 33L, tp = 27L), row.names = c(NA, 
-1L), class = c("tbl_df", "tbl", "data.frame")), `0.6` = structure(list(
    fn = 8L, fp = 0L, tn = 34L, tp = 26L), row.names = c(NA, 
-1L), class = c("tbl_df", "tbl", "data.frame")), `0.7` = structure(list(
    fn = 8L, fp = 0L, tn = 34L, tp = 26L), row.names = c(NA, 
-1L), class = c("tbl_df", "tbl", "data.frame")), `0.8` = structure(list(
    fn = 8L, fp = 0L, tn = 34L, tp = 26L), row.names = c(NA, 
-1L), class = c("tbl_df", "tbl", "data.frame")), `0.9` = structure(list(
    fn = 30L, fp = 0L, tn = 34L, tp = 4L), row.names = c(NA, 
-1L), class = c("tbl_df", "tbl", "data.frame")), `1` = structure(list(
    fn = 34L, fp = 0L, tn = 34L, tp = 0L), row.names = c(NA, 
-1L), class = c("tbl_df", "tbl", "data.frame")))

当我为 10 个不同的分位数应用分位数回归模型时，它基本上是一个长度为 10 的列表。每个元素都是一个包含真/假正/负计数的数据框。现在我想编写一个函数，我可以在其中“动态”计算可以使用这些计数计算的各种指标。例如，第一个元素如下所示：

> cms[[1]]
# A tibble: 1 x 4
     fn    fp    tn    tp
  <int> <int> <int> <int>
1     0    34     0    34

因为它是一个列表，所以我真的很想用purrr 的map 或lapply 或类似的东西做点什么。然后我想：总有一天我想要真正的阳性率，有一天我可能想要特异性。因此，我想我会编写一个函数，它可以将一些列作为输入并执行“经典”dplyr::mutate。但是我再一次被我关于整洁评估的知识所困扰。所以我做了这样的事情（请不要评判）：

fun = function(...){
  f = rlang::enexpr(...)
  return(f)
}

fpr = fun(tp / tp + fn)

# does not work
map(cms, ~mutate(.x, fpr=fpr)) 

# this (non-tidy-eval) works
map(cms, ~mutate(.x, fpr=tp / tp + fn))

我真的很想动态地传入列并使用 tidy-evaluation 计算结果。因此，我将不胜感激任何帮助或指针:)

【问题讨论】：

您的数据保留数据框列表是否有原因？整洁的动词对于嵌套的数据结构总是很尴尬；处理此类数据的更惯用方法是将数据帧绑定在一起（添加quantile 列以识别行的来源）并使用正常的变异函数。即使您需要列表中的数据，这样做可能更容易，然后使用split() 或group_split() 恢复原始结构。
非常感谢！我会尝试采用这种方法:)

标签： r dplyr purrr rlang tidyeval

【解决方案1】：

您也可以使用以下解决方案。

首先，我们必须定义一个接受数据集和多个参数的函数。我们为我们的数据集显式使用data 参数，并通过... 捕获所有其他参数
然后我们使用enquos 函数返回一个引用函数列表来化解我们通过... 捕获的表达式，并强制使用大爆炸运算符!!! 对其进行评估，该运算符通常用于拼接参数列表中的参数列表我们的数据集 data 到 tidy_eval 函数的上下文
然后我们遍历列表中的每个元素，并将我们的函数应用于每个元素，同时评估我们想要的表达式

library(rlang)

fn <- function(data, ...) {
  args <- enquos(...)
  
  data %>%
    mutate(out = eval_tidy(!!!args, data = data))
}

df %>%
  map_dfr(~ .x %>% fn(tp / (tp + fn)))

# A tibble: 11 x 5
      fn    fp    tn    tp   out
   <int> <int> <int> <int> <dbl>
 1     0    34     0    34 1    
 2     1    26     8    33 0.971
 3     3    22    12    31 0.912
 4     5     7    27    29 0.853
 5     5     3    31    29 0.853
 6     7     1    33    27 0.794
 7     8     0    34    26 0.765
 8     8     0    34    26 0.765
 9     8     0    34    26 0.765
10    30     0    34     4 0.118
11    34     0    34     0 0

【讨论】：

这就是我要找的东西！非常非常感谢你！！现在我只需要了解这里发生了什么:)
@Lenn 不客气。有关更多信息，您可以从阅读 ?rlang::nse-force 或 tidyeval.tidyverse.org/multiple.html 开始，它们确实帮助我理解了它。
非常感谢！！

【解决方案2】：

我不确定我是否理解正确，但您可以这样定义参数计算：

fpr <- \(...) with(list(...), tp / (tp + fn))

然后定义一个辅助函数：

add_param <- \(f, ...) tibble::tibble(..., "{substitute(f)}" := f(...))

最后，通过pmap()调用它：

library(purrr)

cms %>%
  dplyr::bind_rows() %>%
  pmap_dfr(add_param, fpr)

# A tibble: 11 x 5
      fn    fp    tn    tp   fpr
   <int> <int> <int> <int> <dbl>
 1     0    34     0    34 1    
 2     1    26     8    33 0.971
 3     3    22    12    31 0.912
 4     5     7    27    29 0.853
 5     5     3    31    29 0.853
 6     7     1    33    27 0.794
 7     8     0    34    26 0.765
 8     8     0    34    26 0.765
 9     8     0    34    26 0.765
10    30     0    34     4 0.118
11    34     0    34     0 0

（使用的数据：）

cms <- list(`0` = structure(list(fn = 0L, fp = 34L, tn = 0L, tp = 34L), row.names = c(NA, -1L), class = c("tbl_df", "tbl", "data.frame")), `0.1` = structure(list( fn = 1L, fp = 26L, tn = 8L, tp = 33L), row.names = c(NA, -1L), class = c("tbl_df", "tbl", "data.frame")), `0.2` = structure(list( fn = 3L, fp = 22L, tn = 12L, tp = 31L), row.names = c(NA, -1L), class = c("tbl_df", "tbl", "data.frame")), `0.3` = structure(list( fn = 5L, fp = 7L, tn = 27L, tp = 29L), row.names = c(NA, -1L), class = c("tbl_df", "tbl", "data.frame")), `0.4` = structure(list( fn = 5L, fp = 3L, tn = 31L, tp = 29L), row.names = c(NA, -1L), class = c("tbl_df", "tbl", "data.frame")), `0.5` = structure(list( fn = 7L, fp = 1L, tn = 33L, tp = 27L), row.names = c(NA, -1L), class = c("tbl_df", "tbl", "data.frame")), `0.6` = structure(list( fn = 8L, fp = 0L, tn = 34L, tp = 26L), row.names = c(NA, -1L), class = c("tbl_df", "tbl", "data.frame")), `0.7` = structure(list( fn = 8L, fp = 0L, tn = 34L, tp = 26L), row.names = c(NA, -1L), class = c("tbl_df", "tbl", "data.frame")), `0.8` = structure(list( fn = 8L, fp = 0L, tn = 34L, tp = 26L), row.names = c(NA, -1L), class = c("tbl_df", "tbl", "data.frame")), `0.9` = structure(list( fn = 30L, fp = 0L, tn = 34L, tp = 4L), row.names = c(NA, -1L), class = c("tbl_df", "tbl", "data.frame")), `1` = structure(list( fn = 34L, fp = 0L, tn = 34L, tp = 0L), row.names = c(NA, -1L), class = c("tbl_df", "tbl", "data.frame")))

【讨论】：

【解决方案3】：

您还可以使用switch() 创建更通用的函数并控制流程。您可以根据需要添加更多措施。在下面的简单示例中，输入可以是列表列中的数据框或四列数字。

library(tidyverse)

my_fun_1 <- function(dat, measure = c("fp_rate", "fn_rate")) {
  switch(
    measure,
    fp_rate = dat[["fp"]] / (dat[["fp"]] + dat[["tn"]]),
    fn_rate = dat[["fn"]] / (dat[["fn"]] + dat[["tp"]])
  )
}

dat1 <- dat %>%
  enframe() %>%
  rowwise() %>%
  mutate(
    fnr = my_fun_1(value, "fn_rate"),
    fpr = my_fun_1(value, "fp_rate"),
  ) %>%
  ungroup()

dat1

# # A tibble: 11 x 4
#    name  value               fnr    fpr
#    <chr> <list>            <dbl>  <dbl>
#  1 0     <tibble [1 x 4]> 0      1
#  2 0.1   <tibble [1 x 4]> 0.0294 0.765
#  3 0.2   <tibble [1 x 4]> 0.0882 0.647
# <Omitted>

my_fun_2 <- function(fn, fp, tn, tp, measure = c("fp_rate", "fn_rate")) {
  switch(measure,
    fp_rate = fp / (fp + tn),
    fn_rate = fn / (fn + tp)
  )
}

dat2 <- dat %>%
  bind_rows(.id = "quantile") %>%
  mutate(
    fnr = my_fun_2(fn, fp, tn, tp, "fn_rate"),
    fpr = my_fun_2(fn, fp, tn, tp, "fp_rate")
  )

dat2

# # A tibble: 11 x 7
#    quantile    fn    fp    tn    tp    fnr    fpr
#    <chr>    <int> <int> <int> <int>  <dbl>  <dbl>
#  1 0            0    34     0    34 0      1
#  2 0.1          1    26     8    33 0.0294 0.765
#  3 0.2          3    22    12    31 0.0882 0.647
# <Omitted>

【讨论】：