Tex, python, illusrator, VPSの学生ノート

latotex-blog

R

R(Anaconda)でつくる!散布図・箱ひげ図・バイオリンプロット・ヒストグラム

投稿日:2020年10月6日 更新日:







講義の関係でRを使ったので、データの可視化のために使った図のRコードを
メモとして残して置くことにしました。

使用している環境はanaconda(windows)です。
前回の記事にanacondaでRを使う方法を説明していますので、併せてどうぞ。

今回用いるデータはとある異次元スポーツ漫画のキャラクターの身長体重のデータです。
せっかくなので、ある試合形式での勝者と敗者で分けることにしました。
Schoolのイニシャルで何の漫画か分かる方もいらっしゃるかもしれません(笑)

データ(.csv)を載せておきます。情報はwikiから入手してますのでご自由にお使いください。

school,group,height,weight
SE,loser,152.5,40
SE,winner,179,58
SE,loser,175,55
SE,winner,167,53
SE,winner,171,52
SE,loser,185,62
SE,loser,180,65
SE,loser,172,58
SE,loser,173,57
HM,winner,179,67
HM,winner,166.5,52
HM,loser,166,55
SR,winner,166,52
SR,loser,172,56
YB,winner,172,59
YB,winner,183,71
YB,winner,178,66
YB,loser,187,76
HT,winner,178,62
HT,winner,179,64
HT,loser,158,48
HT,loser,173,60
HT,winner,160,49
HT,loser,191,85
HT,winner,187,72
HT,loser,173,60
RK,winner,182,69
RK,loser,185,73
RKD,winner,176,61
RKD,loser,180,68
RKD,loser,182,67
RKD,winner,170,61
RKD,winner,177,64
RKD,loser,176,62
RKD,winner,164,53
RKD,loser,179,69
SN,loser,153,52
SN,winner,178,66
SN,winner,195,81
SN,winner,189,82
SN,loser,178,63
SN,loser,170,60
HG,winner,179,72
HG,loser,175,63
HG,loser,193,114
HG,winner,172,54
HG,winner,195,60
NS,winner,187,73
MH,loser,203,95
SI,loser,168,51

スポンサーリンク

Rコード

実行する前にいくつかライブラリのインストールが必要です。anacondaを使用している方は、
以下のコードをコピペすれば大丈夫です。
library(latex2exp)はTeX表記を使いたい方だけインストールしてください。

$ conda install -c r r-tidyverse
$ conda install -c conda-forge r-latex2exp  r-ggbeeswarm

library(latex2exp)をインストールしなかった方は、
以下のコードのTeX()と$で囲まれた部分を削除してください。
散布図・箱ひげ図・バイオリンプロット・ヒストグラムを一気に作図しています。

#ライブラリの宣言
library(tidyverse) #データ抽出・グラフ作図など
library(latex2exp) #TeX記法を有効化
library(ggbeeswarm) #蜂群図を作図

#データの読み込み
input <- read_csv('C:/Users/user/Desktop/R_plot/input.csv')
input

#平均の計算
mean <- input %>% group_by(group) %>% summarise(meanheight = mean(height))

#winnerとloserの数(N)を計算
len_n <- input %>% count(group)
len_n

#inputのままではアルファベット順('loser','winner')にグラフが並ぶので、Levelで変更する
input$facet <- factor(input$group, levels = c('winner', 'loser'))

#回帰直線の決定係数、p値を求める
model_input <- lm(weight ~ height, data = input)
summary(model_input)


#散布図の作図
fig_scatter = ggplot(data = input) +
                     aes(x = height, y = weight, color = facet, shape= facet) + #X軸に身長、Y軸に体重をとりloser, winnerごとに色づけ
              stat_smooth(method = lm) + #回帰直線を引く
              geom_point(aes(color = facet, shape = facet),
                        show.legend = FALSE, size = 2.5) + #自動で作られるlegendを消す

              theme_classic() + #テーマをclassicに設定
              scale_color_manual(name = 'The Tiebreaker Elimination Match',
                                labels = c('Winners (N=25)','Losers (N=25)'),
                                values = c('winner'='#4DB6D0', 'loser'='#D9717D')) + #xticksのテキスト、色の変更
              labs(x = TeX('Height ($\\mathrm{cm}$)'), y = TeX('Weight ($\\mathrm{kg}$)'),
                  color = 'The Tiebreaker Elimination Match') + #xlabelの設定、TeX()でTeX表記が可能でバックスラッシュ(\)は2つ必要

              annotate('text', x = 190,   y = 40,
                      label = TeX('$R^2$ = $0.689$ (p < $0.001$, n = 50)'), size = 5) + #決定係数、p値の表示(少数点は$$で囲むことで半角のピリオドになる)
              theme(
                    legend.position = c(0.4,0.7),
                    legend.title = element_text(size = 17),
                    legend.text = element_text(size = 15),
                    plot.title = element_text(size = 20, face ='bold'),
                    axis.title = element_text(size = 15),
                    rect = element_rect(fill = "transparent"))


