バナナでもわかる話

開設当初は計量経済学・統計学が専門の大学院生でした。今はデータを扱うお仕事をしています。統計学・経済学・投資理論・マーケティング等々に関する勉強・解説ブログ。ときどき趣味も。極力数式は使わずイメージで説明出来るよう心掛けていますが、時々暴走します。

1週間で知識ゼロの初心者がSQL操作を身に着ける方法

インターン先で急にSQLが必要と言われ、急遽身に着ける必要が生じ、本当に何も知らない状態からのスタートだったのですが、結構簡単に身について、今はそこそこスムーズにデータを取り出すことが出来るようになりました。

メモがてら何をやったか書いていこうと思います。


目次

スポンサーリンク



まず「SQLとはなんぞや」というところから始まった

話には聞いたことがありました。
「何か.....データを扱える......らしい.....???」

みたいな状態でした笑

そこで、まずはいきなりSQL操作の練習を始めるよりも、SQLって何ですか、どんなことが出来て、何が便利なんですかということを知ろうと考えました。

はじめてでもわかるSQLとデータ設計

それにあたり読んだのがこの本です。

・はじめてでもわかるSQLとデータ設計

SQL関連の本をAmazonで物色していた時に、コメントで「非常にわかりやすい」「意外と中級者でも学べることが多い」「この本読んでわからなかったら、SQL向いてない」と書かれていたので、まあわかりやすいのだろうと思って最初に読む本に決めました。

実際私が期待していた通りの本で、SQLっていったい何なの?というところから始まり、一通り雰囲気をおさえることが出来ました。
また中盤以降は簡単なSQL操作まで学ぶことが出来、この本一冊でもう簡単な操作までなら身に着けることが出来ます。

SQLzoo

知識としては理解しました。ただ、やはり練習をしたい。環境を整えるのは面倒くさい。
そんなことを考えていたら友人から「SQLzoo」が良いよとアドバイスを頂きました。

ここですね。
https://sqlzoo.net/wiki/SQL_Tutorial/ja

実際にクエリを打ち込んで、正しい結果を得られるかクイズ形式で練習することが出来ます。

答えが分からない場合、ちょっとネットで検索すれば、こんな感じで答えが落ちているので大丈夫です。
SQLZOO「SELECT within SELECT Tutorial」 回答集 #初心者 - Qiita

なるほど、こんな感じでSQLというのは使えるのか~とイメージを掴むことが出来ました。

より実践的な知識

最後のダメ押しとして、一冊実践的な本を読みました。
zooと先ほどの本ではカバー出来ていない、How toをこの本でおさえることが出来たのはでかいです。

SQL実践入門

・SQL実践入門

SQL、ループがないけどどうすんの?みたいな話とかCASEの詳しい使い方とかが特にためになりました。
まだ全ての内容をインプットできているわけではありませんが、非常にわかりやすく実践的。
どう書くのが効率が良く、コストを少なく抑えられるのかが仕組みベースで説明されているのも非常にわかりやすい!

SQLは内部でデータ操作方法を勝手に選択してくれるので、どうしてもブラックボックス感というか、何をやっているのかイメージしにくい感じがありますが、あまり高度なところへは踏み込まず、しかし一方で行っている操作をイメージしやすくなるよう説明がなされています。

ゼロ過剰負の二項回帰のStanによる実装

今回は、ゼロ過剰負の二項回帰モデルをやりたいと思います。
なんか名前がゴツゴツしいですね。


とりあえず、今回もStanコードを書くのがメインなので、モデル部分はザックリいきます。

目次

スポンサーリンク


モデル

ゼロ過剰とは

ゼロ過剰ポワソン分布は有名ですね。
要は確率 \omegaでゼロしか出ない分布、確率 1-\omegaでポワソン分布が選ばれる混合分布を考える時ゼロ過剰ポワソン分布と呼びます。本来のポワソン分布よりも \omegaだけゼロが過剰に出ていますよね。だからゼロ過剰です。

では、ゼロ過剰負の二項分布とは何かというと、先ほどのポワソンを負の二項分布に変えればゼロ過剰負の二項分布です。

負の二項分布

今回は次のような定義で負の二項分布を定義しておきます。

 f_{NB} = \frac{\Gamma(\theta+Y_i)}{\Gamma(\theta)\Gamma(Y_i+1)}(\frac{\theta}{\theta+\mu_i})^{\theta} (\frac{\mu_i}{\theta+\mu_i})^{y_i}

負の二項回帰

更に次のような構造を仮定することで回帰することにします。

 log(\mu_i) = \beta_0+\beta_1 X_{(1,i)} +\cdots + \beta _{Kb} X_{(Kb,i)}
 log(\frac{\omega_i}{1-\omega_i}) =logit(\omega_i) =\gamma_0 + \gamma_1 x_{(1,i)} +\cdots + \gamma_{Kg} x_{(kg,i)}

 \beta,\gammaがパラメータになります。


Stanによる実装

というわけでコードを書いてみました。

例の有名な教科書のゼロ過剰ポワソンの部分のコードを真似してます。

model="
functions{
	real ZINB_lpmf(int Y,real omega,real theta,real mu){
		if(Y==0){
			return log_sum_exp(bernoulli_lpmf(0|omega),bernoulli_lpmf(1|omega)*neg_binomial_2_lpmf(0|mu,theta));
		}else{
			return bernoulli_lpmf(1|omega)*neg_binomial_2_lpmf(Y|mu,theta);
		}
	}
}

data{
	int N;
	int Kb;
	int Kg;
	int<lower=0> Y[N];
	matrix[N,Kb] X;
	matrix[N,Kg] XX;
}

parameters{
	real<lower=0> theta;
	real beta0;
	vector[Kb] beta;
	real gamma0;
	vector[Kg] gamma;
}

transformed parameters{
	real<lower=0> mu[N];
	real<lower=0,upper=1> omega[N];
	real q[N];



	for(i in 1:N){
		q[i] = gamma0+XX[i]*gamma;
		omega[i] = inv_logit(q[i]);
		mu[i] =exp(beta0+X[i]*beta);

	}	
}

model{
	for(i in 1:N){
		Y[i] ~ ZINB(omega[i],theta,mu[i]);
	}
}"


収束しない場合は、弱事前分布ですかね。
回帰係数の部分に正規分布かt分布をあてるのが良いかと。

階層ベイズ生存解析を用いたwebサイトの訪問者分析に関するStanでの実装

今回も少し難しめの話。
前回生存解析についてまとめたので、生存解析を使っているマーケティングモデルでも勉強してみようかと探してみたところ、次の論文があったので、論文モデルを整理しながらStanで実装してみようと思います。

前回の生存解析の記事
www.bananarian.net

今回まとめる論文
山口景子 『頻度の時間変化を考慮した階層ベイズモデルによるウェブサイト訪問行動の分析』
https://www.jstage.jst.go.jp/article/marketingscience/22/1/22_220102/_pdf/-char/ja

Stanについてよく知らない人はこの本がオススメ


目次

スポンサーリンク



webマーケティング研究の現状

webマーケティング研究

これは論文の内容ではありませんが、マーケティングサイエンス分野におけるwebマーケティング研究の現状について概観しておこうと思います。

まず、私が調べた限りですが、webマーケティングに関するマーケティング研究の関心は*1最近非常に高まっています。

しかし、その一方でwebマーケティング分析において欠かせないユーザー(or 顧客 or 消費者)のアクセスログデータは基本的に、各企業が管理しており、マーケティング研究者の手元にはありません。その為研究者がこれらの研究顧客分析を行うにあたっては、企業と共同研究を行う必要があり、ハードルが高く、報告も少ないのが現状です。

アクセスログの経営学的意義

経営学においては、消費者の購買行動(購買前、購買後含む)や購買心理を集計的な観点、個別的な観点から分析し、その結果を企業経営に役立つ形でインプリケーションとして提示することが求められます。

しかし購買前行動については、実際に使用できるデータ(消費者が商品購買前に何をしていたかに関するデータ)がほとんどなく、現象として観察することは出来ても計量が難しく、実際に役立てるのが難しいと言われてきました。

ただ今はというと、webサービスやECサイトの登場と共に、膨大なユーザーアクセスログが蓄積され、購買前の行動を十分に観察出来るようになりました。そのため、今経営学分野ではアクセスログを使った研究をしたいというニーズが高まりつつあるわけです。

one to one マーケティング

また、細かなユーザー情報を収拾できるようになったために、ウェブマーケティング分野ではone to oneマーケティングと言って、「消費者一人一人のニーズや状況を汲み取ったマーケティングコミュニケーションを行おう」という状況に移行しつつあります。

ウェブサイトの訪問頻度のモデル化

PV数

ウェブサイトのPV数はそのサイトの広告価値に影響します。そこでPV数を高めたり、今後の潜在的なリスクを見つけるためにどういった要因がPV数に影響を及ぼしているか分析出来たら嬉しいということになります。

さてここで、山口さんはとりあえずPV数を「訪問頻度」と「訪問一回当たりのPV数」に分解し、今回はそのうちの「訪問頻度」について考えてみたというわけですね。

モデル

尤度

 T日間において、ユーザー i=1,\cdots,Nがそれぞれ J_i回サイトに訪れたという状況を考えます。ユーザーiがj回目にサイトに訪れた日数を t_{(i,j)}と置くと、各回の訪問間隔 y_{(i,j)}=t_{(i,j+1)}-t_{(i,j)}はパラメータ \lambda_{ij}の指数分布に従うと仮定します。

ここで、 j=J_iの場合の y_{(i,j)}が本来は観測されないことに注意してください。観察期間 Tとの差を考え、指数分布の切断を考えます。


まず、 j≠J_iの場合の密度関数
 f(y_{(i,j)};\lambda_{ij})=\lambda_{ij}exp(-\lambda_{ij} y_{(i,j)})

 j=J_iの場合は次のように切断を考えます。

 y_{(i,j)}=T-t_{(i,j)}
この時、観測されていない変数 y_{(i,j)}^*=t_{(i,j+1)}-t_{(i,j)}は指数分布に従うため、
 f(y_{(i,j)}^*;\lambda_{ij})=\lambda_{ij}exp(-\lambda_{ij} y_{(i,j)}^*)

ここで、少なくとも y_{(i,j)}^*≧y_{(i,j)}であることはわかっているので、

 Prob(y_{(i,j)}^*≧y_{(i,j)})=1-Prob(y_{(i,j)}^*<y_{(i,j)})=1-F(y_{(i,j)}) = exp(-\lambda_{ij} y_{(i,j)})



更に、顧客の情報を織り込みたいので、次のようにパラメータを規定します。
1を含む顧客情報に関する(K+1)次元ベクトル x_{ij}を用いて、 \lambda_{ij}を次のように考えます。

 \lambda_{ij} = exp(\beta_i x_{ij})

ただし \beta_iは(K+1)次元パラメータベクトル。

事前分布と階層パラメータ

更に事前分布として次のように設定する。

 \beta_i ~ MultiNormal(\delta,\Sigma_{\beta})

 \delta~  MultiNormal(適宜設定)
 \Sigma_{\beta} ~  InvWishart(適宜設定)

共変量の選択

この論文では、目的上経時情報が知りたいので、そのような共変量を選択し、セミパラメトリックなcox比例ハザードモデルを行い、妥当な共変量を判断した後に、再度実行を行っている。

cox比例ハザードモデルについてはこちらをどうぞ
www.bananarian.net

Stanで実装してみた

R で擬似アクセスログを作ってみた - あらびき日記
access_logs.R · GitHub

アクセスログやユーザー情報のデータなんて当然私は持ち合わせていないので、上記サイトさんを参考にアクセスログデータもどきを作らせていただきました。

アクセスログ作成プロセスはこの記事では省略しますので、上記サイトさんを参考にしてください。

model="

functions{
	real TruncatedExp_log(real Y,real lam){
		real pr;
		pr = exp(-lam*Y);
		return(log(pr));
	}
}

