ggplot2でfacetごとのヒストグラムに色んな情報を付与する② 〜Tidy evalによる関数化と繰り返し処理〜

概要

前回の続きで、自分用メモです。

mikutaifuku.hatenablog.com

タイトルの通り、Tidy evalにより関数を作り*1、全ての変数に対して処理を繰り返し行います。 要は、以下のようなグラフを Sepal.Width, Petal.Length, Petal.Width 全てに対して作ります。

なお、前提知識として、ブログ下部の「参考」にあるdplyrの基礎知識（使い方）は必要です。「やってみた」系なので、特に有益な情報もないですが、予めご容赦ください。

関数化

データ加工処理

group_var, x_varは、quo()されたもので、関数の中で!!を用いてアンクオートします。他は前回のブログと何も変わりません。

Make_Data <- function(d, group_var, x_var){
    
    df <- d %>% select(x = !!x_var, group = !!group_var)
    
    df_summary <- df %>% 
        group_by(group) %>% 
        summarise(n = n(),
                  mean_x = mean(x),
                  min_x = min(x),
                  max_x = max(x),
                  sd_x =sd(x)) %>% 
        mutate(group_label = paste0(group, " (n = ", n, ")"),
               mean_label = paste0("Mean : ", round(mean_x, 2)),
               sd_label = paste0("SD : ", round(sd_x, 2)),
               min_label = paste0("Min : ", round(min_x, 2)),
               max_label = paste0("Max : ", round(max_x, 2))) %>% 
        mutate(text_label = paste0(mean_label,"\n",sd_label,"\n",min_label,"\n",max_label))
    
    df_plot <- df %>% 
        left_join(df_summary %>% select(group, group_label), by = "group")
    
    return(list(df_plot, df_summary))
}

可視化処理

x_varはquo()されたもので、関数の中で列名だけを使用したいので、quo_name(x_var)により文字列に変換します。他は前回のブログと何も変わりません。

Make_Plot <- function(d_summary, d_plot, x_var){
    
    x_pos <- max(d_summary$max_x)
    y_pos <- Inf
    x_var_name <- quo_name(x_var)
    
    g <- ggplot(d_plot, aes(x)) + 
        theme_minimal() +
        geom_histogram(fill="darkgrey") + 
        geom_vline(data=d_summary, aes(xintercept=mean_x), linetype="dashed", color="darkred") + 
        geom_vline(data=d_summary, aes(xintercept=min_x), linetype="dashed", color="darkred") +
        geom_vline(data=d_summary, aes(xintercept=max_x), linetype="dashed", color="darkred") + 
        geom_text(data=d_summary, aes(x=x_pos, y=y_pos, label=text_label),
                  colour="darkred", inherit.aes=FALSE, vjust="inward", hjust="inward") +
        facet_wrap(~group_label, ncol=1) +
        labs(x=x_var_name)

}

繰り返し処理

以下のようにループ処理すると、冒頭に述べたようなグラフが全ての変数に対して作られます。*2

x_vars <- quos(Sepal.Length, Sepal.Width, Petal.Length, Petal.Width)

for (i in 1:length(x_vars)) {
    
    data_list <- Make_Data(d=iris, x_var=x_vars[[i]], group_var=quo(Species))
    
    df_plot <- data_list[[1]]
    df_summary <- data_list[[2]]
    
    g_x <- Make_Plot(d_summary=df_summary, d_plot=df_plot, x_var=x_vars[[i]])
    
    ggsave(plot = g_x, filename = paste0(quo_name(x_vars[[i]]), ".png"))
    
}

参考

tidyeval.tidyverse.org

さいごに

上記のような処理をする際に、Tidy evalなるものは役立つのではないかと勝手に思っています。 雰囲気で作成したので、間違っていたら、遠慮なくご指摘ください。 また、他に良いやり方があれば、教えてください。

*1:この表現は適切でないかもしれませんが、ご容赦ください

*2:下記のようにループ処理をしなくても、うまく出来る方法があるはず…？