2020/6/6 2020/11/12 Rで機械学習：深層学習編 rstujioでは動く（ないようであり）

参考資料

https://shohei-doi.github.io/notes/posts/2019-05-28-deep-learning/

Rで機械学習：ディープラーニング：深層学習編

https://shohei-doi.github.io/notes/posts/2019-05-28-deep-learning/

Getting Started with Keras Overview

https://tensorflow.rstudio.com/guide/keras/

別の参照サイト

https://clean-copy-of-onenote.hatenablog.com/entry/r/keras_intro

https://ritsuan.com/blog/7384/

console下で次のコマンドを実行

install.packages(“devtools”) install.packages(“keras”) devtools::install_github(“rstudio/keras”) keras::install_keras()

install.packages(“reticulate”) install.packages(“tensorflow”) install.packages(“tfruns”) install.packages(“magrittr”) install.packages(“R6”) install.packages(“tools”)

install.packages(“curl”)

Author Affiliation 土井　翔平国立情報学研究所 Published May 28, 2019 はじめに深層学習による投票行動の予測深層学習による投票先の予測

＃はじめに＃深層学習あるいはディープラーニングはDeep Neural Networkと呼ばれるように、ニューラルネットを発展させたものになります。つまり、ニューラルネットでは一つしかなかった中間層を多層化したのがDNNになります。 TensorflowとはGoogleの開発した機械学習プラットフォームで、KerasはTensorflowをバックエンドにもつ深層学習用のPythonのパッケージになります。今回はR上でKerasを経由してTensorflowを使って深層学習を行ってみます。必要なパッケージのインストールまず、インストールしていない人はdevtoolsをインストールします

library(tidyverse)

## Warning: package 'tidyverse' was built under R version 3.6.2

## -- Attaching packages --------------------------------------------------------------------------- tidyverse 1.3.0 --

## √ tibble  2.1.3     √ dplyr   0.8.3
## √ tidyr   1.0.0     √ stringr 1.4.0
## √ readr   1.3.1     √ forcats 0.4.0
## √ purrr   0.3.3

## Warning: package 'readr' was built under R version 3.6.2

## Warning: package 'stringr' was built under R version 3.6.2

## Warning: package 'forcats' was built under R version 3.6.2

## -- Conflicts ------------------------------------------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()

library(caret)

## Warning: package 'caret' was built under R version 3.6.2

## Loading required package: lattice

## 
## Attaching package: 'caret'

## The following object is masked from 'package:purrr':
## 
##     lift

library(keras)

## Warning: package 'keras' was built under R version 3.6.3

install_keras()

## 
## Installation complete.

library(tensorflow)

## Warning: package 'tensorflow' was built under R version 3.6.3

## 
## Attaching package: 'tensorflow'

## The following object is masked from 'package:caret':
## 
##     train

install_tensorflow()

## 
## Installation complete.

必要なデータの読み込みと下ごしらえ例のごとく、東大・朝日共同調査の2014年衆院選・2016年参院選世論調査のデータを使います。各コードで何をしているのかは前回を参照してください。

data <- read_csv("2014_2016UTASV20161004.csv", 
                 locale = locale(encoding = "shift-jis"), na = c("66", "99", "999"))%>% 
  select(vote = W1Q1,
         party = W1Q2,
         sex = W1F1,
         age = W1F2,
         educ = W1F3,
         job = W1F4,
         W1Q7, W1Q8, W1Q9, W1Q10, W1Q11, W1Q12, W1Q13, W1Q14_1,
         W1Q15_1, W1Q15_2, W1Q15_3, W1Q15_4, W1Q15_5, W1Q15_6, 
         W1Q15_7, W1Q15_8, W1Q15_9, W1Q15_10, W1Q15_11, 
         W1Q16_1, W1Q16_2, W1Q16_3, W1Q16_4, W1Q16_5, W1Q16_6, 
         W1Q16_7, W1Q16_8, W1Q16_9, W1Q16_10, W1Q16_11, 
         W1Q16_12, W1Q16_13, W1Q16_14, W1Q16_15, W1Q16_16, W1Q16_17,
         W1Q17_1, W1Q17_2, W1Q17_3, W1Q17_4, W1Q17_5, W1Q17_6, 
         W1Q17_7, W1Q17_8, W1Q17_9, W1Q17_10, 
         W1Q18_1, W1Q19_1,
         W1Q20_1, W1Q20_2, W1Q20_3, W1Q20_4, W1Q20_5, W1Q20_6, W1Q20_7)%>% 
  mutate(vote = vote - 1,
         party = as.factor(party),
         sex = as.factor(sex),
         educ = as.factor(educ),
         job = as.factor(job))