data{
	//個人ID数
	int N;
	//特性数
	int CNUM;
	//各IDに対応する訪問回数
	int T[N];
	//T[N]の和
	int SUMT;


	//個人の特性
	matrix[SUMT,CNUM] CX;
	//Truncate情報
	int<lower=0,upper=1> Tru[SUMT];
	//DiffTime=Y
	vector<lower=0>[SUMT] Y;
}

parameters{
	//係数パラメータ
	vector[N] beta0;
	matrix[N,CNUM] beta;
	
	//事前分布のパラメータ
	vector[CNUM+1] BETA;
	cov_matrix[CNUM+1] SIGMA;
}

transformed parameters{
	vector<lower=0>[N] lambda0;
	vector<lower=0>[SUMT] lambda;
	vector[CNUM+1] Ibeta[N];

	for(i in 1:N){
		lambda0[i] = exp(beta0[i]);
		Ibeta[i][1]=beta0[i];
		for(c in 1:CNUM){
			Ibeta[i][c+1]=beta[i,c];
		}
		if(i==1){
			for(t in 1:T[i]){
				lambda[t]=lambda0[i]*exp(dot_product(beta[i],CX[t]));
			}
		}
		else{
			for(t in 1:T[i]){
				lambda[T[i-1]+t]=lambda0[i]*exp(dot_product(beta[i],CX[T[i-1]+t]));
			}
		}
	}
}

model{
	//尤度関数
	for(i in 1:SUMT){
		if(Tru[i]==0){
			Y[i] ~exponential(lambda[i]);
		}
		else{
			Y[i] ~TruncatedExp(lambda[i]);
		}
	}			
	//事前分布
		for(i in 1:N){
			Ibeta[i] ~ multi_normal(BETA,SIGMA);
		}

	//階層事前分布
	//適宜調整(仮に下のような感じにしてみた。下のよりももっと無情報に近づけるのが良い)
	BETA ~ multi_normal(rep_vector(0,CNUM+1),diag_matrix(rep_vector(10,CNUM+1)));
	inverse(SIGMA) ~ wishart(10,diag_matrix(rep_vector(10,CNUM+1)));
}

"

library(rstan)
fit=stan(model_code=model,data=data,seed=1234,par=c("Ibeta"))

雑感

かなり解釈しやすいモデルで、使える場面が多々ありそうだな~と思いました。
論文にもあるように、各人のパラメータを使ってセグメンテーションを行うと直感的にもわかりやすいかもしれないです。

*1:理由は後述

Rで行える生存解析を出来る限り初歩から解説してみる~ハザード率、cox比例ハザード、ログランク検定等~

今回は生存解析をやろうと思います。
生存解析に関する解説をしているブログは巷に溢れかえっていますが、他のブログよりもハザード率の解説を丁寧に行うことにより差別化を図っていければいいなと思っています。

目次

スポンサーリンク


ハザード率(Hazard Rates)

ハザード率という概念は、医療や保険の現場でよく利用されます。

2種類のハザード率の定義

具体例

仮に保険屋さんの例で考えてみます。
保険業界では保険契約者のことをPolicy holder と呼んだりします。下の表はある保険会社Aが抱えているPolicy holderから得られたデータです。

Age : 年齢
num : Policy holder の人数
D : Policy holder の内亡くなった人数

D=sample(1:20,length(30:90),replace=TRUE)
Do=order(D)
D=D[Do]
LifeTable=data.frame(Age=30:90,num=sample(100:500,length(30:90),replace=TRUE),D=D)
> LifeTable
   Age num  D
1   30 495  2
2   31 206  2
3   32 412  3
4   33 482  3
5   34 355  4
6   35 335  4
7   36 353  4
8   37 367  4
9   38 312  5
10  39 114  5
11  40 253  6
12  41 121  7
13  42 354  7
14  43 238  7
15  44 194  8
16  45 437  9
17  46 106  9
18  47 410  9
19  48 216  9
20  49 176  9
21  50 234 10
22  51 411 10
23  52 288 10
24  53 241 11
25  54 227 11
26  55 398 11
27  56 404 11
28  57 444 11
29  58 320 12
30  59 238 12
31  60 451 12
32  61 126 13
33  62 306 13
34  63 234 13
35  64 287 13
36  65 350 14
37  66 340 14
38  67 137 14
39  68 200 15
40  69 234 15
41  70 294 16
42  71 318 16
43  72 459 16
44  73 403 17
45  74 488 17
46  75 144 17
47  76 258 17
48  77 265 17
49  78 499 18
50  79 346 18
51  80 422 18
52  81 209 18
53  82 382 18
54  83 218 19
55  84 191 19
56  85 246 19
57  86 483 20
58  87 310 20
59  88 335 20
60  89 247 20
61  90 188 20

(当然データ生成過程からもわかるように架空のデータです。)

ここで保険屋さんは保険料を設定するためにはPolicy holderの生存確率を考えなければなりません。例えば、今30歳の人たちが70歳まで生きる確率はどのくらいか。などなど

この生存確率を考えたいというのが今回の解析のモチベーションです。

ハザード率とは何か

では、考えてみます。

まず、i歳で亡くなる確率、つまり言い換えると寿命がi年である確率を仮に Pr(X = i)と置くことにします。

このように設定することでi歳以降で亡くなる確率、つまり少なくともi-1歳までは生存している確率 Pr(X≧i)は次のようにわかりますね。

 Pr(X≧i) = \sum_{j≧i} Pr(X=j)

ということは、ベイズの定理より少なくともi-1歳までは生きているが、i歳で亡くなってしまう確率 Pr(X=i | X≧i)もわかります。

 Pr(X=i | X≧i) =\frac{Pr(X = i)}{Pr(X≧i) }= \frac{Pr(X = i)}{\sum_{j≧i} Pr(X=j)}

この Pr(X=i | X≧i) がハザード率です。
ちなみに、今は暗黙的に離散時間でハザード率を考えていることに注意してください。

ハザード率から見える生存確率

更にハザード率がわかると、少なくともi-1歳まで生きて、i歳時点では亡くならない確率 1-Pr(X=i | X≧i)もわかるわけです。

よって、少なくともi-1歳まで生きて、更にそこからj歳まで生きる確率 Pr(X>j|X≧i)は次のような確率の掛け算で得られます。

 Pr(X>j|X≧i) = \prod_{k=i}^j  (1-Pr(X=k | X≧k))

ハザード率を連続時間に拡張する

知っているハザード率の定義と違う!と思った方少々お待ちください。
今の話をそのまま連続時間に拡張すると一般的なハザード率の定義になります。

正の連続値確率変数 Tを考えます。
この時、 T t以上となる確率 Pr(T≧t)は確率密度関数 f(t)を用いて次のように表せるはずです。

 Pr(T≧t)=\int_{t}^\infty f(x) dx

これがさっき説明したところの Pr(X≧i)です。

そうするとハザード率 hazard(t)
 hazard(t)=\frac{Pr(T=t)}{Pr(T≧t)}=\frac{f(t)}{\int_{t}^\infty f(x) dx}

これもさっきの理屈と同じです。解釈もさっきの理屈と同じです。
一点違うのは時間が離散から連続になっているという点ですね。

これは見方を変えると次のように見ることも出来ますね。

 dt→0のもとで
 hazard(t)dt = Pr(t≦T≦t+dt|T≧t)

そのため、よくハザード率の説明では次のような定義が成されます。

 hazard(t) =\displaystyle \lim_{dt \to 0} \frac{Pr(t≦T≦t+dt|T≧t)}{dt}

これがよく見かける連続時間におけるハザード率の定義です。

ハザード率の仮定及び推定

離散時間、連続時間の2種類の観点からハザード率について説明しました。
しかし、話が一般的すぎます。
離散時間で考えると Pr(X=i | X≧i)がハザード率だ!
連続時間で考えると \displaystyle \lim_{dt \to 0} \frac{Pr(t≦T≦t+dt|T≧t)}{dt}がハザード率だ!

と言われても、だからどうした、つまりそれをどう扱えばよいのだとなりかねません。
そこで確率分布を何らかの方法で特定しましょう。

ノンパラメトリック推定

離散時間でものを考えるのならば、話は中学生の時の確率レベルで構いません。
要は i歳まで生きていた人の人数 n_iと、i歳時点で亡くなってしまった人の人数 D_iが分かれば良いわけです。
よって、ハザード率の推定量を次のように置くことにしましょう。

 \hat{hazard(i)}=\frac{D_i}{n_i}

このように単純な相対度数を取った推定方法を経験分布による推定と呼びます。
確率論の定義に則れば、サンプルサイズ無限大で相対度数は真の分布と定義上等しいので、真っ当な推定方法です。
これをもう少し大きな枠組みでノンパラメトリックな推定と呼んだりします。

ただし、一般的にノンパラメトリックな推定はパラメトリックな推定と比べるとefficientではないという欠点があります。

パラメトリック推定

ノンパラメトリック推定は分布の仮定をかなり広く取った(正確にはパラメータ空間を広く取った)推定方法でしたが、もう少し分布を限定してしまうことも出来ます。

例えば連続時間で考えた上で、分布 f(t)=\frac{1}{c}exp(-\frac{t}{c})を考えます。
これを片側指数分布と呼びます。

この場合 \int_{t}^\infty f(x) dx=exp(-\frac{t}{c})のため、
 hazard(t) = \frac{1}{c}
になります。

つまり、時間に依存せず、ハザード率は等しいというような分布の仮定になります。
これは生存解析の文脈でハザード率の説明をする際には具体例として必ず取り上げられる特徴的な仮定です。

打ち切りデータにおけるハザード率と生存確率

ただ、現実はそうそう甘くない。先ほどの保険屋さんのデータ例は非常に綺麗なデータでしたが、Policy holder が途中で離脱してしまうということも考えられます。つまり契約の解約です。この場合、少なくとも〇〇歳まで生きていたことはわかるが、それ以上はよくわかりませんというデータになるわけです。

カプランマイヤー推定量

具体例

それでは、打ち切りデータの具体例を見てみます。
RのパッケージsurvBootOutliersにはget.whas100.dataset()という関数でwhas100という打ち切りデータを取ってくることが出来るので、それを使います。

> library(survival)
> library(survBootOutliers)
> Data=get.whas100.dataset()
> head(Data)
  X los age gender      bmi times status
1 1   4  65      0 31.38134     6      1
2 2   5  88      1 22.65790   374      1
3 3   5  77      0 27.87892  2421      1
4 4   9  81      1 21.47878    98      1
5 5   4  78      0 30.70601  1205      1
6 6   7  82      1 26.45294  2065      1

病気の患者のデータですね。
statusが0の場合は生きているか、観察打ち切り(退院、転院等)のどちらかの打ち切りデータです。
statusが1の場合はもう亡くなってしまっていると考えます。
timesは入院から(死亡or離脱or生存)の期間を表します。

survivalパッケージのsurvを利用すると、timesとstatusの関係を整理することが出来ます。

> Surv(Data$times,Data$status)
  [1]    6   374  2421    98  1205  2065  1002  2201   189  2719+ 2638+  492 
 [13]  302  2574+ 2610+ 2641+ 1669  2624  2578+ 2595+  123  2613+  774  2012 
 [25] 2573+ 1874  2631+ 1907   538   104     6  1401  2710   841   148  2137+
 [37] 2190+ 2173+  461  2114+ 2157+ 2054+ 2124+ 2137+ 2031  2003+ 2074+  274 
 [49] 1984+ 1993+ 1939+ 1172    89   128  1939+   14  1011  1497  1929+ 2084+
 [61]  107   451  2183+ 1876+  936   363  1048  1889+ 2072+ 1879+ 1870+ 1859+
 [73] 2052+ 1846+ 2061+ 1912+ 1836+  114  1557  1278  1836+ 1916+ 1934+ 1923+
 [85]   44  1922+  274  1860+ 1806  2145+  182  2013+ 2174+ 1624   187  1883+
 [97] 1577    62  1969+ 1054 

数字はtimesです。そして、status=0の場合は数字の横に+がついています。


このような打ち切りデータの場合、先ほどのようなハザード率・生存確率の推定では、打ち切りを考慮できていません。

