ggplot2でviolinplotを描く

本人、オリジナル。

ggplot2でviolinplotを描く

ggplot2でviolinplotを描こうと思いググっていると、こちらのサイトにcoolなviolin plotがあったので、描いてみたくなって、ちょっと探ってみた。
まずは、テキスト本の引用から。

Chang, W. (2013) 『Rグラフィックス・クックブック - ggplot2によるグラフ作成のレシピ集』, オライリージャパン.pp.138-142

># ggplot2パッケージの読み込み
> library(ggplot2)
> # データセットの読み込み
> library(gcookbook)
> # データセットのサンプル表示
> head(height weight)

データセットはこのような様式である
sex ageYear ageMonth heightIn weightLb
1 f 11.92 143 56.3 85.0
2 f 12.92 155 62.3 105.0
3 f 12.75 153 63.3 108.0
4 f 13.42 161 59.0 92.0
5 f 15.92 191 62.5 112.5
6 f 14.25 171 62.5 112.0

> # 基本プロット
> p<-ggplot(heightweight,aes(x=sex,y=heightIn,colour=sex,))
> p+geom_violin()

Rplot16.jpeg
解説によると、
  1. バイオリンプロットは複数の分布を並べて配置するため、分布の比較がしやすい。
  2. バイオリンプロットはカーネル密度推定を左右対象に描いたもの。
とある
># 箱ひげ図を重ね書きしたバイオリンプロット
> p<-ggplot(heightweight,aes(x=sex,y=heightIn,colour=sex,))
> p+geom_violin()+geom_boxplot(width=.1,fill="black",outer.colour=NA)+
> stat_summary(fun.y=mean,geom = "point", fill="white",shape=21,size=2.5)

Rplot18.jpeg
さて、デフォルトではtrim=TRUEになっていて、最小値から最大値の範囲でプロットされ、バイオリンの端はこれらの値で平らにカットされる。
trim=FALSEとすると、平らにカットされずにプロットされる。
># 端まで表示したバイオリンプロット
> p+geom_violin(trim=FALSE)

Rplot19.jpeg
もうひとつ、デフォルトでは、各バイオリンの面積が等しくなるようにバイオリンの大きさが調整される。
面積が等しくする代わりに、scale="count"を使用して、面積が各グループの観測値の数に比例するように設定することもできる。
># バイオリンの面積が観測数に比例するように調整
> p+geom_violin(scale="count")

Rplot20.jpeg
この例では、女性の数が男性の数よりやや少ないので、fのバイオリンがわずかに狭くなります。
> summary(height weight$sex)
f m
111 125

平衡化の度合いを変更するためには、adjustパラメータを使う。デフォルトの値は1で、大きくすれば滑らかに、小さくすれば滑らかでなくなる。
> # 平衡化の度合いを大きく設定したバイオリンプロット
> p+geom_violin(adjust=2)

Rplot21.jpeg
> # 平衡化の度合いを小さく設定したバイオリンプロット
> p+geom_violin(tadjust=.5)

Rplot22.jpeg

さあ、描いてみよう!

描きたいバイオリンプロットはこちら。
Rplot23.jpeg
データセットは、こちら。
> data07 <- read.csv("ハリー・ポッターと不死鳥の騎士団_上.csv",sep=";")
> head(data07[1:11])
X2005年 X2006年 X2007年 X2008年 X2009年 X2010年 X2011年 X2012年 X2013年 X2014年       srno
1 26 15 11 17 11 7 7 10 10 14 127181857
2 NA 8 4 NA NA NA NA NA NA NA 127192441
3 NA NA NA 22 NA NA NA NA NA NA 120271754
4 19 15 17 19 17 11 10 6 5 7 2127034771
5 10 18 4 NA NA NA NA NA NA NA 2227015423
6 7 6 18 16 13 10 9 5 4 10 2227016173
このデータセットは、ローリング, J.K.(2004) 『ハリー・ポッターと不死鳥の騎士団 (上)』, 静山社.の各年の貸出回数で、srnoは固有番号である。

データの整形