## Parsed with column specification:
## cols(
##   .default = col_character(),
##   ID = col_double(),
##   PREFEC = col_double(),
##   HRDIST = col_double(),
##   W1Q1 = col_double(),
##   W1Q2 = col_double(),
##   W1Q3 = col_double(),
##   W1Q4 = col_double(),
##   W1Q5_1 = col_double(),
##   W1Q5_2 = col_double(),
##   W1Q5_3 = col_double(),
##   W1Q6 = col_double(),
##   W1Q7 = col_double(),
##   W1Q8 = col_double(),
##   W1Q9 = col_double(),
##   W1Q10 = col_double(),
##   W1Q11 = col_double(),
##   W1Q12 = col_double(),
##   W1Q13 = col_double(),
##   W1Q14_1 = col_double(),
##   W1Q14_2_1 = col_double()
##   # ... with 56 more columns
## )

## See spec(...) for full column specifications.

## Warning: 8 parsing failures.
##  row    col expected actual                         file
## 1810 PREFEC a double     -- '2014_2016UTASV20161004.csv'
## 1810 HRDIST a double     -- '2014_2016UTASV20161004.csv'
## 1811 PREFEC a double     -- '2014_2016UTASV20161004.csv'
## 1811 HRDIST a double     -- '2014_2016UTASV20161004.csv'
## 1812 PREFEC a double     -- '2014_2016UTASV20161004.csv'
## .... ...... ........ ...... ............................
## See problems(...) for more details.

シード値の設定いくつかの分析手法では乱数を用います。その名の通り乱数は毎回違う値が出てくるので、分析結果も変わってきます。そこで、乱数を発生させるときの基準となるシード値を設定することで、毎回同じ乱数が発生するようにします。

set.seed(334)

深層学習による投票行動の予測

まずは、投票に行くかどうかを深層学習によって予測します。投票に行くかどうかをtargetとして、投票先を取り除いたデータを作ります。そして、caretを使って訓練データと検証データに分けるためのインデックスを求めます。

data_vote <- data %>% 
  rename(target = vote) %>% 
  select(-party) %>% 
  drop_na()
ind_train <- createDataPartition(y = data_vote$target, p = 0.75, list = FALSE)

因子型になっている性別、学歴、職業をダミー変数に変換します。そして、訓練データと検証データに分けます。

data_vote_dummy <- dummyVars(~ ., data = data_vote)
data_vote <- predict(data_vote_dummy, data_vote) %>% 
as_tibble()
data_train <- data_vote[ind_train,]
data_test <- data_vote[-ind_train,]

Kerasでは入力引数は目的変数と特徴量の行列なので、それぞれ訓練データと検証データについて作成します。

y_train <- data_train %>% 
  select(contains("target")) %>% 
  as.matrix()
y_test <- data_test %>% 
  select(contains("target")) %>% 
  as.matrix()
x_train <- data_train %>% 
  select(-contains("target")) %>% 
  as.matrix()
x_test <- data_test %>% 
  select(-contains("target")) %>% 
  as.matrix()

特徴量行列の列数を見て入力層の数を確認します。

ncol(x_train)

## [1] 74

#keras_model_sequential()でモデルを初期化し、各レイヤーを定義していきます。 #最初の層ではinput_shapeで入力する変数の数を指定します。 #activationとは次のレイヤーに変数を送る際の変換方法を意味しています。 #とりあえず出力層以外はreluでいいと思います。 #出力層は今回はバイナリ変数なのでsigmoidを選びます。 #各レイヤーのunitsはノードの数になります。 #dropoutというのは全てのノードを使うのではなく、ランダムに一定の割合のノードだけを使って学習する方法です。 #これにより、過学習の可能性が低下すると考えられています。

model_vote <- keras_model_sequential()
model_vote %>% 
layer_dense(units = 256, activation = "relu", input_shape = c(74)) %>% 
layer_dropout(rate = 0.2) %>% 
layer_dense(units = 128, activation = "relu") %>% 
layer_dropout(rate = 0.2) %>% 
layer_dense(units = 64, activation = "relu") %>% 
layer_dropout(rate = 0.2) %>% 
layer_dense(units = 32, activation = "relu") %>% 
layer_dropout(rate = 0.2) %>% 
layer_dense(units = 1, activation = "sigmoid")

