ほくそ笑む

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

マイナーだけど最強の統計的検定 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

チェビシェフの不等式について発表しました

先日行われた第40回R勉強会@東京(Tokyo.R)にて、「チェビシェフの不等式」というタイトルで発表させていただきました。

大数の法則の証明にも使われるチェビシェフの不等式ですが、現実問題への適用例として、実際にあった事例をデフォルメして物語形式で発表してみました。

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

また、この発表に対する補足資料を RPubs に上げています。

http://rpubs.com/hoxo_m/19776

無味乾燥と思える数式でも、実際に使われた事例を知ると、急に親近感がわいてくることもあるかと思います。
楽しんでいただけたら幸いです。

それでは、また。

log 変換する?しない?AICでモデル比較するときの注意点

データを分析にかける前に、出力変数を log 変換する、というのはよくあることだと思います。
次のデータを見て下さい。

このデータ、線形モデルに当てはめる前に log 変換したほうがよさそうだなーというのが見てとれます。
それもそのはず、このデータは次のように作っています。

N <- 100
x <- runif(N, min = 1, max = 2)
y <- exp(x + rnorm(N, sd = 0.3))
data <- data.frame(x, y)

それでは、log 変換しないバージョンと、するバージョンでモデルを作成して、AIC を比較してみましょう。

model <- lm(y ~ x, data)
model.log <- lm(log(y) ~ x, data)
aic <- AIC(model, model.log)
print(aic)
##           df    AIC
## model      3 364.09
## model.log  3  38.94

このように、log 変換するバージョンの方が AIC が小さいので、log 変換したほうが良いモデルだということがわかります。

こんどは、次のデータを見てみましょう。

このデータは、次のように生成されているので、log 変換はしないほうが良いはずです。

N <- 100
x2 <- runif(N, min = 1, max = 2)
y2 <- x2 + rnorm(N, sd = 0.4)
data2 <- data.frame(x2, y2)

それでは、log 変換しないバージョンと、するバージョンでモデルを作成して、AIC を比較してみましょう。

model2 <- lm(y2 ~ x2, data2)
model.log2 <- lm(log(y2) ~ x2, data2)
aic2 <- AIC(model2, model.log2)
print(aic2)
##            df   AIC
## model2      3 96.48
## model.log2  3 37.99

なんと、log 変換するバージョンのモデルの方が、AIC が小さくなってしまいました。
これはなぜでしょう?

変数変換のワナ

実は、変数変換を行う前後のモデルは AIC でそのまま比較できません。
なぜなら、AIC の骨格を成す尤度が、変数変換前後で尺度が変わってしまうためです。
ここでは、変数変換後の AIC を変数変換前の尺度にするための補正項を求めてみます。

今、出力変数を変換する関数を  w(y) とします。
このとき、変換前の確率密度関数  f(y) と変換後の確率密度関数  g(w) の間には、次のような関係が成り立ちます。
  f(y) = g(w(y))\frac{dw}{dy}
したがって、変換前の尺度での尤度  Lik_y^* は、変換後の尺度での尤度  Lik_w を用いて次のように表すことができます。
  Lik_y^* = \prod_{i=1}^N f(y_i) = \prod_{i=1}^N g(w(y_i))\frac{dw}{dy}(y_i) = Lik_w \prod_{i=1}^N \frac{dw}{dy}(y_i)
よって、対数尤度は次のようになります。
  logLik_y^* = logLik_w + \sum_{i=1}^N \log\big(\frac{dw}{dy}(y_i)\big)
これにより、変換前の尺度での AIC を求めることができます。
  AIC_y^* = -2logLik_y^* + 2p = -2logLik_w - 2\sum_{i=1}^N \log\big(\frac{dw}{dy}(y_i)\big) + 2p
  AIC_y^* = AIC_w - 2\sum_{i=1}^N \log\big(\frac{dw}{dy}(y_i)\big)
今、 w(y) = \log(y) とすると、 w^\prime = \frac{1}{y} なので、対数変換後のモデルの変換前の尺度での AIC
  AIC_y^* = AIC_w -2\sum_{i=1}^N \log\big(\frac{1}{y_i}\big)
となります。
すなわち、対数変換前後のモデルを AIC で比較したい場合は、対数変換後の AIC に補正項を加えてやればいいだけです。

Rでやってみる

上記の例を用いて、R で実際にやってみましょう。

まずは、最初の例です。

adj <- -2 * sum(log(1/y))
cbind(aic, adj.AIC = aic$AIC + c(0, adj))
##           df    AIC adj.AIC
## model      3 364.09   364.1
## model.log  3  38.94   334.8

やはり、補正項を加えても、log 変換後の方が良いモデルとなっています。いいですね。

それでは問題となる2番目の例です。

adj2 <- -2 * sum(log(1/y2))
cbind(aic2, adj.AIC = aic2$AIC + c(0, adj2))
##            df   AIC adj.AIC
## model2      3 96.48   96.48
## model.log2  3 37.99  107.58

こんどは log 変換しないモデルの方が良いと出ました。やったね!

これにより、log 変換前後のモデルを AIC で比較することができるようになりました。

もうすこし一般的に

もう少し一般的に書くと、次のように書けると思います。

library(numDeriv)
trans.func <- sqrt
adj <- -2*sum(log(grad(trans.func, x=y)))

このように補正項を求めれば、log 変換だけでなく、平方根変換とかでも使えるようになります。

まとめ

この記事は R Advent Calendar 2013 の 23 日目の記事です。
こういう情報 Web 上に無いな〜と思って書いてみました。
みなさん変数変換するときはどうしてるんでしょうかね?
出力変数が2変数以上のときはもうちょっと複雑でヤコビアンを使うことになります。
ヤコビアンも上記の numDeriv パッケージにあるので R で簡単に実装できると思います。

以上

2013年度Rユーザ会で発表してきました

2013年度統計数理研究所共同研究集会「データ解析環境Rの整備と利用」(通称、Rユーザ会)にて、Japan.R 枠で発表させて頂きました。

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

以前作成した Twitter Bot @ の妹分である @ を作成したのでそのお披露目をしてきました。
以前の記事:RPubs の新着記事をつぶやく Twitter Bot 作った

今回、@RPubsRecent の fav 付きのツイートを流すボットを作ったわけですが、ef-prime の鈴木さんのアドバイスで、投稿時間やタイトルを解析して fav が付くかどうか予測できるのではというのは勉強になりました。他にもユーザの投稿回数や以前 fav をもらったかなどの情報は fav 予測に使えそうだなーと思いました。こういう発想がまだできないのはデータアナリストとして駆け出しゆえなので改善したいところです。

Rユーザ会では奥村先生を生で見ることができて感激したり、@wdkz さんに OpenShinyMac 版あったらいいなと言われたりと楽しんできました。

また来年も参加したいなと思います。

それでは。