UPDATE: 2022-12-03 20:50:03
WPからの引っ越し記事なのでレイアウトが崩れてます。
遅ればせながらニューラルネットワークについてまとめていきます。前回はニューラルネットワークについて、軽くおさらいしましたが、今回は3層の簡単なニューラルネットワークをスクラッチで実装していこうと思います。バックプロパゲーションとか意味不明という方は、「誤差逆伝播法をはじめからていねいに」が非常に丁寧かつ勉強になりますので、一読をおすすめします。本当に丁寧で連鎖率、最急降下法から解説されているので、本当に丁寧です。
モデルで使用する様々な関数を用意しておきます。使用するデータセットはirisです。データを正規化し、活性化関数のシグモイド関数と、バックプロパゲーションの際に使用するシグモイド関数の微分を用意しておきます。
library(tidyverse)
# 最小最大正規化
minmax <- function(x){
(x-min(x))/(max(x)-min(x))
}
target <- minmax(matrix(iris[,1]))
feature <- matrix(c(iris[,2], iris[,3], iris[,4]),150,3) %>%
apply(.,2,minmax)
# シグモイド関数
sigm <- function(x){
1 / (1 + exp(-x))
}
# シグモイド関数の導関数
deriv_sigm <- function(x){
x * (1 - x)
}ここでは、データを訓練するための条件を設定しておきます。繰り返し回数のepochは1万回、ラーニングレートは0.5としておきます。特徴量は3つで、隠れ層のニューロン数は5つです。重みとバイアスは乱数で設定しておきます。
# 初期化
epoch <- 10000
L_rate <- 0.5
in_lay_neuro <- ncol(feature)
hid_lay_neuro <- 5
out_neuro <- 1
# 重みとバイアスを初期化
# 入力層から隠れ層
hid_wgt <- matrix(rnorm(in_lay_neuro * hid_lay_neuro, 0, 1),
in_lay_neuro, hid_lay_neuro)
hid_bias <- matrix(rep(runif(hid_lay_neuro), nrow(feature)),
nrow = nrow(feature), byrow = FALSE)
# 隠れ層から出力層
out_wgt <- matrix(rnorm(hid_lay_neuro * out_neuro, 0, 1),
hid_lay_neuro, out_neuro)
out_bias <- matrix(rep(runif(out_neuro), nrow(feature)),
nrow = nrow(feature), byrow = FALSE)では、ニューラルネットワークを実行していきましょう。順伝搬させて、バックプロパゲーションで重みを更新させ、1万回繰り返すことによって学習させていきます。
# ニューラルネットワークを実行
for(i in 1:epoch){
# 順伝搬
hid_lay_in <- feature %*% hid_wgt + hid_bias # 特徴量*重み+バイアス
hid_lay_acts <- sigm(hid_lay_in) # シグモイド関数(特徴量*重み+バイアス)
out_lay_in <- hid_lay_acts %*% out_wgt + out_bias # 活性化された値*重み+バイアス
out_lay_acts <- sigm(out_lay_in) # シグモイド関数(活性化された値*重み+バイアス)
# 誤差逆伝搬
error <- target - out_lay_acts # 誤差
slp_out_lay <- deriv_sigm(out_lay_acts) # 出力層の微分
delta_out_lay <- error * slp_out_lay # デルタ1
slp_hid_lay <- deriv_sigm(hid_lay_acts) # 隠れ層の微分
delta_hid_lay <- delta_out_lay %*% t(out_wgt) * slp_hid_lay # デルタ2(出力層のデルタ1*隠れ層の重み*隠れ層の微分)
out_wgt <- out_wgt + (t(hid_lay_acts) %*% delta_out_lay) * L_rate # 既存値+修正量(デルタ1*隠れ層の値*学習係数)
out_bias <- out_bias + rowSums(delta_out_lay) * L_rate
hid_wgt <- hid_wgt + (t(feature) %*% delta_hid_lay) * L_rate #既存値+修正量(デルタ2*入力層の値*学習係数)
hid_bias <- hid_bias + rowSums(delta_hid_lay) * L_rate
}学習データへの当てはまりなので過学習している感がありますが、そこは本題ではないので、今回はどうでもいいです…テストセット作る気力がありませんでした…そんな手間でもないのですが…
tibble(pred = as.vector(out_lay_acts),
actu = as.vector(target)) %>%
mutate(diff = sqrt((pred - actu)^2))## # A tibble: 150 × 3
## pred actu diff
## <dbl> <dbl> <dbl>
## 1 0.222 0.222 0.00000363
## 2 0.167 0.167 0.00000835
## 3 0.111 0.111 0.0000107
## 4 0.0833 0.0833 0.0000167
## 5 0.194 0.194 0.00000233
## 6 0.306 0.306 0.000000628
## 7 0.0833 0.0833 0.0000139
## 8 0.194 0.194 0.00000328
## 9 0.0277 0.0278 0.0000890
## 10 0.167 0.167 0.00000724
## # … with 140 more rowstibble(pred = as.vector(out_lay_acts),
actu = as.vector(target)) %>%
mutate(diff = sqrt((pred - actu)^2)) %>%
summarise(RMSE = mean(diff))## # A tibble: 1 × 1
## RMSE
## <dbl>
## 1 0.000110{neuralnet}でやってみます。{neuralnet}については、前回の記事でおさらいしているので、時に解説はありません。
library(neuralnet)
df <- data.frame(Y = target,
X = feature)
ns <- neuralnet(Y ~ X.1+X.2+X.3,
dat = df,
hidden = 5, #隠れ層=1でノード数=1
err.fct = "sse", #クロスエントロピー
linear.output = FALSE) #出力層のニューロンに適用
plot(ns)output <- compute(ns, df[, -1])
tibble(pred = as.vector(output$net.result),
actu = as.vector(target)) %>%
mutate(diff = sqrt((pred - actu)^2)) ## # A tibble: 150 × 3
## pred actu diff
## <dbl> <dbl> <dbl>
## 1 0.202 0.222 0.0206
## 2 0.110 0.167 0.0570
## 3 0.127 0.111 0.0156
## 4 0.149 0.0833 0.0657
## 5 0.219 0.194 0.0247
## 6 0.295 0.306 0.0110
## 7 0.182 0.0833 0.0991
## 8 0.201 0.194 0.00698
## 9 0.0904 0.0278 0.0626
## 10 0.138 0.167 0.0291
## # … with 140 more rowsさきほどと似たような結果が返ってきています。パッケージって本当に便利ですね。ありがたい。