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

Question

I have created a function to do a certain type of analysis:

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

The function appears to work as intended:

 causal_med_so(mpg, cyl, qsec, mtcars) 

I would now like to use this function in an apply/map/pmap call to run many models at once in all possible combinations:

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

I am trying to do something like this:

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

But I am encountering some error messages that suggest the list elements are being treated as characters. I have tried several combinations of noquote(), syms(), !!!syms() but can't quite seem to find a solution.

Answer 1

As these are strings, it is better convert to symbol and evaluate (!!) (For testing, used only the first two rows of 'param_dat' (changed cross to cross_df so as to 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)
  }
  
  


}

-testing

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

-output

> 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%"
...