假设我有以下数据框:

library(tidyverse)
fit <- lm(speed ~ dist, data = cars)
select(broom::augment(fit), .fitted:.std.resid) -> dt
names(dt) <- substring(names(dt), 2)


我想使用purrr创建一个残差图网格。例如,到目前为止,我有2个诊断图的公式:

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


我将公式存储在计划针对强化数据集dt运行的列表中。

formulas <- tibble(charts = list(residual, stdResidual))
# A tibble: 2 x 1
  charts
  <list>
1  <fun>
2  <fun>


现在,我需要将dt传递给chart中列formulas的每个元素。实际上,我也在尝试使用gridExtra将两者结合起来,但是现在,如果我至少可以同时渲染它们两者,我将感到满意。我想我应该像

pwalk(list(dt, formulas), ???)


但是我不知道我应该在???中使用什么功能来绘制曲线。

最佳答案

像上面一样,设置函数来绘制每个图:

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


然后,以数据框为第二个参数,在列表中调用每个参数。在这里,您正在invoke函数列表,并将它们并行应用于函数参数列表。由于第二个列表只有一个元素,因此invoke_map循环遍历它们。

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


r - 使用purrr和ggplot创建残差图矩阵-LMLPHP

07-24 09:51
查看更多