カプランマイヤー推定量

先ほどのデータを時間順に並び替えてみることにします

> S=Surv(Data$times,Data$status)
> S[order(S)]
  [1]    6     6    14    44    62    89    98   104   107   114   123   128 
 [13]  148   182   187   189   274   274   302   363   374   451   461   492 
 [25]  538   774   841   936  1002  1011  1048  1054  1172  1205  1278  1401 
 [37] 1497  1557  1577  1624  1669  1806  1836+ 1836+ 1846+ 1859+ 1860+ 1870+
 [49] 1874  1876+ 1879+ 1883+ 1889+ 1907  1912+ 1916+ 1922+ 1923+ 1929+ 1934+
 [61] 1939+ 1939+ 1969+ 1984+ 1993+ 2003+ 2012  2013+ 2031  2052+ 2054+ 2061+
 [73] 2065  2072+ 2074+ 2084+ 2114+ 2124+ 2137+ 2137+ 2145+ 2157+ 2173+ 2174+
 [85] 2183+ 2190+ 2201  2421  2573+ 2574+ 2578+ 2595+ 2610+ 2613+ 2624  2631+
 [97] 2638+ 2641+ 2710  2719+

ちなみにこのデータはデータ数100です。
timesに重複があるのがちょっとややこしいですが、一旦説明の都合上完全に順序があると考えてください。
つまり、6日で2人亡くなっているわけですが、時間軸上先に一人目が亡くなって、次に二人目が亡くなったと考えてください。
つまり
 t_{1}<t_{2}<,\cdots,<t_{100}

だと考えているものとします。
更に、 t_{i}時の切断の有無を d_{i}と表し、切断が成された場合(+がついている場合)は d_{i}=0とします。

この時、 t_{j}時点での生存確率はノンパラメトリックに(経験分布的に相対度数で)考えると次のようになりますね。

 \prod_{k≦j} (\frac{n-k}{n-k+1})^{d{k}}

この生存確率の推定量をカプランマイヤー推定量と呼びます。

生存曲線

このカプランマイヤー推定量は次のようにplotして確認してみるのが一般的です。
ちなみに下のプロットを生存曲線と呼びます。

plot(survfit(Surv(Data$times,Data$status)~Data$gender),lty=c(1,2))
legend(locator(1),c("male","female"), lty=c(1,2))

f:id:bananarian:20190214024928p:plain
ちなみに、普通生存曲線は比較する二つの群をプロットして、どちらの生存確率が高いかといったことを確認するものなので、survfit関数では比較する群を識別できるようformulaで記述します。
今回は男女で分けてみました。理由は特にありません。

信頼区間

カプランマイヤー推定量の信頼区間もsurvfitでは求めることができます。

plot(survfit(Surv(Data$times,Data$status)~Data$gender),lty=c(1,2))
lines(survfit(Surv(Data$times,Data$status)~Data$gender,conf.type="log"),mark.T=F,conf.int=TRUE,col=c("black","red"))
legend(locator(1),c("male","female"),lty=1,col=c("black","red"))

f:id:bananarian:20190214121046p:plain

ただし、この信頼区間の推定、恐らくグリーンウッドの公式を用いた方法が取られていると思われますが、この公式、生存確率が0か1に近い場合過少推定が起こると指摘されています。
以下参照
https://www.jstage.jst.go.jp/article/dds/30/5/30_474/_pdf


パラメトリックアプローチ

カプランマイヤーはノンパラメトリックな推定方法でしたが、パラメトリックに考えることも当然可能です。

Rではsurvreg関数が用意されており、distに分布を指定すればそれに合わせてパラメトリックに生存解析を行うことが可能です。

> survreg(Surv(Data$times,Data$status)~Data$gender,dist="logistic")
Call:
survreg(formula = Surv(Data$times, Data$status) ~ Data$gender, 
    dist = "logistic")

Coefficients:
(Intercept) Data$gender 
  2293.8562   -676.2864 

Scale= 871.8654 

Loglik(model)= -478.8   Loglik(intercept only)= -480.8
        Chisq= 3.94 on 1 degrees of freedom, p= 0.0472 
n= 100 

2群の検定(ログランク検定)

2群のハザード率・生存確率を比較するにあたり、2群のハザード率が等しいか否かを検定する方法にログランク検定があります。ログランク検定の帰無仮説は次のようになります。

帰無仮説:  全ての時間において2群のハザード率が等しい or (生存確率が等しい)

Rではsurvdiff関数によって行えます。

> survdiff(Surv(Data$times,Data$status)~Data$gender)
Call:
survdiff(formula = Surv(Data$times, Data$status) ~ Data$gender)

               N Observed Expected (O-E)^2/E (O-E)^2/V
Data$gender=0 65       28     34.6      1.27      3.97
Data$gender=1 35       23     16.4      2.68      3.97

 Chisq= 4  on 1 degrees of freedom, p= 0.05 
結局ハザード率って何なの

ここで一度整理しておきます。ハザード率の確率論的解釈についてはこの記事の初めでお話しましたが、結局のところノンパラメトリックな観点から見たハザード率は、確率密度の代わりであると考えることも可能です。

ちなみにパラメトリックな解析においては、パラメータの推定値を利用して逆算的にハザード率を求めることも可能です。

cox 比例ハザードモデル

最後に、2群じゃなくてもっと多くの条件からハザードを確認し、多くの共変量の中から特に影響の大きいものを探したいといったモチベーションがあった場合、今までの手法ではうまくいきません。そこでcox比例ハザードモデルというセミパラメトリックな方法を取ります。

比例ハザード

まず、比例ハザードについて説明します。
ある個人iの情報(共変量)として、 X_iが与えられているとします。
この時、 i t時点でのハザード率は次のようになると仮定します。

 hazard_i(t) = hazard_0(t) G(X_i)

 G(X_i) X_iの関数です。
 hazard_0(t)はベースラインハザードと呼ばれます。共変量に全く依存していないことに注意してください。
要は、ハザードは比較実験のための情報が同じであれば一定であるという仮定をおいているわけです。
医療実験の枠組みで解釈するならベースラインハザードはプラセボ群ということになりますね。

更に共変量に添え字 tが無いことにも注意です。このモデルでは、時間によって共変量の影響が変化しないという仮定も入っています。

cox比例ハザードモデル

そして、 G(X_i)=exp(X_i \beta)と置くことで、これをcox比例ハザードモデルと呼びます。

このモデルの尤度を解くことは難しいので、部分尤度から近似推定量を求めます。
これを部分尤度最大化問題と呼びます。

で、この部分尤度最大化問題まで落とし込めれば基本的には解析的に求めることが出来るわけですが、近似解を求める手法も提案されています。

coxph

survivalパッケージではcoxph関数でcox比例ハザードモデルを推定することが出来ます。
methodに対してexactを与えると、部分尤度最大化問題を解析的に求めます。
efronやbreslowを与えると近似解を求めます。近似解はあくまで近似なので、計算量的な問題を気にしないのであればexactの方が良いと思います。デフォルトはefronです。

> summary(coxph(Surv(Data$times,Data$status)~Data$gender+Data$bmi+Data$age, method="exact"))
Call:
coxph(formula = Surv(Data$times, Data$status) ~ Data$gender + 
    Data$bmi + Data$age, method = "exact")

  n= 100, number of events= 51 

                coef exp(coef) se(coef)      z Pr(>|z|)   
Data$gender  0.14484   1.15585  0.30622  0.473  0.63622   
Data$bmi    -0.07093   0.93153  0.03610 -1.965  0.04945 * 
Data$age     0.03713   1.03783  0.01273  2.917  0.00354 **
---
Signif. codes:  0***0.001**0.01*0.05 ‘.’ 0.1 ‘ ’ 1

            exp(coef) exp(-coef) lower .95 upper .95
Data$gender    1.1559     0.8652    0.6342    2.1065
Data$bmi       0.9315     1.0735    0.8679    0.9998
Data$age       1.0378     0.9636    1.0123    1.0640

Concordance= 0.683  (se = 0.037 )
Rsquare= 0.194   (max possible= 0.984 )
Likelihood ratio test= 21.55  on 3 df,   p=8e-05
Wald test            = 19.47  on 3 df,   p=2e-04
Score (logrank) test = 20.83  on 3 df,   p=1e-04

bmiや年齢が影響を及ぼしていることが確認出来ました。

検定によるチェック

で、cox比例ハザードモデル、かなり仮定が強い印象があります。
この仮定が妥当かどうかを検定でチェックしておく必要があります。
survivalではcox.zphによって行えます。
この検定については私は何をやっているのか知らないのですが(リサーチ不足)
とりあえず先人の知恵を盲信して試しておきます。

> cox.zph(coxph(Surv(Data$times,Data$status)~Data$gender+Data$bmi+Data$age))
                rho  chisq     p
Data$gender -0.0325 0.0671 0.796
Data$bmi     0.1420 1.5793 0.209
Data$age     0.0536 0.1986 0.656
GLOBAL           NA 1.6627 0.645

 p>0.1のため、有意差はありません。
つまりcox比例ハザードを棄却出来るほどの情報はないと判断出来ます。

生存解析を学ぶ上で役に立つ参考書

・クライン&メシュベルガー 生存時間解析 (和訳)

・Applied survival analysis using R


・counting processes and survival analysis

消費者の情報探索行動の目的を反映した購買モデルをStanで実装する

今回も中々高度な話をやっていきます。

消費者は何か物を買うときに「情報探索行動」を行います。
しかし、情報探索行動は特に物を買う気の無い消費者も行います。
例えば、特に買いたいものはないけど、流行をチェックするために服屋をぶらつくだとか、本屋の好きなジャンルのコーナーを見るのを日課にしているといったことがそれです。消費者がどちらの状態で情報探索を行っているのかによって、店側はその消費者に取るべきアプローチが変わってくるはずです。

目次

スポンサーリンク



参考文献

今回参考にした論文は次の通り
・Bloch et al .1986 Consumer search: An extended framework
・Newman and Stelin .1972 Prepurchase information seeking for new cars and major household appliances
・Doni 2017 情報探索の目的を考慮した購買決定モデル

主にDoni 2017の内容の要約とStanでの実装になります。
試しで使用するデータセットは持ち合わせてないので、とりあえず型だけ合っている架空のデータ(乱数)を使用して実行できるかどうか試しています。


ちなみにStanについてよく知らないという方は、この本がおすすめです。

情報探索行動

まず、情報探索行動について整理しておきます。情報探索行動は主に「自身の記憶」に対してアプローチする内的情報探索と、「外部」に対してアプローチする外的情報探索に分けられます。今回まとめるDoni 2017では外的情報探索のことを情報探索と呼び、モデル化を行っています。

購買前探索

ニーズを自覚している消費者(何かしら購買目的のある消費者)が行う外的情報探索を特に「購買前探索」と呼びます。

購買前探索は、購買に伴う不確定要素を削減し、集めた情報をもとに購買選択肢の評価や決定を行うために行います。

例えば、〇〇日に東京観光へ行くから、ホテルを予約したい。
予算の範囲内で極力快適なホテルに泊まりたい。
だから色々な情報サイトや口コミサイト、公式の情報を集め、不確定要素を削減し、どのホテルを予約するか決めようといったものがそれです。

進行的探索

ニーズを自覚していない消費者が行う外的情報探索を特に「進行的探索」と呼びます。

これは、製品知識の獲得や、その他欲求の解消が目的で、衝動買いなどが発生したり、今後の購買のための情報集めであることもありますが、基本的には購買目的で行っている行動ではありません。

モデル

情報探索の目的(購買前探索 or 進行的探索)が不明であるというのを隠れマルコフモデルに落とし込むことで定式化を行います。また、ある時点の消費者の購買魅力度(効用)の確定項はそれ以前の具体的な情報探索行動をもって定式化し、購買魅力度のパラメータに対して階層構造を与え、この魅力度のパラメータは消費者の属性が影響していると考えます。
以下詳しく説明していきます。

データ

~与えられている情報~
消費者 i=1,2,\cdots,I
消費者が店(又はECサイト)に訪れた機会 t=1,2,\cdots,T_i

