【Rで機械学習】LSTM-RNNを仮想数列で実験してみる。
前からなんとなく気になっていたLSTM-RNN。
LSTM-RNN（Long short-term memory Recurrent Neural Network）とは・・・なんて話をしだすときりがないので、以下のリンク先をみてください。
要は時系列データを学習するニューラルネットワークの一種なんだけれども、学習させるデータが長すぎたりするといろいろ問題が起こるので、「忘れる」という状態も組み込んだ学習モデルにしよう、というもの。リンク先にもあるように、近年、機械翻訳など、自然言語処理の分野で目覚ましい成果を挙げているそうで、テキストマイニングでごにょごにょやっている人間としてはいつか手をだしてみよう、と思っていたものです。
で、ようやく時間ができたのであれこれ試してみよう、と思い立ち、いつも参考にさせてもらっているこちらを見ながらあれこれ考えてみました。
ひとまず例示にあるような、文章を学習させるモデルを考えたのですが、すでに実験されているように、夏目漱石の上記の例でもなかなか良い予測ができず、自前で宮沢賢治の文章を用意してやってみたりしたのですが、それもいまいち。やっぱり大量に学習データがないとだめなのかなぁ、と考えていたところ、ふと、余計なことをひらめきました。
というわけで今日のお題です。
要するにこれって何なのか？
そもそもLSTM-RNNって何を学習し、何を予測しているのか？と考えてみました。
誤解を恐れずにいえば、LSTM-RNNは、これまでの「状態」から次の「状態」を推測するモデルです。
例えば、「昨日は晴れだった。今日は・・・」に続く言葉の選択肢は、無数にありそうで実はそれほどたくさんはありません。かなり多くのケースで天気にまつわる単語が次にくるでしょう。そのように、これまでの情報から次にくるものを予測するのが、RNNです。
つまるところ、「ある一定の規則性をもった系列データ」であれば、RNNの学習データとして適しているのではないか、と考えられるのです。
ただ、言語データですと、非常に多くの場合分けが考えられるため、膨大な学習データが必要になることは、容易に想像できます。それだけのデータを集めることは結構大変ですし、予測性能を定量的に評価することも難しい。
そこでひらめいたのが、「規則性とランダム性を併せ持った数列」です。
仮想データの概要
規則性をもった数列でぱっと思いつくのが三角関数です。sinカーブなら、で1周期の規則的な並びをしています。
でも、それだけでは面白くないので、各点毎に一定のばらつきを持たせたデータとしたい。なので、ざっくりと次のように考えます。
とすると、規則性がありかつそれなりにランダム性のあるデータを生成することができます。
仮想データ生成用のRコード
例えば、とし、10回の繰り返しを行うとすると、
sinData <- c()
for(i in 0:2000){
curv <- sin((2*pi/200)*i)*100
sinData <- rbind(sinData,floor(rnorm(1,curv,5)))
}
plot(sinData)というコードになり、
こんな感じのデータが生成できます。ばらつきが少ないような気もしますが、とりあえずこれでいってみましょう。
たくさん作る
この2000個のデータだけですとたぶん少なすぎるので、同じようなデータを大量に作ります。
sinDataVec <- sapply(seq(1,5000),function(x){
curv <- 0
sinData <- c()
for(i in 0:2000){
curv <- sin((2*pi/200)*i)*100
sinData <- rbind(sinData,floor(rnorm(1,curv,5)))
}
sinDataU <- paste(sinData,collapse = " ")
return(sinDataU)
})これで10回繰り返しのsinカーブを5000個生成できました。その上で、ベクトルの各要素を半角スペースで区切ったデータにしています。こんな感じ。
"0 -4 6 4 -9 -1 16 0 -2 4 5 12 7 5 9 8 11 2 6 13 10 16 24 15 15 16 14 20 14 17 19 11 19 31 16 12 19 27 27 21 25 14 19 28 27 18 27 29 30 33 27 31 33 42 34 33 45 39 28 41 26 39 37 49 42 36 43 38 45 36 36 39 38 40 43 38 39 41 54 43 57 50 44 44 51 53 61 55 54 48 53 57 51 54 55 44 64 57 58 65 55 57 61 59 73 65 68 60 67 57 70 54 59 65 62 72 69 65 70 61 71 66 60 72 74 74 66 70 60 66 75... <truncated>
こうすることで、半角スペースで区切られたセンテンス（ただし単語はすべて数字）なデータをつくることができます。つまり、文章みたいなものを作ってしまうわけです。
このデータをwrite.csvなりなんなりでテキストファイルに書き出し、学習データとして読み込ませればOKです。
実験してみよう
実験に使ったのはRのパッケージ"mxnet"です。TJOさんが紹介しておられるように、LSTM-RNNが実装されている貴重なRパッケージです。
mxnetのインストール
ちなみに当方はWindows10です。
> install.packages("drat", repos="https://cran.rstudio.com")
> drat:::addRepo("dmlc")
> install.packages("mxnet")これでいけます。
いや、いけるはずなんです。
なんでわざわざ「はず」と言ったかというと、インストールがうまくいかなかったPCがあったからです。
※ちなみにWindows7のPCでした。
Installing MXNet — mxnet documentation
mxnetの公式HPにインストレーションガイドがあるんですが、この手の記事にあるSystem Requirementがどうにも見当たらず。インストールがうまくいかなかった理由がいまいちはっきりせず、でもまあWindows10で動いてるしいいかな、と。というわけで、一部mxnetのインストールがうまくいかない環境もある、ということはご留意ください。
実験用のコード
TJOさんの記事からほぼ丸パクリです。
パッケージの読み込みと初期値の設定
library(mxnet) # init setting batch.size <- 64 seq.len <- 64 num.hidden <- 64 num.embed <- 64 num.lstm.layer <- 1 num.round <- 1 learning.rate <- 0.1 wd <- 0.00001 clip_gradient <- 1 update.period <- 1
ここで各種パラメータを設定しています。基本デフォルト値または推奨値を使います。
機械学習がらみだと、このパラメータチューニングが命、みたいになるんですが、個人的には「ファインチューニングされたモデルに果たしてどこまで意味があるだろうか？」と考えてしまいます。だってさぁ、そんな曲芸みたいなことをするくらいだったら、もっとシンプルなモデルでそこそこの性能を出せる方が"実務用は"使い勝手が良いんじゃないか？と思うのです。って、話がそれてしまうのでそれについてはまた今度。
データ作成用の関数の設定
# define functions
make.dict <- function(text, max.vocab=10000) {
text <- strsplit(text, ' ')
dic <- list()
idx <- 1
for (c in text[[1]]) {
if (!(c %in% names(dic))) {
dic[[c]] <- idx
idx <- idx + 1
}
}
if (length(dic) == max.vocab - 1)
dic[["UNKNOWN"]] <- idx
cat(paste0("Total unique char: ", length(dic), "\n"))
return (dic)
}
make.data <- function(file.path, seq.len=32, max.vocab=10000, dic=NULL) {
fi <- file(file.path, "r")
text <- paste(readLines(fi), collapse=" ")
close(fi)
if (is.null(dic))
dic <- make.dict(text, max.vocab)
lookup.table <- list()
for (c in names(dic)) {
idx <- dic[[c]]
lookup.table[[idx]] <- c
}
char.lst <- strsplit(text, ' ')[[1]]
num.seq <- as.integer(length(char.lst) / seq.len)
char.lst <- char.lst[1:(num.seq * seq.len)]
data <- array(0, dim=c(seq.len, num.seq))
idx <- 1
for (i in 1:num.seq) {
for (j in 1:seq.len) {
if (char.lst[idx] %in% names(dic))
data[j, i] <- dic[[ char.lst[idx] ]]-1
else {
data[j, i] <- dic[["UNKNOWN"]]-1
}
idx <- idx + 1
}
}
return (list(data=data, dic=dic, lookup.table=lookup.table))
}
drop.tail <- function(X, batch.size) {
shape <- dim(X)
nstep <- as.integer(shape[2] / batch.size)
return (X[, 1:(nstep * batch.size)])
}
get.label <- function(X) {
label <- array(0, dim=dim(X))
d <- dim(X)[1]
w <- dim(X)[2]
for (i in 0:(w-1)) {
for (j in 1:d) {
label[i*d+j] <- X[(i*d+j)%%(w*d)+1]
}
}
return (label)
}ここで読み込んだデータを処理する関数を定義しています。
データの読み込みと処理
# read data # text saved in ANSI format # UTF-8 format text return error orgData <- file.path(getwd(),"R","RNNtest","testdata_5000_by200.txt") ret <- make.data(orgData, seq.len=seq.len) #saveRDS(ret,file=file.path(getwd(),"R","RNNtest","ret_longSinData.rds")) #ret <- readRDS(file=file.path(getwd(),"R","RNNtest","ret_longSinData.rds")) X <- ret$data dic <- ret$dic lookup.table <- ret$lookup.table vocab <- length(dic) shape <- dim(X) train.val.fraction <- 0.8 size <- shape[2] X.train.data <- X[, 1:as.integer(size * train.val.fraction)] X.val.data <- X[, -(1:as.integer(size * train.val.fraction))] X.train.data <- drop.tail(X.train.data, batch.size) X.val.data <- drop.tail(X.val.data, batch.size) X.train.label <- get.label(X.train.data) X.val.label <- get.label(X.val.data) X.train <- list(data=X.train.data, label=X.train.label) X.val <- list(data=X.val.data, label=X.val.label)
ここでデータを読み込み、学習用データとバリデーション用データを作っていきます。8割を学習用データ、2割をバリデーション用データとしています。
コードのコメントにちょっと入れてありますが、読み込むテキストファイルの文字コードがなぜかUTF-8だとだめでした。なのでANSIで保存したものを読み込ませています。
データの作りによってはここでこける場合もあるようです。データが少ないときによく起こるようです。その場合は"train.val.fraction"を小さくするか、おとなしくデータを増やすか、どちらかの対応をとる必要があるようです。
※データを増やす方が筋が良いです、たぶん。
学習
# learning phase
model <- mx.lstm(X.train, X.val,
ctx=mx.cpu(),
num.round=num.round,
update.period=update.period,
num.lstm.layer=num.lstm.layer,
seq.len=seq.len,
num.hidden=num.hidden,
num.embed=num.embed,
num.label=vocab,
batch.size=batch.size,
input.size=vocab,
initializer=mx.init.uniform(0.1),
learning.rate=learning.rate,
wd=wd,
clip_gradient=clip_gradient)ここで学習をさせます。設定はデフォルトです。
ちなみに、二行目に
ctx=mx.cpu()
という部分があります。どうやらここでCPUを使うかGPUを使うかの設定ができるようです。mxnetはGPUも使えるそうです。実験はしてないけど。
コードを実行すると、
・・・ Epoch [1755] Train: NLL=3.32279407801579, Perp=27.7377438069585 Epoch [1770] Train: NLL=3.32105396106587, Perp=27.6895188595004 Epoch [1785] Train: NLL=3.31924919093958, Perp=27.6395907110192 Epoch [1800] Train: NLL=3.31755815507309, Perp=27.5928906686436 Epoch [1815] Train: NLL=3.31583562501149, Perp=27.5454019970546 Epoch [1830] Train: NLL=3.31411731894502, Perp=27.4981112073608 Epoch [1845] Train: NLL=3.31249291220934, Perp=27.4534793502559 Epoch [1860] Train: NLL=3.31089905081646, Perp=27.4097571622291 Epoch [1875] Train: NLL=3.30928869163623, Perp=27.3656531293534 Epoch [1890] Train: NLL=3.30772970039499, Perp=27.3230235540153 Epoch [1905] Train: NLL=3.30615184790342, Perp=27.279945847294 Epoch [1920] Train: NLL=3.30469496115406, Perp=27.240230992713 Epoch [1935] Train: NLL=3.30319686671104, Perp=27.1994531062254 Epoch [1950] Train: NLL=3.30171898022999, Perp=27.1592850913819 Iter [1] Train: Time: 249.333600997925 sec, NLL=3.30135091707144, Perp=27.1492905985423 Iter [1] Val: NLL=3.10572335645587, Perp=22.3253623308432
という感じに学習の収束状況が表示されていきます。今回は大体4分くらいで終わりました。
ちなみにTJOさんが夏目漱石でやった実験のときの学習は3分くらいだったようです。今回のような、規則性のある数列だったらまだしも、通常の文章で学習時間が3分というのはさすがに短いな、と素朴に感じます。
※実際に夏目漱石の文章を学習させたモデルで文章を生成させると確かに夏目漱石の雰囲気はあるけれど日本語としてはめちゃくちゃ、という結果だったようです。
予測の準備
# prepare for prediction
cdf <- function(weights) {
total <- sum(weights)
result <- c()
cumsum <- 0
for (w in weights) {
cumsum <- cumsum+w
result <- c(result, cumsum / total)
}
return (result)
}
search.val <- function(cdf, x) {
l <- 1
r <- length(cdf)
while (l <= r) {
m <- as.integer((l+r)/2)
if (cdf[m] < x) {
l <- m+1
} else {
r <- m-1
}
}
return (l)
}
choice <- function(weights) {
cdf.vals <- cdf(as.array(weights))
x <- runif(1)
idx <- search.val(cdf.vals, x)
return (idx)
}
make.output <- function(prob, sample=FALSE) {
if (!sample) {
idx <- which.max(as.array(prob))
}
else {
idx <- choice(prob)
}
return (idx)
}ここで予測値を生成するための関数を設定しています。
予測のための関数を作る
# create for prediction model
infer.model <- mx.lstm.inference(num.lstm.layer=num.lstm.layer,
input.size=vocab,
num.hidden=num.hidden,
num.embed=num.embed,
num.label=vocab,
arg.params=model$arg.params,
ctx=mx.cpu())予測モデルを生成。
予測してみる
# create sentense
start <- "0"
seq.len <- 200
random.sample <- TRUE
last.id <- dic[[start]]
out <- "0 "
for (i in (1:(seq.len-1))) {
input <- c(last.id-1)
ret <- mx.lstm.forward(infer.model, input, FALSE)
infer.model <- ret$model
prob <- ret$prob
last.id <- make.output(prob, random.sample)
out <- paste0(out, lookup.table[[last.id]], sep=" ")
}
res <- paste0(out)
resVec <- as.numeric(unlist(strsplit(res," ")))
plot(resVec)コメントは"create sentense"ですが実際には0を起点にして数列を予測させています。
で、それを分解して数値型のベクトルにしてプロットさせる、というのを最後の3行でやっています。
ここのコードでオリジナルなのは正直ここだけです。
実験結果は・・・
どや！
割ときれいにsinカーブになってるじゃないですかー。
0を起点にし、を200個に区切っているので、本当ならば200で0に戻ってきてほしかったのですが、残念ながらずれてしまいました。ちょっとのずれがだんだん大きくなって後ろの方にしわ寄せがいく、というスケジュール管理上ありがちなアレですね。わかります。
それでもまぁ、数分の学習で、しかもパラメータをいじらないでこれだけ性能が出るんだったら十分じゃないでしょうか。
本当は「どんなデータだったら予測がうまくいくモデルをたてられるのか」を検証しようと思ったのですが、いろいろめんどうだったのでやっていません。
たとえばですね、
- データの区切りを細かくするとどうなるか（例：2πを200個でなく1,000個に区切ったらどうなるか）
- 一文をもっと長くしたらどうなるか（例：10周期を100周期にするとどうなるか）
- 読み込ませる文を増やしたらどうなるか（例：5,000回繰り返しを10,000回繰り返しにしたらどうなるか）
などなど、データの性質によっておそらく学習精度や得られたモデルの予測性能ってきっと変わると思うんですよ。パラメータに依存する部分ではなく、データの質に依存する部分ですね。それがわかったら、どんなデータであれば学習させるのに筋が良いかがわかるだろう、と。そこんところを検討したかったんですが、まぁ、アレです。
そのうちやるかもしれません。
予定は未定です。
