神經網路 (Neural Network)

套件準備

神經網路於 R 中可以透過套件 nnet 來實作，可以用來建構與擬和隱藏層 (Hidden Layers)。

packageName <- c("nnet")
for(i in 1:length(packageName)) {
  if(!(packageName[i] %in% rownames(installed.packages()))) {
    install.packages(packageName[i])
  }
}
lapply(packageName, require, character.only = TRUE)

## Loading required package: nnet

## [[1]]
## [1] TRUE

資料準備

使用內建的 iris 資料集。iris 以鳶尾花的特徵作為資料來源，共含有 150 筆資料，分成 3 類，每類各 50 筆資料，每筆資料各有 4 個特徵。

類神經網路訓練的規律在樣本中，樣本需要足夠代表性，也需要注意樣本的均衡性及多樣性，盡量讓不同類的樣本數量大致相等為佳。本例中便是針對不同類別分別提取相同數量的樣本。其次透過函式 class.ind 處理分類標籤，回傳一分類向量，以 1,0 代表是否屬於該類別，似 one-hot encoding。

data(iris3)
set.seed(123)
Iris <- rbind(iris3[,,1],iris3[,,2],iris3[,,3])
class_encoding <- class.ind(c(rep("s",50), rep("c",50), rep("v",50)))
head(class_encoding, 5)

##      c s v
## [1,] 0 1 0
## [2,] 0 1 0
## [3,] 0 1 0
## [4,] 0 1 0
## [5,] 0 1 0

training_idx <- c(sample(1:50,25), sample(51:100,25), sample(101:150,25))
training_data.label <- class_encoding[training_idx, ]
training_data <- Iris[training_idx,]
testing_data <- Iris[-training_idx,]

建構網路

# the prototype of nnet
# x: 特徵矩陣
# y: 分類矩陣
# formula: 擬合公式，如 Class(輸出類別) ~ x1(屬性1) + x2(屬性2) + x3(屬性3) + ... 等
# data: 含有特徵與分類的資料框
# weights: 分類類別權重
# subset: 指定用來訓練的樣本
# na.action: 對缺失值的處理，如 na.pass, na.omit 等
# size: 隱藏層的神經元個數
# mask: 邏輯向量，用來表示那些參數需要被考慮用來建網路(默認為所有)
# linout: 線性輸出單元的開關，預設為 logistic 輸出函式
# entropy: 是否符合最大條件似然估計，預設為最小平方法(least-squares)
# softmax: 符合對數線型模型(log-linear model)或最大條件似然估計的開關，而 linout, entropy, softmax 與 censored 為互斥
# censored: softmax 的變種，產生出的結果表示所有可能的分類。舉例若 softmax 分類結果為 (0,1,1) 表示分類結果為第 2 `及`第 3 類，而若 censored 分類結果為 (0,1,1) 表示分類結果為第 2 `或`第 3 類
# skip: 在輸入或輸出之間是否設置跳層連接
# rang: 初始的隨機權重值定義範圍，及 [-rang, rang]
# decay: 權重參數的衰減率，預設為 0
# maxit: 最大反覆計算數值，預設為 100
# Hess: 若為真，則回傳最佳權值的 Hess Matrix
# trace: 列出每次優化過程
# MaxNWs: 設定最大權值，值越大擬合會越耗時
# abstol: 擬合終止條件，低於 abstol，表示達到可接受擬合
# reltol: 若優化一值無法達到設定標準，則當已優化參數已達到 1-reltol 時，則停止
nnet(formula, data, weights, subset, na.action, ...)
nnet(x, y, weights, size, Wts, mask,
     linout = FALSE, entropy = FALSE, softmax = FALSE,
     censored = FALSE, skip = FALSE, rang = 0.7, decay = 0,
     maxit = 100, Hess = FALSE, trace = TRUE, MaxNWts = 1000,
     abstol = 1.0e-4, reltol = 1.0e-8, ...)

建立網路模型，隱藏層數為 3, 隨機權重值為 0.1，權值衰減率為 5e-6，最大反覆計算次數為 800。 回傳值中 weights 表示共有幾個參數值(表示 node 間的加權值，此為訓練出的結果)，value 表示樣本誤差的值。而若有出現 converged 表示結果已經收斂，若是出現 stopped after N iterations 表示已達最大反覆計算次數，但尚未收斂。

iris.nn <- nnet(training_data, training_data.label, 
  size = 3, rang = 0.1, decay = 5e-6, maxit = 800)

