이 기사는 플롬 스크래치 Advent Calendar 2016의 11 일째 기사입니다.

최근에는 Python에서 TensorFlow나 Chainer를 사용해 보는 것이 유행하고 있습니다만, 이번은 굳이 R의 신경망 패키지인 neuralnet 를 사용해 보았습니다.

공식 레퍼런스의 neuralnet.pdf 에 있는 샘플 코드를 참고로 합니다.

가정 독자

신경망을 공부 한 적이있는 사람

통계학 공부를 한 적이 있는 사람

R을 만진 적이있는 사람

R에서 신경망을 사용하고 싶은 사람

준비

패키지를 설치합니다.

> install.packages("neuralnet")
> library("neuralnet")

XOR 문제

단순 퍼셉트론에서는 학습할 수 없는 XOR 학습을 합니다.
첫째, 데이터 준비.

> XOR <- c(0,1,1,0)
> xor.data <- data.frame(expand.grid(c(0,1), c(0,1)), XOR)

xor.data는 다음과 같습니다.

> xor.data
  Var1 Var2 XOR
1    0    0   0
2    1    0   1
3    0    1   1
4    1    1   0

그리고 신경망을 구축합니다.

net.xor <- neuralnet(XOR~Var1+Var2, xor.data, hidden=4, rep=5)

첫 번째 인수는 모델이고 두 번째 인수는 훈련 데이터입니다. 또한 hidden는 숨겨진 뉴런 수를 지정하고 rep는 훈련 횟수를 지정합니다.
(레퍼런스에서는 숨겨진 뉴런을 2로 하고 있었지만, 학습의 정밀도가 낮았기 때문에 4로 하고 있습니다.)

네트워크로서는 이렇게 됩니다.

> plot(net.xor, rep="best")

rep="best" 에 의해 오차가 가장 작은 것을 플롯하고 있습니다.

net.xor가 올바르게 XOR을 나타내는지 확인합니다.

> xor.data[-3]
  Var1 Var2
1    0    0
2    1    0
3    0    1
4    1    1

> compute(net.xor, xor.data[-3])$net.result
                [,1]
[1,] -0.005591322981
[2,]  0.991365312571
[3,]  1.003765769383
[4,]  0.006757999021

네 개의 입력에 대해 각각 대체로 정확한 대답을 얻었습니다.

불임 데이터의 로지스틱 회귀

다음은 불임에 대한 데이터를 다룹니다.
(센시티브한 데이터입니다만, 레퍼런스로 사용하고 있었으므로..)

> data(infert, package="datasets")
> infert
    education age parity induced case spontaneous stratum pooled.stratum
1      0-5yrs  26      6       1    1           2       1              3
2      0-5yrs  42      1       1    1           0       2              1
3      0-5yrs  39      6       2    1           0       3              4
4      0-5yrs  34      4       2    1           0       4              2
5     6-11yrs  35      3       1    1           1       5             32
6     6-11yrs  36      4       2    1           1       6             36
7     6-11yrs  23      1       0    1           0       7              6
8     6-11yrs  32      2       0    1           0       8             22
9     6-11yrs  21      1       0    1           1       9              5
10    6-11yrs  28      2       0    1           0      10             19
11    6-11yrs  29      2       1    1           0      11             20
12    6-11yrs  37      4       2    1           1      12             37
13    6-11yrs  31      1       1    1           0      13              9
14    6-11yrs  29      3       2    1           0      14             29
15    6-11yrs  31      2       1    1           1      15             21
16    6-11yrs  27      2       2    1           0      16             18
17    6-11yrs  30      5       2    1           1      17             38
18    6-11yrs  26      1       0    1           1      18              7
19    6-11yrs  25      3       2    1           1      19             28
20    6-11yrs  44      1       0    1           1      20             17
...(省略)
 [ reached getOption("max.print") -- omitted 123 rows ]

데이터 설명은 여기을 참조하십시오.
자연·인공유산 후의 불임증에 대한 데이터입니다.

네트워크를 구축합니다.

net.infert <- neuralnet(case~parity+induced+spontaneous, infert,　err.fct="ce", linear.output=FALSE, likelihood=TRUE)

피험자인지 대조군인지를 나타내는 case 를 목적변수로 하고, parity (실험횟수?), induced (인공유산), spontaneous .err.fct 는 오차 함수를 지정합니다. ce 의 경우는 크로스 엔트로피, sse 의 경우는 제곱 오차가 됩니다. 기본적으로 제곱 오차입니다.linear.output 는 act.fct 를 출력 레이어의 뉴런에 적용하지 않으려면 TRUE 로, 적용하려면 FALSE 로 설정합니다.act.fct 는 활성화 함수를 지정합니다. 기본적으로 로지스틱 함수입니다.likelihood가 TRUE이면 오차 함수가 음의 로그 우도와 동등하면 정보량 표준의 AIC와 BIC가 계산됩니다.

그런 다음 gwplot 에서 각 공변량의 목적 변수에 대한 Generalized Weight를 플롯합니다.

> par(mfrow = c(1,3))
> gwplot(net.infert, selected.covariate="parity", max=3.5, min=-2)
> gwplot(net.infert, selected.covariate="parity", max=3.5, min=-2)
> gwplot(net.infert, selected.covariate="induced", max=3.5, min=-2)
> gwplot(net.infert, selected.covariate="spontaneous", max=3.5, min=-2)

Generalized Weight는 공변량이 목표 변수에 미치는 영향도를 나타냅니다. 0 부근에 모이는 경우는 너무 영향을 주지 않는 것을 나타냅니다.spontaneous 는 다른 것에 비해 영향도가 큰 것일지도 모릅니다.

마지막으로 confidence.interval 에서 Generalized Weight의 신뢰 구간과 NIC를 계산합니다.

confidence.interval(net.infert)
$lower.ci
$lower.ci[[1]]
$lower.ci[[1]][[1]]
              [,1]
[1,]  0.2378732931
[2,] -0.7767930421
[3,] -5.6821658449
[4,] -8.7671639096

$lower.ci[[1]][[2]]
              [,1]
[1,] -0.7548627922
[2,] -6.4897821363



$upper.ci
$upper.ci[[1]]
$upper.ci[[1]][[1]]
             [,1]
[1,] 2.8480852032
[2,] 4.5389670051
[3,] 0.7944060804
[4,] 1.0157270261

$upper.ci[[1]][[2]]
              [,1]
[1,]  4.3246718745
[2,] -0.7591746629



$nic
[1] 135.6941297

다음에 하고 싶은 일

R의 신경망 패키지는 그 밖에도 「 nnet 」라고 하는 것이 있기 때문에, 다음은 그것을 만져 보자고 생각합니다.

참고