きれいな散布図行列を書く

statmodeling.hatenablog.com

mikutaifuku.hatenablog.com

エレガントな散布図行列を書くコードを見つけた。
Bostonデータセットのサイズでは問題ないが、
データ量が多いとかなり重い処理となる。
サンプリングする必要があるだろう。
後者では紹介したコードを試してみる。

#相関行列
library(tidyverse)
library(ggthemes)
library(scales)
library(GGally)
library(MASS)

d <- Boston
dim(d)
d <- as_data_frame(d)
N_col <- ncol(d)
ggp <- ggpairs(d, upper='blank', diag='blank', lower='blank')
i <- 1
for(i in 1:N_col) {
  x <- d[,i]
  colnames(x) <- "tmp_name"
  p <- ggplot(x, aes(tmp_name))
  p <- p + theme(text=element_text(size=14), axis.text.x=element_text(angle=40, vjust=1, hjust=1))
  bw <- (max(x)-min(x))/10
  p <- p + geom_histogram(binwidth=bw, color='darkgrey', fill='darkgrey', alpha=0.5)
  p <- p + geom_line(eval(bquote(aes(y=..count..*.(bw)))), stat='density', alpha=0.5)
  p <- p + geom_label(data=data.frame(x=-Inf, y=Inf, label=colnames(d)[i]), aes(x=x, y=y, label=label), hjust=0, vjust=1) 
  p <- p + theme_bw() + scale_color_pander()
  ggp <- putPlot(ggp, p, i, i)
}

zcolat <- seq(-1, 1, length=81)
zcolre <- c(zcolat[1:40]+1, rev(zcolat[41:81]))

for(i in 1:(N_col-1)) {
  for(j in (i+1):N_col) {
    x <- as.numeric(unlist(d[,i]))
    y <- as.numeric(unlist(d[,j]))
    r <- cor(x, y, method='spearman', use='pairwise.complete.obs')
    zcol <- lattice::level.colors(r, at=zcolat,
                                  col.regions=colorRampPalette(c(scales::muted('red'), 'white', scales::muted('blue')), space='rgb')(81))
    textcol <- ifelse(abs(r) < 0.4, 'grey20', 'white')
    ell <- ellipse::ellipse(r, level=0.95, type='l', npoints=50, scale=c(.2, .2), centre=c(.5, .5))
    p <- ggplot(data.frame(ell), aes(x=x, y=y))
    p <- p + theme_bw() + theme(
      plot.background=element_blank(),
      panel.grid.major=element_blank(), panel.grid.minor=element_blank(),
      panel.border=element_blank(), axis.ticks=element_blank()
    )
    p <- p + geom_polygon(fill=zcol, color=zcol)
    p <- p + geom_text(data=NULL, x=.5, y=.5, label=100*round(r, 2), size=6, col=textcol)
    ggp <- putPlot(ggp, p, i, j)
  }
}

for(j in 1:(N_col-1)) {
  for(i in (j+1):N_col) {
    x <- d[,j]
    y <- d[,i]
    colnames(x) <- "tmp_x_name"
    colnames(y) <- "tmp_y_name"
    p <- ggplot(data.frame(x, y), aes(x=tmp_x_name, y=tmp_y_name))
    p <- p + theme(text=element_text(size=14), axis.text.x=element_text(angle=40, vjust=1, hjust=1))
    p <- p + geom_point(size=1, color='darkgrey', fill='darkgrey', alpha=0.5)
    p <- p + theme_bw() + scale_color_pander()
    p <- p + theme(text=element_text(size=14), axis.text.x=element_text(angle=40, vjust=1, hjust=1))
    ggp <- putPlot(ggp, p, i, j)
  }
}

print(ggp)
#ggsaveでは保存できなかった。

#これもうまくいかない
#png(file='ggally.png', res=500, w=1500, h=1500)
#print(ggp, left=0.3, bottom=0.3)
#dev.off()