草薙の研究ログ

英語の先生をやってます。

ゼロ過剰ポアソン分布をデータにフィットさせる

ゼロ過剰ポアソン分布では2つのプロセスが考えられている。まず,最初に0の確率がσである二項分布で,値が0でないときのカウントデータがμに従うという。統計モデリングにおいて「ゼロが多いときに使うといい」とはよく聞くものの,厳密にいえば,このような二段階の過程が十分に考えられる事象を対象にするといいと思う。そして,殆どの場合は,先んじている0かそうでないかということにはあまり関心がないときに。

#使うパッケージ
library(fitdistrplus)
library(gamlss)

#ある実測のデータ
d<-c(0,5,6,0,1,8,0,2,0,1,4,2,0,3,8,9,1,1,0,10,1,2,0,2,11,3,0,8,5,11,3,8,8,8,14,7,8,6,5,1,8,7,2,0,6,8,3,3,0,6,2,11,2,0,0,0,0,0,0)

#可視化
hist(d)

#0の割合
length(d[d==0])/length(d)

#まずはポアソンを普通にデータにフィット
fit.pois<-fitdist(d,"pois")
summary(fit.pois)

#次にゼロ過剰ポアソン分布をデータにフィット
fit.ZIP<-fitdist(d,"ZIP",start=1)
summary(fit.ZIP)

#2つのモデルを比較してみる
gofstat(list(fit.pois,fit.ZIP),fitnames=c("Poisson","ZIP"))

#これではσを出してくれない。gamlssを使う
fit.ZIP2<-gamlss(d~1,family=ZIP)
fit.ZIP2


うむ。

わーい!どんなときでも有意差を見つけられるフレンズなんだね!

「思ったように有意差が出なかったんですけどなにかこのデータから言えることはありませんか?」

「どんなデザインですか?」

「処置群・統制群,事前・事後,成果変数は1です」

「そうですね…まずは処置群を恣意的に何パターンかに分割してみましょう!そうするとそれぞれのグループの標本サイズが減るし検定が多重になるので,事前事後の得点差について第一種の過誤の可能性が高まります!まあ4-5グループに分割したら,有意水準を補正しない限りどこか有意になるでしょう!これが王道です」

「はい!」

「その後に,さもそのパターン自体に最初から興味があったように研究仮説自体を改定するのです!これはHARKingと呼ばれる有名な技法です!」

「先生,大変です!性別,学年,事前の得点,学校,恋人の有無,そういった変数で分けたグループでも,どこにも有意はありません!」

「安心してください!まだ手はあります!今度は事前と事後で伸びたひと,伸びなかったひとの数を,手持ちの2値のデモグラフィック変数すべての組み合わせについてカイ二乗検定を別々にするのです!別々にやるのが大事ですよ!」

「先生ぇ…どこも有意になりません」

「大丈夫!まだ手はあります!外れ値だとして,事後得点の下側のひとりずつを外していき,それぞれのステップで何度も検定をして,有意になったときにやめてそれを報告するのです!」

「先生ぇ…ダメですぅ」

「そうですか,ではまず10個のデモグラフィック変数をすべて投入してクラスタリングをしましょう。まずは階層的クラスタリングを何回も繰り返して,有意になる階層でやめましょう。それでダメならクラスタリング方法を変えましょう。それでダメなら,k-means法,それでダメなら混合分布モデル,それでダメならクラスタリングに入れるデモグラフィック変数を減らしていきましょう。方法や,入れる変数の組み合わせで考えると無数にパターンができますから,どこかで必ず第一種の過誤が起きるはずです」

「先生ぇ…どうしましょう」

「(まじかそろそろ有意水準いじろっかな…)いえ!まだまだ手はあります。そもそも成果変数はなんですか?」

「英語のテストの点です」

「そうですか。項目数は?」

「30です」

