差分

このページの2つのバージョン間の差分を表示します。

--- dmb:2011:q1 [2011/11/07 09:48] – watalu
+++ dmb:2011:q1 [不明な日付] (現在) – 外部編集 (不明な日付) 127.0.0.1
@@ 行 1: / 行 1: @@
-==== 学習誤差と予測誤差 ====
+==== 課題#1 学習誤差と予測誤差 ====
-=== 課題 ===
-今回は比較的単純な課題です．
+  - 初稿 2011.11.07
+  - 第二稿 2011.11.10
-  + 線形学習機械の最小二乗学習とk最近接機械の誤判別率を，シミュレーションを用いて比較しなさい．
+=== はじめに ===
-  + 今回のシミュレーション設定に対して，最適なkを決めてみなさい．
-  + 学習用データによる誤判別率の推定と検証ゥデータによる誤判別率の推定を比較して考察しなさい．
+今回は比較的単純な課題です．
-〆切は来週の月曜日の2限が始まる時刻まで，とします．
+  - 線形学習機械の最小二乗学習とk最近接機械の誤判別率を，シミュレーションを用いて比較しなさい．
+  - 今回のシミュレーション設定に対して，最適なkを決めてみなさい．
+  - 学習用データによる誤判別率の推定と検証ゥデータによる誤判別率の推定を比較して考察しなさい．
-コードは，解説付きのコードの一番下に「貼り付け用」を別に用意したので，そちらを使うと良いです
+〆切は来週の月曜日の2限が始まる時刻まで，とします．Word形式のレポートファイルの送付先は，[[mailto:data.mining.finale_at_gmail.com]]です．(_at_を半角の＠マークで置き換えてください)
+コードは，解説付きのコードの一番下に「貼り付け用」を別に用意したので，そちらを使うと良いです．いきなり全部をコピーするのでなく，四角囲みごとに．
 === コード ===
 <code>
@@ 行 22: / 行 25: @@
   if( setting==1 ) {
     X <- rbind(X,
-                   cbind(rnorm(ceiling(n/2), mean=0, sd=1),
+               cbind(rnorm(ceiling(n/2), mean=0, sd=1),
-                            rnorm(ceiling(n/2), mean=0, sd=1)) )
+                     rnorm(ceiling(n/2), mean=0, sd=1)) )
     y <- rbind(y,
-                   as.matrix(array(0, dim=c(ceiling(n/2)) ) ) )
+               as.matrix(array(0, dim=c(ceiling(n/2)) ) ) )
     X <- rbind(X,
-                   cbind(rnorm(floor(n/2), mean=2, sd=1),
+               cbind(rnorm(floor(n/2), mean=2, sd=1),
-                            rnorm(floor(n/2), mean=2, sd=1)) )
+                     rnorm(floor(n/2), mean=2, sd=1)) )
     y <- rbind(y,
-                   as.matrix(array(1, dim=c(floor(n/2)) ) ) )
+               as.matrix(array(1, dim=c(floor(n/2)) ) ) )
     Data <- cbind(X,y)
     colnames(Data) <- c("X.1", "X.2", "y")
@@ 行 92: / 行 95: @@
     # k-最近接機械でk=1
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],
-                             k=1, prob=FALSE)
+                    k=1, prob=FALSE)
     data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)],
-                             k=1, prob=FALSE)
+                     k=1, prob=FALSE)
     error.temp.learn <- append(error.temp.learn,
 -sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,
 -sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # k-最近接機械でk=3
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],
-                             k=3, prob=FALSE)
+                    k=3, prob=FALSE)
     data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)],
-                             k=3, prob=FALSE)
+                     k=3, prob=FALSE)
     error.temp.learn <- append(error.temp.learn,
 -sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,
 -sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # k-最近接機械でk=5
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],
-                             k=5, prob=FALSE)
+                    k=5, prob=FALSE)
     data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)],
-                             k=5, prob=FALSE)
+                     k=5, prob=FALSE)
     error.temp.learn <- append(error.temp.learn,
 -sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,
 -sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # k-最近接機械でk=7
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],
-                             k=7, prob=FALSE)
+                    k=7, prob=FALSE)
     data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)],
-                             k=7, prob=FALSE)
+                     k=7, prob=FALSE)
     error.temp.learn <- append(error.temp.learn,
 -sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,
 -sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # k-最近接機械でk=9
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],
-                             k=9, prob=FALSE)
+                    k=9, prob=FALSE)
     data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)],
-                             k=9, prob=FALSE)
+                     k=9, prob=FALSE)
     error.temp.learn <- append(error.temp.learn,
 -sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,
 -sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # k-最近接機械でk=15
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],
-                             k=15, prob=FALSE)
+                    k=15, prob=FALSE)
     data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)],