## # weights:  27
## initial  value 55.301436 
## iter  10 value 29.067117
## iter  20 value 24.838476
## iter  30 value 24.679822
## iter  40 value 24.227996
## iter  50 value 23.692088
## iter  60 value 15.269172
## iter  70 value 2.341863
## iter  80 value 1.911406
## iter  90 value 0.527444
## iter 100 value 0.152829
## iter 110 value 0.074393
## iter 120 value 0.052010
## iter 130 value 0.051265
## iter 140 value 0.050785
## iter 150 value 0.050455
## iter 160 value 0.047093
## iter 170 value 0.040056
## iter 180 value 0.034578
## iter 190 value 0.032474
## iter 200 value 0.031081
## iter 210 value 0.030705
## iter 220 value 0.030299
## iter 230 value 0.029498
## iter 240 value 0.028170
## iter 250 value 0.027782
## iter 260 value 0.027312
## iter 270 value 0.026024
## iter 280 value 0.025265
## iter 290 value 0.024344
## iter 300 value 0.024214
## iter 310 value 0.023841
## iter 320 value 0.023572
## iter 330 value 0.023276
## iter 340 value 0.022862
## iter 350 value 0.022696
## iter 360 value 0.021970
## iter 370 value 0.021330
## iter 380 value 0.021274
## iter 390 value 0.020983
## iter 400 value 0.020424
## iter 410 value 0.019992
## iter 420 value 0.019920
## iter 430 value 0.019841
## iter 440 value 0.019618
## iter 450 value 0.019581
## iter 460 value 0.019521
## iter 470 value 0.019244
## iter 480 value 0.019136
## iter 490 value 0.019074
## iter 500 value 0.019037
## iter 510 value 0.018965
## iter 520 value 0.018892
## iter 530 value 0.018858
## iter 540 value 0.018841
## iter 550 value 0.018827
## iter 560 value 0.018817
## iter 570 value 0.018768
## iter 580 value 0.018673
## iter 590 value 0.018605
## iter 600 value 0.018586
## iter 610 value 0.018583
## iter 620 value 0.018569
## iter 630 value 0.018526
## iter 640 value 0.018500
## iter 650 value 0.018490
## iter 660 value 0.018484
## iter 670 value 0.018481
## iter 680 value 0.018467
## iter 690 value 0.018444
## iter 700 value 0.018430
## iter 710 value 0.018420
## iter 720 value 0.018418
## iter 730 value 0.018405
## iter 740 value 0.018383
## iter 750 value 0.018361
## iter 760 value 0.018352
## iter 770 value 0.018348
## iter 780 value 0.018333
## iter 790 value 0.018230
## iter 800 value 0.018192
## final  value 0.018192 
## stopped after 800 iterations

網路建置方式與權值

此網路共有 27 個參數，其中 21 個為權重值(weights)，5 個為偏差值(bias)。網路建構中 \(b\) 為 bias，\(i_n, n=1...k\) 表示輸入特徵值，而 \(o\) 為 output (輸出)的節點。

# 網路建置方式
summary(iris.nn)

## a 4-3-3 network with 27 weights
## options were - decay=5e-06
##  b->h1 i1->h1 i2->h1 i3->h1 i4->h1 
##  -0.48  -0.90  -2.15   3.42   1.39 
##  b->h2 i1->h2 i2->h2 i3->h2 i4->h2 
##   0.25   0.38   0.59  -1.04  -0.48 
##  b->h3 i1->h3 i2->h3 i3->h3 i4->h3 
## -31.03   2.36  -6.74   0.89  18.69 
##  b->o1 h1->o1 h2->o1 h3->o1 
##  -3.58  16.58  -3.16 -24.81 
##  b->o2 h1->o2 h2->o2 h3->o2 
##   4.35 -12.67   2.13  -1.32 
##  b->o3 h1->o3 h2->o3 h3->o3 
##  -7.06  -4.74  -4.80  24.54

# 網路層數中各有幾個 node 組成
iris.nn$n

## [1] 4 3 3

# 顯示出學習後的 node 間參數值
iris.nn$wts

##  [1]  -0.4781871  -0.9007472  -2.1457919   3.4163151   1.3867984
##  [6]   0.2493249   0.3775797   0.5929770  -1.0438995  -0.4807341
## [11] -31.0346038   2.3566526  -6.7415599   0.8862190  18.6948434
## [16]  -3.5819747  16.5835188  -3.1596877 -24.8122480   4.3491211
## [21] -12.6674290   2.1267045  -1.3185513  -7.0582985  -4.7446825
## [26]  -4.8026421  24.5434242