まず、列名を「X2005年」から「2005年」のように変更する。
> colnames(data08)<-c("2006年","2007年","2008年","2009年","2010年","2011年","2012年","2013年","2014年","srno")
> head(data08)
2006年 2007年 2008年 2009年 2010年 2011年 2012年 2013年 2014年       srno
1 15 11 17 11 7 7 10 10 14 127181857
2 8 4 NA NA NA NA NA NA NA 127192441
3 NA NA 22 NA NA NA NA NA NA 120271754
4 15 17 19 17 11 10 6 5 7 2127034771
5 18 4 NA NA NA NA NA NA NA 2227015423
6 6 18 16 13 10 9 5 4 10 2227016173
resape2パッケージでggplot2パッケージが読み込めるようにデータ整形を行う。
> library(reshape2)
> data09<-melt(data08,id.vars="srno",variable.name="year",value.name="count")
> head(data09)
      srno   year count
1 127181857 2006年 15
2 127192441 2006年 8
3 120271754 2006年 NA
4 2127034771 2006年 15
5 2227015423 2006年 18
6 2227016173 2006年 6

とりあえず、mainを描く

> p<-ggplot(data09,aes(x=year,y=count,colour=year))
> p+geom_violin(trim=T,fill="#999999",linetype="blank",alpha=I(1/3))+
ylim(0, 25)+geom_hline(yintercept=4,size=1,colour="#0072B2",alpha=.5,linetype=2)+
 theme(legend.position="none")
Rplot24.jpeg

geom_pointrange(平均[μ]のpointと標準偏差のrange[μ±σ])を追加する

> p<-ggplot(data09,aes(x=year,y=count,colour=year))
> p+geom_violin(trim=T,fill="#999999",linetype="blank",alpha=I(1/3))+
ylim(0, 25)+geom_hline(yintercept=4,size=1,colour="#0072B2",alpha=.5,linetype=2)+
 stat_summary(geom="pointrange",fun.y = mean, fun.ymin = function(x) mean(x)-sd(x), fun.ymax = function(x) mean(x)+sd(x), size=1,alpha=.5)+
 theme(legend.position="none")
Rplot25.jpeg

平均pointをlineで描く

>p<-ggplot(data09,aes(x=year,y=count,colour=year))
>p+geom_violin(trim=T,fill="#999999",linetype="blank",alpha=I(1/3))+
ylim(0, 25)+geom_hline(yintercept=4,size=1,colour="#0072B2",alpha=.5,linetype=2)+
 stat_summary(geom="pointrange",fun.y = mean, fun.ymin = function(x) mean(x)-sd(x), fun.ymax = function(x) mean(x)+sd(x), size=1,alpha=.5)+
 stat_summary(fun.y = mean, geom="line", aes(group=1))+
 theme(legend.position="none")
Rplot26.jpeg

各グループの平均値を最小値の位置に、データ数を最大値の位置に追加する

> n_fun <- function(x){
return(data.frame(y = max(x), label = paste0("n = ",length(x))))
}

> mean_fun <- function(x){
return(data.frame(y = min(x)+0.5, label = paste0(round(mean(x),1))))
}

> p<-ggplot(data09,aes(x=year,y=count,colour=year))
> p+geom_violin(trim=T,fill="#999999",linetype="blank",alpha=I(1/3))+
ylim(0, 25)+geom_hline(yintercept=4,size=1,colour="#0072B2",alpha=.5,linetype=2)+
 stat_summary(geom="pointrange",fun.y = mean, fun.ymin = function(x) mean(x)-sd(x), fun.ymax = function(x) mean(x)+sd(x), size=1,alpha=.5)+
 stat_summary(fun.data = n_fun, geom = "text",colour="#0072B2",size=3)+
 stat_summary(fun.y = mean, geom="line", aes(group=1))+
 stat_summary(fun.data = mean_fun, geom = "text",colour="#0072B2",size=3)+
 theme(legend.position="none")
Rplot27.jpeg

  • 最終更新:2015-02-01 14:28:32

このWIKIを編集するにはパスワード入力が必要です

認証パスワード