消費者iが各機会tにおいて購買をしたか否か
 I_{it} =1⇒商品を購入
 I_{it} = 0⇒商品未購入

各消費者iの属性行列 Z_i
ex) 性別などなど

各消費者iの各機会tにおける情報探索行動に関する行列 X_{it}
ex)アクセスログなどなど


~与えられていない未知の情報~
消費者iが機会t時点でどのような目的 c_{it}で情報探索行動を行っていたか

消費者の購買行動のモデル

まず、消費者iは購買魅力度 U_{it}^{c_{it}}を持つと仮定します。
ここで、消費者が商品の購買を決める( I_{it} =1)とは次のような状況であると考えます。

消費者iと機会tに依存するある閾値 \tau_{it}が存在し、
 U_{it}^{c_{it}} >\tau_{it}^{c_{it}} ⇒I_{it} =1
 U_{it}^{c_{it}} ≦\tau_{it}^{c_{it}} ⇒I_{it} =0

更に、 X_{it}のうち、購買前探索に関係しそうな変数を X_{it}^{(1)}、進行的探索に関係しそうな変数を X_{it}^{(2)}と名付けます。この変数分類は、過去の購買前探索・進行的探索に関する学術論文を参考に決定します。

例えば次のような情報です。
・購買前探索を行っている消費者は同一商品の閲覧回数が増える
・進行敵探索を行っている消費者は多様な商品ページを見る
などなど。これらの情報はこれからのマーケティング関連の研究でどんどん増えていくであろう情報なので、必要な時に情報をアップデートしておく必要があります。


そして、購買魅力度を次のように規定します。
 U_{it}^{c_{it}} = \beta_i^{(c_{it})} X_{it}^{(c_{it})} + \epsilon_{it}^{(c_{it})}

更に購買閾値についてですがDoni 2017では
(Moe and Fader 2004,Johnson et al. 2003, Brucks 1985)
を参考に次のように特定化しています。

来店機会 tまでの累積購買回数 N_{it}を用いて、
 \tau_{it}^{c_{it}} = INIT_{it}^{c_{it}} +\beta_{0i}^{c_{it}} NPUR_{it} +E_{it}^{c_{it}}
ただし NPUR_{it} =1-exp(-N_{it})
 E_{it}は誤差項

情報探索行動目的のモデル化

マルコフ過程なので、遷移確率を考えます。
 Pr(c_{it}=s) =u_{it}(s)
 c_{it}が1次マルコフ過程に従うとすると、直前の状態にのみ依存するため、次のようになる。

 u_{it}(s) = \sum_{r=1}^2 Pr(c_{it}=s|c_{it-1}=r)u_{it-1}(r)

ここで遷移確率行列 \Gamma_{i}を次のように表す。

 \Gamma_{i} =\begin{pmatrix}
\lambda_i &&1-\lambda_i\\
1-\rho_i && \rho_i
\end{pmatrix}


初期状態の確率を \delta_i =(\delta_{i1},\delta_{i2})とおく。

選択確率

そして、 Pr(I_{it}=1|c_{it}=s) = \frac{exp(V_{it}^{s}-\tau_{it}^{s})}{1+exp(V_{it}^{s}-\tau_{it}^{s})}
ただし、 Vとは先ほどの購買魅力度の確定要素の部分とします。これはロジットですね。


こうして、長くなりましたが顧客iの購買有無のベクトルに関する尤度 l(\theta)を求めることが出来ました。
 l(\theta) =sum\{ \delta_i diag(Pr(I_{i1}|c_{i1}=1),Pr(I_{i1}|c_{i1}=2)) \Gamma_i \cdots \Gamma_i diag(Pr(I_{iT_i}|c_{iT_i}=1) Pr(I_{iT_i}|c_{iT_i}=2)) \}

階層構造

最後にパラメータ \betaに関して Z_iを使って階層構造を規定しておきます。

 \beta_i^{(s)} = MultiNormal(\Delta_s Z_i , \Sigma_s)


非常に雑なシミュレーションデータの作成

今回のメインはStanコードなので、形だけデータをそろえておきます。

I=20;MAXT=100
T=sample(1:MAXT,I,replace=TRUE)
Y=matrix(,I,MAXT)
for(i in 1:I){
	Y[i,1:T[which(1:I==i)]] <- sample(c(0,1),T[which(1:I==i)],replace=TRUE)
	Y[i,T[which(1:I==i)]:MAXT] <- 0
}
C=2
s1=5
X1=matrix(,I*MAXT,s1)

for(s in 1:s1){
index1=1
index2=MAXT
	for(i in 1:I){
		X1[index1:index2,s] <- rnorm(MAXT,mean=0.05*I,sd=sqrt(s))
		index1 = index1 + MAXT
		index2 = index2 + MAXT
	}
}

s2=4
X2=matrix(,I*MAXT,s2)

for(s in 1:s2){
index1=1
index2=MAXT
	for(i in 1:I){
		X2[index1:index2,s] <- rnorm(MAXT,mean=0.3*I,sd=sqrt(s))
		index1 = index1 + MAXT
		index2 = index2 + MAXT
	}
}

N=matrix(,I,MAXT)
for(i in 1:I){
	for(t in 1:MAXT){
		x=rpois(1,lambda=1)
		if(t>1){
			N[i,t] = N[i,t-1] + x
		}
		else{
			N[i,t] = x
		}
	}
}

zs=3
Z=matrix(,I,zs)
for(ss in 1:zs){
	for(i in 1:I){
		Z[i,ss]=rpois(1,lambda=sqrt(sqrt(i))*ss)
	}
}

data=list(I=I,MAXT=MAXT,T=T,Y=Y,C=C,s1=s1,X1=X1,s2=s2,X2=X2,N=N,zs=zs,Z=Z)

ちょっと工夫としては、Stanでunbalanced dataを扱うのは厄介なので、一旦 T_iを一番大きいところにそろえているところです。
Stanのモデルブロックで調整します。

Stanコード

では、今までの話をコードにしてみます。
事前分布は基本的にはDoni 2017を参考にしましたが、MCMCの初期値探索が難しかったため、かなり元の論文よりも制約をかけています。
一応回るようにはなってますが、この辺の制約は実データも交えて相談ということになると思います。

#unbalanced-dataの欠損部分に一時的に0を入れて、Stan内で0の部分は実行をかけないよう調整する
#調整をかけるのは購買の有無と説明変数行列
model ="
functions{
	//ある人iの購買の有無(T=1,...T[i])、T[i]、二種類の状況のVtベクトル配列、推移確率パラメータ、初期値を入れると、対数尤度を表す関数
	real lmm_log(vector Y,int T, vector Vt1,vector Vt2, real lambda, real rho, row_vector init){
		matrix[2,2] tr_mat;
		row_vector[2] prr;
		real pr;
		vector[2] vec1;
		vector[2] vec2;
		matrix[2,2] pr_mat;
		tr_mat[1,1] = lambda;
		tr_mat[1,2] = 1-lambda;
		tr_mat[2,1] = 1-rho;
		tr_mat[2,2] = rho;
		prr = init;
		for(t in 1:(T-1)){
			vec1[1] = 1-inv_logit(-Vt1[t]);
			vec1[2] = 1-inv_logit(-Vt2[t]);
			vec2[1] = inv_logit(-Vt1[t]);
			vec2[2] = inv_logit(-Vt2[t]);
			pr_mat = Y[t]*diag_matrix(vec1)+(1-Y[t])*diag_matrix(vec2);
			prr = prr*pr_mat*tr_mat;
		}
		vec1[1] = 1-inv_logit(-Vt1[T]);
		vec1[2] = 1-inv_logit(-Vt2[T]);
		vec2[1] = inv_logit(-Vt1[T]);
		vec2[2] = inv_logit(-Vt2[T]);
		pr_mat = Y[T]*diag_matrix(vec1)+(1-Y[T])*diag_matrix(vec2);
		pr = prr*pr_mat*rep_vector(1.0,2);
		return(log(pr));
	}

//  matrix seiho_Kronecker_product(matrix A,matrix B){
//  int Ad1;
//  int Bd1;
//  matrix[Ad1*Bd1,Ad1*Bd1] res_mat; 
 //   Ad1=num_elements(A[1]);
 //   Bd1=num_elements(B[1]);
 //   for(i in 1:Ad1){
 //     for(ii in 1:Ad1){
 //       res_mat[((i-1)*Bd1+1):i*Bd1,((ii-1)*Bd1+1):ii*Bd1]=A[i,ii]*B;
  //    }
  //  }
 //   return(res_mat);
//  }

//  vector vec_operator(matrix A){
//    int length;
//    int Ad1;
//    int Ad2;
//    vector[length] res_vec;
//    Ad1=num_elements(A'[1]);
//    Ad2=num_elements(A[1]);
//    length = num_elements(A);
//    for(i in 1:Ad2){
//      res_vec[((i-1)*Ad1+1):(i*Ad1)]=A'[i]';
//    }
//    return(res_vec);
//  }

}

data{
	//顧客数I,TのMAX値,実際のT,購買有無Y
	int I;
	int MAXT;
	int T[I];
	matrix[I,MAXT] Y;

	//状態数C=2
	int C;
	//状態1の説明変数s1種類
	int s1;
	matrix[I*MAXT,s1] X1;
	
	//状態2の説明変数s2種類
	int s2;
	matrix[I*MAXT,s2] X2;

	//閾値の為の変数
	int N[I,MAXT];

	//ベータに階層性を持たせるための顧客情報Z,zsは顧客情報の種類,
	int zs;
	matrix[I,zs] Z;
}

transformed data{
	real NPUR[I,MAXT];
	//NPUR = 1-exp(-N)
	for(i in 1:I){
		for(t in 1:MAXT){
			NPUR[i,t] = 1-exp(-N[i,t]);
		}
	}
}

parameters{
	matrix[I,s1] beta1;
	matrix[I,s2] beta2;
	matrix[I,C] beta0;
	//遷移確率
	real<lower=0,upper=1> lambda[I];
	real<lower=0,upper=1> rho[I];
	//初期値
	vector<lower=0,upper=1>[I] delta1;
	real INIT[I,C];
	//ベータとINITの階層パラメータ
	matrix[zs,s1+2] b1;
	matrix[zs,s2+2] b2;
	vector[s1+2] b01;
	vector[s2+2] b02;
	cov_matrix[s1+2] Sigma1;
	cov_matrix[s2+2] Sigma2;
	
}

transformed parameters{
	//効用と閾値
	matrix[I,MAXT] tau[C];
	matrix[I,MAXT] U[C];
	matrix[I,MAXT] Vt[C];
	matrix[I,2] D;
	//ベータの階層パラメータ
	matrix[I,s1+2] B1;
	matrix[I,s2+2] B2;
  //ベータの階層パラメータの連結
  matrix[zs+1,s1+2] bv1;
  matrix[zs+1,s2+2] bv2;
	//パラメータのまとめ
	vector[s1+2] theta1[I];
	vector[s2+2] theta2[I];

  ////ベータの階層パラメータの連結を行う
  bv1[1]=b01';
  bv2[1]=b02';
  for(ss in 2:(zs+1)){
    bv1[ss]=b1[ss-1];
    bv2[ss]=b2[ss-1];
  }  

  //U,tau,Vt,Dを作る
	for(i in 1:I){
		for(t in 1:MAXT){
			U[1][i,t] = dot_product(beta1[i],X1[(i-1)*MAXT + t]); 
			U[2][i,t] = dot_product(beta2[i],X2[(i-1)*MAXT + t]); 
			for(c in 1:C){
				tau[c][i,t] = INIT[i,c] - beta0[i,c]*NPUR[i,t];
				Vt[c][i,t] = U[c][i,t]-tau[c][i,t];
			}
		}
   	D[i,1] = delta1[i];
	  D[i,2] = 1-delta1[i];   
	}

  //Bを作る
	for(i in 1:I){
		for(ss in 1:(s1+2)){
			B1[i,ss] = b01[ss] + dot_product(b1[1:zs,ss],Z[i]);
		}
		for(SS in 1:(s2+2)){
			B2[i,SS] = b02[SS] + dot_product(b2[1:zs,SS],Z[i]);
		}
	}

  //thetaを作る
	for(i in 1:I){
		theta1[i][1] = INIT[i,1];
		theta1[i][2] = beta0[i,1];
		theta2[i][1] = INIT[i,2];
		theta2[i][2] = beta0[i,2];
    for(ss in 1:s1){
		  theta1[i][ss+2] = beta1[i,ss];
    }
    for(ss in 1:s2){
  		theta2[i][ss+2] = beta2[i,ss];
    }
	}

}	

