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.

akrun · Accepted Answer · 2021-08-27T22:18:56.000

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

Thank you @akrun! FYI the optional function parameters (...) are for possible additional covariates for adjustment (not all models will be adjusted). The idea here is to get the various model outputs in an object and extract/organize relevant parameters for tabular or file output. Cheers! — Raoul Duke, Aug 30 '21 at 15:37
Is there a way to preserve the name of the dataset so it's clear which dataset was used in a particular model call? — Raoul Duke, Aug 30 '21 at 16:02
Thanks @akrun, posted as a new question at https://stackoverflow.com/q/68990144/5745045 — Raoul Duke, Aug 30 '21 at 20:47

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

1 Answers1

Linked