r - 让函数接受参数列表列

Question

与Pass a list of lists of unquoted character parameters to an apply/map/pmap call相关.

我有一个看起来像这样的函数:

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

我想调整模型中的某些变量，所以我 bind_cols 额外的协变量:

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

并运行模型:

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

我收到一个错误:

Error in eval(predvars, data, env) : object 'vs' not found

Answer 1

我们可以使用

library(purrr)
out <- param_dat %>%
         slice_head(n = 2) %>%
         pmap(., ~ invoke(causal_med_so, ..1, ..2, ..3, ..4, ..5))
Running nonparametric bootstrap

Running nonparametric bootstrap

-结构

> str(out)
List of 2
 $ :List of 56
  ..$ d0           : num -0.0631
  ..$ d1           : num -0.0631
  ..$ d0.ci        : Named num [1:2] -0.14458 -0.00145
  .. ..- attr(*, "names")= chr [1:2] "1.777555%" "96.54248%"
  ..$ d1.ci        : Named num [1:2] -0.14458 -0.00145
  .. ..- attr(*, "names")= chr [1:2] "1.777555%" "96.54248%"
  ..$ d0.p         : num 0.062
  ..$ d1.p         : num 0.062
  ..$ d0.sims      : num [1:1000, 1] -0.0135 -0.0658 -0.1265 -0.1003 -0.0049 ...
  ..$ d1.sims      : num [1:1000, 1] -0.0135 -0.0658 -0.1265 -0.1003 -0.0049 ...
  ..$ z0           : num -0.0799
  ..$ z1           : num -0.0799
  ..$ z0.ci        : Named num [1:2] -0.2338 0.0353
  .. ..- attr(*, "names")= chr [1:2] "2.142035%" "97.09108%"
  ..$ z1.ci        : Named num [1:2] -0.2338 0.0353
  .. ..- attr(*, "names")= chr [1:2] "2.142035%" "97.09108%"
  ..$ z0.p         : num 0.224
  ..$ z1.p         : num 0.224
  ..$ z0.sims      : num [1:1000, 1] -0.1527 -0.0219 0.0202 -0.0953 -0.1865 ...
  ..$ z1.sims      : num [1:1000, 1] -0.1527 -0.0219 0.0202 -0.0953 -0.1865 ...
  ..$ n0           : num 0.441
  ..$ n1           : num 0.441
  ..$ n0.ci        : Named num [1:2] 0.0806 2.7754
  .. ..- attr(*, "names")= chr [1:2] "7.723976%" "99.76811%"
  ..$ n1.ci        : Named num [1:2] 0.0806 2.7754
...