#続いて、定義したモデルをコンパイルします。 #lossとは学習において最小化する損失関数の種類になります。 #バイナリ変数が出力なのでbinary_crossentoropyを選択します。 #optimizerとは損失関数を最小化するためのアルゴリズムになります。 #いろいろありますが、とりあえずよく名前を聞くAdamを使います。 #metricsは予測精度の種類を指定します。 #今回はバイナリ変数なので的中率を採用します。

model_vote %>% 
  compile(loss = "binary_crossentropy",
          optimizer = optimizer_adam(),
          metrics = c("accuracy"))

#コンパイルしたモデルをデータにフィットさせます。 #epochsとは学習を繰り返す回数です。 #batch_sizeとは一回の学習で使用するデータの数です。 #全部のデータを一度に使わないことで過学習の可能性を低くすると考えられています。 #validation_splitは学習における評価を行うデータの割合です。

history <- model_vote %>% 
  fit(x_train, y_train,
      epochs = 30,
      batch_size = 100,
      validation_split = 0.2)

学習過程を可視化します。

plot(history)

検証データで予測精度を求めます。

model_vote %>% evaluate(x_test, y_test)

##      loss  accuracy 
## 0.5826418 0.6989619

深層学習による投票先の予測

続いて、どの政党に投票するかを予測します。概ね、先ほどと同じコードなので相違点だけ言及します。 targetをvoteではなくpartyにします。

data_party <- data %>% 
  rename(target = party) %>% 
  select(-vote) %>% 
  drop_na()
ind_train <- createDataPartition(y = data_party$target, p = 0.75, list = FALSE)
data_party_dummy <- dummyVars(~ ., data = data_party)
data_party <- predict(data_party_dummy, data_party) %>% 
  as_tibble()
data_train <- data_party[ind_train,]
data_test <- data_party[-ind_train,]
y_train <- data_train %>% 
  select(contains("target")) %>% 
  as.matrix()
y_test <- data_test %>% 
  select(contains("target")) %>% 
  as.matrix()
x_train <- data_train %>% 
  select(-contains("target")) %>% 
  as.matrix()
x_test <- data_test %>% 
  select(-contains("target")) %>% 
  as.matrix()
ncol(x_train)

## [1] 74

#出力層のノード数を10にして、activationをsoftmaxにします。

model_party <- keras_model_sequential()
model_party %>% 
  layer_dense(units = 256, activation = "relu", input_shape = c(74)) %>% 
  layer_dropout(rate = 0.2) %>% 
  layer_dense(units = 128, activation = "relu") %>% 
  layer_dropout(rate = 0.2) %>% 
  layer_dense(units = 64, activation = "relu") %>% 
  layer_dropout(rate = 0.2) %>% 
  layer_dense(units = 32, activation = "relu") %>% 
  layer_dropout(rate = 0.2) %>% 
  layer_dense(units = 10, activation = "softmax")

損失関数をcategorical_crossentoropyにします。

model_party %>% 
  compile(loss = "categorical_crossentropy",
          optimizer = optimizer_sgd(),
          metrics = c("accuracy"))
history <- model_party %>% 
  fit(x_train, y_train,
      epochs = 30,
      batch_size = 100,
      validation_split = 0.2)
plot(history)

model_party %>% evaluate(x_test, y_test)

##      loss  accuracy 
## 1.4083306 0.5735294

エポック数の増加もう少しepoch数を増やしても良さそうです。

history <- model_party %>% 
  fit(x_train, y_train,
      epochs = 100,
      batch_size = 100,
      validation_split = 0.2)
plot(history)

過学習今回のデータはサンプルサイズも変数の数も少ないのでドロップアウトやバッチ学習はいらないのかもしれません。

model_party <- keras_model_sequential()
model_party %>% 
  layer_dense(units = 256, activation = "relu", input_shape = c(74)) %>% 
  layer_dense(units = 128, activation = "relu") %>% 
  layer_dense(units = 64, activation = "relu") %>% 
  layer_dense(units = 32, activation = "relu") %>% 
  layer_dense(units = 10, activation = "softmax")

model_party %>% 
  compile(loss = "categorical_crossentropy",
          optimizer = optimizer_sgd(),
          metrics = c("accuracy"))

history <- model_party %>% 
  fit(x_train, y_train,
      epochs = 30,
      validation_split = 0.2)
plot(history)

model_party %>% evaluate(x_test, y_test)

##      loss  accuracy 
## 1.1632370 0.6519608

Deep Neural Network1

fumi

2020/11/12

Rで機械学習：ディープラーニング：深層学習編

Getting Started with Keras Overview

別の参照サイト

深層学習による投票行動の予測

深層学習による投票先の予測