StatsBeginner: 初学者の統計学習ノート

統計学およびR、Pythonでのプログラミングの勉強の過程をメモっていくノート。たまにMacの話題。

Rでパワーアナリシス(検出力・検定力分析)を行う

たとえば重回帰分析とかを行って、効果が「有意ではない」ということを積極的に主張に取り入れたいときは、検出力が十分であったかを確認しなければならない。というのも、わざと出来の悪いモデルを使ったり、サンプルサイズを少なくしたりすれば、有意でないような結果を得ることは簡単だからだ。まあ検出力も、必要な効果量をどれぐらいに設定するかとか、その効果量に含まれる残差の分散の仮定の置き方などによって、ある程度恣意的に引き上げることができてしまうが、やらないよりはいいでしょう。


G*Powerというソフトが便利なのだが(MacでもWindowsでも使える)、シンプルなケースならRのpwrパッケージでできる。
解説はこのあたりを見ればいいかと。
Power Analysis in R
Quick-R: Power Analysis


G*Powerの説明は、ちょっとわかりにくいけど、たとえばこの解説。
https://www.mizumot.com/method/mizumoto-takeuchi.pdf


検出力の分析は「有意水準」「効果量」「サンプルサイズ」「検出力」のどれかを求める手続きで、ネット上や教科書の解説のほとんどは「サンプルサイズの決定」に関するものだが、べつにそれに限らず、これらのうち3つについて仮定を与えれば残りの1つを決められるので、用途は意外と広い。
効果量については、Cohenが提案している、
f^2 > 0.02 ・・・小さめの効果
f^2 > 0.15 ・・・中くらいの効果
f^2 > 0.35 ・・・大き目の効果
という基準を採用する場合は難しく考えなくてよいのだが、たとえば「回帰係数が0.1」というように具体的な値を検出したいと考えている場合は、効果量の表現に平方和が必要になって、データのばらつき具合についても仮定を置かなくてはならなくなる。


ここでは回帰分析で「有意でない」という結果が得られたときに、それを積極的に主張してよいのかどうか判断する方法を考えたいのだが、正直良くわからないので、以下のような方法で問題がある場合はご指摘いただけると助かります。


データはもう手元にあるわけで、サンプルサイズは決まっている。有意水準はたいがい0.05とかだろう。そのうえで、「検出力0.8以上になる効果量を知りたい」あるいは「◯◯という効果量を有意水準0.05で検出できる確率(検出力)を知りたい」ということになるわけである。
で、効果量について上述のCohenのような基準を考えておけば悩まくていいのだが、こんなものでは含意がよくわからないので、現実的な値で語りたくなる。


たとえば回帰分析を行った結果、x1の係数が凄く小さくて有意でなかったとする。しかしこれだけでは、「効果がない」のか「検出力が低い」のか区別がつかない。
で、「変数x1の回帰係数が少なくとも0.1ぐらいあれば、現実社会へのインプリケーションとして意味あるよね」みたいなことが言える時がある。その場合は、「真の係数が0.1だった場合に、今回と同じサンプルサイズ等でその効果が検出できる確率」を計算して、それが0.8とか0.9ぐらいあれば、「十分検出可能なのに、分析の結果有意でなかったのだから、たぶん意味があるレベルの効果は無いのだろう」と積極的に言えるようになる。「本当は0.1ぐらいの効果があるのに、検出力不足で有意にならなかった」わけではなさそうだからだ。


しかしこの計算をするには、効果量を求めるのに、回帰係数だけでなく残差についても仮定を置かないといけない。そこが面倒なのだが、残差(期待値の周りのばらつき)はもとの回帰分析と同じということにしておけば、話がわかりやすい。要するに、予測値からの乖離は同じぐらいになるという前提にして、「意味のある回帰係数」と「元のx」から「yの予測値」を出し、それに「最初の回帰分析をやったときの残差」を足して、「社会的に意味のある効果があった場合の、目的変数y」のデータを仮につくって、そのデータに対して同じように回帰分析(と分散分析)を行って、効果量を求めるわけである。期待値のまわりのばらつきが同じでも、「意味のある回帰係数」が大きければ、yの変動に占める残差の割合は小さくなるので、検出力が上がることになる。
数学が得意な人が考えればわざわざ仮のデータを作ったりしなくても求められそうだけど、自分は「説明変数同士に相関があるかもしれないからタイプIII平方和を使う」というあたりでもう考える気がなくなったので↓のようにやってみた。


以下のような関数を作っておいて、

library(car)
library(pwr)

