※資料作成は岩嵜航さん(東北大学)にご協力いただきました。

(左右キーで進みます!)

統計解析をしよう!

1. 課題を見つける/仮説を立てる

2. 実験や観察をしてデータを集める

3. データを整理する

4. データを解析して仮説を検証する


  • 仮説の検証にはエビデンスが必要
  • でも生物の表現型には ばらつきがある
  • 実験や観察で得られた差や効果は偶然の産物じゃないの?
    • これに答えるのが統計解析
    • 推論や予測などにも使うよ

広くて深い統計解析の世界

  • データの荒海を泳ぎ切ってもどこにも 「究極の真実」 などありはしないのだ。
  • 統計学はその時その場かぎりでの 「最良の結論」 を導く便法にすぎないのだ。
    (三中信宏)

この実習で扱う統計解析

  • 実験生物学でよく使う超古典的 + 基本的な統計解析法
    • 統計解析にあたっての心構え
    • 各解析方法の実践(理論についてはほぼやりません!)
  • Rのみ(有料ソフトなし)ででき、発展的な解析の足がかりへ

統計的仮説検定…“有意差”を求める超古典的な群間比較

  1. 仮説検定の進め方(正規性, 等分散性の検定など)
  2. 2群の検定(Studentのt検定など)
  3. 多群の検定(ANOVAなど)

統計モデリング…値の関係性を調べる

  1. 一般線形モデル(lm)
  2. 一般化線形モデル(glm)

母集団と標本

統計解析…標本に基づいて、母集団の性質を推定する

  • 母集団の性質を知りたいが実測は不可能
  • そこでランダムに抽出した標本から母集団の性質を推定する
    • 実験で得られた値など(ランダムでなければ意味がない)
  • 集団にはばらつきがあるので毎回異なる値が得られる
  • →ばらつきを考慮して母集団の性質を推定する

統計的仮説検定を使う場面とは

  • 例えばこんなとき…
  • とある卒研生が「栄養豊富な餌で育ったハエは体が大きくなる」ことを主張しようとしてデータを集めた。
  • これまでのデータによると、通常の餌で育てたハエの体長は平均3.0mm, 標準偏差1.0mmの正規分布に従う。
  • 卒研生が栄養豊富な餌で育てたハエ10匹の体長は、3.0, 3.0, 3.2, 3.4, 3.6, 4.0, 4.2, 4.2, 4.3, 4.5 mmであった。
  • この結果から、卒研生は栄養豊富な餌で育ったハエは身体が大きくなると結論づけた。
  • ところが教授はこれに対して「たまたま大きいハエがとれちゃったんじゃないの?」とコメントした。
  • さて、この教授にどのように反論したらよいだろうか?

統計的仮説検定の考え方

「こんなことがたまたま起こる確率はすごく低いです!」

  • 母集団からこのような標本が得られる可能性が低いことを示す

帰無仮説(通常餌の母集団からこの標本が偶然得られた)

対立仮説(偶然ではない=異なる母集団から得られた)

※帰無仮説と対立仮説は排他的

  1. 帰無仮説のもとで今回得られた標本が偶然生じる確率(\(p\)値, \(p\)-value)を計算する
  2. \(p\)値が有意水準(\(\alpha\))より低い場合、帰無仮説を棄却する
    • 伝統的に\(p\) < 0.05で棄却(偶然起こるのは1/20回以下)
  3. その結果、対立仮説を採択する(=「有意差がある」)

\(p\)値をどのように求めるか(1/2)

\(p\)値は検定統計量に基づいて求める

  • 検定統計量とは…
    • 仮説検定で用いられる統計量
    • (めっちゃざっくり言うと、とある前提に基づいて標本の性質をまとめた仮説検定の基準になる値)
    • 標本から計算された値を「検定統計量の実現値」と呼ぶ
    • \(Z\)統計量、\(t\)統計量、\(F\)統計量、カイ二乗統計量など
  • 帰無仮説のもとでの検定統計量の確率分布を元に、「得られた検定統計量の実現値が偶然得られる確率(=\(p\)値)」を計算する
  • \(p\)値が有意水準(\(\alpha=0.05\))より低ければ帰無仮説を棄却する

確率分布って何?

  • 確率分布とは…ある確率変数がどんな確率でどんな値をとるかを表した分布(Xが値でYが確率)
  • 確率変数とは…実際に結果が得られるまでどんな値が得られるかが決まっていない変数
    • 同じ手続きでデータを得ても異なる値が得られるもの = 多くの実験/観測データはこれに当てはまる
  • 確率の総和は1となる
  • さまざまな典型的な確率分布が知られる

\(p\)値をどのように求めるか(2/2)

仮説検定の手続き(3~5はRが勝手にやってくれる)

  1. 母集団に関する帰無仮説と対立仮説を設定する
  2. 検定統計量(=検定方法)を選ぶ
    • 検定の目的と標本の性質によって変わる
    • \(Z\)統計量、\(t\)統計量、\(F\)統計量、カイ二乗統計量など
  3. 有意水準\(\alpha\)を決める(伝統的には\(\alpha = 0.05\))
  4. 標本から検定統計量の実現値を求める
  5. 帰無仮説のもとでの検定統計量の確率分布と、検定統計量の実現値を比較し、「帰無仮説のもとで得られた検定統計量の実現値が偶然得られる確率(=\(p\)値)」を計算する
  6. \(p\)値が有意水準より低ければ帰無仮説を棄却する

簡単な例で見てみよう(1/2)

  • とある卒研生(p.6)の例だと…母集団は正規分布に従い、平均(=3.0)と 標準偏差(=1.0)がわかっている
  • 平均と標準偏差が既知の正規分布の場合、\(Z\)統計量が使える
    • \(Z = \frac{\bar{X} - \mu}{\sqrt{\sigma^2/n}}\)…平均値の差を標準誤差\({\sqrt{\sigma^2/n}}\)で標準化
      • \(\bar{X}\)…標本の平均 = 3.74
      • \(\mu\)…母集団の平均 = 3.0
      • \(\sigma\)…母集団の標準偏差 = 1.0
      • \(n\)…サンプルサイズ = 10
  • 帰無仮説のもとでは\(Z\)は標準正規分布(平均0, 標準偏差1の正規分布)に従う
  • 今回の場合、\(Z = \frac{3.74 - 3}{\sqrt{1^2/10}}\) = 2.340085

簡単な例で見てみよう(2/2)

  • 帰無仮説のもとで\(Z\)が従う標準正規分布では、\(Z\)が灰色の範囲(-1.96 < \(Z\) < 1.96)外の値をとる確率は5%(=有意水準\(\alpha\))

  • 今回の場合、\(Z=2.340085\) ←範囲外!
  • 帰無仮説のもとで\(Z=2.340085\)になる確率(=\(p\)値)は0.01927935
  • → 有意水準\(\alpha=0.05\)より低い
  • → 帰無仮説を棄却し、対立仮説を採用する

さまざまな検定統計量

標本の性質や検定の目的によって使う検定統計量は異なる

  • 母集団が平均と分散が既知の正規分布である場合…

    • \(Z\)統計量:\(\frac{\bar{X} - \mu}{\sqrt{\sigma^2/n}}\)…平均値の差を標準誤差\({\sqrt{\sigma^2/n}}\)で標準化
    • 帰無仮説のもとでは\(Z\)は標準正規分布に従う
  • 母集団が平均が既知、分散が未知の正規分布である場合…

    • \(t\)統計量:\(\frac{\bar{X} - \mu}{\sqrt{\hat{\sigma}^2/n}}\)…母分散\(\sigma^2\)の代わりに不偏分散\(\hat{\sigma}^2\)を使う
    • 帰無仮説のもとでは\(t\)は自由度\(df = n-1\)の\(t\)分布に従う
  • 他にも\(F\)統計量カイ二乗統計量など

  • 不適切な統計量(=方法)を用いると誤った\(p\)値が得られる

正しい解析法を使わないと意味がない

統計解析法にはそれぞれ守るべき前提条件がある

  • 正しい\(p\)値を求めるために必要
  • 標本の性質や解析の目的にあった方法を使わないと間違った\(p\)値が得られてしまう

