Search code examples
rtry-catchsapply

Skip to the next level in sapply function when error occurs


I have a nested function using sapply() that I run over sets of interaction variables and outcome variables. These functions create plots that I then save. The modelling works perfectly, accept in some cases a particular variable cannot be predicted due to a lack of data availability, insufficient factor levels, etc. I need to skip over these variables that cannot generate models, as currently as soon as the error is reached, the function is haulted and the remaining plots cannot be generated.

My code looks like the following, adapted for the mtcars dataset:


library(tidyverse)
library(marginaleffects)

outcome_var_list = c("mpg","cyl","wt","hp")
interact_var_list =  c("gear","am","wt")
  
iterate <- sapply(outcome_var_list,function(k){

outcome_var_list = outcome_var_list[outcome_var_list == k] 

results = list()
  for (r in interact_var_list) {
    f = paste(k, "~", r, "*factor(vs)")
    m = lm(f, subset(mtcars, carb %in% c(1,2,3,4)))
    s = plot_slopes(m, variables = r, condition = "vs", draw = FALSE)
    tmp = s[, c("estimate", "conf.low", "conf.high", "vs")]
    tmp$outcome = k
    tmp$regressor = r
    results = c(results, list(tmp))
  }
results = do.call("rbind", results)  


plot1 = results %>% 
  mutate(min = min(conf.low), max = max(conf.high)) %>% 
  ggplot(aes(x=factor(vs), 
             y=estimate, 
             color = regressor, 
             ymin=conf.low, 
             ymax=conf.high)) + 
  geom_errorbar(position = position_dodge(0.4)) + 
  geom_point(position = position_dodge(0.4)) + 
  scale_x_discrete(expand = c(0,0)) + 
  theme_light() + 
  ggtitle(label = paste0("Model 1: ",k)) + 
  theme(plot.title = element_text(hjust = 0.5)) + 
  labs(y= "Interaction Coefficient", x = "X") + 
  theme(plot.title = element_textbox_simple(vjust=-1)) +
  theme(plot.margin = margin(2,0,0,0, "cm")) + 
  theme(axis.text.x = element_text(size = 5))

  ggsave(plot1,file=paste0("plot_",k,".png"))

})

In this code, I include wt as a variable in outcome_var_list to intentionally generate an error. wt cannot be predicted because the variable cannot be an outcome and interaction variable. Note that this is not the error in my original data. If this were the case I could simply filter this out, but unfortunately the variable combinations in my true data are so extensive that they cannot be filtered manually. Therefore, I intend to use something generic to catch all errors in the functions, and skip to the next variable in outcome_var_list, regardless of why the given outcome variable does not work.

When the above code is run, plots for mpg and cyl are generated, but the final two plots are not. wt should not be generated as this is impossible, but hp can be predicted and should be accepted.

How can I skip over levels that generate errors, and produce all remaining plots? The errors are only specific to variables in outcome_var_list, not interact_var_list, if that helps. I have seen elsewhere suggestions of using tryCatch, but these all appear very case specific. Is there a general error catching approach I can implement in this code to skip any errors?


Solution

  • For a minimal change, you could wrap the function with purrr::safely() to capture errors:

    library(tidyverse)
    library(marginaleffects)
    
    outcome_var_list = c("mpg","cyl","wt","hp")
    interact_var_list =  c("gear","am","wt")
    
    model_ <- function(k){
      
      outcome_var_list = outcome_var_list[outcome_var_list == k] 
      
      results = list()
      for (r in interact_var_list) {
        f = paste(k, "~", r, "*factor(vs)")
        m = lm(f, subset(mtcars, carb %in% c(1,2,3,4)))
        s = plot_slopes(m, variables = r, condition = "vs", draw = FALSE)
        tmp = s[, c("estimate", "conf.low", "conf.high", "vs")]
        tmp$outcome = k
        tmp$regressor = r
        results = c(results, list(tmp))
      }
      results = do.call("rbind", results)  
      
      
      plot1 = results %>% mutate(min = min(conf.low), max = max(conf.high)) %>% 
        ggplot(aes(x=factor(vs), y=estimate, color = regressor, ymin=conf.low, ymax=conf.high)) + 
        geom_errorbar(position = position_dodge(0.4)) + geom_point(position = position_dodge(0.4))
      
      ggsave(plot1,file=paste0("plot_",k,".png"))
      
    }
    
    safe_model <- safely(model_)
    iterate <- sapply(outcome_var_list,safe_model)
    #> Saving 7 x 5 in image
    #> Saving 7 x 5 in image
    #> Warning in model.matrix.default(mt, mf, contrasts): the response appeared on
    #> the right-hand side and was dropped
    #> Warning in model.matrix.default(mt, mf, contrasts): problem with term 1 in
    #> model.matrix: no columns are assigned
    #> Saving 7 x 5 in image
    
    iterate
    #>        mpg            cyl            wt            hp           
    #> result "plot_mpg.png" "plot_cyl.png" NULL          "plot_hp.png"
    #> error  NULL           NULL           simpleError,2 NULL
    
    list.files(pattern = "^plot_.*png$")
    #> [1] "plot_cyl.png" "plot_hp.png"  "plot_mpg.png"
    

    Created on 2023-08-02 with reprex v2.0.2