calculate_power <- function(model, val.number, sufficient.effect, sig.level=0.05) {
  # library{car}{pwr}が必要。
  # modelにはlmの推定結果を与える。推定するときにlm(..., x=TRUE, y=TRUE, model=TRUE)としておく。
  # val.numberには、切片から数えて何個目の変数について計算するか番号を入れる。
  # sufficient.effectには、検出したい大きさの回帰係数を入れる。
  # val.number, sufficient.effectはベクトルで複数指定してもよい。
  
  coef.sufficient <- model$coefficients
  coef.sufficient[val.number] <- sufficient.effect
  
  # 回帰係数が指定した「社会的に意味ある値」だった場合のy
  y.sufficient <- t(coef.sufficient) %*% t(model$x) + model$residuals  # xに切片も入ってる
  
  # データセットの形にする
  df.sufficient <- data.frame(y.sufficient=t(y.sufficient),
                              as.data.frame(model$model[,-1]))  # modelの1列目はyになってる
  
  # 再び回帰して分散分析結果を得る
  lm.sufficient <- lm(y.sufficient ~ ., data=df.sufficient)
  anova.sufficient <- Anova(lm.sufficient, type='III')
  ss.factor.sufficient <- anova.sufficient$`Sum Sq`[val.number]
  ss.resid.sufficient <- anova.sufficient$`Sum Sq`[length(anova.sufficient$`Sum Sq`)]
  df.factor.sufficient <- anova.sufficient$Df[val.number]
  df.resid.sufficient <- anova.sufficient$Df[length(anova.sufficient$Df)]
  
  # 効果量を計算
  eta.sq <- ss.factor.sufficient / (ss.factor.sufficient + ss.resid.sufficient)
  f.sq <- eta.sq/(1-eta.sq)
  
  # この効果量を検出できる確率
  pow <- pwr.f2.test(u = df.factor.sufficient, v = df.resid.sufficient, f2 = f.sq, sig.level = sig.level)
  
  output <- list(pow$power, f.sq)
  names(output) <- c('Power', 'f2')
  return(output)
}
}


まず、目的変数y、説明変数x1〜x3を作って、回帰分析をやってみる。

> set.seed(1)
> x1 <- rnorm(100,0,1)
> x2 <- rnorm(100,5,1)
> x3 <- rnorm(100,10,1)
> y <- 2*x1 + 3*x2 + 3*x3 +rnorm(100, 0, 10)
> 
> model.1 <- lm(y~x1+x2+x3, x=T, y=T, model=T)
> summary(model.1)

Call:
lm(formula = y ~ x1 + x2 + x3, model = T, x = T, y = T)

Residuals:
     Min       1Q   Median       3Q      Max 
-25.8201  -5.2738   0.0281   6.5058  18.2364 

Coefficients:
            Estimate Std. Error t value  Pr(>|t|)    
(Intercept)  -7.1879    11.3108  -0.635    0.5266    
x1            1.4204     1.1169   1.272    0.2065    
x2            2.4506     1.0485   2.337    0.0215 *  
x3            4.0462     0.9712   4.166 0.0000677 ***
---
Signif. codes:  0***0.001**0.01*0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 9.98 on 96 degrees of freedom
Multiple R-squared:  0.1981,	Adjusted R-squared:  0.1731 
F-statistic: 7.908 on 3 and 96 DF,  p-value: 0.00009087


x1の真の係数は2だけど、1.4204と推定され、pは0.2065だから有意ではない。これが、サンプルサイズ(もしくはばらつきが大きい)のせいなのか、本当に効果がないのかを考えたいなら、「x1がどの程度大きければ意味のある効果なのか」を決める必要がある。
仮にそれが1ぐらいだとすると……

> calculate_power(model=model.1, val.number=2, sufficient.effect=1)$Power
[1] 0.1457216


今回のようなサンプルサイズやばらつき具合のデータでは、「x1の係数が1」という効果が仮にあったとしても0.146ぐらいの確率でしか検出できないみたいだから、「x1に効果はない」と言うのは憚られる。
特に、あってほしい効果が検出されないなら単に「残念です、サンプルサイズを増やすか、実験計画を工夫して誤差を減らしましょう」で済むが、自分の説を主張する上で「あってほしくない効果」だった場合は、ついうっかり「どうだ、俺の言ったとおり効果はないじゃないか!」と言いたくなってしまい危険である。


ちなみに、真の値である「係数は2」は検出できるのかというと……

> calculate_power(model=model.1, val.number=2, sufficient.effect=2)$Power
[1] 0.4330289