-                             k=15, prob=FALSE)
+                     k=15, prob=FALSE)
     error.temp.learn <- append(error.temp.learn,
 -sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,
 -sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # k-最近接機械でk=21
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],
-                             k=21, prob=FALSE)
+                    k=21, prob=FALSE)
     data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)],
-                             k=21, prob=FALSE)
+                     k=21, prob=FALSE)
     error.temp.learn <- append(error.temp.learn,
 -sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,
 -sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # k-最近接機械でk=25
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],
-                             k=31, prob=FALSE)
+                    k=31, prob=FALSE)
     data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)],
-                             k=31, prob=FALSE)
+                     k=31, prob=FALSE)
     error.temp.learn <- append(error.temp.learn,
 -sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,
 -sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # k-最近接機械でk=51
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],
-                             k=51, prob=FALSE)
+                    k=51, prob=FALSE)
     data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)],
-                             k=51, prob=FALSE)
+                     k=51, prob=FALSE)
     error.temp.learn <- append(error.temp.learn,
 -sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,
 -sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # k-最近接機械でk=75
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],
-                             k=75, prob=FALSE)
+                    k=75, prob=FALSE)
     data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)],
-                             k=75, prob=FALSE)
+                     k=75, prob=FALSE)
     error.temp.learn <- append(error.temp.learn,
 -sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,
 -sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # k-最近接機械でk=101
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],
-                             k=101, prob=FALSE)
+                    k=101, prob=FALSE)
     data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)],
-                             k=101, prob=FALSE)
+                     k=101, prob=FALSE)
     error.temp.learn <- append(error.temp.learn,
 -sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,
 -sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # k-最近接機械でk=201
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],
-                             k=201, prob=FALSE)
+                    k=201, prob=FALSE)
     data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)],
-                             k=201, prob=FALSE)
+                     k=201, prob=FALSE)
     error.temp.learn <- append(error.temp.learn,
 -sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,
 -sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # k-最近接機械でk=301
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],
-                             k=301, prob=FALSE)
+                    k=301, prob=FALSE)
     data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)],
-                             k=301, prob=FALSE)
+                     k=301, prob=FALSE)
     error.temp.learn <- append(error.temp.learn,
 -sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,
 -sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
    # 上の結果の回収
@@ 行 236: / 行 239: @@
 </code>
-箱ひげ図の描画．
+学習用データによる誤判別率の推定値の標本分布を要約する．次の3行を実施すれば，箱ひげ図が描けて，各学習機械の誤判別率の平均と標準偏差も算出される．
+箱ひげ図については，次項参照のこと．
 <code>
 boxplot(error.rate.learn)
+apply(error.rate.learn,2,"mean")
+sqrt(apply(error.rate.learn,2,"var"))
+</code>
+検証用データにおける誤判別率についても，同様の次の3行で要約できる．
+<code>
 boxplot(error.rate.eval)
+apply(error.rate.eval,2,"mean")
+sqrt(apply(error.rate.eval,2,"var"))
 </code>
@@ 行 253: / 行 266: @@
   if( setting==1 ) {
     X <- rbind(X,
-                   cbind(rnorm(ceiling(n/2), mean=0, sd=1),
+               cbind(rnorm(ceiling(n/2), mean=0, sd=1),
-                            rnorm(ceiling(n/2), mean=0, sd=1)) )
+                     rnorm(ceiling(n/2), mean=0, sd=1)) )
     y <- rbind(y,
-                   as.matrix(array(0, dim=c(ceiling(n/2)) ) ) )
+               as.matrix(array(0, dim=c(ceiling(n/2)) ) ) )
     X <- rbind(X,
-                   cbind(rnorm(floor(n/2), mean=2, sd=1),
+               cbind(rnorm(floor(n/2), mean=2, sd=1),
-                            rnorm(floor(n/2), mean=2, sd=1)) )
+                     rnorm(floor(n/2), mean=2, sd=1)) )
     y <- rbind(y,
-                   as.matrix(array(1, dim=c(floor(n/2)) ) ) )
+               as.matrix(array(1, dim=c(floor(n/2)) ) ) )
     Data <- cbind(X,y)
     colnames(Data) <- c("X.1", "X.2", "y")
@@ 行 304: / 行 317: @@
     data.fit <- fitted(data.lm)
     error.temp.learn <- append(error.temp.learn,
 -sum(abs(data.learn$y-data.fit)<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,
 -sum(abs(data.eval$y-data.pred)<0.5)/n.eval)
     # knn:1
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],
-                             k=1, prob=FALSE)
+                    k=1, prob=FALSE)
     data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)],
-                             k=1, prob=FALSE)
+                     k=1, prob=FALSE)
     error.temp.learn <- append(error.temp.learn,
 -sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,
 -sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # knn:3
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],
-                             k=3, prob=FALSE)
+                    k=3, prob=FALSE)
     data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)],
