r - Create a matrix of residual plots using purrr and ggplot -
suppose have following dataframe:
library(tidyverse) fit <- lm(speed ~ dist, data = cars) select(broom::augment(fit), .fitted:.std.resid) -> dt names(dt) <- substring(names(dt), 2)
i create grid of residuals plots using purrr
. example, have formulas 2 diagnostic plots far:
residual <- function(model) {ggplot(model, aes(fitted, resid)) + geom_point() + geom_hline(yintercept = 0) + geom_smooth(se = false)} stdresidual <- function(model) {ggplot(model, aes(fitted, std.resid)) + geom_point() + geom_hline(yintercept = 0) + geom_smooth(se = false)}
and storing formulas in list plan run against fortified dataset dt
.
formulas <- tibble(charts = list(residual, stdresidual)) # tibble: 2 x 1 charts <list> 1 <fun> 2 <fun>
now need pass dt
each element of column chart
in formulas
. trying combine both using gridextra
, satisfied if @ least render both of them. think should run like
pwalk(list(dt, formulas), ???)
but have no idea function should use in ???
render plots.
set functions plot each one, did above:
diagplot_resid <- function(df) { ggplot(df, aes(.fitted, .resid)) + geom_hline(yintercept = 0) + geom_point() + geom_smooth(se = f) + labs(x = "fitted", y = "residuals") } diagplot_stdres <- function(df) { ggplot(df, aes(.fitted, sqrt(.std.resid))) + geom_hline(yintercept = 0) + geom_point() + geom_smooth(se = f) + labs(x = "fitted", y = expression(sqrt("standardized residuals"))) } diagplot_qq <- function(df) { ggplot(df, aes(sample = .std.resid)) + geom_abline(slope = 1, intercept = 0, color = "black") + stat_qq() + labs(x = "theoretical quantiles", y = "standardized residuals") }
then call each in list, dataframe second argument. here you're invoke
ing list of functions, , parallel-ly applying them list of function arguments. since there's 1 element second list, invoke_map
loops on them.
fit <- lm(mpg~wt, mtcars) df_aug <- augment(fit) purrr::invoke_map(.f = list(diagplot_resid, diagplot_stdres, diagplot_qq), .x = list(list(df_aug))) %>% gridextra::grid.arrange(grobs = ., ncol = 2, top = paste("diagnostic plots for", as.expression(fit$call)))
Comments
Post a Comment