読者です 読者をやめる 読者になる 読者になる

広告/統計/アニメ/映画 等に関するブログ

広告/統計/アニメ/映画 等に関するブログ

【備忘録】Rで矢印のグラフを描く

R 統計

グラフにこんな矢印を入れたい時ってありますよね? f:id:yyhhyy:20160827192859p:plain これは、因子分析をした時のプロットをイメージしています。

色々と調べた結果をデータの準備からプロットまで手順を追ってメモをしておきます。

データの準備

それっぽいデータを乱数で用意

取り敢えず正規分布の乱数を作成。

平均を0、分散を0.5として7つずつ

set.seed(123)
mr1 <- rnorm(7,mean = 0,sd=0.5)
mr2 <- rnorm(7,mean = 0,sd=0.5)

それっぽいイメージ項目の文字列を作成

names <- c("美しい","賢い","派手な","高貴な","個性的な","明るい","温かい")

データフレームを用意してdplyrのbind_colsを使ってデータフレームを作ります (別にcbindでも同じことです)

res <- NULL
res <- as.data.frame(res)
library("dplyr", lib.loc="C:/hogehoge/R-3.2.3/library")
res <- bind_cols(as.data.frame(mr1),as.data.frame(mr2))
res$names <- names

結果、このようなデータを用意しました

mr1         mr2    names
1 -0.28023782 -0.63253062   美しい
2 -0.11508874 -0.34342643     賢い
3  0.77935416 -0.22283099   派手な
4  0.03525420  0.61204090   高貴な
5  0.06464387  0.17990691 個性的な
6  0.85753249  0.20038573   明るい
7  0.23045810  0.05534136   温かい

矢印をひく為のデータを用意

このサイトを参考にしました。

5 functions to do Principal Components Analysis in R · Gaston Sanchez

矢印には出発点とゴール地点とがあります。その値を持ったデータフレームを別途用意すれば良いのです。

arrowsという名称でデータフレームを用意します。

x1,x2が出発点なので"0"。今回のデータのレコード数をnrowで確認して、必要な数だけの0を並べます。 y1,y2はゴール地点なので描画するデータの値と同じです

arrows <- NULL
arrows <- as.data.frame(arrows)
x1 <- rep(0,nrow(res))
y1 <- rep(0,nrow(res))
arrows <- bind_cols(as.data.frame(x1),as.data.frame(y1))
x2 <- res$mr1
y2 <- res$mr2
arrows$x2 <- x2
arrows$y2 <- y2

こんなデータになります

x1 y1          x2          y2
1  0  0 -0.28023782 -0.63253062
2  0  0 -0.11508874 -0.34342643
3  0  0  0.77935416 -0.22283099

ggplotで描く

ggplotの描画範囲を大きくする

グラフの端で文字が消えないよう、x軸 y軸の最大値・最小値を少し大きめに取ります。

有効数字3桁として、0.1だけ絶対値を大きくとりました。

a <- round(max(res$mr1,res$mr2),3) + 0.1
b <- round(min(res$mr1,res$mr2),3) - 0.1

ベースの値をプロット

先ずはデータの値(今回は因子分析の因子負荷量をイメージしています。)をgeom_pointで、質問項目名をgeom_textで、先ほど決めたグラフの軸の値でxlim,ylimで指定します

g <- ggplot(data=res,aes(x=res$mr1,y=res$mr2))
g <- g + geom_point()
g <- g + geom_text(aes(x=res$mr1,y=res$mr2),label=res$names,vjust=-1)
g <- g + xlim(b,a)
g <- g + ylim(b,a)
plot(g)

するとこんなグラフになりますが、ちょっと見辛いです。

f:id:yyhhyy:20160827194219p:plain

縦横の比率を同じにする

グラフの描画エリアが正方形であって欲しい場合があります。今回は、縦も横も因子負荷量ですから、同じスケールでないと正確にイメージできない可視化となってしまいます。

こちらのサイトを参考にしました。

ggplot2: きれいなグラフを簡単に合理的に - Watal M. Iwasaki

g <- g + coord_fixed(ratio=1)

を加えます。

また、負の値を取りますので、0の場所にx軸、y軸の軸がありません。 そこで、0の水平線と垂線を引いて見やすくします。色もブルーにしてみました。

g <- g + geom_hline(yintercept = 0,color="blue")
g <- g + geom_vline(xintercept = 0,color="blue")

これでかなり見やすくなりました。

f:id:yyhhyy:20160827194835p:plain

いよいよ矢印を引きます

こちらのサイトを参考にしました。

ggplot2 Quick Reference: geom_segment | Software and Programmer Efficiency Research Group

geom_segmentという関数を使って、先ほど作った矢印用のデータフレームarrowsを対象データとして使います。arrow=arrow()で直線が矢印に変わります。

今回は太さを1にし、色をグレーにしてみました。

g <- g + geom_segment(data=arrows,aes(x=x1,y=y1,xend=x2,yend=y2),colour="gray65",arrow=arrow(),size=1)

f:id:yyhhyy:20160827195149p:plain

細かいこだわり

よくみると矢印が青い線の上に乗っかって青線が消えています。ggplotはグラフのデータにどんどんレイヤーを上乗せしていくので、上のレイヤーにしたデータは後で加えないと行けません。 ですので、geom_vlineとgeom_hlineは後ろに順番を入れ替えるべきです。

また、x軸、y軸の目盛りも黒文字の方が読み易いでしょう。

その結果のグラフが最初のグラフのです

f:id:yyhhyy:20160827192859p:plain

全てのコード

set.seed(123)
mr1 <- rnorm(7,mean = 0,sd=0.5)
mr2 <- rnorm(7,mean = 0,sd=0.5)
res <- NULL
res <- as.data.frame(res)
library("dplyr", lib.loc="C:/hogehoge/R-3.2.3/library")
res <- bind_cols(as.data.frame(mr1),as.data.frame(mr2))
res$names <- c("美しい","賢い","派手な","高貴な","個性的な","明るい","温かい")
arrows <- NULL
arrows <- as.data.frame(arrows)
x1 <- rep(0,nrow(res))
y1 <- rep(0,nrow(res))
arrows <- bind_cols(as.data.frame(x1),as.data.frame(y1))
x2 <- res$mr1
y2 <- res$mr2
arrows$x2 <- x2
arrows$y2 <- y2
library("ggplot2", lib.loc="C:/hogehoge/R-3.2.3/library")
a <- round(max(res$mr1,res$mr2),3) + 0.1
b <- round(min(res$mr1,res$mr2),3) - 0.1
g <- ggplot(data=res,aes(x=res$mr1,y=res$mr2))
g <- g + geom_point()
g <- g + geom_text(aes(x=res$mr1,y=res$mr2),label=res$names,vjust=-1)
g <- g + xlim(b,a)
g <- g + ylim(b,a)
g <- g + coord_fixed(ratio=1)
g <- g + geom_segment(data=arrows,aes(x=x1,y=y1,xend=x2,yend=y2),colour="gray65",arrow=arrow(),size=1)
g <- g + geom_hline(yintercept = 0,color="blue")
g <- g + geom_vline(xintercept = 0,color="blue")
g <- g + theme(axis.text.x=element_text(angle=0,colour="black",size=12,hjust=1))
g <- g + theme(axis.text.y=element_text(angle=0,colour="black",size=12))
plot(g)
ggsave(plot=g,file="20160830.png",dpi=300,width=4,height=1.5,scale=3)