「よかった,では項目分析をして,弁別力がなかったり信頼性を下げたりする項目をひとつずつ減らしてその度毎に検定をするのです!そして有意になったらやめるのです。なあに,その項目はなかったことにするか,materialのところにテストの質の観点から予め外したと書けばいいのですよ!もうなんなら全項目別々に検定したっていいくらいだ!」

「先生,外していったら項目がなくなりました…」

「(おいまじかよ)こんなことは数学的に絶対無いはずですが…ううむ」

「わたしはもうダメでしょうか…」

「大丈夫です!その被験者にまた来てもらって新しくテストをやりましょう!遅延テストといえばいいのです」

「…それはできなさそうです」

「では,どんなデータでもいいから被験者について知っていることはありませんでしたか」

「ええと,実験ノートに実験中あくびをした人をメモっておきました。靴下の色もメモってますよ!」

「素晴らしいですね!そのあくびをした数人を外して分析すると?」

「あ!あ!先生!有意です!やっと有意になりました!先生ありがとうございます!私の研究に有意差がありました!」

「わーい!有意差だ!先生はどんなときでも有意差を見つけられる先生なんですね!」

「たーのし―!」

 

*この記事はQRP(quetionable research practice)およびHARKing(研究仮説の改定),そして(本来するべきではない)事後的分析において無理に有意差を見出すことの悪質さについての理解を(私自身が)深めるために書いたものです。

モデルの中で何が捨象できるかを語らない科学

数理モデルというものは,その記述の仕方の形式性の割には,数理モデルということばに親しみを感じないほとんどのひとが思うより,本来結果主義的で効用主義的なものだ。

モデルは,もちろん現象それ自体ではないし,その現象を大幅に捨象していて,しかしそこから得られる予測や知見が有益だと見込まれているものだ。この「有益だ」という考え方は一部の学術分野にはないこともあるが。

人文社会系のほとんどの数理モデルは,世界が数字に支配されていて,その世界の斉一的な決定則を表すものだなんてことを意味しない。せいぜいが「観測がうまく当てはまる」,「うまい数理的な近似になっている」という程度の含意である。しかし,そのモデル(世界の決定則それ自体ではない)について考えることで,人が適切に意思決定をできたり,そして個人間の合意が得られ,判断の公共性が発生する(たとえばある種のエビデンスになる)というに考えられている。

 

たとえば,TOEICのスコアは大学が自前でやっている単語テストの成績から予測できるとする。

y = ax + b

という簡単なモデルを考えて,

TOEIC = 8.5×単語テストの得点 - 120

とか,そんなふうに。

このモデルは,それがうまくTOEICのスコアを予測できるとか,つまりこの現象のいい数理的な近似になっていれば,まあいいモデルだといえる。

 

ただし,このとき,TOEICは単語の力だけではないのだから,このモデルは世界の斉一的な決定則の記述として不完全だ!というのはちょっと勇み足だと思う。

TOEICは単語のテストだけではない!とか。

もっというなら,TOEICのときの部屋の温度をモデルに取り入れるべきかだとか,世界の斉一的な決定則を考えれば無限にそんな要因はありえる。

数理モデルを扱う人がもつ,結果主義というか,もっと大きくいってプラグマティズム的な考え方の下では,単にこのモデルはそれらを捨象しているのである。線形モデルなら,それら全部をひっくるめて誤差(残差)として考える。

 

ここで問題は,何が捨象できるかそして何を積極的に捨象するべきかということになる。

 

…外国語教育研究やその関連分野である第二言語習得研究が扱ってきた変数や現象は莫大であり,確かに複雑極まりない。もはや還元主義の傾向が強いテーマに関しては指数的に用語が増えていっていて,収拾付かない例もある。

だからこそ,なにが捨象できるか,そしてなにを捨象するべきか,という考えが今後重要になってくると思う。

そして個人的には,大局的に人間の意思決定や判断の合意形成や公共性の創出という点から見れば,捨象できるものはずっとずっと多いと思っている。

…世界の斉一的な決定則それ自体を考えるならば,むしろなにも捨象できないとも思っている。

