RでKerasを用いた順序関係があるカテゴリ分類を試してみた（その６）

1.はじめに

回帰問題として使われることが多い米国ボストン市郊外における地域別の住宅価格のデータセットを、機械学習mlrパッケージを用いてカテゴリ分類にチャレンジしてみました。
機械学習パッケージmlrを使った順序関係があるカテゴリ分類（その１）
機械学習パッケージmlrを使った順序関係があるカテゴリ分類（その２）
機械学習パッケージmlrを使った順序関係があるカテゴリ分類（その３）
機械学習パッケージmlrを使った順序関係があるカテゴリ分類（その４）
機械学習パッケージmlrを使った順序関係があるカテゴリ分類（その５）

まだ、ニューラルネットワークは試していなかったので、今回試してみることにします。
mlrではなく、深層学習のフレームワークで有名なkerasパッケージを使ってみます。

2.環境

OS :Ubuntu 18.04.5 LTS
R :Version4.0.2
RStudio :Version 1.3.1073

ANACONDAを使ってPython3.7をインストール済みです。
kerasパッケージはPythonのAPIを使っているので、必須になります。
参考：RでKeras（インストール + チュートリアル）

library(tidyverse)
library(keras)

3.データの準備

前回までと同様のデータを準備します。

data(BostonHousing, package = "mlbench")
df = BostonHousing
df$medvC = cut(df$medv,breaks =3,labels =c(1,2,3))
n = nrow(df)
train.set = scan("train.txt")　　　　　#第1回目で保存したもの
test.set = setdiff(1:n, train.set)

$>Read 354 items

訓練データを準備します。
目的変数をtrain_Yとして分離します。

train_X = df[train.set,-c(14:15)]
train_Y = as.numeric(df[train.set,15])-1
train_Y = to_categorical(train_Y)

目的変数はOne-Hot-エンコーディングしました。
dim(train_X)で、次元を確認します。

dim(train_X)

$>[1] 354  13

train_Xは２次元データになり、最初の次元はデータ数、次の次元は特徴量になります。

4.データの正規化

ニューラルネットワークにデータを入れる場合は正規化する必要があるので、正規化します。

mean = apply(train_X,2,mean)
std = apply(train_X,2,sd)
train_X = scale(train_X,center = mean,scale = std)

５.モデルの構築

256パーセプトロン、ドロップアウト層を挟んで、2層のニューラルネットワークを構築します。

model = keras_model_sequential()
model %>% 
  layer_dense(256,activation="relu",
              input_shape = dim(train_X)[2]) %>% 
  layer_dropout(0.25) %>%
  layer_dense(256,activation="relu") %>% 
  layer_dropout(0.25) %>%
  layer_dense(3,activation = "softmax")

model %>% compile(
  optimizer ="adam",
  loss="categorical_crossentropy",
  metrics=c("accuracy")
)

ネットワークの構造は次のとおりです。

model

$>Model
$>Model: "sequential_3"
$>______________________________________________________________________________
$>Layer (type)                       Output Shape                   Param #     
$>==============================================================================
$>dense_9 (Dense)                    (None, 256)                    3584        
$>______________________________________________________________________________
$>dropout_6 (Dropout)                (None, 256)                    0           
$>______________________________________________________________________________
$>dense_10 (Dense)                   (None, 256)                    65792       
$>______________________________________________________________________________
$>dropout_7 (Dropout)                (None, 256)                    0           
$>______________________________________________________________________________
$>dense_11 (Dense)                   (None, 3)                      771         
$>==============================================================================
$>Total params: 70,147
$>Trainable params: 70,147
$>Non-trainable params: 0
$>______________________________________________________________________________

今回のデータは、２次元データのため、１層目のinput_shapeは、特徴量の次元を指定しました。
最初の次元はデータ数のため、特に指定する必要はありません。
データの構造によって、input_shapeは次元数を指定する必要があります。

５.交差検証法を用いたモデルの訓練データの適合

訓練データをさらに検証データに分割し、４分割の交差検証法による訓練データを適合させます。
交差検証の結果はall_scoresに入れます。

k =4
indices = sample(1:nrow(train_X))
folds = cut(1:length(indices), breaks = k,labels = F)

num_epochs = 20
all_scores =c()
for (i in 1:k){
  val_indices = which(folds == i,arr.ind = T)
  val_data = train_X[val_indices,]
  val_targets = train_Y[val_indices,]
  partial_data = train_X[-val_indices,]
  partial_targets = train_Y[-val_indices,]
  
  results = model %>% fit(partial_data,partial_targets,
                epochs=num_epochs,batch_size=16,
                verbose=1,validation_data=list(val_data, val_targets))
  all_scores =c(all_scores,results$metrics$val_accuracy[num_epochs])
  
}

　〜省略〜
$>Epoch 19/20
$>17/17 [==============================] - 0s 13ms/step - loss: 0.0052 - accuracy: 1.0000 - val_loss: $>0.0493 - val_accuracy: 0.9888
$>Epoch 20/20
$>17/17 [==============================] - 0s 14ms/step - loss: 0.0076 - accuracy: 0.9962 - val_loss: $>0.0418 - val_accuracy: 0.9888

RStudioを使っていると、自動的に上のような学習の進行状況のグラフが描かれます。
この点は、Python版よりも優れているところです。
検証結果の平均は

mean(all_scores)

$>[1] 0.9830184

accuracyは0.98と非常に高くなりました。
早速、テストデータにfitさせてみます。

6.テストデータによる検証

まずテストデータを準備します。

test_X = df[test.set,-c(14:15)]
test_Y = as.numeric(df[test.set,15])-1
test_Y = to_categorical(test_Y)

mean = apply(test_X,2,mean)
std = apply(test_X,2,sd)
test_X = scale(test_X,center = mean,scale = std)

テストデータをモデルにfitさせます。

result_test = model %>% predict(test_X,batch_size=16, verbose=0)

result_test = apply(result_test,1,which.max)

accuracy,kappaを求めます。

library(Metrics)
accuracy(result_test,df[test.set,15])
ScoreQuadraticWeightedKappa(result_test,df[test.set,15])
table(df[test.set,15],result_test )

$>[1] 0.8223684   #accuracy
$>[1] 0.8034483   #kappa
$>   result_test
$>     1  2  3
$>  1 62  9  0
$>  2  8 51  3
$>  3  0  7 12

全体的な評価であるkappa0.80と非常に優れた結果になりましたが、クラス１の誤分類率が0.13、クラス２の誤分類率が0.18、クラス３の誤分類率が0.37とクラス３が特に悪くなりました。