4割ぐらいしか検出できないようだ。

Rでファイルをダウンロードするかどうか確認させる関数

ネット上にあるcsvファイルをダウンロードしてきて使う場合、read.table()にurlを与えて直接データフレームをつくってしまう場合もあれば、ファイルとしてダウンロードして置いておきたい場合もあります(実行のたびにダウンロードしたくない等の理由で)。
で、実行するときに、すでにダウンロード済みなのであれば再ダウンロード(上書き)はしたくないという場合があるので、確認しながらダウンロードできると便利です。

簡単な処理ではありますが、コードの使い回しのためにここに書いておきます。
そのファイルがすでに存在するかどうかをメッセージで表示した上で、ダウンロードするかどうか訊いてくるので、コンソールでyを入力したらダウンロード、nを入力したら中止ということにしておきます。
ファイルがすでに存在する場合、そのファイルの更新日時を確認してから(たとえば古かったら)ダウンロードしたいという場合もあるので、更新日時も取得して表示するようにしておきます。
処理確認ダイアログを出す関数askYesNo()の使い方は、askYesNoのドキュメントをみてください。

confirm_file_dl <- function(url,dst){
  # dstには保存するときのパス&ファイル名を与える
  
  if(file.exists(dst)) {
    message(paste('\n\"', dst, '\"', ' already exists!', sep=''))
    mtime <- file.info(dst)$mtime  # ファイルの更新日時の取得
    message(paste('(Last modified at ', mtime, ')\n', sep=''))
  } else {
    message(paste('\n\"', dst, '\"', ' doesn\'t exist!\n', sep=''))
  }

    dl_or_not <- askYesNo(msg='Do you want to download the file?', default = FALSE, prompts = 'y/n/na')
  if(dl_or_not==TRUE) {
    download.file(url, destfile = dst)
  }
}


たとえばGoogleのモビリティ・レポートのファイルは、国別データは1ファイルにまとまってるのですが、現時点で600MBもあって、外出中にテザリングで作業してる時なんかは、必要ないならダウンロードしたくないですね。


ファイルがすでに存在する場合。

> confirm_file_dl(url='https://www.gstatic.com/covid19/mobility/Global_Mobility_Report.csv',
+                 dst='source/Global_Mobility_Report.csv')

"source/Global_Mobility_Report.csv" already exists!
(Last modified at 2021-08-17 18:13:17)

Do you want to download the file? (y/n/na) 


ファイルが存在しない場合。(nを入力してダウンロードを実行)

> confirm_file_dl(url='https://www.gstatic.com/covid19/mobility/Global_Mobility_Report.csv',
+                 dst='source/Global_Mobility_Report.csv')

"source/Global_Mobility_Report.csv" doesn't exist!

Do you want to download the file? (y/n/na) y
trying URL 'https://www.gstatic.com/covid19/mobility/Global_Mobility_Report.csv'
Content type 'text/csv' length 637979115 bytes (608.4 MB)
==================================================
downloaded 608.4 MB

Rのsource()関数で呼び出すスクリプトに引数を渡すとき

学生に説明する必要が発生したためエントリ起こしておく。
コマンドライン引数みたいな感じで、source()で呼び出されるスクリプトに呼ぶ側のスクリプトから引数を渡すときは、以下のようにやればよい。
source1.Rからsource3.Rまでのスクリプトを準備してあり、それをreader.Rからsource()関数で呼び出す。
その時に、commandArgs()という関数を使う。

#呼ばれる側のスクリプト1(source1.R)
# 文字列が1つ渡される想定

print(commandArgs())
#呼ばれる側のスクリプト2(source2.R)
# ベクトルが一つ渡される想定

mean(commandArgs())
#呼ばれる側のスクリプト3(source3.R)
# 文字列と数値がリストで渡される想定

args <- commandArgs()
print(rep(args[[1]], args[[2]]))
# 呼ぶ側のスクリプト(reader.R)

# 渡す引数が1個なら単にそれを書けばいい
commandArgs <- function(...) {'ばか'}
source('source1.R')

# ベクトルを渡すこともできる
commandArgs <- function(...) {c(1,2,5,7,8)}
source('source2.R')

# 複数の引数をリストで渡す
commandArgs <- function(...) {list('あほ', 5)}
source('source3.R')


なおここで、function(...)の三点ドットは、定義されていない引数を表す記号。
以下、実行結果。