model{
  //vec_operator(bv1) ~ multi_normal(rep_vector(0,(zs+1)*(s1+2)),seiho_Kronecker_product(Sigma1,diag_matrix(rep_vector(100,zs+1));
  //vec_operator(bv2) ~ multi_normal(rep_vector(0,(zs+1)*(s2+2)),seiho_Kronecker_product(Sigma2,diag_matrix(rep_vector(100,zs+1));
	for(i in 1:(zs+1)){
    for(ii in 1:(s1+2)){
      bv1[i,ii] ~ student_t(4,0,3);
    }
    for(ii in 1:(s2+2)){
      bv2[i,ii] ~ student_t(4,0,3);
    }
	}
  inverse(Sigma1) ~ wishart(10,diag_matrix(rep_vector(1,s1+2)));
	inverse(Sigma2) ~ wishart(10,diag_matrix(rep_vector(1,s2+2)));
	for(i in 1:I){
		D[i,1] ~ beta(0.001,0.001);
		lambda[i] ~ beta(0.001,0.001);
		rho[i] ~ beta(0.001,0.001);
		theta1[i] ~ multi_normal(B1[i],Sigma1);
		theta2[i] ~ multi_normal(B2[i],Sigma2);
	}
  for(i in 1:I){
    Y[i,1:T[i]]' ~ lmm(T[i],Vt[1][i]',Vt[2][i]',lambda[i],rho[i],D[i]);
  }
}"
library(rstan)
fit=stan(model_code=model,data=data,seed=1234,par=c("beta0","beta1","beta2"))

出力結果に関しては、そもそもデータがあれなので置いておくとして、こんな感じですね。
恐らく間違ってはいないはず。
ログデータを取れるweb屋さんとかだと使いようによっては便利かもしれないですね。

多項プロビットモデルの最尤推定をRで行う方法と数理、気を付けるべき点

今回は多項プロビットモデルです。少々高度な内容になります。

目次

スポンサーリンク



多項プロビットモデル

具体例

皆さんは離散選択モデルというモデルをご存知でしょうか。

主に人間の意思決定をモデル化する際に利用されるモデルです。
例えば、コンビニに行って、何を購入するか決めるとします。
あくまで例ですが仮に「何か甘いものが食べたい」という漠然とした目的をもってコンビニに入った人だと考えましょう。

ここでこの人は普通「甘いものが売られている売り場」へ向かうはずです。
そして、パッケージ、値段、ラインナップ等々を吟味したうえでたくさんある選択肢の中から一つの商品を選び、レジへと持っていったとします。

この選択の過程を今回は多項プロビットモデルというモデルを使って解析します。

数式

さっきの話を簡単にまとめると要は

パッケージ、値段等の情報を適当な重みを付けて比較し、「最もその人にとって良いと思える商品を1つ手に取った」という状況ですね。

つまり、その人にとっての何らかの選択基準が存在し、その選択基準に基づいて最も良いと思える商品を手に取ったと考えられます。

この時の個人 iの商品 jに対する選択基準 Y_{i,j}^{*}を以後効用と呼ぶことにします。
この効用とは経済学の概念で、例えばAさんが商品1を買うか商品2を買うか迷っているとした場合、Aさんはその商品に関する情報を使って効用 Y_{A,1}^{*},Y_{A,2}^{*}を頭の中で作り上げます。

そしてもし、 Y_{A,1}^{*}>Y_{A,2}^{*}なら商品1を購入し、 Y_{A,1}^{*}>Y_{A,2}^{*}ならば商品2を購入するといった状況を考えるわけです。


ここで、「いやいや、僕はそんなよく分からない効用なんてものを考えて行動していないし、そんなモデル意味が無いよ」という批判は一旦置いておきます。*1


この効用 Y_{i,j}^{*}は、誤差項 \epsilon_{i,j}とその人が持ちうる情報 I_{i,j}によって次のような線形関係があると考えます。

 Y_{i,j}^{*} = V_{i,j} + \epsilon_{i,j}
ただし、 \epsilon_{i,j}は期待値 0、分散共分散行列 \Sigmaの多変量正規分布に従うと仮定します。

更に、 V_{i,j} = \beta_{0}^{(i)} + \beta_{1}^{(i)} X_{(i,j),1} +\beta_{2}^{(i)} X_{(i,j),2} +,\cdots ,+\beta_{k}^{(i)} X_{(i,j),k}= X^{(i,j)}\beta^{(i)}
と仮定します。ここで Xとは値段や商品配置、パッケージ等の購買に関する判断基準を指します。
 \beta^{(i)}は個人 iが暗黙的もしくは無意識的に設けているパラメータベクトルで、 X^{(i,j)}は行列です。