#バイオリンプロット, 箱ひげ図
fig_box_and_violin = ggplot(data = input) +
                            aes(x = group, y = height) +
                    geom_violin() + #バイオリンプロットを作図
                    geom_boxplot(width = 0.3, fill = 'gray') + #箱ひげ図を作図

                    labs(x = 'the tiebreaker elimination match', y = TeX('Height ($\\mathrm{cm}$)')) +
                    scale_x_discrete(labels = c('Winners (N=50)','Losers (N=50)'),
                                    limits = c('winner','loser')) + #この場合はlevelの変更の代わりにscale_x_discreteが使える
                    theme(
                          axis.title.x = element_blank(),
                          plot.title = element_text(size = 20, face ='bold'),
                          axis.title.y = element_text(size = 15),
                          axis.text.x = element_text(color = c('#4DB6D0','#D9717D'), size = 15),
                          legend.position = 'none')


#蜂群図を追加
beeswarm = fig_box_and_violin +
          geom_quasirandom(aes(color = group, shape = group), alpha = 2/3) + #蜂群図を作図

          geom_text(data = mean,
                    aes(y = meanheight, label = round(meanheight,2), group = group),
                        color = 'white', position = position_dodge(0.8)) #箱ひげ図の上に平均値を表示する


#ヒストグラム
fig_histogram = ggplot(data = input) +
                geom_histogram(aes(x = height, fill = group),
                              position ='stack', binwidth = function(x) ceiling((max(x) - min(x)) / sqrt(length(x))),
                              color = 'white') +

                stat_bin(aes(x = height, y = ..count.., label = ..count..),
                        geom = 'text', binwidth =  function(x) ceiling((max(x) - min(x)) / sqrt(length(x))),
                        size = 6) + #頻度をビンの上に表示する
                labs(x = TeX('Height ($\\mathrm{cm}$)'), y = 'Frequency') +
                facet_wrap(~ facet) +  #loser, winnerに分ける
                theme(
                      plot.title = element_text(size = 20, face='bold'),
                      axis.title = element_text(size = 15),
                      legend.position ='none',
                      strip.text = element_text(size = 20))


#保存
ggsave('C:/Users/user/Desktop/R_plot/fig_scatter.png', fig_scatter)
ggsave('C:/Users/user/Desktop/R_plot/beeswarm_figure.png', beeswarm)
ggsave('C:/Users/user/Desktop/R_plot/hist_figure.png', fig_histogram)

作図結果

作図結果をそれぞれ載せておきます。
上から、散布図、箱ひげ図+バイオリンプロット、ヒストグラムの順で掲載しています。
漫画の世界でも、身長が伸びるほど体重が増える関係は変わらず、
勝ち組(winner)の方が負け組(loser)よりもバラつきが少ないことが分かりました。

散布図:
身長と体重の関係は「weight = -113.9707 + 1.0064*height」となりました。
直線と灰色のエリアはそれぞれ回帰曲線と95%信頼区間を示しています。

R_scatter_plot

箱ひげ図+バイオリンプロット:
ggplotのデフォルトの設定では、中央値(横棒)、四分位数(ボックス)、四分位数の1.5倍の範囲(ヒゲ)、平均(箱の数値)を表します。

R_beeswarm_figure

ヒストグラム:
身長におけるヒストグラムで、ビンの上にある数字は頻度を示しています。
ちょっとビンの設定がいまいちな気がします・・・

R_fig_histogram

参考にしたサイト様

・ヒストグラムのビン設定
https://blog.atusy.net/2018/11/09/binwdith-for-geom-histogram/

・ヒストグラムに頻度をプロットする
https://stackoverflow.com/questions/33026512/display-the-total-number-of-bin-elements-in-a-stacked-histogram-with-ggplot2

・箱ひげ図に平均値をプロットする
https://stackoverflow.com/questions/62433874/boxplot-ggplot2-show-mean-value-and-number-of-observations-in-grouped-boxplot

-R
-, , , ,

Copyright© latotex-blog , 2020 All Rights Reserved Powered by STINGER.