差分

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

この比較画面へのリンク

両方とも前のリビジョン前のリビジョン
次のリビジョン		前のリビジョン
dmb:2011:q1 [2011/11/07 09:41] – [コード] wataludmb:2011:q1 [不明な日付] (現在) – 外部編集 (不明な日付) 127.0.0.1
行 1: 行 1:
-==== 学習誤差と予測誤差 ====+==== 課題#1 学習誤差と予測誤差 ==== 
 + 
 +  - 初稿 2011.11.07 
 +  - 第二稿 2011.11.10 
 + 
 +=== はじめに === 
 + 
 +今回は比較的単純な課題です． 
 + 
 +  - 線形学習機械の最小二乗学習とk最近接機械の誤判別率を，シミュレーションを用いて比較しなさい． 
 +  - 今回のシミュレーション設定に対して，最適なkを決めてみなさい． 
 +  - 学習用データによる誤判別率の推定と検証ゥデータによる誤判別率の推定を比較して考察しなさい． 
 + 
 +〆切は来週の月曜日の2限が始まる時刻まで，とします．Word形式のレポートファイルの送付先は，[[mailto:data.mining.finale_at_gmail.com]]です．(_at_を半角の＠マークで置き換えてください) 
 + 
 +コードは，解説付きのコードの一番下に「貼り付け用」を別に用意したので，そちらを使うと良いです．いきなり全部をコピーするのでなく，四角囲みごとに．
 === コード === === コード ===
 +<code>
 +# データを発生させる関数
 +generate.data <- function(n, p, k, setting) {
 +  # 最初に空の変数を作るとあとのコードが便利
 +  X <- NULL
 +  y <- NULL
 +  
 +  if( setting==1 ) {
 +    X <- rbind(X, 
 +               cbind(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)) ) ) )
 +    X <- rbind(X,
 +               cbind(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)) ) ) ) 
 +    Data <- cbind(X,y)
 +    colnames(Data) <- c("X.1", "X.2", "y")
 +    # 最後にデータのランダムな並べ替え
 +    Data.ret <- Data[sample(c(1:n)),]
 +    return(Data.ret)
 +  }
 +}
 +
 +# データセットを最初のn.learnレコードを学習用に，残りを検証用に，分割する関数
 +split.data <- function(dataset, n.learn) {
 +  data.learn <- dataset[c(1:n.learn),]
 +  data.eval <- dataset[-c(1:n.learn),]
 +  return(list(learn=data.learn, eval=data.eval))
 +}
 +</code>
 +
 +<code>
 +# シミュレーション回数
 +m <- 1000
 +# データの変数の次元 (今回は未使用の変数)
 +p <- 2
 +# クラス数 (これも今回は未使用の変数)
 +k <- 2
 +# 学習用データのレコード数
 +n.learn <- 50
 +# 検証用データのレコード数
 +n.eval <- 20
 +# サンプル数
 +n <- n.learn + n.eval
 +</code>
 +
 +<code>
 +# {}内に書かれたシミュレーションをm回繰り返す．
 +error.rate.eval <- NULL
 +error.rate.learn <- NULL
 +for( i in c(1:m) ) {
 +    # データの生成と分割
 +    data.gen <- generate.data(n,2,2,setting=1)
 +    data.split <- split.data(data.gen, n.learn)
 +    data.learn <- data.frame(data.split$learn)
 +    data.eval <- data.frame(data.split$eval)
 +    # 準備
 +    error.temp.learn <- NULL
 +    error.temp.eval <- NULL
 +    # 各種学習機械の適用
 +    # 線形学習機械の最小二乗学習
 +    data.lm <- lm(y~X.1+X.2, data=data.learn)
 +    data.fit <- fitted(data.lm)
 +    data.pred <- predict(data.lm, newdata=data.eval)
 +#    print(data.eval$y-data.pred)
 +#    print(sum(abs(data.eval$y-data.pred)<0.5)/n.eval)
 +#    print(data.learn$y-data.fit)
 +#    print(sum(abs(data.learn$y-data.fit)<0.5)/n.learn)
 +    # 学習用データの当てはめ誤差
 +    error.temp.learn <- append(error.temp.learn, 
 +                                        1-sum(abs(data.learn$y-data.fit)<0.5)/n.learn)
 +    # 検証用データの当てはめ誤差
 +    error.temp.eval <- append(error.temp.eval, 
 +                                        1-sum(abs(data.eval$y-data.pred)<0.5)/n.eval)
 +    # k-最近接機械でk=1
 +    data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)], 
 +                    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)  
 +    error.temp.learn <- append(error.temp.learn, 
 +                               1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
 +    error.temp.eval <- append(error.temp.eval, 
 +                              1-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)  
 +    data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)], 
 +                     k=3, prob=FALSE)  
 +    error.temp.learn <- append(error.temp.learn, 
 +                               1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
 +    error.temp.eval <- append(error.temp.eval, 
 +                              1-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)  
 +    data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)], 
 +                     k=5, prob=FALSE)  
 +    error.temp.learn <- append(error.temp.learn, 
 +                               1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
 +    error.temp.eval <- append(error.temp.eval, 
 +                              1-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)  
 +    data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)], 
 +                     k=7, prob=FALSE)  
 +    error.temp.learn <- append(error.temp.learn, 
 +                               1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
 +    error.temp.eval <- append(error.temp.eval, 
 +                              1-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)  
 +    data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)], 
 +                     k=9, prob=FALSE)  
 +    error.temp.learn <- append(error.temp.learn, 
 +                               1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
 +    error.temp.eval <- append(error.temp.eval, 
 +                              1-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)  
 +    data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)], 
 +                     k=15, prob=FALSE)  
 +    error.temp.learn <- append(error.temp.learn, 
 +                               1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
 +    error.temp.eval <- append(error.temp.eval, 
 +                              1-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)  
 +    data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)], 
 +                     k=21, prob=FALSE)  
 +    error.temp.learn <- append(error.temp.learn, 
 +                               1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
 +    error.temp.eval <- append(error.temp.eval, 
 +                              1-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)  
 +    data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)], 
 +                     k=31, prob=FALSE)  
 +    error.temp.learn <- append(error.temp.learn, 
 +                               1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
 +    error.temp.eval <- append(error.temp.eval, 
 +                              1-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)  
 +    data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)], 
 +                     k=51, prob=FALSE)  
 +    error.temp.learn <- append(error.temp.learn, 
 +                               1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
 +    error.temp.eval <- append(error.temp.eval, 
 +                              1-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)  
 +    data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)], 
 +                     k=75, prob=FALSE)  
 +    error.temp.learn <- append(error.temp.learn, 
 +                               1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
 +    error.temp.eval <- append(error.temp.eval, 
 +                              1-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)  
 +    data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)], 
 +                     k=101, prob=FALSE)  
 +    error.temp.learn <- append(error.temp.learn, 
 +                               1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
 +    error.temp.eval <- append(error.temp.eval, 
 +                              1-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)  
 +    data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)], 
 +                     k=201, prob=FALSE)  
 +    error.temp.learn <- append(error.temp.learn, 
 +                               1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
 +    error.temp.eval <- append(error.temp.eval, 
 +                              1-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)  
 +    data.pred <- knn(data.learn[,c(1:2)], data.eval[,c(1:2)], data.learn[,c(3)], 
 +                     k=301, prob=FALSE)  
 +    error.temp.learn <- append(error.temp.learn, 
 +                               1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
 +    error.temp.eval <- append(error.temp.eval, 
 +                              1-sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
 +
 +   # 上の結果の回収
 +    error.rate.learn <- rbind(error.rate.learn, error.temp.learn)
 +    error.rate.eval <- rbind(error.rate.eval, error.temp.eval)
 +}
 +
 +# 最後に少しお化粧
 +colnames(error.rate.learn) <- c("lm", "knn.1", "knn.3", "knn.5", "knn.7", 
 +                      "knn.9", "knn.15", "knn.21", "knn.25", "knn.51", "knn.75", 
 +                      "knn.101", "knn.201", "knn.301")
 +rownames(error.rate.learn) <- c(1:m)
 +colnames(error.rate.eval) <- c("lm", "knn.1", "knn.3", "knn.5", "knn.7", 
 +                      "knn.9", "knn.15", "knn.21", "knn.25", "knn.51", "knn.75", 
 +                      "knn.101", "knn.201", "knn.301")
 +rownames(error.rate.eval) <- c(1:m)
 +</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>
  
 == 貼り付け用 == == 貼り付け用 ==
行 13: 行 266:
   if( setting==1 ) {   if( setting==1 ) {
     X <- rbind(X,      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,     y <- rbind(y,
-                   as.matrix(array(0, dim=c(ceiling(n/2)) ) ) )+               as.matrix(array(0, dim=c(ceiling(n/2)) ) ) )
     X <- rbind(X,     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,     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)     Data <- cbind(X,y)
     colnames(Data) <- c("X.1", "X.2", "y")     colnames(Data) <- c("X.1", "X.2", "y")
行 64: 行 317:
     data.fit <- fitted(data.lm)     data.fit <- fitted(data.lm)
     error.temp.learn <- append(error.temp.learn,      error.temp.learn <- append(error.temp.learn, 
-                                        1-sum(abs(data.learn$y-data.fit)<0.5)/n.learn)+                               1-sum(abs(data.learn$y-data.fit)<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,      error.temp.eval <- append(error.temp.eval, 
-                                        1-sum(abs(data.eval$y-data.pred)<0.5)/n.eval)+                              1-sum(abs(data.eval$y-data.pred)<0.5)/n.eval)
  
     # knn:1     # knn:1
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],      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)],      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,      error.temp.learn <- append(error.temp.learn, 
-                                        1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)+                               1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,      error.temp.eval <- append(error.temp.eval, 
-                                        1-sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)+                              1-sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # knn:3     # knn:3
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(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)],      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,      error.temp.learn <- append(error.temp.learn, 
-                                        1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)+                               1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,      error.temp.eval <- append(error.temp.eval, 
-                                        1-sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)+                              1-sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # knn:5     # knn:5
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],      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)],      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,      error.temp.learn <- append(error.temp.learn, 
-                                        1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)+                               1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,      error.temp.eval <- append(error.temp.eval, 
-                                        1-sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)+                              1-sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # knn:7     # knn:7
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],      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)],      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,      error.temp.learn <- append(error.temp.learn, 
-                                        1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)+                               1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,      error.temp.eval <- append(error.temp.eval, 
-                                        1-sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)+                              1-sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # knn:9     # knn:9
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],      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)],      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,      error.temp.learn <- append(error.temp.learn, 
-                                        1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)+                               1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,      error.temp.eval <- append(error.temp.eval, 
-                                        1-sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)+                              1-sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # knn:15     # knn:15
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],      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)],      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,      error.temp.learn <- append(error.temp.learn, 
-                                        1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)+                               1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,      error.temp.eval <- append(error.temp.eval, 
-                                        1-sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)+                              1-sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # knn:21     # knn:21
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],      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)],      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,      error.temp.learn <- append(error.temp.learn, 
-                                        1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)+                               1-sum(abs(data.learn$y-(as.numeric(data.fit)-1))<0.5)/n.learn)
     error.temp.eval <- append(error.temp.eval,      error.temp.eval <- append(error.temp.eval, 
-                                        1-sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)+                              1-sum(abs(data.eval$y-(as.numeric(data.pred)-1))<0.5)/n.eval)
     # knn:25     # knn:25
     data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)],      data.fit <- knn(data.learn[,c(1:2)], data.learn[,c(1:2)], data.learn[,c(3)], 
行 199: 行 452:
 </code> </code>
  
-結果のグラフ 
 <code> <code>
 boxplot(error.rate.learn) boxplot(error.rate.learn)
 +apply(error.rate.learn,2,"mean")
 +sqrt(apply(error.rate.learn,2,"var"))
 </code> </code>
  
-結果のグラフ +
 <code> <code>
 boxplot(error.rate.eval) 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> </code>