当然添え字のつけ方で、各人共通のパラメータを設けたりすることも可能になります。
よって、 V_{i,j}を条件付けた際の Y_{i}^{*} の分布 P(Y_{i}^{*} | V_{i,j},j=1,2,\cdots , k)は次のようになることが分かりますね。


 P(Y_{i}^{*} | V_{i,j},j=1,2,\cdots , k) = \frac{1}{(2 \pi)^\frac{k}{2}\sqrt{ |\Sigma| }}exp(-\frac{1}{2}(Y_{i}^{*}-V_{i})' \Sigma^{-1} (Y_{i}^{*}-V_{i}))

ただし、 Y_{i}^{*},V_{i}はそれぞれ効用と判断基準を並べた j次列ベクトルとします。

与えられているデータ

ここで問題になってくるのは

効用 Y_{i}^{*}の値なんて観測できなくない??ってことです。
 iさんにとってのチ〇ルチョコの効用は10,チョコパイの効用は20だから、 iさんはチョコパイを購入したんだな~なんてことはわからなくて、実データでは、その辺の話を全部すっ飛ばして

 i さんは「チョコパイを購入した」という情報だけ得られます。

もし、効用まで観測できれば P(Y_{i}^{*} | V_{i,j},j=1,2,\cdots , k) に対して最尤法を適用しておしまいですが、観測出来ていないので簡単にはいきません。そこで、少し工夫する形で別の尤度を考えます。


今回の iさんは商品 Jを購入したとしましょう。

購買情報を踏まえた尤度

 iさんが商品 Jを購入したということは、次の状況が生じているはずです。


 Y_{i,J}^{*} ≧ Y_{i,j}^{*} for  j = 1,2,...k
こう書き換えても問題ありません。
 Y_{i,J}^{*} = max\{Y_{i,j}^{*} |j=1,2,...k \}


更に、 iさんの購買情報 \omega_{i}を次のように考えます。
 \omega_{i} = (\omega_{i,1},\cdots,\omega_{i,k})
ここで、 \omega_{i,J} = 1 \omega_{i,t} = 0
ただし、 t≠J

つまり、購入した商品には 1、購入しなかった商品には 0を与えたダミー変数ベクトルを用意するわけです。


そうすると、購買情報 \omega_{i}における分布 Prob(\omega_{i} | V_{i,j},j=1,2,\cdots , k)は次のようになるはずですね。

 Prob(\omega_{i} | V_{i,j},j=1,2,\cdots , k)
 = \int_{\{Y_{i,1}^{*}<Y_{i,J}^{*}\}},\cdots \int_{\{Y_{i,J}^{*}=-\infty\}}^{\{Y_{i,J}^{*}=+\infty\}},\int_{\{Y_{i,J+1}^{*}<Y_{i,J}^{*}\}}\cdots, \int_{\{Y_{i,k}^{*}<Y_{i,J}^{*}\}} P(Y_{i}^{*} | V_{i,j},j=1,2,\cdots , k) dY_{i,1}^{*},\cdots,dY_{i,k}^{*}

何かえらいこっちゃなってますが、要は多変量正規分布の密度を切断している分布になります。

まあ、当然ですがこの Prob(\omega_{i} | V_{i,j},j=1,2,\cdots , k)はオープンフォームになっているため、普通の方法で最尤推定量を求めることは出来ません。

そのため、プロビットモデルは長く日の目を拝むことなく、より計算が簡単なロジットモデルが発展しました。

しかし、今日ではコンピュータの計算速度の向上により、このプロビットモデルの最尤推定値を探索的に求めることが可能になっています。

GHKアルゴリズム

最尤推定値を探索的に求める方法は様々ありますが、例えばフィッシャーのスコア法では対数尤度の二回微分に関する期待値を利用します。
しかし、肝心の尤度がゴツすぎるため、微分したものの期待値なんてもってのほか。求めることが出来ません。
そこで、一旦乱数を取り出してやり、期待値の近似値を求めます。その近似値を利用して、探索解を求めるという手順を取ります。

その際、乱数の発生させ方に一工夫必要で、その取り出し方をGHKアルゴリズムと呼びます。

もう積分記号なんか見たくないとは思いますが、再度先ほどの尤度を書いてみます。

 Prob(\omega_{i} | V_{i,j},j=1,2,\cdots , k)
 = \int_{\{Y_{i,1}^{*}<Y_{i,J}^{*}\}},\cdots \int_{\{Y_{i,J}^{*}=-\infty\}}^{\{Y_{i,J}^{*}=+\infty\}},\int_{\{Y_{i,J+1}^{*}<Y_{i,J}^{*}\}}\cdots, \int_{\{Y_{i,k}^{*}<Y_{i,J}^{*}\}} P(Y_{i}^{*} | V_{i,j},j=1,2,\cdots , k) dY_{i,1}^{*},\cdots,dY_{i,k}^{*}


ここで、
 Y_{i,J}^{*} ≧ Y_{i,j}^{*} for  j = 1,2,...k
 Y_{i,j}^{*} = V_{i,j} + \epsilon_{i,j}

のため、
 V_{i,J} + \epsilon_{i,J} ≧ V_{i,j} + \epsilon_{i,j}
更に、
 V_{i,J} -V_{i,j} ≧   \epsilon_{i,j} -  \epsilon_{i,J}

ここで、 \epsilon_{i,j} -  \epsilon_{i,J} =E_{i,j^*} for  j^* = 1,2,...k-1
 E[E_{i,j^*}] =0, V[E_{i,j^*}] =\Sigma^*であるとします。

多変量正規分布には加法性があるので、 E_{i,j^*}の組も多変量正規分布に従います。
つまり E_{i}は多変量正規分布に従います。
さてここで、分散共分散行列 \Sigma^*に対してコレスキー分解を施し、
 \Sigma^{*} = \Gamma \Gamma^{'}と置くと、

 E_{i} =\Gamma \xi
ただし、 \xiは各要素がi.i.dに標準正規分布に従う確率変数ベクトル。

 \Gammaは上三角行列なので次のように書くことが出来ますね。

 E_{i,1} =\Gamma_{1,1} \xi_1
 E_{i,2} =\Gamma_{1,2} \xi_1+ \Gamma_{2,2} \xi_2
 E_{i,2} =\Gamma_{1,3} \xi_1+ \Gamma_{2,3} \xi_2+ \Gamma_{3,3} \xi_3
 \vdots

つまり、長くなりましたが何が言いたいかというと、多変量正規分布に従う確率変数は、期待値ベクトル(今回は0)と分散共分散行列さえわかっていれば、普通の標準正規分布から得られるわけです。


こうして、対象の多変量正規分布からサンプリングを行い、更に必要な期待値計算をモンテカルロ近似によって計算し、それを用いて適当な最適化アルゴリズムを使うというのがGHKアルゴリズムの概要です。

このアルゴリズム、上の説明を見ても分かる通り
ある一つの選択肢を基準に他の

Rによる多項プロビット回帰

「GHKアルゴリズム、、なんて大変なんだ」と思った方もご安心。Rではmlogitパッケージを使って簡単に推定することが出来ます。

使用するデータ
data("TravelMode", package = "AER")
> head(TravelMode)
  individual  mode choice wait vcost travel gcost income size
1          1   air     no   69    59    100    70     35    1
2          1 train     no   34    31    372    71     35    1
3          1   bus     no   35    25    417    70     35    1
4          1   car    yes    0    10    180    30     35    1
5          2   air     no   64    58     68    68     30    2
6          2 train     no   44    31    354    84     30    2

AERパッケージのTravelModeデータです。
mlogitパッケージのExampleで使っていたので、そのまま使うことにします。
https://cran.r-project.org/web/packages/mlogit/mlogit.pdf

ちなみに各変数は
individual : 個人iの識別番号(i=1,...200)
mode : 乗り物の種類(選択肢)
choice : その乗り物を選んだか否か
wait : 乗り場における待ち時間(当然自家用車なら0)
vcost : 乗り物を使うのにかかるコスト
travel : かかる時間
income : 個人の収入
http://127.0.0.1:23970/library/AER/html/TravelMode.html

今回のデータはchoice毎に行があり、individualが重複する形の縦に長いデータとなっています。
このようなデータフレームをlong型と呼びます。ちなみに1行で個人データをひとまとめにしているデータをwide型と呼び、例えば次のようなものがあります。

> head(Fishing)
     mode price.beach price.pier price.boat price.charter catch.beach catch.pier catch.boat catch.charter   income
1 charter     157.930    157.930    157.930       182.930      0.0678     0.0503     0.2601        0.5391 7083.332
2 charter      15.114     15.114     10.534        34.534      0.1049     0.0451     0.1574        0.4671 1250.000
3    boat     161.874    161.874     24.334        59.334      0.5333     0.4522     0.2413        1.0266 3750.000
4    pier      15.134     15.134     55.930        84.930      0.0678     0.0789     0.1643        0.5391 2083.333
5    boat     106.930    106.930     41.514        71.014      0.0678     0.0503     0.1082        0.3240 4583.332
6 charter     192.474    192.474     28.934        63.934      0.5333     0.4522     0.1665        0.3975 4583.332
mlogit.data関数

mlogitを使用する前に、解析で使うデータフレームをmlogitに適用しやすい形に変換しておくことが無難です。
その際の変換に用いるのがmlogit.data関数です。

ただし、別にmlogitを使用する際に関数内で適切な指定をしてやれば変換していないデータフレームに実行をかけることも出来ます。

TM <- mlogit.data(TravelMode, choice = "choice", shape = "long",
alt.levels = c("air", "train", "bus", "car"),id.var="individual",)

choiceにはlong型の場合は選択肢を選んだか否か(yes or no ; 1 or 0)に関する変数を指定します。wide型の場合は選んだ選択肢の入った変数を指定します。
shapeは"long" か "wide" か使用するデータの型を選択します。
alt.levelsで選択肢を改めて指定しておく必要があります。long型の場合は必須ですが、wide型の場合は必要ありません。
id.varでlong型の場合に個人識別をしておく必要があります。

mlogit関数

mlogit関数で実行します。デフォルトはただのlogitなのでprobitで行う場合はprobit=TRUEとします。

pr <- mlogit(choice ~ wait + vcost | income |travel , TM,
probit = TRUE)

formulaを|で区切っていますが、これはそれぞれ次のような意味になっています。
個人iの選択jに関する効用 U_{i,j}について
 U_{i,j} = \alpha_{(0,j)} + \beta_w Wait_{(i,j)} +\beta_v Vcost_{(i,j)} + \gamma_{j} Income_{i} + \omega_{j} Travel_{(i,j)}

添え字に注目してください!

実行&結果
> summary(pr)

Call:
mlogit(formula = choice ~ wait + vcost | income | travel, data = TM, 
    probit = TRUE)

Frequencies of alternatives:
    air   train     bus     car 
0.27619 0.30000 0.14286 0.28095 

bfgs method
22 iterations, 0h:0m:11s 
g'(-H)^-1g = 6.11E-07 
gradient close to zero 

Coefficients :
                     Estimate  Std. Error z-value  Pr(>|z|)    
train:(intercept)  0.11400922  0.50036804  0.2279 0.8197623    
bus:(intercept)   -0.25750600  0.46140096 -0.5581 0.5767789    
car:(intercept)   -1.70532857  0.67252768 -2.5357 0.0112223 *  
wait              -0.02591688  0.00596662 -4.3436 1.401e-05 ***
vcost             -0.00571812  0.00332269 -1.7209 0.0852629 .  
train:income      -0.02256556  0.00677919 -3.3287 0.0008727 ***
bus:income        -0.01125839  0.00862617 -1.3051 0.1918437    
car:income        -0.00637486  0.00788242 -0.8087 0.4186627    
air:travel        -0.01473926  0.00360134 -4.0927 4.264e-05 ***
train:travel      -0.00291735  0.00079889 -3.6517 0.0002605 ***
bus:travel        -0.00313288  0.00089814 -3.4882 0.0004863 ***
car:travel        -0.00296051  0.00089036 -3.3251 0.0008840 ***
train.bus          0.94852133  0.38768124  2.4467 0.0144190 *  
train.car          1.06025359  0.37869969  2.7997 0.0051147 ** 
bus.bus            0.38464898  0.16055087  2.3958 0.0165838 *  
bus.car            0.27405472  0.37816033  0.7247 0.4686330    
car.car            0.57842389  0.24356722  2.3748 0.0175584 *  
---
Signif. codes:  0***0.001**0.01*0.05 ‘.’ 0.1 ‘ ’ 1

Log-Likelihood: -172.56
McFadden R^2:  0.39187 
Likelihood ratio test : chisq = 222.39 (p.value = < 2.22e-16)

地味に"gradient close to zero" が重要です。これが"last step couldn't find higher value"となっている場合は問題有です。
coefficientsの最後の方に並んでいる(選択肢).(選択肢)はそれぞれの分散共分散です。一個分散が欠けているのはスケールを揃えるのに用いているためだと思われます。
McFadden R^2は一応経験的な適合度指標として使われています。あまり紋切型で考えるのもイマイチですが、0.5くらいが目安なので今回は少し小さめ。

各個人の選択確率予測値はprobabilitiesに入っています。

> head(pr$probabilities)
           air       train         bus       car
[1,] 0.1463981 0.230907011 0.069925608 0.6030067
[2,] 0.3550429 0.194959842 0.012583377 0.4531929
[3,] 0.4270799 0.025918716 0.052778939 0.4559133
[4,] 0.4102070 0.007009033 0.004554783 0.5633459
[5,] 0.2017710 0.479339802 0.114605173 0.1839117
[6,] 0.1113763 0.478200196 0.122358769 0.3097929

多項ロジットとの違いは?(IIA特性)

何故よくわからんGHKアルゴリズムを使ってまで(計算に時間をかけてまで)probitを使うのだ。多項ロジットで良いではないかと思う人もいると思うので違いを説明しておくと

多項ロジットの場合は、誤差項の共分散が無いので、各選択肢の代替関係が同等であるという仮定が入っています。
例えば車か飛行機かを選ぶにあたって、その選択肢の中に追加でバスが入ってきたとします。この場合、例えば陸路で安価に行けた方が嬉しいなら車の選択肢を選んでいた人がバスを選ぶようになる確率よりも飛行機の選択肢からバスに移る確率の方が多いように感じますし、旅行先が渋滞まみれのような場所では車で目的地に向かうのは不便なので、飛行機よりも車を選んでいた人の方がバスに流れていくはずです。このような変化に多項ロジットは対応出来ません。

これをIIA特性(無関係な選択肢からの独立)と呼びます。

これを解決するためにはネストロジットという手法もありますが、多項プロビットでも解決することが出来ます。

IIA仮定が妥当か否かの検定(ハウスマン・マクファーデン検定)

IIA仮定が妥当であれば多項ロジットを使う方が計算の点からも良く、またロジットは選択肢が実際には観測されていない場合でも機能するため、多項ロジットだって無下には出来ません。

そこで仮説検定を行います。
Hausman and McFadden (1984)
EconPapers: Specification Tests for the Multinomial Logit Model
で提案されたハウスマン・マクファーデン検定では

帰無仮説: IIA特性を持つ
対立仮説 : IIA特性は持たない

という検定を行います。検定においてはフルモデルでの推定結果と、選択肢を一個取り除いた場合の推定結果を比較します。
もしIIA特性があれば、直接関係のない選択肢が消えてもオッズ比は(誤差の範囲で)自然な値になるはずです。

mlogitパッケージではこの検定をhmftest関数として与えています。

> x <- mlogit(choice ~ wait + vcost | income |travel , TM,reflevel="car")
> g <- mlogit(choice ~ wait + vcost | income |travel , TM,reflevel="car",alt.subset=c("car","bus","train"))
> hmftest(x,g)

        Hausman-McFadden test

data:  TM
chisq = 27.572, df = 9, p-value = 0.001124
alternative hypothesis: IIA is rejected

> g2 <- mlogit(choice ~ wait + vcost | income |travel , TM,reflevel="car",alt.subset=c("car","bus","air"))
> g3 <- mlogit(choice ~ wait + vcost | income |travel , TM,reflevel="car",alt.subset=c("car","air","train"))
> hmftest(x,g2)

        Hausman-McFadden test

data:  TM
chisq = 178.24, df = 9, p-value < 2.2e-16
alternative hypothesis: IIA is rejected

> hmftest(x,g3)

        Hausman-McFadden test

data:  TM
chisq = 41.746, df = 9, p-value = 3.656e-06
alternative hypothesis: IIA is rejected

選択肢を除いたmlogitとフルモデルのmlogitで比較を行っています。
今回はどの場合でも棄却(p-value <0.05) されたため、IIA特性は妥当とは言えないということです。
よって、今回は多項プロビットモデルを利用しています(当然他のIIA仮定を緩めたロジットを利用しても良い)

離散選択におけるその他の選択肢

ここは、これから解説記事を書く中で少しずつリンクを貼ってこうと思います。
とりあえずはざっと羅列。

①多項プロビット
今回説明したもの

②多項ロジット回帰
IIA特性があるが、解釈のしやすい離散選択モデル
クローズドフォームなので計算が楽


②ネステッドロジット
IIAを緩和すべく、選択肢をネストしたロジット
選択の順序関係は考慮していないことに注意

③ネステッドロジットのIIAを更に緩めたモデル
paired combinatorial logit モデル
ordered generalized extreme value モデル
cross-nested logit モデル

④generalized nested logit
上のネストロジットを一般化したモデル
IIAはかなり緩和されるが、
パラメータの置き方や解釈の仕方が難解で計算量も多い

⑤C-logit モデルとpath size logit モデル
確定項の方で相関を表現したモデル

②~⑤までを総称してGEVモデルと呼ぶ。
GEVと多項プロビットの大きな違いは、確率項の大きさが異なっていても多項プロビットは利用できることで、GEVでは確率項の大きさが同一であることを仮定している。

⑥離散連続選択モデル
離散選択を行った後に連続値の選択を行う場合には離散連続選択モデルが利用される。これについてはmultiple discrete-continuous extreme value モデルとそれを一般化した generalized multiple discrete-continuous extreme value モデルがある。

このまとめについては下pdf参照
http://www.trans.civil.nagoya-u.ac.jp/~yamamoto/papers/TE2012.pdf


また、このpdfにはありませんが
⑦多変量プロビットモデル

というものもあります。
これについてもいつか記事にします。

*1:この記事を全部読めば、その手の批判は的外れであるということが分かるかと思います。ただ、この時点でそういう批判が出てしまう気持ちはよくわかります。

Rで多変量正規分布の最尤推定量を求める

今回は多変量正規分布についてやっていこうと思います。

目次

スポンサーリンク



多変量正規分布とは

n次元確率変数ベクトル Yを考えます。この時、次のような密度 f(Y;\mu,\Sigma)を持つ時、 Yは多変量正規分布に従うと言います。

 f(Y;\mu , \Sigma) = \frac{1}{(2 \pi)^\frac{n}{2}\sqrt{ |\Sigma| }}exp(-\frac{1}{2}(Y-\mu)' \Sigma^{-1} (Y-\mu))

ただし、
 \muはn次元期待値ベクトル
 \Sigma n×n分散共分散行列
 'は転置記号
 \Sigma^{-1}は分散共分散行列の逆行列
 |\Sigma|は分散共分散行列の行列式

を表すものとします。

求めたいパラメータ

ここで、最尤法で考えたいパラメータですが、次の通りになります。
期待値 \mu=(\mu_1,\mu_2,\cdots,\mu_n) n通り
分散 \sigma=(\sigma_{11},\sigma_{22},\cdots,\sigma_{nn}) n通り
共分散 cov=(\sigma_{12},\cdots,\sigma_{1n},\sigma_{23},\cdots,\sigma_{2n},\cdots,\sigma_{(n-1)n}) \begin{eqnarray*}
  && {}_n C _2 \\
\end{eqnarray*}通り

流石多変量分布!パラメータが多い!
少し工夫しながら推定を行うコードを組んでいこうと思います。

使用する関数

mvnorm関数

R既存の関数には多変量正規分布を扱う関数はありませんが、mvtnormパッケージには多変量正規分布からの乱数を発生させるrmvnorm関数や、密度を与えるdmvnorm関数がセットされています。
今回は推定に使用するデータを次のようにrmvnorm関数で発生させてみます。

library(mvtnorm)
Dim=4
mu=rep(0,Dim)
sigma=diag(Dim)
Y=rmvnorm(1000,mu,sigma)

今回は n=4(Dim)に設定し、全ての期待値を0、全ての分散を1、全ての共分散を0で試しています。
また、対数尤度を考えるにあたって、dmvnorm関数を使用しています。

optim関数

最適化はoptimで行うことにします。optimは、まずparに対してパラメータの初期値を与えて、fnに推定パラメータを引数とする関数(今回は対数尤度)を与え、control=list(fnscale=-1)と設定することで最大化問題を探索的に求めてくれます。

Rで実装

n変量正規分布からのデータ xを入れると対数尤度を返す関数norm_paraを作成します。

norm_para = function(x){
	D=dim(x)[2]
	num=dim(x)[1]
	return(function(para){
		mu=para[1:D]
		var=para[(D+1):(D+D)]
		covnum=choose(D,2)
		cov=para[(2*D+1):(2*D+covnum)]
		sig_mat=diag(var)
		cumnum=c(0,cumsum((D-1):1))
		for(i in 1:(D-1)){
			sig_mat[i,i+(1:(D-i))]=sig_mat[i+(1:(D-i)),i]=cov[(cumnum[i]+1):cumnum[i+1]]
		}
		LL=0
		for(n in 1:num){
			LL=LL+log(dmvnorm(x[n,],mean=mu,sigma=sig_mat))
		}
		
		return(LL)}
	)
}

*1更に、適当な初期値を与えてoptimを実行してやります。データは先ほどmvnorm関数の節で作ったデータを利用します。

A=optim(par=c(rep(0.5,4),rep(1,4),rep(0,choose(4,2))),fn=norm_para(Y),control=list(fnscale=-1))
optim(par=A$par, fn=norm_para(Y), method="BFGS",control=list(fnscale=-1)) 


出力結果

$par
 [1] -0.016002375  0.049480996  0.048697919  0.022775051  0.962845786
 [6]  0.967682984  0.968557138  0.988855280  0.029744115  0.005733175
[11] -0.033611495  0.017052120  0.036690593 -0.001633487

$value
[1] -5616.856

$counts
function gradient 
     122       21 

$convergence
[1] 0

$message
NULL

 parのところに推定値が並んでいます。始めの n(=4)個が期待値、次の n(=4)個が分散、その次からは共分散の推定値が cov=(\sigma_{12},\cdots,\sigma_{1n},\sigma_{23},\cdots,\sigma_{2n},\cdots,\sigma_{(n-1)n})といった形で並んでいます。

よって、今回の各パラメータの推定値は
 \hat{\mu} =(-0.016002375 , 0.049480996 , 0.048697919 , 0.022775051)
 \hat{\sigma} =(0.962845786 , 0.967682984 , 0.968557138 , 0.988855280)
 \hat{cov} = (0.029744115 , 0.005733175 , -0.033611495 , 0.017052120 , 0.036690593 , -0.001633487)

真の値は
 \mu = (0,0,0,0)
 \sigma = (1,1,1,1)
 cov = (0,0,0,0,0,0)
だったので、中々近い値が出ていますね。今回はサンプルサイズ1000で試しましたが、悪くない値だと思います。

*1:id:abrahamcow さんからのご指摘を頂き、修正しました。出力結果convergenceが0になっていないと収束したとは言えないようです。恐らく初期値問題だと思われますので、一度初期値をoptimで与えた後、再度BFGSで最適化処理を行うという方法に変更したところconvergence=0となりました。

R言語で勾配とヘシアンを出力する関数を作成する

Rには、微分して値を出力したり、ヘシアンを出力する既存関数としてderiv関数というものがあるみたいなのですが、
なんかネットで調べて試してみても、何か使い方がよくわかんなかったので、まどろっこしくなって作りました。

関数形と微分したい変数名、変数に代入したい値を入力すると勾配とヘシアンを出力する関数です。

目次


スポンサーリンク



勾配とヘシアンとは

とりあえず、勾配とヘシアンの説明を簡単にしておきます。

ある多変量関数 f(X)があるとします。ここで X n次元ベクトルとします。
この時、 Xに関する勾配とは次の Gを指します。

 G = \frac{\partial f(X)}{\partial X}= ( \frac{\partial f(X)}{\partial X_1},\cdots , \frac{\partial f(X)}{\partial X_n})'

ただし、 X_iとは X i番目の要素とします。


また、 Xに関するヘシアン Hとは次のような行列を指します。

 H = \begin{pmatrix}
\frac{\partial^2 f(X)}{\partial X_1^2} & \frac{\partial^2 f(X)}{\partial X_1 \partial X_2} & \cdots & \frac{\partial^2 f(X)}{\partial X_1 \partial X_n} \\
\frac{\partial^2 f(X)}{\partial X_2 \partial X_1} & \frac{\partial^2 f(X)}{\partial X_2^2} & & \vdots\\
\vdots & &\ddots & \vdots\\
\frac{\partial^2 f(X)}{\partial X_n \partial X_1} &\cdots& & \frac{\partial^2 f(X)}{\partial X_n^2} \\
\end{pmatrix}

要は1回微分したものを並べたベクトルと、それぞれの組み合わせで二回微分したものを並べた行列です。

これを作成した後適当な値を Xに代入することで、数値の入った行列やベクトルを得ます。
この勾配やヘシアンは特に最適化において力を発揮します。

今回使用するRの既存関数

expression関数

Rで、値を代入していない変数を扱う時はexpressionを利用することになります。
expression関数に入れた計算式は計算されることなく(これを評価されないと呼ぶ)、計算式のまま保持されます。
具体例を見てみます。

> expression(X^2)
expression(X^2)
> expression(X^2+1)
expression(X^2 + 1)
> expression(sqrt(X))
expression(sqrt(X))
> siki=expression(sqrt(X)+1)
> siki
expression(sqrt(X) + 1)
eval関数

expression関数に入った値を評価するにはeval関数を利用します。これも具体例を見た方が早いので見てみます。

> siki=expression(sqrt(X)+1)
> siki
expression(sqrt(X) + 1)
> eval(siki)
 eval(siki) でエラー:  オブジェクト 'X' がありません 
> X=4
> eval(siki)
[1] 3

グローバル環境にXの値が無い場合、式は評価不可能なのでエラーを吐きます。
Xの値が入っている場合は式が評価され、値が出力します。

assign関数

文字列(character型)を変数に変換し、そこに値を代入する関数です。これも具体例を見たらすぐわかるかと。

> xx
 エラー:  オブジェクト 'xx' がありません 
> assign("xx",5)
> xx
[1] 5

これも地味に便利です。

勾配とヘシアンの表現型を表示する関数の作成

ある関数が与えられた時に、勾配やヘシアンに関して値を代入する前の関数形を知りたいという需要もあるかもしれないので、まずそういったものを出力する関数を作成します。

勾配
grad=function(expr,par=c()){
	###expr:表現式(expression)
	###par:微分する変数(character)
	G=list()
	g_len=length(par)
	for(i in 1:g_len){
		x=par[i]
		G[[i]]=D(expr,x)
	}
return(G)
}

grad関数は、exprにexpression、parに微分したい変数を突っ込むことで、微分された状態をリストで返します。
具体例としてはこんな感じ

> siki=expression(x1^2+x2^3)
> grad(expr=siki,par=c("x1","x2"))
[[1]]
2 * x1

[[2]]
3 * x2^2
ヘシアン
Hes=function(expr,par=c()){
	###expr:表現式(expression)
	###par:微分する変数(character)
		res=matrix(,length(par),length(par))
		G=list()
		GG=list()
		g_len=length(par)
		
		##1階微分後の表現型のリストGを作成
		for(i in 1:g_len){
			x=par[i]
			G[[i]]=D(expr,x)
		}
		##2階微分後の表現型のリストGGを作成
		for(i in 1:g_len){
			GG_inner=list()
			for(j in 1:g_len){
				GG_inner[[j]]=D(G[[i]],par[j])
			}
			GG[[i]]=GG_inner
		}
	return(GG)
}

Hes関数も先ほどのgradと同様の引数をもってヘシアンの関数形を返します。matrix型で表示することは出来ないので、リストでi行j列目を表現しています。

> siki=expression(x1^2+x2^3)
> Hes(expr=siki,par=c("x1","x2"))
[[1]]
[[1]][[1]]
[1] 2

[[1]][[2]]
[1] 0


[[2]]
[[2]][[1]]
[1] 0

[[2]][[2]]
3 * (2 * x2)

勾配とヘシアンの値を出力する関数

先ほどの関数も応用しながら、変数に値を代入して、値が出力されるとこまでの関数を作ってみようと思います。

勾配値を出力する関数
cul_grad=function(expr,par=c(),sub=c(),var=c()){
	###expr:表現式(expression)
	###par:微分する変数(character)
	###sub:変数に代入する値(real)
	###var:表現式内の全ての変数(character)
	if(length(var)==length(sub)){
		res=c()
		G=list()
		g_len=length(par)
		
		##微分後の表現型のリストGを作成
		for(i in 1:g_len){
			x=par[i]
			G[[i]]=D(expr,x)
		}
		##各変数に値を代入していく
		for(ii in sub){
			num=which(sub==ii)
			assign(var[num],ii)
		}
		##リストGを評価したものをベクトルとして表示
		for(i in 1:g_len){
			res[i]=eval(G[[i]])
		}
		return(res)
	}
	else{
	print("Error,\"length(var) == length(sub)\" must be TRUE.")
	}
}

exprにはexpression関数で書いた関数の表現形を入れます。
parには微分したい変数をcharacter型で入力します。
subには変数に代入する値を入れます。次に説明するvarと順番を対応させる必要があります。
varには、exprで使用している全ての変数を識別するために入力します。

具体例

> siki=expression(x1^2+x2^3)
> cul_grad(expr=siki,par=c("x1","x2"),sub=c(2,3),var=c("x1","x2"))
[1]  4 27
ヘシアン値を出力する関数
cul_Hes=function(expr,par=c(),sub=c(),var=c()){
	###expr:表現式(expression)
	###par:微分する変数(character)
	###sub:変数に代入する値(real)
	###var:表現式内の全ての変数(character)
	if(length(var)==length(sub)){
		res=matrix(,length(par),length(par))
		G=list()
		GG=list()
		g_len=length(par)
		
		##1階微分後の表現型のリストGを作成
		for(i in 1:g_len){
			x=par[i]
			G[[i]]=D(expr,x)
		}
		##2階微分後の表現型のリストGGを作成
		for(i in 1:g_len){
			GG_inner=list()
			for(j in 1:g_len){
				GG_inner[[j]]=D(G[[i]],par[j])
			}
			GG[[i]]=GG_inner
		}
		##各変数に値を代入していく
		for(ii in sub){
			num=which(sub==ii)
			assign(var[num],ii)
		}
		##リストGを評価したものをベクトルとして表示
		for(i in 1:g_len){
			for(j in 1:g_len){
				res[i,j]=eval(GG[[i]][[j]])
			}
		}
		return(res)
	}
	else{
	print("Error,\"length(var) == length(sub)\" must be TRUE.")
	}
}

先ほどのcul_grad関数と同じように利用します

> siki=expression(x1^3+x2^4)
> cul_Hes(expr=siki,par=c("x1","x2"),sub=c(2,3),var=c("x1","x2"))
     [,1] [,2]
[1,]   12    0
[2,]    0  108

Rで線形回帰において総当たり法を行う関数を作成する

今回は、前回書いた0と1の組み合わせを全て出力する関数を応用して、説明変数選択の自動化(総当たり法)を行ってみたいと思います。
ちなみに前回書いた記事とはこちら
Rで任意の個数の0と1の組み合わせパターンを出力する関数を作る - バナナでもわかる話


何言ってるか分からないと思うので初めに少し説明から入ります。

目次

スポンサーリンク



説明変数の選択

被説明変数ベクトル yに対して、説明変数行列 Xを使って線形回帰をするというようなことを考えます。
この時、実際の分析を行うにあたって真の構造はわからないので何を説明変数とするかという説明変数選択問題が発生します。


当然、予測をするのか説明をするのかでどんな基準で変数選択をするかは変わってきて、例えばAIC基準を利用したり、lassoを使ってみたり、決定係数を見てみたり色々方法はあるわけですが(lassoを除けば)結局次のような問題が生じます。

「基準は良いがそのアルゴリズムはどう組むの??全パターン試すの意外としんどくない?」

そこで、普通は逐次選択法といって一定のアルゴリズムに従って逐次的に確認する方法を採用します。この逐次選択法はRではパッケージ化されていて簡単に試すことが出来ます。

しかし、この方法だと全てのパターンを見ることは出来ていません。あくまで時間的なコストと精度との兼ね合いをもって、逐次的に処理をしているにすぎません。そのため、可能なら全てのパターンを見た方が良いわけです。全てのパターンを見ることを総当たり法と呼びます。

総当たり法のアイデア

まず、想定されうる全ての説明変数を含んだ行列 Xを用意します。
そして前回の0と1の全パターンを出力する関数を使って、個数が説明変数の種類数と等しくなるような0と1の組み合わせを出力します。
1の部分を用いる説明変数だと考えて、対応する説明変数の組み合わせで回帰を繰り返し行います。

そして特定の基準(今回は修正済み決定係数で比較する)に従って順位付けしたものを出力します。


これで総当たり法が柔軟に行えるはずです。

関数の記述

sentaku=function(X,y){
###前回のsubsetfun関数
	subsetfun=function(kosuu){
		XX=matrix(,2^kosuu,kosuu)
		for(i in 1:kosuu){
			CCC=t(rbind(rep(0,2^(kosuu-i)),rep(1,2^(kosuu-i))))
			XX[,i]=rep(CCC,2^(i-1))
		}
		return(XX)
	}
###データ
	X=as.matrix(X)
	y=as.vector(y)
###説明変数の組み合わせパターンの出力
	subset=subsetfun(ncol(X))
###箱の作成
	kaiki_list=list()
	adj_vec=c()
	X_trans=matrix(0,nrow(X),ncol(X))
###総当たり回帰の実行
	for(i in 1:nrow(subset)){
		subset_row=subset[i,]
		for(ii in 1:nrow(X)){
			X_trans[ii,]=X[ii,]*subset_row  ###掛け算をすることで、0の部分は説明変数が全て0になる
		}
		X_trans=as.data.frame(X_trans)
		adj_vec[i]=summary(lm(y~.,data=X_trans))$adj.r.squared  ###ここを変えれば基準を変えられる
		kaiki_list[[i]]=lm(y~.,data=X_trans)
	}
return(list(kaiki_list=kaiki_list,adj.r.squared=adj_vec))
}

出てきたものを決定係数が小さい物から順に並べるには次のようにすれば良い。

s=sentaku(X,y)
#これで[[2]]に修正済み決定係数の列が出来た。
#決定係数の小さい順に並べてみる
for(i in order(s[[2]])){
	print(s[[2]][i])
}

これで、例えばこの説明変数を除くと急激に決定係数が減少するだとか、逆にこの説明変数はどちらでも良いなんてものが比較できたりします。

Rで任意の個数の0と1の組み合わせパターンを出力する関数を作る

今回はタイトルのような関数を作ってみたいと思います。
0と1の組み合わせってなんやねんっていうと、例えば2個のもので考えるなら

 (00,01,10,11)

こんな感じ。この組み合わせの総数は 2^{個数}個あるので、手作業で頑張るのは個数が大きくなってくるとしんどいです。
※5個の時点で32パターンあります。

そこで、関数化してみます。

目次

スポンサーリンク



アイデアの種

例えば、先ほどの (00,01,10,11)を次のように縦に並べてみます。
 00
 01
 10
 11

これらの数列を左の項から順番に比べた時に、どの時点で各数列が異なると識別できるのか考えてみます。
例えば最初にある 00 01は初めの数字は同じ0で異なるものかどうかは識別出来ません、次に並ぶ数字を確認して初めて異なる数列であると判断できます。

アルゴリズムのアイデア

もう少し個数の多い例でも見てみます。例えば5個のケース。

      [,1] [,2] [,3] [,4] [,5]
 [1,]    0    0    0    0    0
 [2,]    0    0    0    0    1
 [3,]    0    0    0    1    0
 [4,]    0    0    0    1    1
 [5,]    0    0    1    0    0
 [6,]    0    0    1    0    1
 [7,]    0    0    1    1    0
 [8,]    0    0    1    1    1
 [9,]    0    1    0    0    0
[10,]    0    1    0    0    1
[11,]    0    1    0    1    0
[12,]    0    1    0    1    1
[13,]    0    1    1    0    0
[14,]    0    1    1    0    1
[15,]    0    1    1    1    0
[16,]    0    1    1    1    1
[17,]    1    0    0    0    0
[18,]    1    0    0    0    1
[19,]    1    0    0    1    0
[20,]    1    0    0    1    1
[21,]    1    0    1    0    0
[22,]    1    0    1    0    1
[23,]    1    0    1    1    0
[24,]    1    0    1    1    1
[25,]    1    1    0    0    0
[26,]    1    1    0    0    1
[27,]    1    1    0    1    0
[28,]    1    1    0    1    1
[29,]    1    1    1    0    0
[30,]    1    1    1    0    1
[31,]    1    1    1    1    0
[32,]    1    1    1    1    1

個数は5なので、 2^5=32通りあります。組み合わせを考えれば自明ですが、一番初めの数字が0のパターンは \frac{2^5}{2}=16通り、一番初めの数字が1のパターンも同様に \frac{2^5}{2}=16通りあるはずです。

一番初めの数字が0のパターンだけ試しに抜き出してみます。

      [,1] [,2] [,3] [,4] [,5]
 [1,]    0    0    0    0    0
 [2,]    0    0    0    0    1
 [3,]    0    0    0    1    0
 [4,]    0    0    0    1    1
 [5,]    0    0    1    0    0
 [6,]    0    0    1    0    1
 [7,]    0    0    1    1    0
 [8,]    0    0    1    1    1
 [9,]    0    1    0    0    0
[10,]    0    1    0    0    1
[11,]    0    1    0    1    0
[12,]    0    1    0    1    1
[13,]    0    1    1    0    0
[14,]    0    1    1    0    1
[15,]    0    1    1    1    0
[16,]    0    1    1    1    1

今度は一つ目の数字は皆同じなので二つ目の数字を見てみます。先ほどと同様に16パターンのうち、二つ目の数字が0であるパターンは \frac{16}{2}=8個のはずです。


この操作を順々に繰り返していくと結局、総パターンの内、左から見ていった時に k個目までが同じ数列であるパターン数は \frac{2^{個数}}{2^k}個であると考えられます。

関数化

さて、今の手順を関数化してみることにします。

subsetfun=function(kosuu){
	XX=matrix(,2^kosuu,kosuu)
	for(i in 1:kosuu){
		CCC=t(rbind(rep(0,2^(kosuu-i)),rep(1,2^(kosuu-i))))
		XX[,i]=rep(CCC,2^(i-1))
	}
	return(XX)
}

試しに、個数=6で出力してみます。

> subsetfun(6)
      [,1] [,2] [,3] [,4] [,5] [,6]
 [1,]    0    0    0    0    0    0
 [2,]    0    0    0    0    0    1
 [3,]    0    0    0    0    1    0
 [4,]    0    0    0    0    1    1
 [5,]    0    0    0    1    0    0
 [6,]    0    0    0    1    0    1
 [7,]    0    0    0    1    1    0
 [8,]    0    0    0    1    1    1
 [9,]    0    0    1    0    0    0
[10,]    0    0    1    0    0    1
[11,]    0    0    1    0    1    0
[12,]    0    0    1    0    1    1
[13,]    0    0    1    1    0    0
[14,]    0    0    1    1    0    1
[15,]    0    0    1    1    1    0
[16,]    0    0    1    1    1    1
[17,]    0    1    0    0    0    0
[18,]    0    1    0    0    0    1
[19,]    0    1    0    0    1    0
[20,]    0    1    0    0    1    1
[21,]    0    1    0    1    0    0
[22,]    0    1    0    1    0    1
[23,]    0    1    0    1    1    0
[24,]    0    1    0    1    1    1
[25,]    0    1    1    0    0    0
[26,]    0    1    1    0    0    1
[27,]    0    1    1    0    1    0
[28,]    0    1    1    0    1    1
[29,]    0    1    1    1    0    0
[30,]    0    1    1    1    0    1
[31,]    0    1    1    1    1    0
[32,]    0    1    1    1    1    1
[33,]    1    0    0    0    0    0
[34,]    1    0    0    0    0    1
[35,]    1    0    0    0    1    0
[36,]    1    0    0    0    1    1
[37,]    1    0    0    1    0    0
[38,]    1    0    0    1    0    1
[39,]    1    0    0    1    1    0
[40,]    1    0    0    1    1    1
[41,]    1    0    1    0    0    0
[42,]    1    0    1    0    0    1
[43,]    1    0    1    0    1    0
[44,]    1    0    1    0    1    1
[45,]    1    0    1    1    0    0
[46,]    1    0    1    1    0    1
[47,]    1    0    1    1    1    0
[48,]    1    0    1    1    1    1
[49,]    1    1    0    0    0    0
[50,]    1    1    0    0    0    1
[51,]    1    1    0    0    1    0
[52,]    1    1    0    0    1    1
[53,]    1    1    0    1    0    0
[54,]    1    1    0    1    0    1
[55,]    1    1    0    1    1    0
[56,]    1    1    0    1    1    1
[57,]    1    1    1    0    0    0
[58,]    1    1    1    0    0    1
[59,]    1    1    1    0    1    0
[60,]    1    1    1    0    1    1
[61,]    1    1    1    1    0    0
[62,]    1    1    1    1    0    1
[63,]    1    1    1    1    1    0
[64,]    1    1    1    1    1    1

うまくいっていますね。

コメント

この関数、なんで作ろうかと思ったかというと、線形回帰の変数選択の自動化をしたかったから書きました。次回にでも変数選択の自動化関数についても書いてみたいと思います。

ちなみにyahoo知恵袋にてこんな質問が落ちていました。
4桁かつ、0と1の組み合わせ - 0と1からなる4桁の数字の組み合わせはどれく... - Yahoo!知恵袋
この手の質問もこの関数ならすぐに視覚的に見せることが出来ますね。