差分
このページの2つのバージョン間の差分を表示します。
両方とも前のリビジョン前のリビジョン次のリビジョン | 前のリビジョン | ||
mselab:2012:stat:week3:r2 [2012/12/18 06:51] – [決定木に基づく対象限定] watalu | mselab:2012:stat:week3:r2 [不明な日付] (現在) – 外部編集 (不明な日付) 127.0.0.1 | ||
---|---|---|---|
行 1: | 行 1: | ||
- | 縛り。 | + | ===== 統計工学実験 第3週 ===== |
+ | ==== 連絡 ==== | ||
- | * 学習機械にはlm()かrpart()しか使わない。 | + | * [[mselab: |
- | * kmeans()を層別に使う。 | + | ==== 最終課題 ==== |
+ | * 学習用データ(tic.learn)に基づいて、V86の契約に関するモデルを構築し、訪問対象に加える条件(訪問ルール)を提案せよ。 | ||
+ | * 学習機械にはlm()かrpart()しか使わない。 | ||
+ | * 層別のモデル構築も、候補に加える。 | ||
+ | * 層別の生成には、データの集計、決定木の他に、k-means法によるクラスタリングも候補に加える。 | ||
+ | * 提案した訪問ルールの契約達成率などを、検証用データ(tic.eval)に適用して検討せよ。 | ||
+ | * 学習用データでモデルを学習し、検証用データで精度を検討する、という縛りの中で、最適な訪問ルールを定めよ。これがこの実験の最終成果物である。 | ||
+ | |||
+ | ==== 準備 ==== | ||
準備。 | 準備。 | ||
+ | |||
< | < | ||
- | install.packages(c(" | + | Sys.setenv(" |
+ | install.packages(c(" | ||
library(mvtnorm) | library(mvtnorm) | ||
+ | library(mvpart) | ||
library(MASS) | library(MASS) | ||
</ | </ | ||
+ | |||
+ | データがない人は、次のコードも実行する必要がある。 | ||
+ | |||
+ | < | ||
+ | tic.learn <- read.table(" | ||
+ | tic.eval <- read.table(" | ||
+ | tic.test <- read.table(" | ||
+ | tic.eval <- cbind(tic.eval, | ||
+ | colnames(tic.eval)[86] <- " | ||
+ | rm(tic.test) | ||
+ | </ | ||
+ | |||
+ | さらに先週のレポート課題と同様に、V1とV5のグループ化も済ませるとよいかもしれない。 | ||
+ | あるいは今週の課題で改めて、グループ化を見直してもよい。 | ||
+ | |||
+ | ==== クラスタリング ==== | ||
+ | |||
+ | データの層別を行う方法の総称。生成した層のことを、クラスタ(群)という。大きく階層クラスタリングと非階層クラスタリングに分かれる。 | ||
+ | |||
+ | 階層クラスタリングは、レコード間の距離を全ての組み合わせについて算出して作成した行列を距離行列から出発する。 | ||
+ | まずは最も近いレコード同士をグループ(群)にまとめる。その結果、2レコードは1つのクラスタに属するが、残りのレコードは点のままである。 | ||
+ | そのクラスタと残りのレコードの間の距離行列を算出し、最も近いレコード同士、最も近いレコードとグループ、もしくは最も近いグループ同士を再びグループに\\ | ||
+ | まとめる。 | ||
+ | これを繰り返すことで、クラスタ(群)分けを得るのが、階層クラスタリングである。 | ||
+ | 階層クラスタリングには、レコード同士の距離だけでなく、レコードとグループの距離、グループ同士の距離、を定める必要がある。 | ||
+ | またクラスタを生成する過程をグラフに表したものを、デンドログラムと呼ぶ。 | ||
+ | |||
+ | それに対して、クラスタ(群)ごとの群内のばらつきが最小になるように、目的関数を定め、離散最適化法を用いてクラスタを生成するのが、非階層クラスタリング\\ | ||
+ | である。 | ||
+ | 代表的な非階層クラスタリングのひとつである$k$-means法では、各群のユークリッド距離の平均が最小になるように、クラスタ平均を付置する。 | ||
=== k-means法によるクラスタリング === | === k-means法によるクラスタリング === | ||
行 99: | 行 141: | ||
* ブースティング (Boosting) | * ブースティング (Boosting) | ||
* バギング (Bagging) | * バギング (Bagging) | ||
+ | |||
+ | ==== 層別 ==== | ||
=== k-means法による層別 === | === k-means法による層別 === | ||
- | k-means法は、数値変数でしか用いられないため、データは「tic.learn[, | + | k-means法は、数値変数でしか用いられないため、データは「tic.learn[, |
< | < | ||
- | tic.learn.kmeans <- kmeans(tic.learn[, | + | tic.learn.kmeans <- kmeans(tic.learn[, |
</ | </ | ||
行 115: | 行 159: | ||
tic.kmeans.dist <- rep(0, max(tic.learn.kmeans$cluster) ) | tic.kmeans.dist <- rep(0, max(tic.learn.kmeans$cluster) ) | ||
for( j in c(1: | for( j in c(1: | ||
- | tic.kmeans.dist[j] <- sum( (tic.learn[i, | + | tic.kmeans.dist[j] <- sum( (tic.learn[i, |
} | } | ||
tic.learn$cluster[i] <- sort.list(tic.kmeans.dist)[1] | tic.learn$cluster[i] <- sort.list(tic.kmeans.dist)[1] | ||
行 122: | 行 166: | ||
</ | </ | ||
- | 念のため、keansの結果と比較して、計算に誤りがないことを確認するためにクロス集計を行う。この結果が対角であれば、計算はあっている。 | + | 念のため、kmeansの結果と比較して、計算に誤りがないことを確認するためにクロス集計を行う。この結果が対角であれば、計算はあっている。 |
< | < | ||
行 139: | 行 183: | ||
V1は1から41の値を取ることが確認できたら、次のように、clusterという変数をtic.learn内に作り、まず0で埋める。 | V1は1から41の値を取ることが確認できたら、次のように、clusterという変数をtic.learn内に作り、まず0で埋める。 | ||
- | そして、V1の値ごとに層の値を指定するコードを書き、Rに実行させる。 | + | そして、V1の値ごとに層の値を指定するコードを書き、Rに実行させる。下記は、先週に行った決定木分析を踏まえた層別の例である。 |
< | < | ||
行 240: | 行 284: | ||
table(tic.learn$cluster) | table(tic.learn$cluster) | ||
</ | </ | ||
+ | |||
+ | === 検証用データの層別 === | ||
+ | |||
+ | 検証用データに層別変数 cluster を加えるには、上のコードの「tic.learn」をすべて「tic.eval」に変えればよい。 | ||
+ | |||
+ | ==== 層別後の解析 ==== | ||
+ | |||
=== 層別後の解析 === | === 層別後の解析 === | ||
行 304: | 行 355: | ||
</ | </ | ||
で25.9%となる。 | で25.9%となる。 | ||
+ | |||
+ | === 回帰分析に基づく対象限定 (層別なし) === | ||
+ | |||
+ | まず、すべての変数を用いて回帰分析を行う。 | ||
+ | |||
+ | < | ||
+ | tic.lm <- lm(V86~V1gr+V2+V3+V4+V5gr+V6+V7+V8+V9+V10 | ||
+ | +V11+V12+V13+V14+V15+V16+V17+V18+V19+V20 | ||
+ | +V21+V22+V23+V24+V25+V26+V27+V28+V29+V30 | ||
+ | +V31+V32+V33+V34+V35+V36+V37+V38+V39+V40 | ||
+ | +V41+V42+V43+V44+V45+V46+V47+V48+V49+V50 | ||
+ | +V51+V52+V53+V54+V55+V56+V57+V58+V59+V60 | ||
+ | +V61+V62+V63+V64+V65+V66+V67+V68+V69+V70 | ||
+ | +V71+V72+V73+V74+V75+V76+V77+V78+V79+V80 | ||
+ | +V81+V82+V83+V84+V85, | ||
+ | print(tic.lm) | ||
+ | summary(tic.lm) | ||
+ | plot(tic.lm) | ||
+ | </ | ||
+ | |||
+ | 上で「object ' | ||
+ | この結果をtic.lmに収めたら、次はAICで変数選択をさせる。 | ||
+ | |||
+ | < | ||
+ | tic.lm.aic <- stepAIC(tic.lm) | ||
+ | </ | ||
+ | |||
+ | 推定したモデルに基づいて、個別のレコードごとの契約の予測を立てる。その予測値が__0.05__以上なら訪問してみることとした場合、次のようになる。 | ||
+ | |||
+ | < | ||
+ | tic.learn$visit <- predict(tic.lm.aic, | ||
+ | </ | ||
+ | |||
+ | 集計してみると。 | ||
+ | < | ||
+ | table(tic.learn$visit) | ||
+ | table(tic.learn$visit, | ||
+ | </ | ||
+ | |||
+ | === 回帰分析に基づく対象限定 (層別あり) === | ||
+ | |||
+ | 学習したモデルに基づいて、訪問対象を狭めるには、predict()という関数を用いて、訪問対象か否かというリストを作成する。 | ||
+ | まずクラスタ1について、設定まで調整したモデルを、学習用データ(tic.learn)から得る。(rpart関数に指定してあるモデルは適当なので、各自の得たものを用いること) | ||
+ | |||
+ | < | ||
+ | tic.lm.1 <- stepAIC(lm(V86~., | ||
+ | </ | ||
+ | |||
+ | 次に、このモデル(ここではtic.rpart.1)を、そのまま学習用データ(tic.learn)に適用して、契約してくれるか否かの予測を行う。 | ||
+ | この際、下に記した0.05という閾値は調整(増やしたり減らしたり)が必要かもしれない。 | ||
+ | |||
+ | < | ||
+ | tic.learn$visit <- rep(0, dim(tic.learn)[1]) | ||
+ | tic.learn$visit[tic.learn$cluster==1] <- predict(tic.lm.1, | ||
+ | </ | ||
+ | |||
+ | 同様のことを、クラスタごとに、すべてのクラスタについて行う。(ここではk=2) | ||
+ | |||
+ | < | ||
+ | tic.lm.2 <- stepAIC(lm(V86~., | ||
+ | tic.learn$visit[tic.learn$cluster==2] <- predict(tic.lm.2, | ||
+ | tic.lm.3 <- stepAIC(lm(V86~., | ||
+ | tic.learn$visit[tic.learn$cluster==3] <- predict(tic.lm.3, | ||
+ | ... | ||
+ | </ | ||
+ | |||
+ | この層別解析の結果をまとめる。 | ||
+ | |||
+ | < | ||
+ | table(1*(predict(tic.lm.1)> | ||
+ | table(1*(predict(tic.lm.2)> | ||
+ | table(1*(predict(tic.lm.3)> | ||
+ | ... | ||
+ | </ | ||
+ | |||
+ | 全体の集計は、上のテーブルを足しても良いし、集計し直しても良い。 | ||
+ | |||
+ | < | ||
+ | table(tic.learn$visit, | ||
+ | </ | ||
=== 決定木に基づく対象限定 (層別なし) === | === 決定木に基づく対象限定 (層別なし) === | ||
行 315: | 行 446: | ||
次に、このモデル(ここではtic.rpart)を、そのまま学習用データ(tic.learn)に適用して、契約してくれるか否かの予測を行う。 | 次に、このモデル(ここではtic.rpart)を、そのまま学習用データ(tic.learn)に適用して、契約してくれるか否かの予測を行う。 | ||
- | この際、下に記した0.05という閾値は調整(増やしたり減らしたり)が必要かもしれない。 | + | この際、下に記した__0.05__という閾値は、確率が0.05以上なら訪問する、という意味なので、調整(増やしたり減らしたり)が必要かもしれない。 |
< | < | ||
行 355: | 行 486: | ||
で38.275%となる。 | で38.275%となる。 | ||
+ | === 決定木に基づく対象限定 (層別あり) === | ||
+ | |||
+ | 学習したモデルに基づいて、訪問対象を狭めるには、predict()という関数を用いて、訪問対象か否かというリストを作成する。 | ||
+ | まずクラスタ1について、設定まで調整したモデルを、学習用データ(tic.learn)から得る。(rpart関数に指定してあるモデルは適当なので、各自の得たものを用いること) | ||
+ | |||
+ | < | ||
+ | tic.rpart.1 <- rpart(V86~., | ||
+ | </ | ||
+ | |||
+ | あるいは | ||
+ | |||
+ | < | ||
+ | tic.rpart.1 <- rpart(V86~., | ||
+ | </ | ||
+ | |||
+ | とsubset()関数を用いて、データの一部を用いるように指定する。 | ||
+ | |||
+ | 次に、このモデル(ここではtic.rpart.1)を、そのまま学習用データ(tic.learn)に適用して、契約してくれるか否かの予測を行う。 | ||
+ | この際、下に記した0.05という閾値は調整(増やしたり減らしたり)が必要かもしれない。 | ||
+ | |||
+ | < | ||
+ | tic.learn$visit <- rep(0, dim(tic.learn)[1]) | ||
+ | tic.learn$visit[tic.learn$cluster==1] <- predict(tic.rpart.1, | ||
+ | </ | ||
+ | |||
+ | 同様のことを、クラスタごとに、すべてのクラスタについて行う。(ここではk=2) | ||
+ | |||
+ | < | ||
+ | tic.rpart.2 <- rpart(V86~., | ||
+ | tic.learn$visit[tic.learn$cluster==2] <- predict(tic.rpart.2, | ||
+ | tic.rpart.3 <- rpart(V86~., | ||
+ | tic.learn$visit[tic.learn$cluster==3] <- predict(tic.rpart.3, | ||
+ | ... | ||
+ | </ | ||
+ | |||
+ | この層別解析の結果をまとめる。 | ||
+ | |||
+ | < | ||
+ | table(1*(predict(tic.rpart.1)> | ||
+ | table(1*(predict(tic.rpart.2)> | ||
+ | table(1*(predict(tic.rpart.3)> | ||
+ | ... | ||
+ | </ | ||
+ | |||
+ | 全体の集計は、上のテーブルを足しても良いし、集計し直しても良い。 | ||
+ | |||
+ | < | ||
+ | table(tic.learn$visit, | ||
+ | </ | ||
+ | |||
+ | ここも層別なしの解析と比較しておく。 | ||
+ | |||
+ | === 検証 === | ||
+ | |||
+ | 以上のように、層別も加えて分析して作り上げたモデルが、目標を達成しているかどうか、を検証用データ (tic.eval) で確認する。 | ||
+ | |||
+ | |||
+ | ==== レポート提出について ==== | ||
+ | |||
+ | レポート提出要領: | ||
+ | |||
+ | ^項目^指定^ | ||
+ | |提出期限|実験実施の翌週の月曜日の午後7時0分まで (でも今回は12月25日から冬休みなので、12月25日の午後7時でいい)| | ||
+ | |提出方法|電子メールに添付 (宛先は配付資料に記載)| | ||
+ | |ファイル形式|Wordファイル (LaTeXで作成する場合は、dvipdfmxでPDFに変換すること)| | ||
+ | |メールの件名|統計実験3レポート提出(XXXXXXX)| | ||
+ | |レポートファイルの名称|統計実験3_XXXXXXX.doc あるいは 統計実験3_XXXXXXX.docx| | ||
+ | |提出部数|レポートは各自1通ずつ。{{: | ||
+ | |||
+ | |||
+ | ==== 実験当日の修正 ==== | ||
+ | |||
+ | 自分のMacだと問題が発生せず、実験室のPCだとRが落ちる不具合があります。メモリが少ないためかもしれません。Rが勝手に終了する場合には、kmeansのコードは次のように nstart を削除し、iter.max を追加する修正をお願いします。 | ||
+ | |||
+ | === k-means法による層別 (iter.max追加、nstart削除) === | ||
+ | |||
+ | k-means法は、数値変数でしか用いられないため、データは「tic.learn[, | ||
+ | < | ||
+ | tic.learn.kmeans <- kmeans(tic.learn[, | ||
+ | </ | ||
+ | |||
+ | k-means法の結果を適用するには、レコードごとに「centers」の座標とのユークリッド距離を算出し、一番小さくなる層にその変数を割り当てる。 | ||
+ | |||
+ | < | ||
+ | date() | ||
+ | tic.learn$cluster <- rep(0, dim(tic.learn)[1] ) | ||
+ | for( i in c(1: | ||
+ | tic.kmeans.dist <- rep(0, max(tic.learn.kmeans$cluster) ) | ||
+ | for( j in c(1: | ||
+ | tic.kmeans.dist[j] <- sum( (tic.learn[i, | ||
+ | } | ||
+ | tic.learn$cluster[i] <- sort.list(tic.kmeans.dist)[1] | ||
+ | } | ||
+ | date() | ||
+ | </ | ||
+ | |||
+ | 念のため、kmeansの結果と比較して、計算に誤りがないことを確認するためにクロス集計を行う。この結果が対角であれば、計算はあっている。 | ||
+ | |||
+ | < | ||
+ | table(tic.learn$cluster, | ||
+ | </ | ||
+ | |||
+ | centers=に指定する値は、いろいろ変えてみるといい。 |