預測資料並建立列聯表

# max.col 會回傳該列(row)資料中值最大的行索引(column index)
iris.nn.test <- function(real, pred) {
  real.data <- max.col(real)
  pred.data <- max.col(pred)
  table(real.data, pred.data)
}
iris.nn.test(class_encoding[-training_idx,], predict(iris.nn, testing_data))

##          pred.data
## real.data  1  2  3
##         1 23  0  2
##         2  0 25  0
##         3  3  0 22

由上可以看出此模型分錯了 6 筆資料，sensitivity 約為 92%。

[optional] 透過擬合公式建立神經網路

• 準備資料

newIris <- data.frame(
  rbind(iris3[,,1],iris3[,,2],iris3[,,3]), 
  Species=factor(c(rep("s",50), rep("c",50), rep("v",50)))
)
head(newIris, 5)

##   Sepal.L. Sepal.W. Petal.L. Petal.W. Species
## 1      5.1      3.5      1.4      0.2       s
## 2      4.9      3.0      1.4      0.2       s
## 3      4.7      3.2      1.3      0.2       s
## 4      4.6      3.1      1.5      0.2       s
## 5      5.0      3.6      1.4      0.2       s

• 透過擬合公式建立神經網路

newIris.sample <- c(sample(1:50,25), sample(51:100,25), sample(101:150,25))
newIris.nn <- nnet(
  Species ~ ., newIris, subset = newIris.sample,
  size = 3, rang = 0.1, decay = 5e-6, maxit = 800
)

## # weights:  27
## initial  value 82.383168 
## iter  10 value 15.180689
## iter  20 value 0.607821
## iter  30 value 0.029309
## iter  40 value 0.022011
## iter  50 value 0.020369
## iter  60 value 0.018536
## iter  70 value 0.018208
## iter  80 value 0.017729
## iter  90 value 0.017310
## iter 100 value 0.016872
## iter 110 value 0.016294
## iter 120 value 0.015957
## iter 130 value 0.015622
## iter 140 value 0.015476
## iter 150 value 0.015126
## iter 160 value 0.014099
## iter 170 value 0.013485
## iter 180 value 0.013101
## iter 190 value 0.012998
## iter 200 value 0.012871
## iter 210 value 0.012762
## iter 220 value 0.012458
## iter 230 value 0.011633
## iter 240 value 0.011490
## iter 250 value 0.011445
## iter 260 value 0.011389
## iter 270 value 0.011308
## iter 280 value 0.011052
## iter 290 value 0.010976
## iter 300 value 0.010966
## iter 310 value 0.010953
## iter 320 value 0.010944
## iter 330 value 0.010911
## iter 340 value 0.010819
## iter 350 value 0.010772
## iter 360 value 0.010744
## iter 370 value 0.010738
## iter 380 value 0.010728
## iter 390 value 0.010708
## iter 400 value 0.010698
## iter 410 value 0.010689
## iter 420 value 0.010678
## iter 430 value 0.010674
## iter 440 value 0.010667
## iter 450 value 0.010619
## iter 460 value 0.010585
## iter 470 value 0.010575
## iter 480 value 0.010565
## iter 490 value 0.010560
## iter 500 value 0.010557
## iter 510 value 0.010554
## iter 520 value 0.010551
## iter 530 value 0.010548
## iter 540 value 0.010541
## iter 550 value 0.010532
## iter 560 value 0.010498
## iter 570 value 0.010474
## iter 580 value 0.010462
## iter 590 value 0.010457
## iter 600 value 0.010451
## iter 610 value 0.010448
## iter 620 value 0.010445
## iter 630 value 0.010444
## iter 640 value 0.010437
## iter 650 value 0.010412
## iter 660 value 0.010402
## iter 670 value 0.010397
## iter 680 value 0.010393
## iter 690 value 0.010387
## iter 700 value 0.010372
## iter 710 value 0.010368
## iter 720 value 0.010363
## iter 730 value 0.010357
## iter 740 value 0.010356
## iter 750 value 0.010354
## iter 760 value 0.010345
## iter 770 value 0.010332
## iter 780 value 0.010329
## iter 790 value 0.010319
## iter 800 value 0.010313
## final  value 0.010313 
## stopped after 800 iterations

• 預測結果並建立列聯表

table(
  newIris$Species[-newIris.sample], 
  predict(newIris.nn, newIris[-newIris.sample,], type = "class")
)

##    
##      c  s  v
##   c 23  0  2
##   s  0 25  0
##   v  1  0 24