-                             k=3, prob=FALSE)
+                     k=3, prob=FALSE)
     error.temp.learn <- append(error.temp.learn,
 -sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,
 -sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # knn:5
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],
-                             k=5, prob=FALSE)
+                    k=5, prob=FALSE)
     data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)],
-                             k=5, prob=FALSE)
+                     k=5, prob=FALSE)
     error.temp.learn <- append(error.temp.learn,
 -sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,
 -sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # knn:7
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],
-                             k=7, prob=FALSE)
+                    k=7, prob=FALSE)
     data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)],
-                             k=7, prob=FALSE)
+                     k=7, prob=FALSE)
     error.temp.learn <- append(error.temp.learn,
 -sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,
 -sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # knn:9
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],
-                             k=9, prob=FALSE)
+                    k=9, prob=FALSE)
     data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)],
-                             k=9, prob=FALSE)
+                     k=9, prob=FALSE)
     error.temp.learn <- append(error.temp.learn,
 -sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,
 -sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # knn:15
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],
-                             k=15, prob=FALSE)
+                    k=15, prob=FALSE)
     data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)],
-                             k=15, prob=FALSE)
+                     k=15, prob=FALSE)
     error.temp.learn <- append(error.temp.learn,
 -sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,
 -sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # knn:21
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],
-                             k=21, prob=FALSE)
+                    k=21, prob=FALSE)
     data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)],
-                             k=21, prob=FALSE)
+                     k=21, prob=FALSE)
     error.temp.learn <- append(error.temp.learn,
 -sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,
 -sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # knn:25
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],
@@ 行 439: / 行 452: @@
 </code>
-結果のグラフ
 <code>
 boxplot(error.rate.learn)
+apply(error.rate.learn,2,"mean")
+sqrt(apply(error.rate.learn,2,"var"))
 </code>
-結果のグラフ
 <code>
 boxplot(error.rate.eval)
+apply(error.rate.eval,2,"mean")
+sqrt(apply(error.rate.eval,2,"var"))
+</code>
+=== 解説 ===
+== 箱ひげ図 ==
+箱ひげ図は，一次元データの打点の要約方法である．ヒストグラムの代替で，対称性と裾の重さを図示する．
+下図はデータの散らばり具合，ヒストグラム，箱ひげ図の対応例である
+{{ :dmb:2011:pointplot-histogram-boxplot.jpg? |}}
+この図の場合，箱ひげ図を横に寝かせて描いたので，右方向を上，左方向を下と思って欲しい．
+|ひげの上にある点|1.5倍の範囲を超えたデータ|
+|長方形の上に伸びたひげの横線|箱の長さの1.5倍の範囲にあるデータの最大値|
+|長方形の上辺|データを小さい順に並べたときの「上側1/4」(75%点)の値|
+|長方形中央の横線|データを小さい順に並べたときの「真ん中」(50%点)の値|
+|長方形の下辺|データを小さい順に並べたときの「下側1/4」(25%点)の値|
+|長方形の下に伸びたひげの横線|箱の長さの1.5倍の範囲にあるデータの最小値|
+|ひげの下にある点|1.5倍の範囲を超えたデータ|
+|箱の長さ|上辺-下辺|
+上の図の作図に用いたコード．
+<code>
+X <- rgamma(100, shape=2)
+jpeg("pointplot-histogram-boxplot.jpg", width=600, height=600)
+par(mfrow=c(3,1))
+plot(cbind(X,1), xlim=c(0,10))
+hist(X, xlim=c(0,10))
+boxplot(X,horizontal=TRUE, ylim=c(0,10))
+dev.off()
+</code>
+== ヒストグラムを並べる場合 ==
+グラフの数が多いので，お勧めはしないが，箱ひげ図を描く代わりに，ヒストグラムを並べると，こうなる．
+学習用データの誤判別率のグラフを並べた例．
+{{ :dmb:2011:histograms-learn.jpg |}}
+<code>
+jpeg("histograms-learn.jpg", width=600, height=1800)
+par(cex=0.3)
+par(mfrow=c(14,1))
+for( i in c(1:14) ) {
+  hist(error.rate.learn[,i],
+       xlab=colnames(error.rate.learn)[i],
+       main=paste("Histogram for ",colnames(error.rate.learn)[i]))
+}
+dev.off()
+</code>
+こちらは検証用データにおける誤判別率のグラフを並べた例．
+{{ :dmb:2011:histograms-eval.jpg |}}
+<code>
+jpeg("histograms-eval.jpg", width=600, height=1800)
+par(cex=0.3)
+par(mfrow=c(14,1))
+for( i in c(1:14) ) {
+  hist(error.rate.eval[,i],
+       xlab=colnames(error.rate.eval)[i],
+       main=paste("Histogram for ",colnames(error.rate.eval)[i]))
+}
+dev.off()
 </code>

Applied Statistics and Data Mining

サイト用ツール

ユーザ用ツール

差分

サイト用ツール

ページ用ツール

ユーザ用ツール

差分