背景

2軸のggplotを使って2値分類器の説明変数の分布を可視化する(カテゴリ変数) の続編
モデルを作成する際、説明変数の分布を確認するかと思う。
分布の確認の方法ついて、あまり記事を見かけないので私の実施している方法をまとめる。

確認対象

目的変数	説明変数
2値	連続変数

サンプルデータ

MASSからデータ取得取得「低体重出生とそのリスク因子の関連」

library(MASS)
df <- birthwt
df <- within(df, {
  low <- factor(low, labels=c("No", "Yes"))
  lwt <- lwt * 0.454
  race <- factor(race, labels=c("White","Black","Other"))
  smoke <- factor(smoke, labels=c("No","Yes"))
  ptl <- factor(ptl)
  ht <- factor(ht, labels=c("No","Yes"))
  ui <- factor(ui, labels=c("No","Yes"))
  ftv <- factor(ftv)
})

確認内容

目的変数ごとにヒストグラムを描く
目的変数ごとに確率密度曲線を描く
連続変数を離散化した結果()を目的変数ごとにヒストグラムを描く
- 手法：カイマージ(Chi-merge)
離散化した結果を用いて、カテゴリ変数を可視化する(前回の方法)
離散化した結果を戻り値として取得

library(ggplot2)
library(dplyr)
library(discretization)

binary_classification_plot_integer <- function(label, future, name){
  # make df
  df_marge <- data.frame(future=future,label=factor(label))
  df_marge_mean <- 
    df_marge %>%
    group_by(label) %>%
    summarise(mean=mean(future)) %>%
    as.data.frame

  # plot
  p <- ggplot(data=df_marge, aes(x=future, fill=label))
  p <- p + geom_histogram(aes(colour=label),position="identity", alpha=0.3, bins=30)
  p <- p + theme_light() + xlab("value") + ylab("count") + labs(title=paste0(name," (count)"))
  p <- p + theme(legend.position="none")
  p <- p + geom_vline(data=df_marge_mean, aes(xintercept=mean, color=label),linetype="dashed")
  p <- p + facet_grid(label~.)
  plot(p)

  dens <- density(df_marge$future)
  p <- ggplot(data=df_marge, aes(x=future, y=..density.., fill=label))
  p <- p + geom_density(aes(colour=label), alpha =0.4)
  p <- p + theme_light() + xlab("value") + ylab("density") + labs(title=paste0(name," (density)"))
  p <- p + geom_vline(data=df_marge_mean, aes(xintercept=mean, color=label),linetype="dashed")
  p <- p + xlim(range(dens$x))
  plot(p)

  # カイマージ
  chiM <- chiM(df_marge, alpha=0.05)
  df_chiM <- cbind(df_marge, future_class=chiM$Disc.data[,"future"])

  # カイマージデータ
  chiM_max <- max(df_chiM$future_class)
  chiM_label <- c(paste0("<=",chiM$cutp[[1]]),paste0(">",chiM$cutp[[1]][chiM_max-1]))
  chiM_master <- data.frame(future_class=c(1:chiM_max),future_lavel=chiM_label)
  df_chiM_join <- inner_join(df_chiM, chiM_master ,by="future_class")
  
  # カイマージの閾値を可視化
  p <- ggplot(data=df_chiM_join, aes(x=future, fill=future_lavel))
  p <- p + geom_histogram(aes(colour=future_lavel),position="identity", alpha=0.3, bins=30)
  p <- p + theme_light() + xlab("value") + ylab("count") + labs(title=paste0(name," (chiM count)"))
  p <- p + facet_grid(label~.)
  plot(p)

  # カイマージのカテゴリの分布を可視化
  binary_classification_plot_factor(df_chiM_join[,"label"], df_chiM_join[,"future_lavel"], name)

  return(df_chiM_join)
  }

出力サンプル

グラフ

df_int_to_cate <- binary_classification_plot_integer(df[,"low"], df[,"lwt"], "lwt")

出力データ

head(df_int_to_cate)

future	label	future_class	future_lavel
82.628	No	3	<=84.671
70.37	No	2	<=75.364
47.67	No	1	<=48.124
49.032	No	2	<=75.364
48.578	No	2	<=75.364
56.296	No	2	<=75.364

参考