Rで日付データの処理

自分用のメモ。

#日付クラスへ変換
d<-"2016-1-1"
d2<-as.Date(d)
class(d2)

#日付データの足し引き(日付クラスだとこれができるようになるのが最高)
d2-1
d2+1
d2-1000
d2+1000

#基準日から1日毎にログイン回数を累積計算
#datは時間とログイン回数のデータフレーム

#基準日を設定
start<-as.Date("2016-04-08")
r<-numeric(130)

#計算
for(i in 1:130){
 r[i]<-sum(dat[dat[,1]<start+i,2])
 }

一般化パレート分布をデータに当てはめる

一般化パレート分布は所得の分布などに使われるそうだ。
外国語教育研究でもこういった分布になる変数を私はひとつだけ知っている(いわないwww)。

Rにいろいろあると思うけど,ここではactuarパッケージとfitdistrplusパッケージを使う。
actuarパッケージに関数があるから,それをfitdistrplusパッケージのfitdist関数当てはめるというわけ。

#パッケージの準備
library(actuar)
library(fitdistrplus)

#乱数作っちゃう
#第一形状母数が3,第二形状母数が3,尺度母数が1000
set.seed(1)
dat<-rgenpareto(1000,3,3,scale=1000)

#経験分布を可視化
par(mfrow=c(1,2))
plot(ecdf(dat),main="")
hist(dat,col="lightblue",main="")


f:id:kusanagik:20170131170612p:plain

#最尤推定(初期値は適当)
fit<-fitdist(dat,"genpareto",start=list(shape1=1,shape2=1,scale=1000))
summary(fit)

Fitting of the distribution ' genpareto ' by maximum likelihood 
Parameters : 
          estimate  Std. Error
shape1    2.973575   0.3122382
shape2    2.811662   0.2800328
scale  1070.970526 236.9332116
Loglikelihood:  -8230.236   AIC:  16466.47   BIC:  16481.2 
Correlation matrix:
           shape1     shape2      scale
shape1  1.0000000 -0.6723317  0.9114599
shape2 -0.6723317  1.0000000 -0.9020353
scale   0.9114599 -0.9020353  1.0000000

plot(fit)


f:id:kusanagik:20170131170939p:plain


うむ。

MCMCを使って指数正規合成分布(ex-Gaussian)の母数を推定

RのMCMCpackにはMCMCmetrop1Rっていう関数があって,これは任意(自作)の対数尤度の関数をいれてMCMCでサンプリングすることができる。なので,結構手軽にMCMCを使ってデータに好きな分布を当てはめることが可能。

ここでは(まったくそんなことはしなくてもいいんだけど),指数正規合成分布の母数(μ,σ,τ)をMCMCを使って推定してみる。

#準備
library(retimes)
library(MCMCpack)

#データの例
dat<-rexgauss(1000,3000,100,800)

#関数の準備
llf<-function(beta,x){
sum(log(dexgauss(x,beta[1],beta[2],beta[3])))
}

#MCMCしてみる,初期値は全部適当,burninとかmcmcの数とかデフォルトのまま
m<-MCMCmetrop1R(llf,theta.init=c(2000,100,100),x=dat)

#結果を見てみる
summary(m)

Iterations = 501:20500
Thinning interval = 1 
Number of chains = 1 
Sample size per chain = 20000 

1. Empirical mean and standard deviation for each variable,
   plus standard error of the mean:

       Mean    SD Naive SE Time-series SE
[1,] 3005.7 13.00  0.09189         0.3102
[2,]  110.8 10.92  0.07724         0.2642
[3,]  779.5 27.79  0.19647         0.6677

2. Quantiles for each variable:

        2.5%    25%    50%    75%  97.5%
var1 2979.96 2997.0 3005.7 3014.3 3031.0
var2   90.49  103.5  110.5  117.8  133.7
var3  726.38  760.6  778.9  798.1  836.6

plot(m)


f:id:kusanagik:20170128185732p:plain