有意差を求めて間違った解析法を使うのは不正/不誠実

  • 間違った方法によって得られた\(p < 0.05\)に意味はない

自分のデータに合った解析を選べるようになろう!

  • 今回は古典的な統計的仮説検定→統計モデリングの入口のみ
  • より良い解析法を常に検討していく姿勢が大切!
    • より複雑なモデル、ベイズ統計など

仮説検定のよくある間違い

\(p\)>0.05 →「差がない」と結論するのは間違い

  • \(p\)>0.05 → 帰無仮説が棄却できない ≠ 差がない
  • 統計的仮説検定の立場からは「どちらとも言えない」
  • 態度を保留するのが正解

\(p\)値が小さい →「差が大きい」と結論するのも間違い

  • \(p\)値はサンプルサイズが大きいと有意になりやすい
  • \(p\)値が小さいからといって差が大きいとは限らない
  • 差の大きさを示すには効果量(effect size)

まずは統計的仮説検定をしてみよう!

データの性質やりたいことによって方法は変わる

統計的仮説検定をしてみよう!

統計的仮説検定をしてみよう!

【復習】データを読み込んでざっくり眺める

library(palmerpenguins)               #penguinsを読み込み
library(tidyverse)                    #tidyverseを読み込み
head(penguins)                        #penguinsの最初を見せて!
## # A tibble: 6 x 8
##   species island bill_length_mm bill_depth_mm flipper_length_… body_mass_g sex  
##   <fct>   <fct>           <dbl>         <dbl>            <int>       <int> <fct>
## 1 Adelie  Torge…           39.1          18.7              181        3750 male 
## 2 Adelie  Torge…           39.5          17.4              186        3800 fema…
## 3 Adelie  Torge…           40.3          18                195        3250 fema…
## 4 Adelie  Torge…           NA            NA                 NA          NA <NA> 
## 5 Adelie  Torge…           36.7          19.3              193        3450 fema…
## 6 Adelie  Torge…           39.3          20.6              190        3650 male 
## # … with 1 more variable: year <int>
  • アデリーペンギンの体重に性差があるか?

統計的仮説検定をしてみよう!

アデリーペンギンの体重に性差があるか?

[練習問題]

  • まずはデータをプロットしよう
    • 元データはpenguins
    • dplyrのfilterでspecies == “Adelie”だけ抽出
    • ggplot2でプロット
      • X軸…sex
      • Y軸…body_mass_g

統計的仮説検定をしてみよう!

アデリーペンギンの体重に性差があるか?

penguins_adelie = penguins %>%
  filter(species == "Adelie")
head(penguins_adelie)
## # A tibble: 6 x 8
##   species island bill_length_mm bill_depth_mm flipper_length_… body_mass_g sex  
##   <fct>   <fct>           <dbl>         <dbl>            <int>       <int> <fct>
## 1 Adelie  Torge…           39.1          18.7              181        3750 male 
## 2 Adelie  Torge…           39.5          17.4              186        3800 fema…
## 3 Adelie  Torge…           40.3          18                195        3250 fema…
## 4 Adelie  Torge…           NA            NA                 NA          NA <NA> 
## 5 Adelie  Torge…           36.7          19.3              193        3450 fema…
## 6 Adelie  Torge…           39.3          20.6              190        3650 male 
## # … with 1 more variable: year <int>

統計的仮説検定をしてみよう!

アデリーペンギンの体重に性差があるか?

gp = ggplot(data = penguins_adelie) +
  geom_point(aes(x = sex, y = body_mass_g), 
             position = position_jitter(width = 0.05))
gp
## Warning: Removed 1 rows containing missing values (geom_point).

  • オスのほうが大きそう…!でもNAとかあるなぁ…

統計的仮説検定をしてみよう!

アデリーペンギンの体重に性差があるか?

penguins_adelie = penguins %>%
  filter(species == "Adelie", !is.na(sex)) #NAを除く
head(penguins_adelie)
## # A tibble: 6 x 8
##   species island bill_length_mm bill_depth_mm flipper_length_… body_mass_g sex  
##   <fct>   <fct>           <dbl>         <dbl>            <int>       <int> <fct>
## 1 Adelie  Torge…           39.1          18.7              181        3750 male 
## 2 Adelie  Torge…           39.5          17.4              186        3800 fema…
## 3 Adelie  Torge…           40.3          18                195        3250 fema…
## 4 Adelie  Torge…           36.7          19.3              193        3450 fema…
## 5 Adelie  Torge…           39.3          20.6              190        3650 male 
## 6 Adelie  Torge…           38.9          17.8              181        3625 fema…
## # … with 1 more variable: year <int>

統計的仮説検定をしてみよう!

アデリーペンギンの体重に性差があるか?

gp = ggplot(data = penguins_adelie) +
  geom_point(aes(x = sex, y = body_mass_g), 
             position = position_jitter(width = 0.05))
gp

  • いい感じ!さて…

統計的仮説検定をしてみよう!

データの正規性等分散性によって使える方法は変わる

正規性:標本が正規分布に従うかどうか

正規分布とは

  • 左右対象の釣鐘型の分布
  • 現実世界でしばしば見られる
    • ある一つの数値を目標とした作業で生じる偶然的な誤差
    • 性別と年齢を固定したときの身長の分布平均と分散
  • 平均と分散(または標準偏差)がわかればどのような分布になるか一意に決まる(めちゃ便利)

等分散性:分散の程度が違うかどうか

  • この場合、オスのほうがメスより分散が大きい
  • 実際はFテストやBartlettテストの結果で判断する

統計的仮説検定をしてみよう!

統計的仮説検定の進め方

  1. データをプロットして眺める
  2. 各標本に正規性があるか調べる
    • Q-Q plot
    • Shapiro-Wilkテスト
  3. 等分散性はあるか調べる
    • Fテスト
  4. 2, 3の結果を受けて検定方法を決め、検定する
    • 正規性/等分散性の有無で使える方法が違う
    • 各検定方法の前提条件をよく確認すること

統計的仮説検定をしてみよう!

