グラフにこんな矢印を入れたい時ってありますよね? これは、因子分析をした時のプロットをイメージしています。
色々と調べた結果をデータの準備からプロットまで手順を追ってメモをしておきます。
データの準備
それっぽいデータを乱数で用意
取り敢えず正規分布の乱数を作成。
平均を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)
するとこんなグラフになりますが、ちょっと見辛いです。
縦横の比率を同じにする
グラフの描画エリアが正方形であって欲しい場合があります。今回は、縦も横も因子負荷量ですから、同じスケールでないと正確にイメージできない可視化となってしまいます。
こちらのサイトを参考にしました。
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")
これでかなり見やすくなりました。
いよいよ矢印を引きます
こちらのサイトを参考にしました。
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)
細かいこだわり
よくみると矢印が青い線の上に乗っかって青線が消えています。ggplotはグラフのデータにどんどんレイヤーを上乗せしていくので、上のレイヤーにしたデータは後で加えないと行けません。 ですので、geom_vlineとgeom_hlineは後ろに順番を入れ替えるべきです。
また、x軸、y軸の目盛りも黒文字の方が読み易いでしょう。
その結果のグラフが最初のグラフのです
全てのコード
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)