将未加引号的字符参数列表的列表传递给 apply/map/pmap 调用

Question

我创建了一个函数来进行某种类型的分析：

library(tidyverse)
library(mediation)

causal_med_so <- function(predictor, mediator, outcome, data, ...){
  
  if(!missing(...)) {
    data <- {{data}} %>%
      dplyr::select({{predictor}}, {{mediator}}, {{outcome}}, ...) %>% 
      dplyr::filter(across(.cols = everything(), .fns = ~ !is.na(.)))
    
    predictor <- enquo(predictor)
    mediator <- enquo(mediator)
    outcome <- enquo(outcome)
    
    med.form <- formula(paste0(
      quo_name(mediator), "~",
      paste0(
        quo_name(predictor), "+",
        paste0(c(...), collapse = "+"), 
        collapse = "+"
      )
    ))
    
    med.fit <- eval(bquote(lm(.(med.form), data = data)))
    
    out.form <- formula(paste0(quo_name(outcome), "~",
                               paste0(
                                 quo_name(predictor), "+",
                                 quo_name(mediator), "+",
                                 paste0(c(...), collapse = "+"),
                                 collapse = "+"
                               )))
    
    out.fit <- eval(bquote(lm(.(out.form), data = data)))
    
    med.out <- mediation::mediate(med.fit, out.fit,
                                  treat = quo_name(predictor),
                                  mediator = quo_name(mediator),
                                  boot=T, boot.ci.type = "bca")
    return(med.out)
  } else {
    data <- {{data}} %>%
      dplyr::select({{predictor}}, {{mediator}}, {{outcome}}) %>% 
      dplyr::filter(across(.cols = everything(), .fns = ~ !is.na(.)))
    
    predictor <- enquo(predictor)
    mediator <- enquo(mediator)
    outcome <- enquo(outcome)
    
    med.form <- formula(paste0(quo_name(mediator), "~", quo_name(predictor)))
    
    med.fit <- eval(bquote(lm(.(med.form), data = data)))
    
    out.form <- formula(paste0(quo_name(outcome), "~",
                               quo_name(predictor), "+", quo_name(mediator)))
    
    out.fit <- eval(bquote(lm(.(out.form), data = data)))
    
    med.out <- mediation::mediate(med.fit, out.fit,
                                  treat = quo_name(predictor),
                                  mediator = quo_name(mediator),
                                  boot=T, boot.ci.type = "bca")
    return(med.out)
  }
}

函数似乎按预期运行：

 causal_med_so(mpg, cyl, qsec, mtcars)

我现在想在 apply/map/pmap 调用中使用此函数，以所有可能的组合一次调用运行许多模型：

param_list <- list(
  predictor = c("mpg", "cyl"),
  mediator = c("drat", "disp", "wt", "cyl"),
  outcome = c("qsec", "gear", "carb", "hp"),
  data = c("mtcars")
) %>%
  cross()

我正在尝试做这样的事情：

lmap(param_list, causal_med_so)
lapply(param_list, causal_med_so)

但是我遇到了一些错误消息，提示列表元素被视为字符。我尝试了 noquote()、syms()、!!!syms() 的几种组合，但似乎无法找到解决方案。

Answer 1

因为这些是字符串，所以最好转换为 symbol 并计算 (!!)（为了测试，只使用 'param_dat' 的前两行（更改为 cross 到 cross_df 从而 return a tibble)

causal_med_so <- function(predictor, mediator, outcome, data, ...){
  predictor <- rlang::ensym(predictor)
  mediator <- rlang::ensym(mediator)
  outcome <- rlang::ensym(outcome)
 
 
 if(!missing(...)) {
     data <- get(data, envir = .GlobalEnv) %>%
       dplyr::select(!!predictor, !!mediator, !!outcome, ...) %>% 
       dplyr::filter(across(.cols = everything(), .fns = ~ !is.na(.)))
    
     predictor <- enquo(predictor)
     mediator <- enquo(mediator)
     outcome <- enquo(outcome)
    
     med.form <- formula(paste0(
       quo_name(mediator), "~",
       paste0(
         quo_name(predictor), "+",
         paste0(c(...), collapse = "+"), 
         collapse = "+"
       )
     ))
    
     med.fit <- eval(bquote(lm(.(med.form), data = data)))
    
     out.form <- formula(paste0(quo_name(outcome), "~",
                                paste0(
                                  quo_name(predictor), "+",
                                  quo_name(mediator), "+",
                                  paste0(c(...), collapse = "+"),
                                  collapse = "+"
                                )))
    
     out.fit <- eval(bquote(lm(.(out.form), data = data)))
    
     med.out <- mediation::mediate(med.fit, out.fit,
                                   treat = quo_name(predictor),
                                   mediator = quo_name(mediator),
                                   boot=T, boot.ci.type = "bca")
     return(med.out)
   } else {
 
    data <- get(data, envir = .GlobalEnv) %>%
      dplyr::select(!!predictor, !!mediator, !!outcome) %>% 
      dplyr::filter(across(.cols = everything(), .fns = ~ !is.na(.)))
    
    
    
  med.form <- formula(paste0(quo_name(mediator), "~", quo_name(predictor)))
  
  med.fit <- eval(bquote(lm(.(med.form), data = data)))
  
  out.form <- formula(paste0(quo_name(outcome), "~",
                             quo_name(predictor), "+", quo_name(mediator)))
  
  out.fit <- eval(bquote(lm(.(out.form), data = data)))
  
  med.out <- mediation::mediate(med.fit, out.fit,
                                treat = quo_name(predictor),
                                mediator = quo_name(mediator),
                                boot=T, boot.ci.type = "bca")
  return(med.out)
  }
  
  


}

-测试

param_dat <- list(
  predictor = c("mpg", "cyl"),
  mediator = c("drat", "disp", "wt", "cyl"),
  outcome = c("qsec", "gear", "carb", "hp"),
  data = c("mtcars")
)    %>% cross_df

out <- param_dat %>%
        slice_head(n = 2)%>%
     pmap(., causal_med_so)
Running nonparametric bootstrap

Running nonparametric bootstrap

-输出

> str(out)
List of 2
 $ :List of 56
  ..$ d0           : num -0.0731
  ..$ d1           : num -0.0731
  ..$ d0.ci        : Named num [1:2] -0.1545 0.0325
  .. ..- attr(*, "names")= chr [1:2] "3.053716%" "97.96547%"
  ..$ d1.ci        : Named num [1:2] -0.1545 0.0325
  .. ..- attr(*, "names")= chr [1:2] "3.053716%" "97.96547%"
  ..$ d0.p         : num 0.158
  ..$ d1.p         : num 0.158
  ..$ d0.sims      : num [1:1000, 1] -0.0181 -0.0445 -0.0792 -0.1008 -0.088 ...
  ..$ d1.sims      : num [1:1000, 1] -0.0181 -0.0445 -0.0792 -0.1008 -0.088 ...
  ..$ z0           : num 0.197
  ..$ z1           : num 0.197
  ..$ z0.ci        : Named num [1:2] 0.0461 0.3122
  .. ..- attr(*, "names")= chr [1:2] "1.787667%" "96.56288%"
  ..$ z1.ci        : Named num [1:2] 0.0461 0.3122
  .. ..- attr(*, "names")= chr [1:2] "1.787667%" "96.56288%"
...

将未加引号的字符参数列表的列表传递给 apply/map/pmap 调用

Pass a list of lists of unquoted character parameters to an apply/map/pmap call

r

apply

lapply

purrr

tidyeval