この章では、層を1つ追加して3層にします。
引き続きKaggleの手書き文字認識をします。
http://www.kaggle.com/c/digit-recognizer
とりあえずデータを読み込みます。
setwd("/Users/KeiHarada/Documents/digit")
# read data
traindata <- read.csv("ORG/train.csv")
testdata <- read.csv("ORG/test.csv")
train_label <- traindata$label[1:28000]
valid_label <- traindata$label[28001:42000]
ここでは28*28のまま扱います。
train_mat <- as.matrix(traindata[1:28000,-1])
# check
image(matrix(train_mat[1,],ncol=28))
まずは復習を兼ねて、4×4のエリアの平均値をとって、7×7の画像とし、そこからニューラルネットワークで学習してみましょう。 ここでは平均値が127より大きいかどうかで0/1に変換します。 ちょっと工夫して行列の演算を利用して変換します。
meanMat <- matrix(0.0,nrow=28*28,ncol=49)
for (i in seq(7)){
for (j in seq(7)){
tempmat <- matrix(0.0,nrow=28,ncol=28)
tempmat[((4*i-3):(4*i)),((4*j-3):(4*j))] <- 1.0/16.0
meanMat[,7*(j-1)+i] <- as.numeric(tempmat)
}
}
train49_mat_mean <- sign(train_mat %*% meanMat - 127)
うまくできてるかチェックしましょう。
image(matrix(train49_mat_mean[1,],nrow=7))
次に、学習のために正解を用意します。
answer_mat <- matrix(0,nrow=28000,ncol=10)
for (i in seq(10)){
answer_mat[train_label==(i-1),i] <- 1
}
では、学習させてみましょう。
# learn weights
W <- matrix(0.0,nrow=10,ncol=49)
intercept <- rep(0.0,length=10)
# learn rate
eta <- 0.001
for (i in seq(28000)){
# feed forward
output <- 1 / (1 + exp(-1*(W %*% train49_mat_mean[i,] + intercept)))
# back propagation
W <- W + eta * (answer_mat[i,] - output) %*% t(train49_mat_mean[i,])
intercept <- intercept + eta * (answer_mat[i,] - output)
}
出力の計算
output_mat <- 1 / (1 + exp(-1*(train49_mat_mean %*% t(W) + matrix(1,nrow=28000,ncol=1) %*% matrix(intercept,ncol=10))))
trainres <- max.col(as.matrix(output_mat)) - 1
Confusion Matrix
table(trainres,train_label)
## train_label
## trainres 0 1 2 3 4 5 6 7 8 9
## 0 2185 1 58 61 18 115 72 20 46 19
## 1 46 2766 217 293 205 415 280 233 546 316
## 2 41 13 1628 62 79 30 126 50 88 29
## 3 90 41 223 2018 52 441 77 26 278 89
## 4 12 0 54 27 1223 109 88 35 68 410
## 5 141 23 59 146 54 876 76 41 64 87
## 6 100 5 241 25 245 78 1887 19 79 120
## 7 67 69 118 116 145 190 42 2338 81 521
## 8 22 187 210 89 68 155 101 27 1366 88
## 9 17 2 16 72 667 112 30 135 78 1086
Categorization Accuracy
mean(trainres == train_label)
## [1] 0.6204643
最大値よりも精度が落ちてますね。
ここで、さきほどの平均を取る作業もニューラルネットの一部とみなします。
# learn weights
W1 <- t(meanMat)
intercept1 <- rep(-127.0,length=49)
W2 <- matrix(0.0,nrow=10,ncol=49)
intercept2 <- rep(0.0,length=10)
# learn rate
eta1 <- 0.001
eta2 <- 0.001
for (i in seq(28000)){
# feed forward
output1 <- 1 / (1 + exp(-1*(W1 %*% train_mat[i,] + intercept1)))
output2 <- 1 / (1 + exp(-1*(W2 %*% output1 + intercept2)))
# back propagation
W2 <- W2 + eta2 * (answer_mat[i,] - output2) %*% t(output1)
intercept2 <- intercept2 + eta2 * (answer_mat[i,] - output2)
W1 <- W1 + eta1 * ((output1*(1-output1)) * (t(W2) %*% (answer_mat[i,] - output2))) %*% t(train_mat[i,])
intercept1 <- intercept1 + eta1 * (output1*(1-output1)) * (t(W2) %*% (answer_mat[i,] - output2))
}
出力の計算
output_mat1 <- 1 / (1 + exp(-1*(train_mat %*% t(W1) + matrix(1,nrow=28000,ncol=1) %*% matrix(intercept1,ncol=49))))
output_mat2 <- 1 / (1 + exp(-1*(output_mat1 %*% t(W2) + matrix(1,nrow=28000,ncol=1) %*% matrix(intercept2,ncol=10))))
trainres <- max.col(as.matrix(output_mat2)) - 1
Confusion Matrix
table(trainres,train_label)
## train_label
## trainres 0 1 2 3 4 5 6 7 8 9
## 0 2529 1 51 36 15 411 81 34 138 30
## 1 0 2910 42 20 17 68 12 80 59 16
## 2 38 17 1923 99 10 62 44 21 72 4
## 3 20 40 330 2513 0 1016 1 40 307 70
## 4 7 1 30 5 2199 30 17 48 17 459
## 5 0 2 0 4 0 243 1 0 3 0
## 6 66 21 276 54 244 137 2607 22 94 46
## 7 10 5 31 65 179 49 0 2607 133 1958
## 8 50 110 138 112 51 492 16 36 1869 103
## 9 1 0 3 1 41 13 0 36 2 79
Categorization Accuracy
mean(trainres == train_label)
## [1] 0.6956786
だいぶ精度が上がりました。