ほくそ笑む

R言語と統計解析について

Spark Meetup 2015 で SparkR について発表しました #sparkjp

「初めてのSpark」刊行記念 Spark Meetup 2015で発表してきました。
タイトルは「はじめての SparkR」です。

SparkR は R 言語から Spark を使うためのパッケージで、Spark 1.4.0 から正式にサポートされました。
「RStudio から使える」「dplyr ライクなデータ操作」など、R ユーザーには嬉しい設計になっていますが、機能としてまだ不十分なところが多いです。

発表では、最新の Spark 1.4.1 の SparkR を元にお話しましたが、Meetup 当日に Spark 1.5.0 がリリースされたため、一瞬にして内容が古くなるというミラクルが起きました。

また、発表中に「Parquet とか Avro とかの読み方がわからない」と言ったら、親切にも shiumachi さんが教えて下さいました。

本 Meetup 全体の内容については、下記まとめレポートが詳しいです。

Spark やってみたいという方は、『初めてのSpark』買いましょう!

初めてのSpark

初めてのSpark

データの不備を統計的に見抜く (Gelman's Secret Weapon)

リクルートの高柳さん、Yahooの簑田さんと共同で翻訳した本が出版されます。
「みんなのR」(原題:R for Everyone)です。

みんなのR -データ分析と統計解析の新しい教科書-

みんなのR -データ分析と統計解析の新しい教科書-

この本は、統計言語 R のインストール・基本的な使い方から始まり、統計解析の基礎からちょっと高度な話題まで、幅広く取り扱っています。

特徴としては、

  • RStudio の使用を推奨
  • グラフィクスはすべて ggplot2 を使用
  • plyr, data.table, stringr といった、モダンな便利パッケージを使用*1
  • 説明に使用されるデータはすべて Web からダウンロード可能
  • R の個々の分析関数に対して、使う際の細かい TIPS が数多くちりばめられている

といったことが挙げられます。

原著者の Jared P. Lander さんは、coefplot パッケージuseful パッケージの作者です。
この coefplot パッケージは、作成した統計モデルの係数を可視化するのに非常に便利なパッケージです。

今日は「みんなのR」19章の話題から、coefplot パッケージを使って、取得したデータに問題があることを統計的に見抜くという話を紹介しようと思います。

データ

今回使用するデータは、アメリカ大統領選挙のデータです。
このデータは、4 年に一度の大統領選挙に対して、1948 年から 2000 年に渡って、のべ 15240 人の有権者から取ったアンケート結果です。
データは著者の Web サイトから取得することができます。

connection <- url("http://jaredlander.com/data/ideo.rdata")
load(connection)
close(connection)
head(ideo)
  Year       Vote Age Gender  Race                             Education               Income                  Religion
1 1948   democrat  NA   male white     grade school of less (0-8 grades)  34 to 67 percentile                protestant
2 1948 republican  NA female white high school (12 grades or fewer, incl 96 to 100 percentile                protestant
3 1948   democrat  NA female white high school (12 grades or fewer, incl  68 to 95 percentile catholic (roman catholic)
4 1948 republican  NA female white some college(13 grades or more,but no 96 to 100 percentile                protestant
5 1948   democrat  NA   male white some college(13 grades or more,but no  68 to 95 percentile catholic (roman catholic)
6 1948 republican  NA female white high school (12 grades or fewer, incl 96 to 100 percentile                protestant
  • 選挙年(Year)
  • 民主党(democrat)と共和党(republican)のどちらに投票したか(Vote)
  • 年齢(Age)
  • 性別(Gender)
  • 人種(Race)
  • 教育(Education)
  • 収入(Income)
  • 宗教(Religion)

という変数が格納されています。

coefplot による係数データの可視化

民主党共和党のどちらに投票したか(Vote)を出力変数、人種(Race)・収入(Income)・性別(Gender)・教育(Education)を入力変数として、ロジスティック回帰モデルにあてはめてみます。

model <- glm(Vote ~ Race + Income + Gender + Education, data=ideo, family=binomial(link="logit"))
coef(summary(model))
                                                  Estimate Std. Error     z value      Pr(>|z|)
(Intercept)                                     0.15929845 0.06960771   2.2885172  2.210742e-02
Raceasian                                      -0.28332904 0.20446278  -1.3857243  1.658311e-01
Raceblack                                      -2.48060238 0.09841886 -25.2045424 3.571728e-140
Racehispanic                                   -0.85340290 0.11786821  -7.2403147  4.476449e-13
Racenative american                            -0.39195681 0.14576603  -2.6889448  7.167827e-03
Raceother                                      -0.58168979 0.48829616  -1.1912643  2.335498e-01
RaceUnknown                                    -0.37908755 0.24233631  -1.5643036  1.177463e-01
Income17 to 33 percentile                      -0.06018027 0.06884955  -0.8740837  3.820727e-01
Income34 to 67 percentile                       0.02307343 0.06238488   0.3698561  7.114897e-01
Income68 to 95 percentile                       0.15514729 0.06327773   2.4518467  1.421252e-02
Income96 to 100 percentile                      0.73730304 0.09115114   8.0887969  6.025693e-16
IncomeUnknown                                   0.17534821 0.08894610   1.9713985  4.867831e-02
Gendermale                                      0.09542550 0.03472874   2.7477386  6.000783e-03
GenderUnknown                                   0.34912397 0.41827387   0.8346779  4.038991e-01
Educationgrade school of less (0-8 grades)     -0.32777601 0.06203652  -5.2835977  1.266713e-07
Educationhigh school (12 grades or fewer, incl -0.10646145 0.04702443  -2.2639605  2.357654e-02
Educationsome college(13 grades or more,but no  0.18023660 0.05430502   3.3189678  9.035085e-04
EducationUnknown                               -0.12275738 0.22466669  -0.5463978  5.847925e-01

係数データを表示すると、大量に数値が出てきて何が何やら分からなくなってしまいます。
そこで、coefplot を使って可視化してみます。

library(coefplot)
coefplot(model)

このグラフは、各変数に対する係数の推定値とその標準誤差を表しています。*2
青い太線が 1 標準誤差範囲、細線が 2 標準誤差範囲になります。
このグラフを見ると、

  • 高収入(Income96 to 100 percentile)だと共和党に投票しやすい
  • 黒人(Raceblack)は民主党に投票しやすい
  • Unknown や Others などの係数は誤差範囲が広い

といったことが見て取れるようになります。
便利ですね!

Gelman の「秘密兵器」

ここで趣向を変えて、各年ごとにモデルを作成し、係数がどう変化するかを見てみることにします。
まずは各年ごとのモデルを作成します。*3

library(pforeach)
theYears <- unique(ideo$Year)
npforeach(year=theYears, .c=list)({
  glm(Vote ~ Race + Income + Gender + Education,
      data=ideo[ideo$Year==year, ], family=binomial(link="logit"))
}) -> results
names(results) <- theYears

これらのモデルに対して、係数の時系列プロットを作成するには、coefplot パッケージの multiplot 関数を使えば簡単です。
例えば、高所得者についての係数の時系列プロットは次のようになります。

multiplot(results, coefficients="Income96 to 100 percentile", secret.weapon=TRUE) +
  coord_flip(xlim=c(-3, 3))

1972 年(ニクソン二期目)から、共和党に対する高所得者層の支持が上がっていることが分かります。
1971年のニクソン・ショックに関係がありそうですね。

このように、一連のモデルに対して係数の推定値を並べてプロットするというアイデアは、単純でありながら非常に便利です。
応用統計学の巨人 Andrew Gelman はこのようなプロットを、その有用さから「Secret Weapon(秘密兵器)」と呼びました。*4

データの不備を見抜く

同様に、黒人についての係数の時系列プロットを見てみましょう。

multiplot(results, coefficients="Raceblack", secret.weapon=TRUE) +
  coord_flip(xlim=c(-20, 10))

これはどうしたことでしょうか。
1964 年についてだけ、係数の誤差範囲が異常に広いです。
multiplot 関数の plot 引数を FALSE にして、データだけを表示させてみましょう。

multiplot(results, coefficients="Raceblack", secret.weapon=TRUE, plot = FALSE)
          Value Coefficient   HighInner     LowInner   HighOuter    LowOuter Model
1    0.07119541   Raceblack   0.6297813   -0.4873905   1.1883673   -1.045976  1948
2   -1.68490828   Raceblack  -1.3175506   -2.0522659  -0.9501930   -2.419624  1952
3   -0.89178359   Raceblack  -0.5857195   -1.1978476  -0.2796555   -1.503912  1956
4   -1.07674848   Raceblack  -0.7099648   -1.4435322  -0.3431811   -1.810316  1960
5  -16.85751152   Raceblack 382.1171424 -415.8321655 781.0917963 -814.806819  1964
6   -3.65505395   Raceblack  -3.0580572   -4.2520507  -2.4610605   -4.849047  1968
7   -2.68154861   Raceblack  -2.4175364   -2.9455608  -2.1535242   -3.209573  1972
8   -2.94158722   Raceblack  -2.4761518   -3.4070226  -2.0107164   -3.872458  1976
9   -3.03095296   Raceblack  -2.6276580   -3.4342479  -2.2243631   -3.837543  1980
10  -2.47703741   Raceblack  -2.1907106   -2.7633642  -1.9043839   -3.049691  1984
11  -2.79340230   Raceblack  -2.4509285   -3.1358761  -2.1084548   -3.478350  1988
12  -2.82977980   Raceblack  -2.4609290   -3.1986306  -2.0920782   -3.567481  1992
13  -4.45297040   Raceblack  -3.4433048   -5.4626360  -2.4336392   -6.472302  1996
14  -2.67827784   Raceblack  -2.2777557   -3.0788000  -1.8772336   -3.479322  2000

なんと、1964 年だけ、誤差範囲が 100 倍以上広くなっています。

これは一体なぜでしょうか?
各年のアンケートに答えた黒人の数を確認してみます。

library(dplyr)
ideo %>% 
  filter(Race == "black") %>%
  count(Year)
   Year   n
1  1948  15
2  1952  48
3  1956  49
4  1960  42
5  1964  92
6  1968  85
7  1972 134
8  1976 102
9  1980 104
10 1984 127
11 1988 119
12 1992 172
13 1996 109
14 2000 107

1964 年だけサンプルサイズが特に小さい、ということはないようです。

本書「みんなのR」では、この原因は "underrepresented"、すなわち、サンプルが母集団をうまく代表できていないためと結論づけています。

このように、coefplot を使って係数の推定値の比較を行うことで、データの不備を見つけることができました。
Gelman の「秘密兵器」は分析者にとって非常に強力な武器であることがわかります。

さらなる分析へ

本書「みんなのR」では、このデータに対して、ベイズ統計学の視点から立ち向かいます。
1964 年の係数が他の年の係数と比べて 100 倍になることは考えにくいと思います。
このことは、1964 年の係数は少なくともこの程度の範囲内にあるのではないか(例えば 9 割がた -15 〜 15 の範囲内に収まるだろう)ということを事前知識として持っていることになります。
この事前知識は、ベイズ統計モデルにおける、事前分布としてモデルに取り込むことができます。
このような分析も、R のパッケージを使えば簡単にできます。

1964 年の係数の誤差範囲が非常に小さくなったことがわかると思います。
この手法は、リッジ回帰の罰則項をベイズモデルの対数事前分布とみなしたもので、「Bayesian Shrinkage(ベイズ縮小)」と呼ばれます。

ここから先の分析は、ぜひ、「みんなのR」を手に取って楽しんでください。

みんなのR -データ分析と統計解析の新しい教科書-

みんなのR -データ分析と統計解析の新しい教科書-

以上です。

追記

裏 RjpWiki さんにコメントをいただきました!ありがとうございます!
http://blog.goo.ne.jp/r-de-r/e/063932b25207ca9dd86ff674367dccd9

*1:原著が 2013 年の本なので、dplyr は残念ながら未収録

*2:カテゴリカル変数なので、ダミー変数の係数となっています

*3:もちろん「みんなのR」では pforeach は使われていません

*4:参照: http://andrewgelman.com/2005/03/07/the_secret_weap/

世界一くだらないベイズ推定の話をしてきました

3月3日に行われた第5回「続・わかりやすいパターン認識」読書会にて、ベイズ推定についての話を発表させていただきました。

タイトルは「カップルが一緒にお風呂に入る割合をベイズ推定してみた」です。

人力検索はてなに寄せられた質問と回答をもとに、カップルが一緒にお風呂に入る割合をベイズ推定しています。
深く考えずにネタとして楽しんでいただければ幸いです。


そういえば今日(3/4)は広島で魁!!ベイズ塾というイベントが行われていて、資料もアップされているようですね。

ベイズ推定に関しては、こちらの方が参考になるかと思います。


また、従来の推定法との考え方の違いについては、広島大学の清水先生の記事が非常に分かりやすいです。

この記事はベイズがよく分からなくなったときに何度も読み返してます。名作です。


「続・わかりやすいパターン認識」読書会はまだまだ続きますので、ご興味ある方はぜひご参加ください。

それでは。

マイナーだけど最強の統計的検定 Brunner-Munzel 検定

対応のない 2 群間の量的検定手法として、最も有名なのは Student の t 検定でしょうか。
以前、Student の t 検定についての記事を書きました。

しかし、Student の t 検定は、等分散性を仮定しているため、不等分散の状況にも対応できるように、Welch の t 検定を使うのがセオリーとなっています。

ただし、これら 2つの検定は分布の正規性を仮定しているため、正規性が仮定できない状況では、Mann-Whitney の U検定というものが広く使われています。

Mann-Whitney の U検定は、正規性を仮定しないノンパラメトリック検定として有名ですが、不等分散の状況でうまく検定できないという問題があることはあまり知られていません。

今日は、これらの問題をすべて解決した、正規性も等分散性も仮定しない最強の検定、Brunner-Munzel 検定を紹介し、その検定精度について調査してみます。

Brunner-Munzel 検定

Brunner-Munzel 検定の理論的な側面は、奥村先生のホームページが詳しいです。

すなわち、Mann-Whitney の U検定は、2群間の分布の形状が同じであるという仮定を持つのに対し、Brunner-Munzel 検定は、分布が同じことは仮定せず、両群から一つずつ値を取り出したとき、どちらが大きい確率も等しいという帰無仮説を検定するというものです。

Brunner-Munzel 検定を R で行うには、lawstat パッケージの brunner.munzel.test() 関数を使います。

library(lawstat)
x = c(1,2,1,1,1,1,1,1,1,1,2,4,1,1)
y = c(3,3,4,3,1,2,3,1,1,5,4)
brunner.munzel.test(x,y)
##  Brunner-Munzel Test
## 
## data:  x and y
## Brunner-Munzel Test Statistic = 3.138, df = 17.68, p-value = 0.005786
## 95 percent confidence interval:
##  0.5952 0.9827
## sample estimates:
## P(X<Y)+.5*P(X=Y) 
##            0.789

本記事では、不等分散の状況で Brunner-Munzel 検定がどれほどの検定精度を持つのかを調査します。
その際、比較対象として、Student の t 検定、Welch の t 検定、Mann-Whitney の U 検定についても検定精度を調査します。

それぞれの検定における仮定は次の通りです。

手法 正規性 等分散性
Student’s t
Welch’s t 不要
Mann-Whitney 不要
Brunner-Munzel 不要 不要

1. 正規分布

まずは、正規分布に対する検定精度を調査します。 標準偏差 1 の正規分布に対して、標準偏差を 1/4, 1/2, 3/4, 1, 4/3, 2, 4 と変化させた正規分布との検定をそれぞれ繰り返し、第一種の過誤(alpha error rate)を調査します。

sigma_ratio <- c("1/4", "1/2", "3/4", "1", "4/3", "2", "4")
sigma1 <- c(1/4, 1/2, 3/4, 1, 4/3, 2, 4)
sigma2 <- 1
iter_num <- 2000

library(pforeach)
library(lawstat)
pforeach(sigma=sigma1, .c=rbind)({
  npforeach(i=seq_len(iter_num), .c=rbind)({
    x1 <- rnorm(15, mean = 5, sd = sigma)
    x2 <- rnorm(45, mean = 5, sd = sigma2)
    student <- t.test(x1, x2, var.equal = TRUE)$p.value <= 0.05
    welch <- t.test(x1, x2, var.equal = FALSE)$p.value <= 0.05
    MH <- wilcox.test(x1,x2)$p.value <= 0.05
    BM <- brunner.munzel.test(x1, x2)$p.value <= 0.05
    data.frame(`Student's t`=student, `Welch's t`=welch, `Mann-Whitney`=MH, `Brunner-Munzel`=BM, check.names = FALSE)
  }) -> res
  colSums(res)/iter_num
}) -> result

library(tidyr)
library(dplyr)
data <- result %>% data.frame(check.names = FALSE) %>% 
  cbind(sigma=factor(sigma_ratio, levels=sigma_ratio)) %>% 
  gather(`Test Method`, `Alpha Error Rate`, 1:4)

library(ggplot2)
ggplot(data, aes(x=sigma, y=`Alpha Error Rate`, group=`Test Method`, color=`Test Method`)) + 
  geom_line() + geom_point() + ggtitle("Normal Dist.")

有意水準 0.05 で検定を行っているため、alpha error rate はどれも 0.05 になるはずですが、異なる標準偏差に対する検定において、Student と Mann-Whitney は 0.05 から大きく外れており、検定精度が非常に悪いという結果になりました。
対して、Welch と Brunner-Munzel は異なる標準偏差に対しても alpha error rate は 0.05 を保っており、検定精度は非常に良いです。
ここらへんはまあ、理論通りですね。

2. 連続一様分布

それでは、正規性の仮定が崩れた場合はどうなるでしょうか?
続いては、連続一様分布に対して、先ほどの正規分布と同じ内容のシミュレーションを行ってみます。
すなわち、標準偏差 1 の連続一様分布に対して、標準偏差を 1/4, 1/2, 3/4, 1, 4/3, 2, 4 と変化させた連続一様分布との検定をそれぞれ繰り返し、第一種の過誤を調査します。

sigma_ratio <- c("1/4", "1/2", "3/4", "1", "4/3", "2", "4")
sigma1 <- c(1/4, 1/2, 3/4, 1, 4/3, 2, 4)
a1 <- 5 - sqrt(3) * sigma1
b1 <- 5 + sqrt(3) * sigma1
a2 <- 5 - sqrt(3)
b2 <- 5 + sqrt(3)
iter_num <- 2000

library(pforeach)
library(lawstat)
pforeach(a=a1, b=b1, .c=rbind)({
  npforeach(i=seq_len(iter_num), .c=rbind)({
    x1 <- runif(15, min = a, max = b)
    x2 <- runif(45, min = a2, max = b2)
    student <- t.test(x1, x2, var.equal = TRUE)$p.value <= 0.05
    welch <- t.test(x1, x2, var.equal = FALSE)$p.value <= 0.05
    MH <- wilcox.test(x1,x2)$p.value <= 0.05
    BM <- brunner.munzel.test(x1, x2)$p.value <= 0.05
    data.frame(`Student's t`=student, `Welch's t`=welch, `Mann-Whitney`=MH, `Brunner-Munzel`=BM, check.names = FALSE)
  }) -> res
  colSums(res)/iter_num
}) -> result

library(tidyr)
library(dplyr)
data <- result %>% data.frame(check.names = FALSE) %>% 
  cbind(sigma=factor(sigma_ratio, levels=sigma_ratio)) %>% 
  gather(`Test Method`, `Alpha Error Rate`, 1:4)

library(ggplot2)
ggplot(data, aes(x=sigma, y=`Alpha Error Rate`, group=`Test Method`, color=`Test Method`)) + 
  geom_line() + geom_point() + ggtitle("Uniform Dist.")

結果は、正規分布の場合と同様になりました。
異なる標準偏差に対しては、Student と Mann-Whitney は検定精度が非常に悪く、Welch と Brunner-Munzel は良い精度を保っています。
実は、Welch の t 検定は、ある程度の分布のゆがみに対しても、高い精度を維持できることが知られています。*1
したがって、正規分布が仮定できない場合でも、Mann-Whitney より Welch を使用したほうが良いとする人たちもいます。

3. 対数正規分布(平均値が同じ場合)

上記 2つは対称分布でしたが、歪んだ分布に対する調査として、対数正規分布を考えます。
対数正規分布は、平均値と中央値が異なります。
まずは、平均値が同じ対数正規分布について、標準偏差が 1/4, 1/2, 3/4, 1, 4/3, 2, 4 倍となったときの、第一種の過誤を調査します。

sigma_ratio <- c("1/4", "1/2", "3/4", "1", "4/3", "2", "4")
sigma1 <- c(1, 2, 3, 4, 4, 4, 4)
sigma2 <- c(4, 4, 4, 4, 3, 2, 1)
sigmas1 <- sqrt(log((sigma1^2)/(5^2) + 1))
sigmas2 <- sqrt(log((sigma2^2)/(5^2) + 1))
mus1 <- log(5) - (sigmas1^2)/2
mus2 <- log(5) - (sigmas2^2)/2
iter_num <- 2000

library(pforeach)
library(lawstat)
pforeach(mu1=mus1, sigma1=sigmas1, mu2=mus2, sigma2=sigmas2, .c=rbind)({
  npforeach(i=seq_len(iter_num), .c=rbind)({
    x1 <- rlnorm(15, meanlog = mu1, sdlog = sigma1)
    x2 <- rlnorm(45, meanlog = mu2, sdlog = sigma2)
    student <- t.test(x1, x2, var.equal = TRUE)$p.value <= 0.05
    welch <- t.test(x1, x2, var.equal = FALSE)$p.value <= 0.05
    MH <- wilcox.test(x1,x2)$p.value <= 0.05
    BM <- brunner.munzel.test(x1, x2)$p.value <= 0.05
    data.frame(`Student's t`=student, `Welch's t`=welch, `Mann-Whitney`=MH, `Brunner-Munzel`=BM, check.names = FALSE)
  }) -> res
  colSums(res)/iter_num
}) -> result

library(tidyr)
library(dplyr)
data <- result %>% data.frame(check.names = FALSE) %>% 
  cbind(sigma=factor(sigma_ratio, levels=sigma_ratio)) %>% 
  gather(`Test Method`, `Alpha Error Rate`, 1:4)

library(ggplot2)
ggplot(data, aes(x=sigma, y=`Alpha Error Rate`, group=`Test Method`, color=`Test Method`)) + 
  geom_line() + geom_point() + ggtitle("Log Normal Dist.(Mean)")

Student と Mann-Whitney の検定精度が悪いのはこれまでと同様ですが、Brunner-Munzel についても検定精度が悪くなっています。
また、Welch は善戦しているものの、やはり検定精度はあまり良くありません。

4. 対数正規分布(中央値が同じ場合)

次に、中央値が同じ対数正規分布についても同様に、標準偏差が 1/4, 1/2, 3/4, 1, 4/3, 2, 4 倍となったときの、第一種の過誤を調査します。

sigma_ratio <- c("1/4", "1/2", "3/4", "1", "4/3", "2", "4")
sigma1 <- c(1, 2, 3, 4, 4, 4, 4)
sigma2 <- c(4, 4, 4, 4, 3, 2, 1)
sigmas1 <- sqrt(log((1 + sqrt((4 * sigma1^2)/25 + 1))/2))
sigmas2 <- sqrt(log((1 + sqrt((4 * sigma2^2)/25 + 1))/2))
mu1 <- log(5)
mu2 <- log(5)
iter_num <- 2000

library(pforeach)
library(lawstat)
pforeach(sigma1=sigmas1, sigma2=sigmas2, .c=rbind)({
  npforeach(i=seq_len(iter_num), .c=rbind)({
    x1 <- rlnorm(15, meanlog = mu1, sdlog = sigma1)
    x2 <- rlnorm(45, meanlog = mu2, sdlog = sigma2)
    student <- t.test(x1, x2, var.equal = TRUE)$p.value <= 0.05
    welch <- t.test(x1, x2, var.equal = FALSE)$p.value <= 0.05
    MH <- wilcox.test(x1,x2)$p.value <= 0.05
    BM <- brunner.munzel.test(x1, x2)$p.value <= 0.05
    data.frame(`Student's t`=student, `Welch's t`=welch, `Mann-Whitney`=MH, `Brunner-Munzel`=BM, check.names = FALSE)
  }) -> res
  colSums(res)/iter_num
}) -> result

library(tidyr)
library(dplyr)
data <- result %>% data.frame(check.names = FALSE) %>% 
  cbind(sigma=factor(sigma_ratio, levels=sigma_ratio)) %>% 
  gather(`Test Method`, `Alpha Error Rate`, 1:4)

library(ggplot2)
ggplot(data, aes(x=sigma, y=`Alpha Error Rate`, group=`Test Method`, color=`Test Method`)) + 
  geom_line() + geom_point() + ggtitle("Log Normal Dist.(Median)")

今度は、Welch の検定精度が悪く、Brunner-Munzel は良い精度を保っています。
これは、Brunner-Munzel が「両群から一つずつ値を取り出したとき、どちらが大きい確率も等しいという帰無仮説を検定する」ため、平均値でなく中央値の検定となっているためと考えられます。*2

まとめ

不等分散の状況下において、

  • Student の t 検定
  • Welch の t 検定
  • Mann-Whitney の U 検定
  • Brunner-Munzel 検定

の 4つの検定手法について、その検定精度を調査しました。


理論通り、Student の t 検定および Mann-Whitney の U 検定は、不等分散の状況下では検定精度が悪くなりました。
Welch の t 検定および Brunner-Munzel 検定は、ある程度ゆがみのない分布に対しては、十分な検定精度を保ちました。
さらに、歪んだ分布に対しても、中央値の検定としてならば、Brunner-Munzel 検定は十分な検定精度を保ちました。
Welch の t 検定は、歪んだ分布に対しては、検定精度はあまりよくありませんでした。


Brunner-Munzel 検定は、歪んだ分布に対して、平均値の検定としては検定精度は Welch よりも悪くなりました。
しかし、歪んだ分布に対して平均値を検定するという状況はあまり無いのではないでしょうか?
したがって、ほとんどの場合において、Brunner-Munzel 検定は最強ということです。
したがって、平均値の検定には Welch、中央値の検定には Brunner-Munzel を使い分けるというのがいいのではないでしょうか。
Brunner-Munzel 検定を覚えておいて損はないです。


このように最強の検定なのですが、Brunner-Munzel 検定は知名度が低いようです。

というわけで、マイナーだけど最強の統計的検定、Brunner-Munzel 検定をもっと使っていきましょう!

以上です。

追記

フリーの統計分析プログラムHADで有名な清水先生に貴重なご意見をいただきました。

うーむ、そうですね。ちょっと盛りすぎました。
平均値の場合は Welch、中央値の場合は Brunner-Munzel と使い分けるのが良さそうです。

さらに言うと、小標本の場合にうまくいかないという問題もあり、並べ替えBrunner-Munzel検定*3のような方法も提案されています。

追記2

フリーの統計分析プログラムHADで Brunner-Munzel 検定ができるようになりました!はやい!


ARIMAX で祝日効果を盛り込んだ時系列予測モデルの作成

1. はじめに

うちのブログは平日のアクセス数が休日の 2 倍くらいあります。
みなさんお仕事で必要になったときに検索されて、このブログたどり着くのでしょうか。お疲れ様です。

さて、『データサイエンティスト養成読本 R活用編』という書籍で、ARIMAX モデルを用いた時系列分析のやり方が載っています。

データサイエンティスト養成読本 R活用編 【ビジネスデータ分析の現場で役立つ知識が満載! 】 (Software Design plus)

データサイエンティスト養成読本 R活用編 【ビジネスデータ分析の現場で役立つ知識が満載! 】 (Software Design plus)

今日は、この書籍を参考に、うちのブログのアクセス数を ARIMAX モデルを用いて予測してみようと思います。

2. データの準備

まず、データですが、2014/04/01 〜 2014/11/30 までのブログのアクセス数(セッション数)を Dropbox に置いておきます。

ここからデータを取得し、読み込んでください。

library(xts)
data <- read.csv("https://dl.dropboxusercontent.com/u/432512/20150127_arimax/sessions.csv", row.names=1)
data.xts <- as.xts(data)
plot(data.xts["2014-06-01::2014-06-30"], ylim=c(0,600), type="b", main="セッション数(6月)")

6 月のデータをプロットすると、休日のアクセス数が平日に比べて落ちていることが見てとれると思います。

3. ARIMA モデルによる予測

まずは祝日を考慮せずに ARIMA モデルによる予測をやってみようと思います。
予測は、4月〜10月までのデータを用いて11月のセッション数を予測します。
最初に、訓練データとテストデータに分けます。

data.train <- data.xts["::2014-10-31"]
data.train.ts <- ts(data.train, frequency=7)
data.test <- data.xts["2014-11-01::"]
date.test <- as.Date(index(data.test))

訓練データを用いて ARIMA モデルを作成し、予測値を算出します。

library(forecast)
fit.arima <- auto.arima(data.train.ts)
fc.arima <- forecast(fit.arima, h=30)
pred.arima <- as.vector(fc.arima$mean)

res <- data.frame(date=date.test, pred.arima=pred.arima, act=as.numeric(data.test))

データを整形し、ggplot2 によるグラフの描画を行います。

library(tidyr)
library(ggplot2)

res.m <- gather(res, type, value, -date) 
ggplot(data=res.m, aes(x=date, y=value, color=type)) + geom_line(size=1.5) + ggtitle("ARIMA")

青が実測値、赤が予測値です。
あんまり予測精度はよくありませんが、そんなことより注意して見てほしいのは、11月には祝日が 2日あり(11/3, 11/24)、その日は実測値と予測値が大きく外れているということです。
これは、祝日による効果を ARIMA モデルが考慮できていないことから生じます。
次に見る ARIMAX モデルでは、この祝日効果をモデルに取り入れます。
とりあえずモデルの評価指標として RMSE を計算しておきます。

rmse <- sqrt(mean((res$pred.arima - res$act)^2))
print(rmse)
[1] 73.16669

4. ARIMAX モデルによる祝日効果の取り込み

それでは、ARIMAX モデルによる予測をやってみます。
日本の祝日判定は、Nippon パケージの is.jholiday() 関数を使って行います。

library(Nippon)
is.holiday <- function(date) !(weekdays(date) %in% c("土曜日", "日曜日")) & is.jholiday(date)

dates <- as.Date(index(data.xts), tz="Japan")
jholidays <- data.frame(row.names=dates, is.holiday=is.holiday(dates))
jholidays.xts <- as.xts(jholidays)

祝日効果を取り込んだ ARIMAX モデルを作成し、予測値を出します。

fit.arimax <- auto.arima(data.train.ts, xreg=jholidays.xts["::2014-10-31"])
fc.arimax <- forecast(fit.arimax, xreg=jholidays.xts["2014-11-01::"], h=30)
pred.arimax <- as.vector(fc.arimax$mean)

res <- data.frame(date=date.test, pred.arimax=pred.arimax, act=as.numeric(data.test))

データを整形し、ggplot2 でグラフを描画します。

res.m <- gather(res, type, session, -date)
ggplot(data=res.m, aes(x=date, y=session, color=type)) + geom_line(size=1.5) + ggtitle("ARIMAX")

おー、11/3 と 11/24 の予測値がちゃんと変化しましたね!

モデルの精度を比較するために RMSE を計算します。

rmse <- sqrt(mean((res$pred.arimax - res$act)^2))
print(rmse)
[1] 63.5615

RMSE が下がり、予測精度が良くなったことがわかります。

4. まとめ

ARIMAX モデルを用いて祝日効果を考慮した予測モデルを作成しました。
書籍では、さらに年月日や曜日などの影響も考慮したモデルを作成しています。
気になる方はぜひ書籍の方を読んでみてください。

データサイエンティスト養成読本 R活用編 【ビジネスデータ分析の現場で役立つ知識が満載! 】 (Software Design plus)

データサイエンティスト養成読本 R活用編 【ビジネスデータ分析の現場で役立つ知識が満載! 】 (Software Design plus)

以上です。

追記

auto.arima() を使わず地道にやるとこんな感じに。

auto.arima() はあまり評判が良くないようです。

可視化で理解するマルコフ連鎖モンテカルロ法(MCMC)

先日行われた第9回「データ解析のための統計モデリング入門」読書会にて、
「可視化で理解するマルコフ連鎖モンテカルロ法」というタイトルで発表させて頂きました。

発表スライドは以下です。


この発表は、みどりぼんに登場する、マルコフ連鎖モンテカルロ法(MCMC)のアルゴリズムである「メトロポリス法」と「ギブス・サンプラー」について、可視化して理解しようというお話です。

マルコフ連鎖モンテカルロ法」というのは、字面だけ見ると難しそうですが、この発表で理解すべきポイントは、次のスライド 1枚に凝縮されています。

このことを念頭に置いて、それぞれの手法を見ていきましょう。


まず、メトロポリス法ですが、これは、

  1. 前の状態の近くの点を次の遷移先候補として選ぶ(マルコフ連鎖
  2. そのときの確率比 r < 1 ならば確率 r で棄却する。それ以外は受理(モンテカルロ法

というアルゴリズムです。

これを可視化してアニメーションにすると次のようになります。


http://visualize-mcmc.appspot.com/2_metropolis.html

MCMC でない乱数生成法のアニメーションの動きと比べてみると、メトロポリス法では、次の点への遷移が前の点からそう離れていない場所へと移っていることが分かると思います。ここに、前の状態から次の状態が決まるというマルコフ連鎖の性質が表れています。

また、棄却の様子が赤い×で表現されています。新しい候補を棄却するかどうかは確率的に決まります。これはモンテカルロ法の性質です。*1


一方、ギブス・サンプラーは、

  1. y の値を固定した条件付き分布から x の次候補をサンプリングする
  2. x の値を固定した条件付き分布から y の次候補をサンプリングする

ということを交互に行うシンプルな手法です。

やはりこのアルゴリズムも、次の状態が前の状態によって決まる(マルコフ連鎖)、確率を使ったアルゴリズム(モンテカルロ法)であることが分かると思います。

ギブス・サンプラーは、メトロポリス法を一般化した「メトロポリスヘイスティングス法」の一種で、必ず r = 1 となるため、得られた候補を棄却しなくて済みます。

これは非常に強力な手法なのですが、アルゴリズムの性質上、条件付き分布からのサンプリングが容易にできる場合にしか適用できません。

運の良いことに、階層ベイズモデルではこれが容易にできるので、ベイズ統計ではよく使われているようです。

ギブス・サンプラーを可視化してアニメーションにすると次のようになります。


http://visualize-mcmc.appspot.com/3_gibbs.html

一方を固定してもう一方をサンプルするという動作を繰り返すので、常に直角にカクカク曲がっています。

このようなサンプリング方法で、最終的にはメトロポリス法と同じ分布が得られるというのは面白いですね。

おまけ

おまけとして、三変量正規分布に対するギブス・サンプラーも可視化しています。
結構苦労して作ったので、よければ見てみてください。
http://visualize-mcmc.appspot.com/4_gibbs3d.html

まとめ

2つの MCMC アルゴリズム、「メトロポリス法」と「ギブス・サンプラー」を可視化してみました。

アニメーションにより、それぞれのアルゴリズムの違いがうまく表現できたのではないかと思います。

マルコフ連鎖モンテカルロ法についての理解の助けになれば幸いです。

それではまた。

参考文献

計算統計 2 マルコフ連鎖モンテカルロ法とその周辺 (統計科学のフロンティア 12)

計算統計 2 マルコフ連鎖モンテカルロ法とその周辺 (統計科学のフロンティア 12)

*1:次候補を選ぶ際にも確率的な決め方をしていますが、これもモンテカルロ法の性質です

欠測データの相関係数の推定法について発表しました

先日行われた BUGS/stan勉強会 #3 で発表させていただきました。

タイトルは「Stan で欠測データの相関係数を推定してみた」です。

欠測データに対して相関係数を求めるとき、普通のやり方では実際の値より小さい値になってしまいます。そこで、片側だけしか観測できていない不完全データを用いて推定精度を上げる方法を紹介しています。

スライドは下記にアップしています。

最終的なコード全体はこちらに載せています。

Stan の勉強にあたっては、ごみ箱さんberoberoさん伊東さんにアドバイスを頂きました。ありがとうございます。

beroberoさんにほめていただけるような発表ができて良かったです。

次回以降の BUGS/Stan 勉強会は新しい動きがあるようなので、主催者の中川さんのブログをチェックしてみてください。

追記

set.seed(123)
N <- 1000
x <- rnorm(N, mean = 50, sd = 10)
y <- 10 + 0.8 * x + rnorm(N, mean =0, sd = 7)
data <- data.frame(x, y)
data_full <- subset(data, x >= 60)
data_miss <- subset(data, x < 60)
data_miss$y <- NA

d <- rbind(data_miss, data_full)

library(psych)
corFiml(d)
          x         y
x 1.0000000 0.8169659
y 0.8169659 1.0000000