はpurrr使用して残留プロットの行列を作成し、ggplot

Question

は、私は、次のデータフレームがあるとします。

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

私はpurrrを使用して残差プロットのグリッドを作成したいと思います。

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に対して実行することを計画し、リスト内の数式を格納しています：例えば、私はこれまで2つの診断プロットのための式を有します。

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

今、私は列formulasでchartの各要素にdtを渡す必要があります。私は実際には両方ともgridExtraを使用して結合しようとしていますが、少なくとも両者をレンダリングできれば満足できます。私は

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

ような何かを実行すべきだと思うしかし、私はプロットをレンダリングするために???で使用すべきかの機能は考えています。

Answer 1

は、あなたが上やったように、それぞれ1をプロットする機能を設定します。

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

次に、あなたの第二引数としてデータフレームと、リスト内の各を呼び出します。ここでは関数リストを作成し、関数引数のリストにそれらを並列に適用しています。 2番目のリストには1つの要素しかないので、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)))