1. 各標本に正規性があるか(Q-Q plot

gp = ggplot(data = penguins_adelie) +
       stat_qq(aes(sample = body_mass_g, color = sex)) + 
       facet_wrap( ~ sex, scales = "free")
gp

  • 正規Q-Q plotで直線上に乗っているような気がする

統計的仮説検定をしてみよう!

1. 各標本に正規性があるか

  • Shapiro-Wilkテスト
    • shapiro.test(【調べたい標本】)
      • 【調べたい標本】はベクトルc(a, b, c…)で入れる
      • 【data.frame】$【列名】でも指定できる
    • 帰無仮説:正規性がある
    • p<0.05で正規性がないことを示す
    • (正規性があることは言えない)
    • 1標本の値を入れる(2標本を混ぜない

統計的仮説検定をしてみよう!

1. 各標本に正規性があるか(Shapiro-Wilkテスト)

sw_test_results = penguins_adelie %>%   #penguins_adelieを使う
  group_by(sex) %>%                     #sexでグループ
  summarise(statistic = shapiro.test(body_mass_g)$statistic, 
        #body_mass_gにshapiro.testを行い、そのstatistic値をstatisticという列に
            p.value = shapiro.test(body_mass_g)$p.value,    #同様
            .groups     = "drop") #グループを解除
head(sw_test_results)
## # A tibble: 2 x 3
##   sex    statistic p.value
##   <fct>      <dbl>   <dbl>
## 1 female     0.977   0.199
## 2 male       0.983   0.416
  • 正規性がないとは言えない→「正規性あり」と判断

統計的仮説検定をしてみよう!

2. 等分散性があるか

  • Fテスト
    • ベクトルとして
      • var.test(【標本A】, 【標本B】)
        • 標本はベクトルc(a, b, c…)で入れる
    • データフレームとして
      • var.test(data = 【data.frame】, 【調べたい値の列名】~ 【グループ分けの列名】)
    • 帰無仮説:等分散性がある
    • p<0.05で等分散性がないことを示す

統計的仮説検定をしてみよう!

2. 等分散性があるか(Fテスト)

var.test(data = penguins_adelie, body_mass_g ~ sex)
## 
##  F test to compare two variances
## 
## data:  body_mass_g by sex
## F = 0.60331, num df = 72, denom df = 72, p-value = 0.03356
## alternative hypothesis: true ratio of variances is not equal to 1
## 95 percent confidence interval:
##  0.3787186 0.9611059
## sample estimates:
## ratio of variances 
##          0.6033147
  • p<0.05なので「等分散性なし」と判断

正規性のある2群の比較

アデリーペンギンの体重に性差があるか?

  • 正規性はあり
  • 等分散性はなし
  • 普通のt検定(正規性と等分散性が前提条件)は使えない
  • → Welchのt検定(正規性のみが前提条件)を使う

正規性のある2群の比較

正規性あり等分散なしの2群の検定

  • Welchのt検定
    • ベクトルとして
      • t.test(【標本A】, 【標本B】)
    • データフレームとして
      • t.test(data = 【data.frame】, 【調べたい値の列名】~ 【グループ分けの列名】)
    • 帰無仮説:平均が等しい
    • p<0.05で平均が異なる母集団に由来することを示す

正規性のある2群の比較

アデリーペンギンの体重に性差があるか?(Welchのt検定)

t.test(data = penguins_adelie, body_mass_g ~ sex)
## 
##  Welch Two Sample t-test
## 
## data:  body_mass_g by sex
## t = -13.126, df = 135.69, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group female and group male is not equal to 0
## 95 percent confidence interval:
##  -776.3012 -573.0139
## sample estimates:
## mean in group female   mean in group male 
##             3368.836             4043.493
  • 帰無仮説「平均が等しい」は棄却→有意差あり

正規性のある2群の比較

アデリーペンギンの体重に性差があるか?(Welchのt検定)

gp = ggplot(data = penguins_adelie) +
  geom_point(aes(x = sex, y = body_mass_g), size = 0.8,
             position = position_jitter(width = 0.07), alpha = 0.5) +
  annotate("text", x = 1.5, y = 5200, label = "***", size = 5, color = "gray30") +
  annotate("segment", x = 1.2, xend = 1.8, y = 5000, yend = 5000, color = "gray30") +
  coord_cartesian(ylim = c(0, 6000))
gp

ようやくグラフが完成!

正規性のある2群の比較

アデリーペンギンの体重に性差があるか?(Welchのt検定)

  • 結果をcsvで出力したいときはeasystatsパッケージを使う
    • パッケージをインストールしてから…
    • report(【統計解析】)
      • このままだと文章型で出力される
    • 後ろに%>% as.data.frameとすると表型になる
    • さらに後ろに%>% write_csvで書き出せる

正規性のある2群の比較

アデリーペンギンの体重に性差があるか?(Welchのt検定)

  • 文章として出力する(効果量も教えてくれる)※1行目の#を消してインストール
#install.packages("easystats", repos = "https://easystats.r-universe.dev")
library("easystats")
report(t.test(data = penguins_adelie, body_mass_g ~ sex)) 
## Effect sizes were labelled following Cohen's (1988) recommendations.
## 
## The Welch Two Sample t-test testing the difference of body_mass_g by sex (mean in group female = 3368.84, mean in group male = 4043.49) suggests that the effect is positive, statistically significant, and large (difference = 674.66, 95% CI [-776.30, -573.01], t(135.69) = -13.13, p < .001; Cohen's d = -2.25, 95% CI [-2.68, -1.82])
  • CSVとして書き出す(フォルダにCSVが出力されているはず)
report(t.test(data = penguins_adelie, body_mass_g ~ sex)) %>%
  as.data.frame %>%                        #データフレームの形にして
  write_csv(file = "result_ttest.csv") %>% #csvに書き出し
  print()                                  #表示
## Parameter   | Group | Mean_Group1 | Mean_Group2 | Difference |             95% CI | t(135.69) |      p |                  Method | Alternative |     d |          d  CI
## -----------------------------------------------------------------------------------------------------------------------------------------------------------------------
## body_mass_g |   sex |     3368.84 |     4043.49 |     674.66 | [-776.30, -573.01] |    -13.13 | < .001 | Welch Two Sample t-test |   two.sided | -2.25 | [-2.68, -1.82]

正規性のある2群の比較

var.equal = の設定で等分散性ありの検定に変えられる


等分散性なし→Welchのt検定

  • t.test(data, Y ~ X, var.equal = FALSE)…デフォルト
    • 何も設定しなかったらこっち

等分散性あり→Studentのt検定

  • t.test(data, Y ~ X, var.equal = TRUE)


等分散性がわからない時点で、F検定をせずにWelchのt検定をすべきという考え方がメジャーになりつつある

正規性のある2群の比較

paired = の設定で対応ありの検定に変えられる

対応なし

  • t.test(data, Y ~ X, paired = FALSE)…デフォルト

対応あり

  • t.test(data, Y ~ X, paired = TRUE)
    • 同じ個体から複数回とったデータを比較したいとき

正規性のある2群の比較

[練習問題]

  • 対応なし、等分散性ありの検定をしてみよう
  • 対応あり、等分散性なしの検定をしてみよう

正規性のある2群の比較

[練習問題]

  • 対応なし、等分散性ありの検定をしてみよう
t.test(data = penguins_adelie, body_mass_g ~ sex, 
       paired = FALSE, var.equal = TRUE) # paired = FALSEは省略可能
## 
##  Two Sample t-test
## 
## data:  body_mass_g by sex
## t = -13.126, df = 144, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group female and group male is not equal to 0
## 95 percent confidence interval:
##  -776.2484 -573.0666
## sample estimates:
## mean in group female   mean in group male 
##             3368.836             4043.493

正規性のある2群の比較

[練習問題]

  • 対応あり、等分散性なしの検定をしてみよう
t.test(data = penguins_adelie, body_mass_g ~ sex, 
       paired = TRUE, var.equal = FALSE) # var.equal = FALSEは省略可能
## 
##  Paired t-test
## 
## data:  body_mass_g by sex
## t = -14.264, df = 72, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -768.944 -580.371
## sample estimates:
## mean of the differences 
##               -674.6575

正規性のない2群の比較

くちばしの形は雌雄で異なるか?

  • 細長さは(bill_length_mm)÷(bill_depth_mm)で指標が作れそう
  • こういう割り算データは正規性がないと思ったほうがいい
  • (平均値や中央値が0や1に近いときの分布を考えてみよう)

正規性のない2群の比較

くちばしの細長さは雌雄で異なるか?

[練習問題]

  • アデリーペンギンのくちばしの細長さを計算しよう
  • 計算できたらプロットしてみよう

正規性のない2群の比較

くちばしの細長さは雌雄で異なるか?

[練習問題]

penguins_adelie = penguins %>%
  filter(species == "Adelie", !is.na(sex)) %>% #NAを除く
  mutate(ratio = bill_depth_mm/bill_length_mm)
head(penguins_adelie)
## # A tibble: 6 x 9
##   species island bill_length_mm bill_depth_mm flipper_length_… body_mass_g sex  
##   <fct>   <fct>           <dbl>         <dbl>            <int>       <int> <fct>
## 1 Adelie  Torge…           39.1          18.7              181        3750 male 
## 2 Adelie  Torge…           39.5          17.4              186        3800 fema…
## 3 Adelie  Torge…           40.3          18                195        3250 fema…
## 4 Adelie  Torge…           36.7          19.3              193        3450 fema…
## 5 Adelie  Torge…           39.3          20.6              190        3650 male 
## 6 Adelie  Torge…           38.9          17.8              181        3625 fema…
## # … with 2 more variables: year <int>, ratio <dbl>

正規性のない2群の比較

くちばしの細長さは雌雄で異なるか?

[練習問題]

gp = ggplot(data = penguins_adelie) +
  geom_point(aes(x = sex, y = ratio), 
             position = position_jitter(width = 0.05))
gp

正規性のない2群の比較

くちばしの細長さは雌雄で異なるか?

1. 各標本に正規性はあるか(Q-Q plot

gp = ggplot(data = penguins_adelie) +
       stat_qq(aes(sample = ratio, color = sex)) + 
       facet_wrap( ~ sex, scales = "free")
gp

正規性のない2群の比較

くちばしの細長さは雌雄で異なるか?

1. 各標本に正規性はあるか(Shapiro-Wilkテスト)

sw_test_results = penguins_adelie %>%   #penguins_adelieを使う
  group_by(sex) %>%                     #sexでグループ
  summarise(statistic = shapiro.test(ratio)$statistic, 
            p.value = shapiro.test(ratio)$p.value, 
            .groups     = "drop") 
head(sw_test_results)
## # A tibble: 2 x 3
##   sex    statistic p.value
##   <fct>      <dbl>   <dbl>
## 1 female     0.975 0.164  
## 2 male       0.954 0.00962

統計的仮説検定をしてみよう!

くちばしの細長さは雌雄で異なるか?

2. 等分散性があるか(Fテスト)

var.test(data = penguins_adelie, ratio ~ sex)
## 
##  F test to compare two variances
## 
## data:  ratio by sex
## F = 0.73443, num df = 72, denom df = 72, p-value = 0.1928
## alternative hypothesis: true ratio of variances is not equal to 1
## 95 percent confidence interval:
##  0.4610261 1.1699847
## sample estimates:
## ratio of variances 
##          0.7344341

正規性のない2群の比較

くちばしの細長さは雌雄で異なるか?

  • 正規性はなし
  • 等分散性はあり
  • 対応はない
  • → Wilcoxonの順位和検定(U検定と同じ)を行う

正規性のない2群の比較

正規性なし等分散性ありの2群の比較

  • Wilcoxonの順位和検定
    • デフォルトのwilcox.test()ではタイ(同値)があった場合に正確なp値が出ないのでcoinパッケージを使う
      • ベクトルとして
        • wilcox_test(【標本A】, 【標本B】, distribution = “exact”)
      • データフレームとして
        • wilcox_test(data = 【data.frame】, 【調べたい値の列名】~ 【グループ分けの列名】, distribution = “exact”)
    • 帰無仮説:2群間に差がない
    • p<0.05で異なる母集団に由来することを示す

正規性なし、等分散性ありの2群の比較

くちばしの細長さは雌雄で異なるか?

まずインストールする(1行目の#を消して走らせる)

#install.packages("coin")
library(coin)             # 読み込み
wilcox_test(data = penguins_adelie, ratio ~ sex, distribution = "exact")
## 
##  Exact Wilcoxon-Mann-Whitney Test
## 
## data:  ratio by sex (female, male)
## Z = 0.29941, p-value = 0.7661
## alternative hypothesis: true mu is not equal to 0
  • 帰無仮説「2群間に差がない」は棄却されない→有意差なし

正規性なし、等分散性ありの2群の比較

対応なし→Wilcoxonの順位和検定

  • wilcox_test(data, Y ~ X, distribution = “exact”)

対応あり→Wilcoxonの符号順位検定

  • wilcoxsign_test(data, Y ~ X, distribution = “exact”)

正規性なし、等分散性なしの2群の比較

  • Brunner-Munzel検定

正規性なし、等分散性なしの2群の比較

  • Brunner-Munzel検定
    • brunnermunzelパッケージを使う
    • ベクトルとして
      • brunnermunzel.test(【標本A】, 【標本B】)
    • データフレームとして
      • brunnermunzel.test(data = 【data.frame】, 【調べたい値の列名】~ 【グループ分けの列名】)
    • 帰無仮説:2群間に差がない
    • p<0.05で異なる母集団に由来することを示す
    • 「サンプル数が少ない」というエラーが出たらbrunnermunzel.permutation.test

正規性なし、等分散性なしの2群の比較

さっきのデータで使ってみよう

まずインストールする(1行目の#を消して走らせる)

#install.packages("brunnermunzel")
library(brunnermunzel)             # 読み込み
brunnermunzel.test(data = penguins_adelie, ratio ~ sex)
## 
##  Brunner-Munzel Test
## 
## data:  ratio by sex
## Brunner-Munzel Test Statistic = -0.29701, df = 143.58, p-value = 0.7669
## 95 percent confidence interval:
##  0.3901081 0.5811811
## sample estimates:
## P(X<Y)+.5*P(X=Y) 
##        0.4856446

【まとめ】1要因2群間の検定法

  1. まずはプロット
  2. 正規性, 等分散性, 対応あり/なしを確認
    • Q-Q plot, Shapiro-Wilkテスト
    • F検定
  3. 検定方法を決める
    • Studentのt検定(対応あり/なし)
    • Welchのt検定(対応あり/なし)
    • Wilcoxonの順位和検定
    • Wilcoxonの符号順位検定
    • Brunner-Munzel検定(対応あり/なし)

多群(3群以上)の比較をしよう

2群の比較を単に繰り返すのはダメ

  • 仮説検定の考え方を思い出そう
  1. 同じ母集団由来であった場合に今回得られた標本の差が生じる確率が低い(<5%)→帰無仮説を棄却する
  2. その結果、対立仮説を採用する

どこかで有意差が出る確率はどんどん高まる

多群(3群以上)の比較をしよう

有意差があった群のみ検定したことにする?

→もちろん不正!!

多重比較法を使うか、有意水準を補正する

  • 今回は多重比較を紹介します
  • 有意水準の補正の方法はこちらなど

多群(3群以上)の比較をしよう

【復習】読み込んでデータをざっくり眺める

library(palmerpenguins)               #penguinsを読み込み
library(tidyverse)                    #tidyverseを読み込み
head(penguins)                        #penguinsの最初を見せて!
## # A tibble: 6 x 8
##   species island bill_length_mm bill_depth_mm flipper_length_… body_mass_g sex  
##   <fct>   <fct>           <dbl>         <dbl>            <int>       <int> <fct>
## 1 Adelie  Torge…           39.1          18.7              181        3750 male 
## 2 Adelie  Torge…           39.5          17.4              186        3800 fema…
## 3 Adelie  Torge…           40.3          18                195        3250 fema…
## 4 Adelie  Torge…           NA            NA                 NA          NA <NA> 
## 5 Adelie  Torge…           36.7          19.3              193        3450 fema…
## 6 Adelie  Torge…           39.3          20.6              190        3650 male 
## # … with 1 more variable: year <int>
  • ペンギンの体重は種ごとに異なるか?

多群(3群以上)の比較をしよう

ペンギンの体重は種ごとに異なるか?

  • 体重に性差があるのでメスに限定して調べよう
  • まずはデータをプロットしよう
penguins_female = penguins %>%
  filter(sex == "female")
head(penguins_female)
## # A tibble: 6 x 8
##   species island bill_length_mm bill_depth_mm flipper_length_… body_mass_g sex  
##   <fct>   <fct>           <dbl>         <dbl>            <int>       <int> <fct>
## 1 Adelie  Torge…           39.5          17.4              186        3800 fema…
## 2 Adelie  Torge…           40.3          18                195        3250 fema…
## 3 Adelie  Torge…           36.7          19.3              193        3450 fema…
## 4 Adelie  Torge…           38.9          17.8              181        3625 fema…
## 5 Adelie  Torge…           41.1          17.6              182        3200 fema…
## 6 Adelie  Torge…           36.6          17.8              185        3700 fema…
## # … with 1 more variable: year <int>

多群(3群以上)の比較をしよう

ペンギンの体重は種ごとに異なるか?

  • まずはデータをプロットしよう
gp = ggplot(data = penguins_female) +
  geom_point(aes(x = species, y = body_mass_g), 
             position = position_jitter(width = 0.05))
gp

  • 差がありそうな雰囲気…!

多群(3群以上)の比較をしよう

3群以上の比較を行うときも進め方は同じ

  1. データをプロットして眺める
  2. 各標本に正規性があるか調べる
    • Q-Q plot
    • Shapiro-Wilkテスト
  3. 等分散性はあるか調べる
    • Bartlettテスト ←Fテストの多群版
  4. 2, 3の結果を受けて検定方法を決め、検定する

多群(3群以上)の比較をしよう

1. 各標本に正規性はあるか(Q-Q plot

gp = ggplot(data = penguins_female) +
  stat_qq(aes(sample = body_mass_g, color = species)) + 
  facet_wrap( ~ species, scales = "free")
gp

  • 正規Q-Q plotで直線上に乗っているような気がする

多群(3群以上)の比較をしよう

1. 各標本に正規性はあるか(Shapiro-Wilkテスト)

sw_test_results = penguins_female %>%   #penguins_adelieを使う
  group_by(species) %>%                     #speciesでグループ
  summarise(statistic = shapiro.test(body_mass_g)$statistic, 
        #body_mass_gにshapiro.testを行い、そのstatistic値をstatisticという列に
            p.value = shapiro.test(body_mass_g)$p.value,    #同様
            .groups     = "drop") #グループを解除
head(sw_test_results)
## # A tibble: 3 x 3
##   species   statistic p.value
##   <fct>         <dbl>   <dbl>
## 1 Adelie        0.977   0.199
## 2 Chinstrap     0.963   0.306
## 3 Gentoo        0.981   0.511
  • 「正規性あり」と判断

多群(3群以上)の比較をしよう

2. 等分散性があるか

  • Bartlettテスト
    • ベクトルとして
      • bartlett.test(x = list(A, B, C))
    • データフレームとして
      • bartlett.test(data = 【data.frame】, 【調べたい値の列名】~ 【グループ分けの列名】)
    • 帰無仮説:等分散性がある
    • p<0.05で等分散性がないことを示す

多群(3群以上)の比較をしよう

2. 等分散性があるか(Bartlettテスト)

bartlett.test(data = penguins_female, body_mass_g ~ species)
## 
##  Bartlett test of homogeneity of variances
## 
## data:  body_mass_g by species
## Bartlett's K-squared = 0.19828, df = 2, p-value = 0.9056
  • 「等分散性あり」と判断

多群(3群以上)の比較をしよう

ペンギンの体重は種ごとに異なるか?

  • 正規性あり
  • 等分散性あり
  • 3群以上
  • → 一元分散分析(ANOVA)を使う

多群(3群以上)の比較をしよう

正規性あり等分散性ありの多群比較

  • 一元分散分析(ANOVA)
    • summary(aov(data = 【data.frame】, 【調べたい値の列名】~ 【グループ分けの列名】))
    • 帰無仮説:全ての群が同一の母集団に由来する(=全ての群に差がない)
    • p<0.05で異なる母集団に由来することを示す

多群(3群以上)の比較をしよう

ペンギンの体重は種ごとに異なるか?

summary(aov(data = penguins_female, body_mass_g ~ species))
##              Df   Sum Sq  Mean Sq F value Pr(>F)    
## species       2 60350016 30175008   393.2 <2e-16 ***
## Residuals   162 12430757    76733                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
  • 有意差はある
  • 帰無仮説(群間に差がない)は棄却された
  • どのペアに差があるのか?
    • post-hocテストを行う

多群(3群以上)の比較をしよう

正規性あり等分散性ありの多群比較のpost-hocテスト

  • Tukeyの多重比較
    • TukeyHSD(aov(data = 【data.frame】, 【調べたい値の列名】~ 【グループ分けの列名】))
    • 帰無仮説:2群間に差がない
    • p<0.05で異なる母集団に由来することを示す

多群(3群以上)の比較をしよう

ペンギンの体重は種ごとに異なるか?

TukeyHSD(aov(data = penguins_female, body_mass_g ~ species))
##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = body_mass_g ~ species, data = penguins_female)
## 
## $species
##                       diff        lwr       upr     p adj
## Chinstrap-Adelie  158.3703   22.32078  294.4197 0.0179471
## Gentoo-Adelie    1310.9058 1195.64908 1426.1624 0.0000000
## Gentoo-Chinstrap 1152.5355 1011.00620 1294.0648 0.0000000

多群(3群以上)の比較をしよう

ペンギンの体重は種ごとに異なるか?

gp = ggplot(data = penguins) +
  geom_point(aes(x = species, y = body_mass_g), size = 0.5, 
             position = position_jitter(width = 0.05), alpha = 0.3) +
  annotate("text", x = c(1, 2, 3), y = 7000, label = c("a", "b", "c")) +
  coord_cartesian(ylim = c(0, 8000))
gp
## Warning: Removed 2 rows containing missing values (geom_point).

できあがり!

多群(3群以上)の比較をしよう

正規性なし、等分散性ありの場合は…

  • Kruscal-Wallis検定
    • kruskal.test(data = 【data.frame】, 【調べたい値の列名】~ 【グループ分けの列名】)
    • 帰無仮説:全ての群に差がない
    • p<0.05で異なる母集団に由来することを示す
    • ただし近似のp値を計算するのでサンプルサイズが小さい場合は注意

多群(3群以上)の比較をしよう

post-hocは…

  • Steel-Dwass検定
    • NSM3パッケージを使う
    • pSDCFlig(【調べたい値をベクトルで】, 【グループ分けをベクトルで】, method = 【方法】)
      • methodは3種類
        • “Exact”…正確
        • “Asymptotic”… 漸近
        • “Monte Carlo”…モンテカルロ法
          • 正確以外の場合はサンプルサイズに注意
    • 帰無仮説:2群間に差がない
    • p<0.05で異なる母集団に由来することを示す

多群(3群以上)の比較をしよう

ペンギンの体重は種ごとに異なるか?(Kruscal-Wallis)

kruskal.test(data = penguins_female, body_mass_g ~ species)
## 
##  Kruskal-Wallis rank sum test
## 
## data:  body_mass_g by species
## Kruskal-Wallis chi-squared = 115.24, df = 2, p-value < 2.2e-16

多群(3群以上)の比較をしよう

ペンギンの体重は種ごとに異なるか?(Steel-Dwass)

まずインストールする(1行目の#を消して走らせる)

#install.packages("NSM3")
library(NSM3)
pSDCFlig(penguins_female$body_mass_g, penguins_female$species, method = "Asymptotic")
## Ties are present, so p-values are based on conditional null distribution. 
## Group sizes: 73 34 58 
## Using the Asymptotic method: 
##  
## For treatments Adelie - Chinstrap, the Dwass, Steel, Critchlow-Fligner W Statistic is 3.8595. 
## The smallest experimentwise error rate leading to rejection is 0.0175 .
##   
## For treatments Adelie - Gentoo, the Dwass, Steel, Critchlow-Fligner W Statistic is 13.877. 
## The smallest experimentwise error rate leading to rejection is 0 .
##   
## For treatments Chinstrap - Gentoo, the Dwass, Steel, Critchlow-Fligner W Statistic is 11.2606. 
## The smallest experimentwise error rate leading to rejection is 0 .
## 

【まとめ】1要因多群間の検定法

  1. まずはプロット
  2. 正規性, 等分散性, 対応あり/なしを確認
    • Q-Q plot, Shapiro-Wilkテスト
    • Bartlettテスト
  3. 検定方法を決める

2要因の場合は…

  • Two-way ANOVAやFriedman検定など

割合の検定をしてみよう!

割合の検定をしてみよう!

ペンギンの性比は種ごとに異なるか?

penguins_sexratio_sum = penguins %>% 
  group_by(species, sex) %>%            # speciesとsexごとにグループ分け
  summarise(length = length(species),   # N数を数える
            .groups     = "drop") %>%   # groupを解除
  filter(!is.na(sex)) %>%               # sex == NAを除去
  print()                               # 表示
## # A tibble: 6 x 3
##   species   sex    length
##   <fct>     <fct>   <int>
## 1 Adelie    female     73
## 2 Adelie    male       73
## 3 Chinstrap female     34
## 4 Chinstrap male       34
## 5 Gentoo    female     58
## 6 Gentoo    male       61

割合の検定をしてみよう!

ペンギンの性比は種ごとに異なるか?

gp = ggplot(data = penguins_sexratio_sum, aes(x = species, y = length)) +
  geom_bar(aes(fill = sex), stat = "identity", position = "fill") +
  scale_y_continuous(labels = scales::percent) +
  coord_flip()                    # X軸とY軸を逆にする
gp

  • まぁ違わなそうですけどね…

割合の検定をしてみよう!

  • カイ2乗検定
    • chisq.test(【ベクトルA】,【ベクトルB】)
      • A…【data.frame】$【調べたい値の列名】
      • B…【data.frame】$【グループ分けの列名】
    • 帰無仮説:2群の比率に差がない
    • サンプル数が小さい場合はフィッシャーの正確確率検定
  • フィッシャーの正確確率検定
    • fisher.test(【ベクトルA】,【ベクトルB】)
      • A…【data.frame】$【調べたい値の列名】
      • B…【data.frame】$【グループ分けの列名】
    • 帰無仮説:2群の比率に差がない

割合の検定をしてみよう!

ペンギンの性比は種ごとに異なるか?

penguins_sexratio = penguins %>%
  filter(!is.na(sex))              # NAを除く
chisq.test(penguins_sexratio$sex, penguins_sexratio$species)
## 
##  Pearson's Chi-squared test
## 
## data:  penguins_sexratio$sex and penguins_sexratio$species
## X-squared = 0.048607, df = 2, p-value = 0.976

統計的仮説検定から統計モデリングへ

統計的仮説検定は古くから用いられている方法

だけどこれだとうまく解析できないことも…

  • 例えば値と値の関係性とか、複数の要因が考えられるとき

→こういうときは統計モデリングが適している

統計モデリングの基本

応答変数と説明変数

  • 応答変数(目的変数/従属変数; Y):調べたい値
  • 説明変数(独立変数; X):Yのばらつきの要因として調べる変数

一般線形モデル(Linear model, LM)

  • 説明変数と応答変数を線形回帰するモデリング手法
  • 前提:応答変数の残差は正規分布に従う

一般化線形モデル(Generalized linear model, GLM)

  • 線形以外の式(制限あり)にも回帰できるモデリング手法
  • 前提:応答変数の残差は正規分布、二項分布、ポアソン分布などに従う

モデリングで値の関係性を調べよう

【復習】データを読み込んでざっくり眺める

library(palmerpenguins)               #penguinsを読み込み
library(tidyverse)                    #tidyverseを読み込み
head(penguins)                        #penguinsの最初を見せて!
## # A tibble: 6 x 8
##   species island bill_length_mm bill_depth_mm flipper_length_… body_mass_g sex  
##   <fct>   <fct>           <dbl>         <dbl>            <int>       <int> <fct>
## 1 Adelie  Torge…           39.1          18.7              181        3750 male 
## 2 Adelie  Torge…           39.5          17.4              186        3800 fema…
## 3 Adelie  Torge…           40.3          18                195        3250 fema…
## 4 Adelie  Torge…           NA            NA                 NA          NA <NA> 
## 5 Adelie  Torge…           36.7          19.3              193        3450 fema…
## 6 Adelie  Torge…           39.3          20.6              190        3650 male 
## # … with 1 more variable: year <int>
  • 体重の大きいペンギンは翼長も長い?

モデリングで値の関係性を調べよう

体重の大きいペンギンは翼長も長い?

  • まずはデータをプロットしよう
gp = ggplot(data = penguins_adelie) +
  geom_point(aes(x = body_mass_g, y = flipper_length_mm)) 
gp

  • 微妙な傾向はありそう…統計的にはどうか?

モデリングで値の関係性を調べよう

一般線形モデル(Linear model, LM)

  • Y ~ β0 + β1X
  • 最小二乗法によって残差が最小になるβ0とβ1を求める    引用:biostatics

モデリングで値の関係性を調べよう

一般線形モデル(Linear model, LM)

  • lm(data =【data.frame】,【応答変数の列名】~【説明変数の列名】)
    • 前提:応答変数の残差は正規分布に従う

モデリングで値の関係性を調べよう

体重の大きいペンギンは翼長も長い?(一般線形モデル)

lm_result = lm(flipper_length_mm ~ body_mass_g, data = penguins_adelie) 
                         #結果をlm_resultに入れる
summary(lm_result)       #lm_resultの詳細を表示する
## 
## Call:
## lm(formula = flipper_length_mm ~ body_mass_g, data = penguins_adelie)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -14.426  -3.669   0.239   3.422  17.955 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 1.656e+02  3.918e+00   42.27  < 2e-16 ***
## body_mass_g 6.610e-03  1.049e-03    6.30  3.4e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 5.794 on 144 degrees of freedom
## Multiple R-squared:  0.2161, Adjusted R-squared:  0.2106 
## F-statistic: 39.69 on 1 and 144 DF,  p-value: 3.402e-09

モデリングで値の関係性を調べよう

体重の大きいペンギンは翼長も長い?(一般線形モデル)

  • Coefficients: 回帰係数
    • Estimates: 推定値
      • (Intercept): 切片
      • body_mass_g: body_mass_gの係数
    • Pr(>|t|): 回帰係数が0であるという帰無仮説に対するp値。
  • (ということは…)
  • (Intercept): 1.656e+02 = 165.6
  • body_mass_g: 6.610e-03 = 0.00661
  • Pr(>|t|): 3.4e-09
  • →翼長への体サイズの効果は有意である
  • →Y ~ 0.00661X + 165.6に回帰できる

モデリングで値の関係性を調べよう

easystatsのreportで結果を出力する

report(lm_result) %>%
  as.data.frame() %>%    #データフレーム型にする
  write_csv(file = "result_lm.csv") %>%  # CSVで出力
  print()                #ここでも表示
## Parameter   | Coefficient |           95% CI | t(144) |      p | Std. Coef. | Std. Coef. 95% CI |    Fit
## --------------------------------------------------------------------------------------------------------
## (Intercept) |      165.60 | [157.86, 173.35] |  42.27 | < .001 |  -1.92e-15 |     [-0.15, 0.15] |       
## body mass g |    6.61e-03 | [  0.00,   0.01] |   6.30 | < .001 |       0.46 |     [ 0.32, 0.61] |       
##             |             |                  |        |        |            |                   |       
## AIC         |             |                  |        |        |            |                   | 931.33
## BIC         |             |                  |        |        |            |                   | 940.28
## R2          |             |                  |        |        |            |                   |   0.22
## R2 (adj.)   |             |                  |        |        |            |                   |   0.21
## Sigma       |             |                  |        |        |            |                   |   5.79
  • Working directoryにCSVが出力されているはず

モデリングで値の関係性を調べよう

ggplotで描画もできる(geom_smooth, method = “lm”)

gp = ggplot(data = penguins_adelie) +
  geom_point(aes(x = body_mass_g, y = flipper_length_mm), 
             position = position_jitter(width = 0.05), alpha = 0.5)  +
  geom_smooth(aes(x = body_mass_g, y = flipper_length_mm), method = "lm")  +
                                                              #lmで回帰した直線を引く
  annotate("text", x = 4200, y = 210, 
           label = "(Y ~ 0.00661X + 165.6, p = 3.4e-09)", size = 4)
gp

モデリングで値の関係性を調べよう

残差は正規分布していたのか?

shapiro.test(lm_result$residuals)  #残差の正規性をShapiro検定
## 
##  Shapiro-Wilk normality test
## 
## data:  lm_result$residuals
## W = 0.99179, p-value = 0.562
  • してたっぽいですね!

モデリングで値の関係性を調べよう

性を考慮したらもう少しうまく説明できるかも…?

複数の説明変数を検討することもできる

  • lm(data = 【data.frame】, 【応答変数の列名】~【説明変数1の列名】+【説明変数2の列名】)
    • 前提
      • 応答変数の残差は正規分布に従う
      • 説明変数同士は独立である(相関関係などがない)
    • 有意でない説明変数はモデルから取り除く

モデリングで値の関係性を調べよう

翼長は体重と性で説明できるか?(一般線形モデル)

lm_result = lm(flipper_length_mm ~ body_mass_g + sex, data = penguins_adelie) 
                         #結果をlm_resultに入れる
summary(lm_result)       #lm_resultの詳細を表示する
## 
## Call:
## lm(formula = flipper_length_mm ~ body_mass_g + sex, data = penguins_adelie)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -14.4087  -3.5229   0.1197   3.3750  17.8645 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 1.665e+02  5.300e+00  31.410  < 2e-16 ***
## body_mass_g 6.333e-03  1.560e-03   4.059 8.08e-05 ***
## sexmale     3.440e-01  1.426e+00   0.241     0.81    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 5.813 on 143 degrees of freedom
## Multiple R-squared:  0.2164, Adjusted R-squared:  0.2054 
## F-statistic: 19.75 on 2 and 143 DF,  p-value: 2.676e-08

モデリングで値の関係性を調べよう

翼長は体重と性で説明できるか?(一般線形モデル)

  • 有意ではなかったので、sexの項を取り除いてモデリングは終わり
lm_result = lm(flipper_length_mm ~ body_mass_g, data = penguins_adelie) 
summary(lm_result)
## 
## Call:
## lm(formula = flipper_length_mm ~ body_mass_g, data = penguins_adelie)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -14.426  -3.669   0.239   3.422  17.955 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 1.656e+02  3.918e+00   42.27  < 2e-16 ***
## body_mass_g 6.610e-03  1.049e-03    6.30  3.4e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 5.794 on 144 degrees of freedom
## Multiple R-squared:  0.2161, Adjusted R-squared:  0.2106 
## F-statistic: 39.69 on 1 and 144 DF,  p-value: 3.402e-09

線形ではうまくモデリングできない…


   引用:久保先生の講義のーと

  • 応答変数がマイナス?
  • 本当にばらつきが一定?(右側でばらつき増えてない?)

もっと拡張性の高いモデリングをしよう

一般化線形モデル(Generalized linear model, GLM)

  • 一般線形モデル(単回帰、重回帰)を拡張した回帰分析
    • 応答変数の残差は正規分布、二項分布、ポアソン分布などに従う
    • 正規分布にした場合はlm()と同じ
    • lm()を使うより全部glmで解析するのがもはや一般的

  • 誤差構造リンク関数を設定する
    • 誤差構造:応答変数の残差の確率分布
    • リンク関数:応答変数と説明変数の関係 = 回帰式

もっと拡張性の高いモデリングをしよう

一般化線形モデル(Generalized linear model, GLM)

  • glm(data = 【data.frame】, 【応答変数】~【説明変数】, family = 【誤差構造】(link = 【リンク関数】))
    • 誤差構造の設定でリンク関数は自動で決まる(変更可能)
誤差構造(family) リンク関数(g(μ))
正規(gaussian) μ
二項 (binomial) log(μ/(1-μ))
ポアソン(poisson) log(μ)
ガンマ (gamma) 1/μ

上限なしカウントデータをGLMしよう

植物のサイズが種子数に及ぼす影響を調べよう

  • 久保先生の種子数データを解析しよう
  • カウントデータ(離散値)は一般的に正規性を示さない
seed= read_csv("https://kuboweb.github.io/-kubo/stat/iwanamibook/fig/poisson/data3a.csv") %>%
  rename(no.seed = y, plant_size = x, treatment = f)
head(seed)
## # A tibble: 6 x 3
##   no.seed plant_size treatment
##     <dbl>      <dbl> <chr>    
## 1       6       8.31 C        
## 2       6       9.44 C        
## 3       6       9.5  C        
## 4      12       9.07 C        
## 5      10      10.2  C        
## 6       4       8.32 C

上限なしカウントデータをGLMしよう

植物のサイズが種子数に及ぼす影響を調べよう

  • まずはプロットしてみる
gp = ggplot(data = seed) +
  geom_point(aes(x =plant_size , y = no.seed)) +
  facet_wrap(~treatment)
gp

  • なんとなくサイズが大きいほうが種子数が多いような…?

上限なしカウントデータをGLMしよう

ポアソン分布(Poisson distribution)

  • ある時間間隔(λ)で発生する離散的な事象を数える特定の確率変数 X を持つ離散確率分布
  • 以下のような理由から、上限のないカウントデータのモデリングに使われる
  1. 値が非負の整数である {0, 1, 2, …}
  2. yに下限(ゼロ)はある、上限はよくわからない
  3. 平均と分散がだいたい等しい(データと合っているか検討の余地あり)

上限なしカウントデータをGLMしよう

ポアソン分布(Poisson distribution)でGLMする

  • glm(data = 【data.frame】, 【応答変数の列名】~【説明変数の列名】, family = poisson)

  • デフォルトのリンク関数はlog

    • Y ~ exp(β0 + β1X)
    • 指数曲線に回帰される(0 < y < ∞)
  • 分散が平均よりかなり大きい場合は負の二項分布を使うが、とりあえずポアソンを試してみることが多い

上限なしカウントデータをGLMしよう

植物のサイズが種子数に及ぼす影響を調べよう

glm_result = glm(no.seed ~ plant_size, data = seed, family = poisson)
summary(glm_result)
## 
## Call:
## glm(formula = no.seed ~ plant_size, family = poisson, data = seed)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.3679  -0.7348  -0.1775   0.6987   2.3760  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  1.29172    0.36369   3.552 0.000383 ***
## plant_size   0.07566    0.03560   2.125 0.033580 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##     Null deviance: 89.507  on 99  degrees of freedom
## Residual deviance: 84.993  on 98  degrees of freedom
## AIC: 474.77
## 
## Number of Fisher Scoring iterations: 4

上限なしカウントデータをGLMしよう

植物のサイズが種子数に及ぼす影響を調べよう

glm_result = glm(no.seed ~ plant_size, data = seed, family = poisson)
summary(glm_result)
  • 結果の見方はほぼ同じ
  • Coefficients: 回帰係数
    • Estimates: 推定値
      • (Intercept): 切片
      • plant_size: plant_sizeの係数
    • Pr(>|t|): 回帰係数が0であるという帰無仮説に対するp値。
  • (Intercept): 1.29172
  • plant_size: 0.07566
  • Pr(>|t|): 0.033580
  • →種子数への植物サイズの効果は有意である
  • →Y ~ exp(1.29172 + 0.07566X)に回帰できる

上限なしカウントデータをGLMしよう

ggplotで描画もできる(geom_smooth, method = “glm”)

  • method = glm #GLMを指定できる
  • method.args = list(family = poisson) #分布を指定する
gp = ggplot(data = seed) +
  geom_point(aes(x =plant_size , y = no.seed)) +
  geom_smooth(aes(x =plant_size , y = no.seed), 
              method = glm, method.args = list(family = poisson)) +
  annotate("text", x = 10.5, y = 16, 
           label = "(Y ~ exp(1.29172 + 0.07566X, p = 0.03358)", size = 4)
gp

上限ありカウントデータをGLMしよう

植物のサイズが種子の生存率に及ぼす影響を調べよう

  • 久保先生の種子の生存率データを解析しよう
  • 上限のあるカウントデータ(離散値)も一般的に正規性を示さない
seed2= read_csv("https://kuboweb.github.io/-kubo/stat/iwanamibook/fig/binomial/data4a.csv") %>%
  rename(observed_seed = N, survived_seed = y, plant_size = x, treatment = f)
head(seed2)
## # A tibble: 6 x 4
##   observed_seed survived_seed plant_size treatment
##           <dbl>         <dbl>      <dbl> <chr>    
## 1             8             1       9.76 C        
## 2             8             6      10.5  C        
## 3             8             5      10.8  C        
## 4             8             6      10.9  C        
## 5             8             1       9.37 C        
## 6             8             1       8.81 C

上限ありカウントデータをGLMしよう

植物のサイズが種子の生存率に及ぼす影響を調べよう

  • まずはプロットしてみる
gp = ggplot(data = seed2) +
  geom_point(aes(x = plant_size , y = survived_seed, color = treatment))
gp

  • サイズが大きいほうが生存率が高いような…?
  • treatmentでも違いがありそう

上限ありカウントデータをGLMしよう

二項分布(Binomial distribution)

  • 結果が成功か失敗のいずれかである試行を独立にn回行ったときの成功回数を確率変数とする離散確率分布

  • 以下のような上限のあるカウントデータ(生存率など)のモデリングに使われる
  1. 値が非負の整数である {0, 1, 2, …, N}
  2. yに下限(ゼロ)、上限(最大値)がある

上限ありカウントデータをGLMしよう

二項分布(Binomial distribution)でGLMする

  • glm(data = 【dataframe】, Y ~ X, family = binomial)
    • 応答変数(2値データ)を示す整数からなる2列として
      • 各条件に関する成功数と失敗数の対データなど
    • 応答変数を示すfactor(2値)からなる1列として
      • 成功 or 失敗、0 or 1など
    • 詳しい使い方はこちら
  • デフォルトのリンク関数はロジット(logit)
    • Y ~ 1/(1 + exp(-(β0 + β1X)))
    • シグモイド曲線に回帰される(0 < y < 1)

上限ありカウントデータをGLMしよう

植物のサイズが種子の生存率に及ぼす影響を調べよう

  • 2値データ(Yes or No)を示す2列を作る
  • 今回は生存した種子数(survived_seed)と死んだ種子数(dead_seed)
seed3 = seed2 %>% 
  mutate(dead_seed = observed_seed-survived_seed)
head(seed3)
## # A tibble: 6 x 5
##   observed_seed survived_seed plant_size treatment dead_seed
##           <dbl>         <dbl>      <dbl> <chr>         <dbl>
## 1             8             1       9.76 C                 7
## 2             8             6      10.5  C                 2
## 3             8             5      10.8  C                 3
## 4             8             6      10.9  C                 2
## 5             8             1       9.37 C                 7
## 6             8             1       8.81 C                 7

上限ありカウントデータをGLMしよう

植物のサイズが種子の生存率に及ぼす影響を調べよう

glm_result = glm(cbind(survived_seed, dead_seed) ~ plant_size, 
                 data = seed3, family = binomial)
summary(glm_result)
## 
## Call:
## glm(formula = cbind(survived_seed, dead_seed) ~ plant_size, family = binomial, 
##     data = seed3)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.3998  -1.1536   0.2472   1.1787   3.1231  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -13.7785     1.0773  -12.79   <2e-16 ***
## plant_size    1.4626     0.1107   13.21   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 499.23  on 99  degrees of freedom
## Residual deviance: 217.17  on 98  degrees of freedom
## AIC: 364.35
## 
## Number of Fisher Scoring iterations: 5

上限ありカウントデータをGLMしよう

植物のサイズが種子の生存率に及ぼす影響を調べよう

glm_result = glm(cbind(survived_seed, dead_seed) ~ plant_size, 
                 data = seed3, family = binomial)
summary(glm_result)
  • (Intercept): -13.7785

  • plant_size: 1.4626

  • Pr(>|t|): <2e-16

  • →種子の生存率への植物サイズの効果は有意である

  • →Y ~ 1/(1 + exp(-(-13.7783 + 1.4626X)))に回帰できる

  • では、次にtreatmentの効果も考慮に入れてみよう

上限ありカウントデータをGLMしよう

サイズとtreatmentが種子の生存率に及ぼす影響を調べよう

glm_result = glm(cbind(survived_seed, dead_seed) ~ plant_size + treatment, 
                 data = seed3, family = binomial)
summary(glm_result)
## 
## Call:
## glm(formula = cbind(survived_seed, dead_seed) ~ plant_size + 
##     treatment, family = binomial, data = seed3)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.2584  -0.7948   0.1753   0.8757   3.1589  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -19.5361     1.4138  -13.82   <2e-16 ***
## plant_size    1.9524     0.1389   14.06   <2e-16 ***
## treatmentT    2.0215     0.2313    8.74   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 499.23  on 99  degrees of freedom
## Residual deviance: 123.03  on 97  degrees of freedom
## AIC: 272.21
## 
## Number of Fisher Scoring iterations: 5

上限ありカウントデータをGLMしよう

サイズとtreatmentが種子の生存率に及ぼす影響を調べよう

glm_result = glm(cbind(survived_seed, dead_seed) ~ plant_size + treatment, 
                 data = seed3, family = binomial)
summary(glm_result)
  • (Intercept): -19.5361
  • plant_size: 1.9524…plant sizeが1上がったときの効果
  • treatmentT: 2.0215…C→Tになったときの効果
  • Pr(>|t|): <2e-16
  • →サイズもtreatmentも効果は有意である
  • →Y ~ 1/(1 + exp(-(-19.5361 + 1.9524plant_size + 2.0215treatmentT)))に回帰できる

上限ありカウントデータをGLMしよう

サイズとtreatmentが種子の生存率に及ぼす影響を調べよう

gp = ggplot(data = seed2) +
  geom_point(aes(x = plant_size , y = survived_seed/observed_seed, color = treatment)) +
  geom_smooth(aes(x = plant_size , y = survived_seed/observed_seed, color = treatment), 
               method = glm, method.args = list(family = binomial)) 
gp

  • 植物体が大きいと種子の生存率が有意に良くなる
  • treatmentをすると種子の生存率が有意に良くなる

上限ありカウントデータをGLMしよう

低体重出生に母親の体重が与える影響を調べよう

(応答変数を2値からなる1列として入れる場合)


まずインストールする(1行目の#を消して走らせる)

library(MASS)
head(birthwt, n = 2) #MASSに入っているbirthwtというサンプルデータを使う
##    low age lwt race smoke ptl ht ui ftv  bwt
## 85   0  19 182    2     0   0  0  1   0 2523
## 86   0  33 155    3     0   0  0  0   3 2551
  • low:新生児の体重が2.5kg未満か否か(2.5kg未満が1)
  • age:母親の年齢
  • lwt:母親の体重(ポンド単位)
  • smoke:母親の喫煙有無(喫煙有りが1)
  • ptl:母親の早産経験の有無(経験有りが1)
  • ht:母親の高血圧の有無(有りが1)
  • ui:母親の子宮神経過敏の有(有りが1)

上限ありカウントデータをGLMしよう

低体重出生に母親の体重が与える影響を調べよう

  • まずはプロットしてみる
gp = ggplot(data = birthwt, aes(x = lwt , y = low)) +
  geom_point() 
gp

  • 体重(lwt)が多いほうが低体重出生ではない(y = 0)傾向…?

上限ありカウントデータをGLMしよう

低体重出生に母親の体重が与える影響を調べよう

glm_result = glm(low ~ lwt, 
                 data = birthwt, family = binomial)
summary(glm_result)
## 
## Call:
## glm(formula = low ~ lwt, family = binomial, data = birthwt)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.0951  -0.9022  -0.8018   1.3609   1.9821  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)  
## (Intercept)  0.99831    0.78529   1.271   0.2036  
## lwt         -0.01406    0.00617  -2.279   0.0227 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 234.67  on 188  degrees of freedom
## Residual deviance: 228.69  on 187  degrees of freedom
## AIC: 232.69
## 
## Number of Fisher Scoring iterations: 4

上限ありカウントデータをGLMしよう

低体重出生に母親の体重が与える影響を調べよう

glm_result = glm(low ~ lwt, 
                 data = birthwt, family = binomial)
summary(glm_result)
  • (Intercept): 0.99831
  • plant_size: -0.01406
  • Pr(>|t|): 0.0227
  • →種子の生存率への植物サイズの効果は有意である
  • →Y ~ 1/(1 + exp(-(-0.99831 - 0.01406X)))に回帰できる

上限ありカウントデータをGLMしよう

低体重出生に母親の体重が与える影響を調べよう

gp = ggplot(data = birthwt, aes(x = lwt , y = low)) +
  geom_point() +
  geom_smooth(method = glm, method.args = list(family = binomial)) 
gp

  • 母親の体重(lwt)が多いと有意に低体重出生率が低下する
  • 回帰曲線は低体重出生の割合を示すことに注意

【まとめ】統計モデリング

  1. まずはプロット
  2. 値の性質から誤差構造とリンク関数を推定する
    • 正規分布, ポアソン分布, 二項分布…
    • 使える分布は他にもある
    • ANOVA的な群間比較も行える(説明変数がfactor型なだけ)
  3. 誤差構造とリンク関数を決めてGLMする
  4. どのモデルがいちばん“良い”か
    • モデル選択(AICなど)

必要に応じて複雑なモデリングへ

  • “All models are wrong, but some are useful”

自分のデータを統計解析しよう

  1. どんな統計解析ができるか考えてからデータを取ろう
    • 何を統計的に示したいかをはっきりさせる
    • 統計解析しやすい形でデータを取る
      • 連続値?離散値?応答変数?説明変数?
      • 統計解析の前提条件もよく確認する
  2. 統計解析に渡しやすい形でデータを取る
    • あるいは元データを変換する(tidyr)
  3. まずはプロット!
    • 生データを見ることが一番大切
  4. 統計解析する
  5. 結果を出力し、考察する