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?
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