第2層 層の追加

この章では、層を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

だいぶ精度が上がりました。