> # 渡す引数が1個なら単にそれを書けばいい
> commandArgs <- function(...) {'ばか'}
> source('source1.R')
[1] "ばか"
> 
> # ベクトルを渡すこともできる
> commandArgs <- function(...) {c(1,2,5,7,8)}
> source('source2.R')
[1] 4.6
> 
> # 複数の引数をリストで渡す
> commandArgs <- function(...) {list('あほ', 5)}
> source('source3.R')
[1] "あほ" "あほ" "あほ" "あほ" "あほ"

researchmapのcsv

researchmapのcsv取り込みにクセがありすぎる。
アクションがinsertなのに"invalid_delete_reason,,削除理由が無効です。"というエラーが出るのはバグ?
ちなみに削除理由にmineとか設定すると通る。意味がわからん。
そもそも、csvなのにヘッダーの上に"published papers"とか書かせるフォーマットなのが狂気。

Stanでよく忘れる、よく間違える書き方

  • 文末の;の忘れ。
  • ファイルの最後は空の行に
  • forループの範囲の1:NのところのNを、intじゃなくてrealで宣言してしまっている。
  • transformed parametersのブロックでforループを複数かくとコンパイルエラーになる理由がわからないときある。1つのループにまとめると通る。
  • 定義の順序を間違えててまだ存在しない変数を参照してる。
  • 自作関数を作って、つかうときに、引数の指定をRみたいにmy_function(x=1)みたいに"引数名="をつけるとエラーになる。
  • rstanで"Error in serialize"とかのエラーがでるときは、一回Rを落としてプロセスをキルしてからやるといけたりする。

相関係数の差の検定と、回帰係数の差の検定を、Rでやる

たまに、2つの相関係数が有意に異なるのかや、1つの重回帰モデル中の2つの回帰係数が有意に異なるかを示せると、主張が通りやすいという場面がある。
まぁ、あまり必要になることはないのだが、相関係数の差の検定や回帰係数の差の検定について、日本語でググるとRでパッと使える方法がまとまっているわけではなさそうだったので、ここに書いておこう。

相関係数の差の検定

相関係数の差の検定は、Rの{psych}パッケージのr.test()関数で簡単にできる。
下記に関数の解説があるが、
https://www.rdocumentation.org/packages/psych/versions/2.0.12/topics/r.testr.test function - RDocumentation
Test4のtable1が崩れていたり、「Case A: where Masculinity at time 1 (M1) correlates with Verbal Ability .5 (r12), femininity at time 1 (F1) correlates with Verbal ability r13 =.4」とあるところはM1とF1が逆になっちゃってたり、出力の説明が不足していたりするので要注意。そこから参照されている論文Steiger(1980)をみると、いくつかの疑問は解決する。


1) この関数は1つの相関係数が有意かどうか検定したい場合にも使え、たとえば変数1・2ともにサンプルサイズが100で相関係数が0.66だとすると、

library(psych)
r.test(n=100, r12=0.66)

というふうにする。多くの場合両側で検定すると思うが、片側で検定したい場合は
twotailed = F
という引数を付ければよい。


2) ここから2つの相関係数の差の話に移る。まずは、2つの独立した(サンプルを共有していない)相関係数の差を検定する場合。サンプルサイズは異なっても良い。
変数1と2はサンプルサイズが100で相関係数が0.3、変数3と4はサンプルサイズが120で相関係数が0.25だった場合、

r.test(n=100, r12=0.30, r34=0.25, n2=120)

サンプルサイズが等しいのであれば、n2は付けなくてもよい(デフォルトでnと同じになる)。


3) サンプルを共有している変数が3つ(1・2・3)あって、1と2、1と3というふうに1つの変数を共有する形で相関係数同士の差を検定したい場合。

r.test(n, r12, r23, r13)

というふうにする。この場合、r12とr13を比べた検定結果が返される。このとき、r23も引数として与える点に注意。(使い方の説明が不親切だが、冒頭の解説リンクのtest4のCaseAと同じことで、そちらについては論文Steiger(1980)と照合すると分かる。)


4) サンプルは共有してるけど変数は共有していないような、2組の相関係数を比べる場合。(冒頭の解説リンクでいうとtest4のCaseBに相当)

r.test(n, r12, r34, r23, r13, r14, r24)

冒頭の解説リンクは使い方の説明が不親切なのだが、論文Steiger(1980)と照合すると分かる。差を検定したい関心のある相関係数がr12とr34で、この2つの相関係数の差の検定結果を返している。


他に参考になるページ
http://www.snap-tck.com/room04/c01/stat/stat05/stat0501.html統計学入門−第5章
母相関係数の差の検定の概要と結果 :: 【公式】株式会社アイスタット|統計分析研究所

回帰係数の差の検定

重回帰分析の回帰係数の差の検定については、たとえば複数の回帰係数の信頼区間を出して、大きい方の下限値と小さい方の上限値が重なるかどうかという基準で検定すると、(たとえば5%水準の検定をしたいときに95%信頼区間を用いると)厳しすぎる検定になるらしい。*1


で、使えるケースが多少限られるものの、心理統計の分野で分散分析の延長で共分散分析を習うときに出てくる「平行性の検定」の考え方で、「交互作用が有意になるかどうか」という観点で検定すると簡単にできる。*2

d <- airquality  # 練習用データセットの読み込み
d <- d[complete.cases(d),]  # 欠損値削除
summary(lm(Ozone~Wind+Temp, data = d))


このようにすると以下のような結果が得られる。

Coefficients:
            Estimate Std. Error t value        Pr(>|t|)    
(Intercept) -67.3220    23.6210  -2.850         0.00524 ** 
Wind         -3.2948     0.6711  -4.909 0.0000032617283 ***
Temp          1.8276     0.2506   7.294 0.0000000000529 ***


この-3.29と1.83が有意に異なるかを知りたいという話で、まあ標準誤差とかをみても余裕で異なりそうではあるが、以下のように(従属変数であるOzoneは残して)ロング型にデータを変更し、交互作用の検定をすればいい。これは要するに、2つの変数を1つの変数にまとめて、変数名を新たな変数(ダミー変数)として設け、いわば「値」と「変数名」の交互作用をみるような感じ。

d2 <- d %>%
  select(Ozone, Wind, Temp) %>%  # 変数を限定
  pivot_longer(-Ozone, names_to = 'Variable', values_to = 'Value')   # ロング型に変換

summary(lm(Ozone~Variable*Value, data = d2))


以下のような結果が得られる。

Coefficients:
                    Estimate Std. Error t value             Pr(>|t|)    
(Intercept)        -147.6461    19.7613  -7.471      0.0000000000019 ***
VariableWind        246.6873    21.0072  11.743 < 0.0000000000000002 ***
Value                 2.4391     0.2522   9.673 < 0.0000000000000002 ***
VariableWind:Value   -8.1679     0.7210 -11.329 < 0.0000000000000002 ***


「VariableWind:Value」のところが交互作用(Tempが基準=0になって要するにWindダミーになってるという意味)で、有意になってるので、さっきの回帰係数の差は有意ってことになります。


後で知ったのですが、回帰係数の差の検定については、{car}パッケージのlinearHypothesis関数を使って、簡単に調べることができる。これは、2つの説明変数の回帰係数が等しいという帰無仮説を検定するもの。
あまりよく考えてないんですが、従属変数を複数もつ多変量回帰(Multivariate Regression。carパッケージのManovaで検定したりする)の場合、「すべてのモデルにおいて両変数の回帰係数に差がない」という帰無仮説を検定してるような気がする。モデルの数が増えると、帰無仮説がほとんど棄却されるようになります。上のように交互作用項を入れた上でManovaする方法の場合、交互作用はそれほど有意になりやすくはないです。

# 必要なパッケージの読み込み
library(car)

# airqualityデータセットを使用
data("airquality")

# NA値の除去
airquality_complete <- na.omit(airquality)

cor(airquality_complete)

# 線形回帰モデルの作成
model <- lm(Ozone ~ Solar.R + Wind + Temp, data = airquality_complete)

# Solar.R と Wind の回帰係数が等しいという仮説を検定
linearHypothesis(model, "Solar.R = Wind")

# Multivariate Regression(多変量回帰:従属変数が複数ある)でもできる
model_multi <- lm(cbind(Ozone, Wind) ~ Solar.R + Temp + Month + Day, data = airquality_complete)

# Manovaで説明変数の総合的な有意性を確認
Manova(model_multi)

# Solar.R と Tempの回帰係数が等しいという仮説を検定(棄却できる)
linearHypothesis(model_multi, "Solar.R = Temp")

# Month と Dayの回帰係数が等しいという仮説を検定(棄却できない)
linearHypothesis(model_multi, "Month = Day")

*1:何かで読んだけど出典を忘れてしまった。

*2:回帰係数の差は交互作用で検定すればいいよっていうやり方自体は、以前、SPSSのマニュアルかなにかで読んだのだが、出典は忘れてしまった。でもまあ心理統計では共分散分析とかの解説でよく出てくる内容だと思います。