概要
『新しき 年の始めの うれしきは 古き人どち あへるなりけり』
以前に{tensorflow}のPythonライブラリをimportする関数を用いることで、gensimを活用できるという記事を書きました。
これにより、R/RStudio上ですべてを管理したい/されたいRおじさん（重度なRユーザーを指す。女性でも「おじさん」と呼称するので、淑女の方々はご配慮いただきたい）のできる幅が広がったと言えます。
今回はさらにTensorflowとTheanoのラッパーであるKerasというライブラリを用いてモデルを構築し、新年の挨拶によさそうな短歌の生成を試みました。具体的には「上の句を入力することで下の句を生成する」というタスクを設定しています。
なお、{tensorflow}自体の設定や使い方などは{tensorflow}でデータ分析のHello Worldであるirisデータの分類を行った記事をご参考ください。
また、Keras自体の使い方は下記のドキュメントなどをご参照ください。
元データについて
和歌を掲載しているサイトをスクレイピングして集めたデータを本タスクでは用いました。
データとしては、次のようにu1からu3までが上の句でl1からl2までが下の句になっています。
和歌データ}
> tanka_text
# A tibble: 230,071 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 きのふこそ としはくれしか はるかすみ かすかのやまに はやたちにけり
2 きのふこそ つきはたちしか いつのまに はるのかすみの たちにけるそも
3 あすよりは わかなつまむと かたをかの あしたのはらは けふそやくめる
4 うめのはな それともみえす ひさかたの あまきるゆきの なへてふれれは
5 たかやとの うめのはなそも ひさかたの きよきつきよに ここらちりくる
6 きてみへき ひともあらなくに わかやとの うめのはつはな ちりぬともよし
7 わかせこに みせむとおもひし うめのはな それともみえす ゆきのふれれは
8 うめのはな まつさくえたを たをりもて つととなつけて よそへてもみむ
9 ゆきさむみ さけときかれぬ うめのはな なほこのころは しかとあるかは
10 うめのはな さきてちるとは しらぬかも いままていもか いててあひみぬ
# ... with 230,061 more rows
コーパス作成
丁寧に収集した和歌データを短歌生成タスクに利用するため、すべての句がひらがなのみから成り、各句の文字数が5/7/5/7/7の歌に限定します。
和歌コーパス作成}
tanka_char_len <- tanka_text %>%
dplyr::mutate_all(.funs = dplyr::funs(len = stringr::str_length(string = .))) %>%
dplyr::summarise_all(.funs = dplyr::funs(tb = list(table(.))))
> normalize_tanka_text <- tanka_text %>%
dplyr::mutate_all(.funs = dplyr::funs(len = stringr::str_length(string = .))) %>%
# 各句の文字数を用いて、上の句が3で下の句が2の短歌に限定
dplyr::filter((u1_len == 5 & u2_len == 7 & u3_len == 5) & (l1_len == 7 & l2_len == 7)) %>%
dplyr::select_(.dots = c("u1", "u2", "u3", "l1", "l2")) %>%
# ひらがなのみに限定
dplyr::filter(
!(
stringi::stri_detect_regex(str = u1, pattern = "\\P{Hiragana}") |
stringi::stri_detect_regex(str = u2, pattern = "\\P{Hiragana}") |
stringi::stri_detect_regex(str = u3, pattern = "\\P{Hiragana}") |
stringi::stri_detect_regex(str = l1, pattern = "\\P{Hiragana}") |
stringi::stri_detect_regex(str = l2, pattern = "\\P{Hiragana}")
)
) %>%
print
# A tibble: 150,330 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 きのふこそ としはくれしか はるかすみ かすかのやまに はやたちにけり
2 きのふこそ つきはたちしか いつのまに はるのかすみの たちにけるそも
3 あすよりは わかなつまむと かたをかの あしたのはらは けふそやくめる
4 うめのはな それともみえす ひさかたの あまきるゆきの なへてふれれは
5 たかやとの うめのはなそも ひさかたの きよきつきよに ここらちりくる
6 うめのはな まつさくえたを たをりもて つととなつけて よそへてもみむ
7 ゆきさむみ さけときかれぬ うめのはな なほこのころは しかとあるかは
8 うめのはな さきてちるとは しらぬかも いままていもか いててあひみぬ
9 わかやとに さきたるうめを つききよみ よるよるきつつ みむひともかな
10 かせはやみ おちたきつらし しらなみに かはつなくなり あさゆふことに
# ... with 150,320 more rows
# コーパスサイズ
> nrow(x = normalize_tanka_text)
[1] 150330
# 文字種
> chars <- normalize_tanka_text %>%
unlist %>%
stringr::str_split(string = ., pattern = "") %>%
dplyr::combine() %>%
stringi::stri_unique(str = .) %>%
stringr::str_sort(x = .) %>%
print
[1] "あ" "い" "う" "え" "お" "か" "き" "く" "ぐ" "け" "こ" "ご" "さ" "し" "す" "せ" "そ" "た"
[19] "ち" "つ" "て" "と" "な" "に" "ぬ" "ね" "の" "は" "ひ" "ふ" "へ" "ほ" "ま" "み" "む" "め"
[37] "も" "や" "ゆ" "よ" "ら" "り" "る" "れ" "ろ" "わ" "ゐ" "ゑ" "を"
# 文字種数（出力層の数として利用）
> chars_len <- as.integer(x = length(x = chars)) %>%
print
[1] 49
モデル作成における事前準備
モデル作成に先立ち、パッケージの読み込みから定数や関数を定義します。
また、合わせてKerasで利用できるようにデータの形を変換しています。今回は特にarrayの処理があり、tidyverseに慣れてしまっていると扱いにくいと感じてしまうかもしれません（Numpyを使い慣れているといいかもしれません）。
定義部
ライブルラリ読み込み}
library(tidyverse)
library(tensorflow)
library(quanteda)
library(caret)
# KerasをR上で使えるように{tensorflow}のimport関数で読み込み
keras <- tensorflow::import(module = "keras")
定数定義}
# MAX_LENで生成する文字幅を設定
# STEPで上の句のみに限定するように設定
SET_TEXT_PARAM <- list(
MAX_LEN = as.integer(x = 5 + 7 + 5 + 7 + 7),
STEP = as.integer(x = 5 + 7 + 5)
)
関数定義}
# 入力文を文字N-gramに分割
# 本タスクでは短歌文字列を1文字ずつ分割するのに活用
# @sent: 対象文
# @n: N-gramのN
parseNgram <- function (sent, n = 5) {
return(
dplyr::bind_rows(
lapply(
X = stringr::str_split(string = sent, pattern = ""),
FUN = function (ch) {
dplyr::data_frame(
ch = quanteda::ngrams(ch, n = n, concatenator = " ")
)
}
)
)
)
}
# One-Hot表現に変換するための事前データを作成
# @seed_text: 変換対象の文（sentという名前がつけられている必要がある）
# @chars: コーパス中で出現する文字集合（ボキャブラリ）
createOneHotSeed <- function (
seed_text, chars
) {
return (
seed_text %>%
tibble::rownames_to_column(var = "did") %>%
dplyr::mutate(did = as.integer(x = did)) %>%
dplyr::group_by(did) %>%
dplyr::do(parseNgram(sent = .$sent, n = 1)) %>%
dplyr::mutate(sid = dplyr::row_number(x = did)) %>%
tidytext::unnest_tokens(
output = char, input = ch,
token = stringr::str_split, pattern = " ", to_lower = FALSE
) %>%
dplyr::ungroup(x = .) %>%
dplyr::mutate(char = factor(x = .$char, levels = chars))
)
}
# 学習結果から文字を生成
# @x: 学習したモデルにデータを適用(predict)させた結果（arrayを前提）
# @chars: コーパス中で出現する文字集合（ボキャブラリ）
genChars <- function (x, chars) {
gen_char <- apply(
X = x,
MARGIN = 1,
FUN = function (xx) {
probas <- rmultinom(n = 1L, size = 1L, prob = xx / sum(xx))[, 1]
return (
chars[which.max(x = probas)]
)
}
)
return (stringr::str_c(gen_char, collapse = ""))
}
# 元データの上の句と生成した下の句を連結（@tanka_upperと@resultの順番が変わっていない前提）
# @tanka_upper: 連結させる短歌の上の句
# @result: 学習したモデルにデータを適用(predict)させた結果（arrayを前提）
# @chars: コーパス中で出現する文字集合（ボキャブラリ）
# @diversity: 多様性パラメータ
# @target_num: 連結データ数
mergeTankaUpperLower <- function (
tanka_upper, result, chars,
diversity, target_num = 10
) {
return (
dplyr::bind_cols(
tanka_upper %>%
dplyr::select(u1, u2, u3) %>%
head(n = target_num),
dplyr::data_frame(
lower = apply(
X = exp(x = log(x = result[seq(from = 1, to = target_num), ,]) / diversity),
MARGIN = 1,
FUN = genChars, chars = chars
)
) %>%
dplyr::mutate(
l1 = stringr::str_sub(string = .$lower, start = 1, end = 7),
l2 = stringr::str_sub(string = .$lower, start = 8, end = 14)
) %>%
dplyr::select(-lower)
)
)
}
# 新規適用データを作成
# @org_upper_str: 新しく適用する上の句（文字列ベクトル）
# @chars: コーパス中で出現する文字集合（ボキャブラリ）
# @dummy_seed: One-hot表現への変換に用いたdummyVarsオブジェクト（{caret}のダミー変数作成関数を利用）
# @step: 上の句の文字数
genOrgX <- function (
org_upper_str,
chars, dummy_seed, step
) {
org_tanka_one_hot_seed <- dplyr::data_frame(sent = org_upper_str) %>%
createOneHotSeed(seed_text = ., chars = chars)
return (
array(
data = dplyr::as_data_frame(
x = predict(object = dummy_seed, newdata = org_tanka_one_hot_seed)
) %>%
dplyr::select(-did, -sid) %>%
as.matrix,
dim = c(max(org_tanka_one_hot_seed$did), step, length(x = chars))
)
)
}
データ前処理
Kerasにはテキスト前処理用関数として下記が用意されていますが、Rから利用できないようなので自前でコツコツ処理します。
ここでは{caret}のdummyVarsを活用してOne-hot表現に変換し、各句毎にarrayに格納して、さらにapermで次元（Pythonではshapeに該当するでしょうか）を入れ替えています（同じようにNumpyのreshapeに該当）。
前処理}
tanka_one_hot_seed <- normalize_tanka_text %>%
tidyr::unite_(col = "sent", from = c("u1", "u2", "u3", "l1", "l2"), sep = "") %>%
createOneHotSeed(seed_text = ., chars = chars)
> tanka_one_hot_seed %>%
dplyr::filter(is.element(el = .$did, set = c(1))) %>%
as.data.frame()
did sid char
1 1 1 き
2 1 2 の
3 1 3 ふ
4 1 4 こ
5 1 5 そ
6 1 6 と
7 1 7 し
8 1 8 は
9 1 9 く
10 1 10 れ
11 1 11 し
12 1 12 か
13 1 13 は
14 1 14 る
15 1 15 か
16 1 16 す
17 1 17 み
18 1 18 か
19 1 19 す
20 1 20 か
21 1 21 の
22 1 22 や
23 1 23 ま
24 1 24 に
25 1 25 は
26 1 26 や
27 1 27 た
28 1 28 ち
29 1 29 に
30 1 30 け
31 1 31 り
# ダミー変数作成関数を使ってOne-hot表現へ（ここで作成したオブジェクトは後述の新規データ適用でも利用）
tanka_dummy <- caret::dummyVars(formula = ~ did + sid + char, data = tanka_one_hot_seed)
tanka_one_hot <- dplyr::as_data_frame(
x = predict(object = tanka_dummy, newdata = tanka_one_hot_seed)
)
> tanka_one_hot %>%
dplyr::filter(did == 1) %>%
dplyr::select(-did, -sid)
# A tibble: 31 × 49
char.あ char.い char.う char.え char.お char.か char.き char.く char.ぐ char.け char.こ char.ご char.さ char.し char.す char.せ char.そ
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0
2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
3 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
4 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0
5 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1
6 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
7 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0
8 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
9 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0
10 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# ... with 21 more rows, and 32 more variables: char.た <dbl>, char.ち <dbl>, char.つ <dbl>, char.て <dbl>, char.と <dbl>, char.な <dbl>,
# char.に <dbl>, char.ぬ <dbl>, char.ね <dbl>, char.の <dbl>, char.は <dbl>, char.ひ <dbl>, char.ふ <dbl>, char.へ <dbl>, char.ほ <dbl>,
# char.ま <dbl>, char.み <dbl>, char.む <dbl>, char.め <dbl>, char.も <dbl>, char.や <dbl>, char.ゆ <dbl>, char.よ <dbl>, char.ら <dbl>,
# char.り <dbl>, char.る <dbl>, char.れ <dbl>, char.ろ <dbl>, char.わ <dbl>, char.ゐ <dbl>, char.ゑ <dbl>, char.を <dbl>
# 学習データをKerasで使うために(, , )の形式（array）に変換
X <- aperm(
a = sapply(
X = split(x = tanka_one_hot, f = tanka_one_hot$did),
FUN = function (x) {
return(
x %>%
# 上の句
dplyr::filter(sid <= SET_TEXT_PARAM$STEP) %>%
dplyr::select(-did, -sid) %>%
as.matrix
)
},
simplify = "array"
),
perm = c(3, 1, 2)
)
> dim(x = X)
[1] 150330 17 49
# 一文字ずつ1が立っているか確認（フラグが立つデータが各行で1しかない）
> all(apply(X = apply(X = X, MARGIN = 2, FUN = rowSums) == 1, MARGIN = 1, FUN = all))
[1] TRUE
# yでも同様に変換
Y <- aperm(
a = sapply(
X = split(x = tanka_one_hot, f = tanka_one_hot$did),
FUN = function (x) {
y <- x %>%
# 下の句
dplyr::filter(sid > SET_TEXT_PARAM$STEP) %>%
dplyr::select(-did, -sid) %>%
as.matrix
return (
# 下の句の方が文字数が少ないのでXと同じ次元になるように0埋め
rbind(
y,
matrix(data = 0, nrow = SET_TEXT_PARAM$STEP - nrow(x = y), ncol = ncol(x = y))
)
)
},
simplify = "array"
),
perm = c(3, 1, 2)
)
> dim(x = Y)
[1] 150330 17 49
モデル作成
Kerasで利用するデータ前処理が終わりましたので、ここからモデルの定義をはじめます。
今回はLSTM-RNNによる生成に挑戦してみましょう。KerasではLSTMモデルを利用できる関数が用意されていますので、これを用いました。
なお、いろいろなサイトを参考に構築しましたが、モデル作成に関する調査や学習が足りていないませんので、よりよい方法や手段などあればご指導いただけると幸いです。
LSTM}
model <- keras$models$Sequential()
model$add(
layer = keras$layers$LSTM(
output_dim = 128L, input_shape = c(SET_TEXT_PARAM$STEP, chars_len),
return_sequences = TRUE
)
)
model$add(
layer = keras$layers$LSTM(
output_dim = 128L,
return_sequences = TRUE, activation = "relu"
)
)
model$add(
layer = keras$layers$TimeDistributed(
layer = keras$layers$Dense(output_dim = chars_len, activation = "softmax")
)
)
model$compile(loss = "categorical_crossentropy", optimizer = "rmsprop")
> model$summary()
Layer (type) Output Shape Param # Connected to
====================================================================================================
lstm_1 (LSTM) (None, 17, 128) 91136 lstm_input_1[0][0]
____________________________________________________________________________________________________
lstm_2 (LSTM) (None, 17, 128) 131584 lstm_1[0][0]
____________________________________________________________________________________________________
timedistributed_1 (TimeDistribute(None, 17, 49) 6321 lstm_2[0][0]
====================================================================================================
Total params: 229041
____________________________________________________________________________________________________
# Epoch数が30と少ないが、これでも2.5時間ほどかかる
# 今回は手習いとして小さめで実行した
> model$fit(x = X, y = Y, batch_size = 1000L, nb_epoch = 30L, shuffle = TRUE)
Epoch 1/30
150330/150330 [==============================] - 289s - loss: 3.0063
Epoch 2/30
150330/150330 [==============================] - 288s - loss: 2.9062
Epoch 3/30
150330/150330 [==============================] - 287s - loss: 2.8078
Epoch 4/30
150330/150330 [==============================] - 288s - loss: 2.7971
Epoch 5/30
150330/150330 [==============================] - 287s - loss: 2.7936
Epoch 6/30
150330/150330 [==============================] - 288s - loss: 2.7921
Epoch 7/30
150330/150330 [==============================] - 288s - loss: 2.7913
Epoch 8/30
150330/150330 [==============================] - 288s - loss: 2.7907
Epoch 9/30
150330/150330 [==============================] - 288s - loss: 2.7902
Epoch 10/30
150330/150330 [==============================] - 288s - loss: 2.7898
Epoch 11/30
150330/150330 [==============================] - 288s - loss: 2.7893
Epoch 12/30
150330/150330 [==============================] - 288s - loss: 2.7887
Epoch 13/30
150330/150330 [==============================] - 289s - loss: 2.7882
Epoch 14/30
150330/150330 [==============================] - 288s - loss: 2.7874
Epoch 15/30
150330/150330 [==============================] - 288s - loss: 2.7869
Epoch 16/30
150330/150330 [==============================] - 288s - loss: 2.7861
Epoch 17/30
150330/150330 [==============================] - 288s - loss: 2.7854
Epoch 18/30
150330/150330 [==============================] - 288s - loss: 2.7847
Epoch 19/30
150330/150330 [==============================] - 288s - loss: 2.7840
Epoch 20/30
150330/150330 [==============================] - 288s - loss: 2.7833
Epoch 21/30
150330/150330 [==============================] - 288s - loss: 2.7826
Epoch 22/30
150330/150330 [==============================] - 288s - loss: 2.7818
Epoch 23/30
150330/150330 [==============================] - 288s - loss: 2.7811
Epoch 24/30
150330/150330 [==============================] - 288s - loss: 2.7801
Epoch 25/30
150330/150330 [==============================] - 288s - loss: 2.7793
Epoch 26/30
150330/150330 [==============================] - 288s - loss: 2.7785
Epoch 27/30
150330/150330 [==============================] - 288s - loss: 2.7776
Epoch 28/30
150330/150330 [==============================] - 288s - loss: 2.7766
Epoch 29/30
150330/150330 [==============================] - 288s - loss: 2.7757
Epoch 30/30
150330/150330 [==============================] - 297s - loss: 2.7750
History
# 学習データを適用した結果から下の句を生成
# 歌人が詠んだ上の句と比べて拙さが溢れる
result_predict <- model$predict(x = X[, , , drop = FALSE])[, seq(from = 1, to = SET_TEXT_PARAM$MAX_LEN - SET_TEXT_PARAM$STEP ), ]
> gen_tanka <- mergeTankaUpperLower(
tanka_upper = normalize_tanka_text, result = result_predict, chars = chars,
diversity = 1.0, target_num = nrow(x = normalize_tanka_text)
)
# A tibble: 150,330 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 きのふこそ としはくれしか はるかすみ ままみかせらて まりけれりかり
2 きのふこそ つきはたちしか いつのまに まわくみひきむ しかくとたへも
3 あすよりは わかなつまむと かたをかの つたかここはか かしこなそなめ
4 うめのはな それともみえす ひさかたの はせのあとれの よかやうすつむ
5 たかやとの うめのはなそも ひさかたの はきもによをの みきもなねしは
6 うめのはな まつさくえたを たをりもて なにりこつしの ねふはあれらし
7 ゆきさむみ さけときかれぬ うめのはな あこしきつなは かかれのらかな
8 うめのはな さきてちるとは しらぬかも こるたまのこは さゆかおりかろ
9 わかやとに さきたるうめを つききよみ こけみきらかの おささあそかり
10 かせはやみ おちたきつらし しらなみに つれはりたきす たきのせたかく
# ... with 150,320 more rows
# 多様性のパラメータを変更することで異なる句が生成される。
temperature <- 1.0
org_exp_result_predict <- exp(x = log(x = result_predict) / temperature)
set.seed(seed = 71)
> genChars(x = org_exp_result_predict[1, , ], chars = chars)
[1] "かれかになたかいもになかぬむ"
temperature <- 0.9
org_exp_result_predict <- exp(x = log(x = result_predict) / temperature)
set.seed(seed = 71)
> genChars(x = org_exp_result_predict[1, , ], chars = chars)
[1] "かゑとのたかはこにのいぬらむ"
# パラメータが小さくなるにつれて多様性がなくなる。
set.seed(seed = 71)
> lapply(
X = seq(from = 0.9, to = 0.1, by = - 0.1),
FUN = mergeTankaUpperLower,
tanka_upper = normalize_tanka_text, result = result_predict, chars = chars,
target_num = 10
)
[[1]]
# A tibble: 10 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 きのふこそ としはくれしか はるかすみ かゑとのたかは こにのいぬらむ
2 きのふこそ つきはたちしか いつのまに つへわからなの なやのかまかと
3 あすよりは わかなつまむと かたをかの なにたなみまに ねるひなのなり
4 うめのはな それともみえす ひさかたの いそもふらして しろのしかして
5 たかやとの うめのはなそも ひさかたの とたきくかまに たくのこくらむ
6 うめのはな まつさくえたを たをりもて まにるはすとの そるのなるたれ
7 ゆきさむみ さけときかれぬ うめのはな みたのむはさす おちちしるかせ
8 うめのはな さきてちるとは しらぬかも やろひなほくる こふをつそかり
9 わかやとに さきたるうめを つききよみ けけねすからき さきののしかし
10 かせはやみ おちたきつらし しらなみに こはみみさはの やきもおそなな
[[2]]
# A tibble: 10 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 きのふこそ としはくれしか はるかすみ なりのこなれも くきまぬをはも
2 きのふこそ つきはたちしか いつのまに むけをかなねの はとをせりけを
3 あすよりは わかなつまむと かたをかの おとらのきたそ あとのなのけき
4 うめのはな それともみえす ひさかたの ひつをりきとを いてをかるるけ
5 たかやとの うめのはなそも ひさかたの もみにのみかの しちかしつかふ
6 うめのはな まつさくえたを たをりもて かほなやうかの くるまはりける
7 ゆきさむみ さけときかれぬ うめのはな いたのにまこは あしもすはけり
8 うめのはな さきてちるとは しらぬかも をのかいききや ふきのそなけれ
9 わかやとに さきたるうめを つききよみ たらうつはみの よれしいかけれ
10 かせはやみ おちたきつらし しらなみに なへれちかかぬ すかふけちとむ
[[3]]
# A tibble: 10 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 きのふこそ としはくれしか はるかすみ たすしへやねの たとのをたかな
2 きのふこそ つきはたちしか いつのまに ききめはちきの あきのかのけけ
3 あすよりは わかなつまむと かたをかの かのたかれらの かとやなるかむ
4 うめのはな それともみえす ひさかたの あものこきみの きしもまるとな
5 たかやとの うめのはなそも ひさかたの まきもたてこに とつのまりかな
6 うめのはな まつさくえたを たをりもて つやなりかかく はきみくるかな
7 ゆきさむみ さけときかれぬ うめのはな おほのそさりの あれそしそして
8 うめのはな さきてちるとは しらぬかも ねきのるよけの なるのおらけむ
9 わかやとに さきたるうめを つききよみ いるたこやとや まもねすなする
10 かせはやみ おちたきつらし しらなみに なつよみたみに なとかひるそむ
[[4]]
# A tibble: 10 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 きのふこそ としはくれしか はるかすみ おらもにみらも おとにけすらむ
2 きのふこそ つきはたちしか いつのまに たかやのくりに みきにからから
3 あすよりは わかなつまむと かたをかの おるひくとらの ときのつもかや
4 うめのはな それともみえす ひさかたの ふまにのつさの こらににらつな
5 たかやとの うめのはなそも ひさかたの あもののとらを おりをたららつ
6 うめのはな まつさくえたを たをりもて はやにへかろの あとしほるけし
7 ゆきさむみ さけときかれぬ うめのはな かきのもひとそ もとはなるらむ
8 うめのはな さきてちるとは しらぬかも きれひにもろに しるかしるけき
9 わかやとに さきたるうめを つききよみ しかはのからに なとはなりかむ
10 かせはやみ おちたきつらし しらなみに たとみもやろの きたなをもらは
[[5]]
# A tibble: 10 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 きのふこそ としはくれしか はるかすみ しかののはれと あののつるなり
2 きのふこそ つきはたちしか いつのまに おひひははまの しつのかそらる
3 あすよりは わかなつまむと かたをかの おかよはたらの おこのまりかき
4 うめのはな それともみえす ひさかたの かるのとさかの まりのなもらて
5 たかやとの うめのはなそも ひさかたの かたにひきへも ことのらまるる
6 うめのはな まつさくえたを たをりもて あみよもかみに おらしきりしな
7 ゆきさむみ さけときかれぬ うめのはな おたらもやりの まかをなるけむ
8 うめのはな さきてちるとは しらぬかも こかのくことに はるはみりらし
9 わかやとに さきたるうめを つききよみ やすはにかとは かるかこりかり
10 かせはやみ おちたきつらし しらなみに わきのゆのきる なきかはのなし
[[6]]
# A tibble: 10 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 きのふこそ としはくれしか はるかすみ もたとなつたの あきのさるかむ
2 きのふこそ つきはたちしか いつのまに いつよにもりる からのかりかる
3 あすよりは わかなつまむと かたをかの いなかののにの たかのなるけり
4 うめのはな それともみえす ひさかたの たつにるかとの かきのかのけな
5 たかやとの うめのはなそも ひさかたの こなののなまに こしもしりかり
6 うめのはな まつさくえたを たをりもて なりにかひきの うものけるけむ
7 ゆきさむみ さけときかれぬ うめのはな いものなこへの はかのなそけむ
8 うめのはな さきてちるとは しらぬかも はりのるくろに まきのはりなむ
9 わかやとに さきたるうめを つききよみ あはかなみしそ あれのかりらり
10 かせはやみ おちたきつらし しらなみに くしふこしはの かめたきりけり
[[7]]
# A tibble: 10 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 きのふこそ としはくれしか はるかすみ つきののからの かかのなるかむ
2 きのふこそ つきはたちしか いつのまに いとにのはらの あたのなりかむ
3 あすよりは わかなつまむと かたをかの なはろにはとの なるのなるかむ
4 うめのはな それともみえす ひさかたの かなにのかとの たるのなるかり
5 たかやとの うめのはなそも ひさかたの ひかののかとの かるのしつなむ
6 うめのはな まつさくえたを たをりもて なたのかこまの あきのなるかむ
7 ゆきさむみ さけときかれぬ うめのはな ならののこしの あろのなそけむ
8 うめのはな さきてちるとは しらぬかも いつしのたとに むりのなるかむ
9 わかやとに さきたるうめを つききよみ いきかのことに なみのなりかむ
10 かせはやみ おちたきつらし しらなみに ふれのにつきの みるさなららる
[[8]]
# A tibble: 10 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 きのふこそ としはくれしか はるかすみ こきのもかとる あかのなりかな
2 きのふこそ つきはたちしか いつのまに かかののかとに あとのなりけな
3 あすよりは わかなつまむと かたをかの かきののからの あとのなるかり
4 うめのはな それともみえす ひさかたの しかののかとの なとのなりけむ
5 たかやとの うめのはなそも ひさかたの かきののかとの かきかなのかむ
6 うめのはな まつさくえたを たをりもて かましるかけの あるのなりかり
7 ゆきさむみ さけときかれぬ うめのはな あつののやらの こきのしりかむ
8 うめのはな さきてちるとは しらぬかも まかのるかとの あるのなりけり
9 わかやとに さきたるうめを つききよみ あきののかとの うかのなりかむ
10 かせはやみ おちたきつらし しらなみに あたののかれの こものなるなむ
[[9]]
# A tibble: 10 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 きのふこそ としはくれしか はるかすみ いかののかとの あきのなりかむ
2 きのふこそ つきはたちしか いつのまに いかののからの あきのなりかむ
3 あすよりは わかなつまむと かたをかの いかののかとの あきのなりかむ
4 うめのはな それともみえす ひさかたの かかのにかとの あるのなりけは
5 たかやとの うめのはなそも ひさかたの あきののかとの あきのなのかむ
6 うめのはな まつさくえたを たをりもて なるにのかとの あきのなりかむ
7 ゆきさむみ さけときかれぬ うめのはな あかののからの あきのなりかむ
8 うめのはな さきてちるとは しらぬかも なかののかとの こきのなりけり
9 わかやとに さきたるうめを つききよみ あかののかとの いきのなりかむ
10 かせはやみ おちたきつらし しらなみに あかののかとの こきのなりかむ
モデル変更
上記で用いたLSTMの他にGRUモデルも同じように使えます。詳しい説明は他のページに譲りますが、Kerasではこちらも定義されており、すぐに利用できます。せっかくなので、こちらも実行して比較しましょう。
GRU}
# 各層の設定は同じ
gru_model <- keras$models$Sequential()
gru_model$add(
layer = keras$layers$GRU(
output_dim = 128L, input_shape = c(SET_TEXT_PARAM$STEP, chars_len),
return_sequences = TRUE
)
)
gru_model$add(
layer = keras$layers$GRU(
output_dim = 128L,
return_sequences = TRUE, activation = "relu"
)
)
gru_model$add(
layer = keras$layers$TimeDistributed(
layer = keras$layers$Dense(output_dim = chars_len, activation = "softmax")
)
)
gru_model$compile(loss = "categorical_crossentropy", optimizer = "rmsprop")
> gru_model$summary()
____________________________________________________________________________________________________
Layer (type) Output Shape Param # Connected to
====================================================================================================
gru_1 (GRU) (None, 17, 128) 68352 gru_input_1[0][0]
____________________________________________________________________________________________________
gru_2 (GRU) (None, 17, 128) 98688 gru_1[0][0]
____________________________________________________________________________________________________
timedistributed_2 (TimeDistribute(None, 17, 49) 6321 gru_2[0][0]
====================================================================================================
Total params: 173361
____________________________________________________________________________________________________
# LSTMよりは早いが、2時間近くかかる
> gru_model$fit(x = X, y = Y, batch_size = 1000L, nb_epoch = 30L, shuffle = TRUE)
Epoch 1/30
150330/150330 [==============================] - 236s - loss: 2.9939
Epoch 2/30
150330/150330 [==============================] - 221s - loss: 2.8423
Epoch 3/30
150330/150330 [==============================] - 222s - loss: 2.8003
Epoch 4/30
150330/150330 [==============================] - 222s - loss: 2.7927
Epoch 5/30
150330/150330 [==============================] - 222s - loss: 2.7897
Epoch 6/30
150330/150330 [==============================] - 223s - loss: 2.7875
Epoch 7/30
150330/150330 [==============================] - 223s - loss: 2.7857
Epoch 8/30
150330/150330 [==============================] - 223s - loss: 2.7841
Epoch 9/30
150330/150330 [==============================] - 223s - loss: 2.7827
Epoch 10/30
150330/150330 [==============================] - 223s - loss: 2.7813
Epoch 11/30
150330/150330 [==============================] - 223s - loss: 2.7798
Epoch 12/30
150330/150330 [==============================] - 223s - loss: 2.7784
Epoch 13/30
150330/150330 [==============================] - 223s - loss: 2.7769
Epoch 14/30
150330/150330 [==============================] - 224s - loss: 2.7754
Epoch 15/30
150330/150330 [==============================] - 223s - loss: 2.7738
Epoch 16/30
150330/150330 [==============================] - 223s - loss: 2.7721
Epoch 17/30
150330/150330 [==============================] - 223s - loss: 2.7705
Epoch 18/30
150330/150330 [==============================] - 223s - loss: 2.7689
Epoch 19/30
150330/150330 [==============================] - 223s - loss: 2.7671
Epoch 20/30
150330/150330 [==============================] - 223s - loss: 2.7654
Epoch 21/30
150330/150330 [==============================] - 223s - loss: 2.7636
Epoch 22/30
150330/150330 [==============================] - 223s - loss: 2.7619
Epoch 23/30
150330/150330 [==============================] - 223s - loss: 2.7600
Epoch 24/30
150330/150330 [==============================] - 223s - loss: 2.7583
Epoch 25/30
150330/150330 [==============================] - 223s - loss: 2.7564
Epoch 26/30
150330/150330 [==============================] - 223s - loss: 2.7546
Epoch 27/30
150330/150330 [==============================] - 224s - loss: 2.7527
Epoch 28/30
150330/150330 [==============================] - 223s - loss: 2.7508
Epoch 29/30
150330/150330 [==============================] - 223s - loss: 2.7489
Epoch 30/30
150330/150330 [==============================] - 224s - loss: 2.7470
History
# LSTMと同様、学習データを適用した結果から下の句を生成
gru_result_predict <- gru_model$predict(x = X[, , , drop = FALSE])[, seq(from = 1, to = SET_TEXT_PARAM$MAX_LEN - SET_TEXT_PARAM$STEP ), ]
> gen_gru_tanka <- mergeTankaUpperLower(
tanka_upper = normalize_tanka_text, result = gru_result_predict, chars = chars,
diversity = 1.0, target_num = nrow(x = normalize_tanka_text)
)
# A tibble: 150,330 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 きのふこそ としはくれしか はるかすみ なたのとあやや しまはろてむり
2 きのふこそ つきはたちしか いつのまに まとのにとらす なすろこむしり
3 あすよりは わかなつまむと かたをかの はめしみほとも すとにやるかや
4 うめのはな それともみえす ひさかたの やかきこまもを はちくまるけき
5 たかやとの うめのはなそも ひさかたの おねしめふかき おつまをしへせ
6 うめのはな まつさくえたを たをりもて こるよはれゆる かまにさにほむ
7 ゆきさむみ さけときかれぬ うめのはな かきはしとには あつるをみなり
8 うめのはな さきてちるとは しらぬかも くみにるなろに ゆほひのふふむ
9 わかやとに さきたるうめを つききよみ うしもまれくの なさすなのやは
10 かせはやみ おちたきつらし しらなみに まららしさすは なかりきかれは
# ... with 150,320 more rows
# LSTMモデルと同じようにパラメータを変えて異なる句を生成
set.seed(seed = 71)
> lapply(
X = seq(from = 0.9, to = 0.1, by = - 0.1),
FUN = mergeTankaUpperLower,
tanka_upper = normalize_tanka_text, result = gru_result_predict, chars = chars,
target_num = 10
)
[[1]]
# A tibble: 10 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 きのふこそ としはくれしか はるかすみ かをとのたかは こにのいぬらむ
2 きのふこそ つきはたちしか いつのまに つへわかれしそ ゆやのかまかと
3 あすよりは わかなつまむと かたをかの なにたなたとに ゆしろのなねれ
4 うめのはな それともみえす ひさかたの はさもふらして しるしすしかし
5 たかやとの うめのはなそも ひさかたの あつとぬくれの こきやをきこも
6 うめのはな まつさくえたを たをりもて いかふをかろの あきつみるなむ
7 ゆきさむみ さけときかれぬ うめのはな かかおとらまの さとのしすにむ
8 うめのはな さきてちるとは しらぬかも まふにのみのは のくをめりはる
9 わかやとに さきたるうめを つききよみ ふけらからきの まししつるへし
10 かせはやみ おちたきつらし しらなみに ほはたよはなと なほしれめなを
[[2]]
# A tibble: 10 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 きのふこそ としはくれしか はるかすみ こふのみさきの なるむしるこな
2 きのふこそ つきはたちしか いつのまに いにれつかまの こなのきるみる
3 あすよりは わかなつまむと かたをかの まきみはからは ひとなともかき
4 うめのはな それともみえす ひさかたの はまこかすろに たもるつるりも
5 たかやとの うめのはなそも ひさかたの うくまちかみを なくのなすから
6 うめのはな まつさくえたを たをりもて おらたそまにに こせたなりふれ
7 ゆきさむみ さけときかれぬ うめのはな いもよもちらき なかいききけな
8 うめのはな さきてちるとは しらぬかも おふはこむとへ ひみつはやなる
9 わかやとに さきたるうめを つききよみ かのといかとや はつひへすけふ
10 かせはやみ おちたきつらし しらなみに かすぬちあてを おすしなくらな
[[3]]
# A tibble: 10 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 きのふこそ としはくれしか はるかすみ かゆやもよなる さきひこもらむ
2 きのふこそ つきはたちしか いつのまに みねかてやらむ おろによもらむ
3 あすよりは わかなつまむと かたをかの いやみしつひむ たとのきらつみ
4 うめのはな それともみえす ひさかたの ふりかこにるに みらのおふけむ
5 たかやとの うめのはなそも ひさかたの いくはととりは はたりしらかき
6 うめのはな まつさくえたを たをりもて けもにきしとの あねるしるける
7 ゆきさむみ さけときかれぬ うめのはな あもののきはに みきやたるかな
8 うめのはな さきてちるとは しらぬかも わののとこつも なるのしりまな
9 わかやとに さきたるうめを つききよみ これなひほはを なをにこるかも
10 かせはやみ おちたきつらし しらなみに いかをみとてる くれのくくたる
[[4]]
# A tibble: 10 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 きのふこそ としはくれしか はるかすみ やふまりこきの あそのふるらむ
2 きのふこそ つきはたちしか いつのまに いとののかけは なとはこるりむ
3 あすよりは わかなつまむと かたをかの かのたのきとに ひもをきるけな
4 うめのはな それともみえす ひさかたの あろしのかとの あひのつるかを
5 たかやとの うめのはなそも ひさかたの まかののかりき なみりかりかな
6 うめのはな まつさくえたを たをりもて はなゑかしくに みなかしららり
7 ゆきさむみ さけときかれぬ うめのはな はもしにとたに いれちやとしく
8 うめのはな さきてちるとは しらぬかも こすのからまの なるはなりかな
9 わかやとに さきたるうめを つききよみ こかにのかなも そほもしるかれ
10 かせはやみ おちたきつらし しらなみに にらるのつとは いほのつくみし
[[5]]
# A tibble: 10 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 きのふこそ としはくれしか はるかすみ いかののひまる ゆとるしきなむ
2 きのふこそ つきはたちしか いつのまに いみねのこたそ あふのはかこむ
3 あすよりは わかなつまむと かたをかの よまのこつにの こものしるらな
4 うめのはな それともみえす ひさかたの いかものかりに うきにかもとは
5 たかやとの うめのはなそも ひさかたの みらをくかたの いとそはりかな
6 うめのはな まつさくえたを たをりもて あれのつととの あきそかそなる
7 ゆきさむみ さけときかれぬ うめのはな まはひのなしの なつのなるける
8 うめのはな さきてちるとは しらぬかも たものるかとの あるやきりけむ
9 わかやとに さきたるうめを つききよみ かたをくしゑは まもるなれかむ
10 かせはやみ おちたきつらし しらなみに なとたくはろの こたのさすくて
[[6]]
# A tibble: 10 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 きのふこそ としはくれしか はるかすみ あとひふからに あきそもるらむ
2 きのふこそ つきはたちしか いつのまに なたにのみたの おののとるけむ
3 あすよりは わかなつまむと かたをかの こしてのかとの なきのなるかむ
4 うめのはな それともみえす ひさかたの いみかたかみは たるのなりけも
5 たかやとの うめのはなそも ひさかたの こしものかきも なるまとらかな
6 うめのはな まつさくえたを たをりもて いきののかとの ありもなるけむ
7 ゆきさむみ さけときかれぬ うめのはな こやにとしはの あまのなきけり
8 うめのはな さきてちるとは しらぬかも こきのはかとに なかのしりかり
9 わかやとに さきたるうめを つききよみ あきにのしきは みまのとにしむ
10 かせはやみ おちたきつらし しらなみに こしふこしはる なてもなるりむ
[[7]]
# A tibble: 10 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 きのふこそ としはくれしか はるかすみ ななのとひれる あきのなりらる
2 きのふこそ つきはたちしか いつのまに かかののみたの あきのとるらむ
3 あすよりは わかなつまむと かたをかの おはをのきかの たきにこるかむ
4 うめのはな それともみえす ひさかたの はきののかとの なれのありけは
5 たかやとの うめのはなそも ひさかたの たきのはかりに しきのかのかな
6 うめのはな まつさくえたを たをりもて はきにはかとの あきのなるけむ
7 ゆきさむみ さけときかれぬ うめのはな なるののすとに しるのかるける
8 うめのはな さきてちるとは しらぬかも こつしのかまの あとのなりけむ
9 わかやとに さきたるうめを つききよみ いとにかかとは こかのなそかる
10 かせはやみ おちたきつらし しらなみに かもののかたに かともなまとは
[[8]]
# A tibble: 10 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 きのふこそ としはくれしか はるかすみ あかののかとの あるのなりかむ
2 きのふこそ つきはたちしか いつのまに いきのにかとの いきのなこらむ
3 あすよりは わかなつまむと かたをかの いきのもかとの かとかなるらむ
4 うめのはな それともみえす ひさかたの はかにもかとの あかのなりけむ
5 たかやとの うめのはなそも ひさかたの こかののかとの なりのなるかむ
6 うめのはな まつさくえたを たをりもて なるのかかりに あるのかるかむ
7 ゆきさむみ さけときかれぬ うめのはな あとののはらに あきのなるける
8 うめのはな さきてちるとは しらぬかも あらにのかとの あろのなりける
9 わかやとに さきたるうめを つききよみ なとののかとも なとやなそかむ
10 かせはやみ おちたきつらし しらなみに なきにのかみは たとのなのらは
[[9]]
# A tibble: 10 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 きのふこそ としはくれしか はるかすみ こかののかきの あきのなるけり
2 きのふこそ つきはたちしか いつのまに いかののかきの あきのなのらむ
3 あすよりは わかなつまむと かたをかの いきののかとの あとのなるかな
4 うめのはな それともみえす ひさかたの たるののかりの あきのなりけむ
5 たかやとの うめのはなそも ひさかたの あきののかとの あきのなのかむ
6 うめのはな まつさくえたを たをりもて なきののかとの あきのなるかむ
7 ゆきさむみ さけときかれぬ うめのはな あかののからに あまのなるける
8 うめのはな さきてちるとは しらぬかも かきののかとの あるのなりかる
9 わかやとに さきたるうめを つききよみ なきののかとの なとのなりかる
10 かせはやみ おちたきつらし しらなみに あきののからの なとのなのらは
LSTMもGRUも甲乙つけがたいですね。
モデルで遊ぶ
新年なので「あたらしき」で始まる上の句を用いて、お正月にふさわしそうな下の句を生成を試みました。
新年に合った句の生成に挑戦}
> normalize_tanka_text %>%
dplyr::filter(u1 == "あたらしき") %>%
dplyr::distinct()
# A tibble: 25 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 あたらしき はるのやまへの はなのみそ ところもわかす さきにけるかな
2 あたらしき はるのやまへの はなのみそ ところもわかす さきにちりける
3 あたらしき うれへはおほく さむきよの なかきよりこそ はしまりにける
4 あたらしき としのはしめに とよのとし しるすとならし ゆきのふれるは
5 あたらしき としのはしめは いやとしに ゆきふみならし つねかくにもか
6 あたらしき としのはしめの はつはるの けふふるゆきの いやしけよこと
7 あたらしき としのはしめに いやとしに ゆきふみちらし つねならぬかも
8 あたらしき うれへはおほく さむきよの なかきよりこそ はしまりにけれ
9 あたらしき はるにもさらに にぬまつは ちとせこえこぬ しるへなりけり
10 あたらしき としのはしめの うれしきは ふるきひととち あへるなりけり
# ... with 15 more rows
# 「あたらしきとしのはしめにとよのとし」と「あたらしきとしのはしめのうれしきは」を選択
org_upper_seed_str <- c("あたらしきとしのはしめにとよのとし", "あたらしきとしのはしめのうれしきは")
org_x <- genOrgX(
org_upper_str = org_upper_seed_str,
chars = chars, dummy_seed = tanka_dummy, step = SET_TEXT_PARAM$STEP
)
# LSTMモデル
set.seed(seed = 71)
lapply(
X = seq(from = 1.0, to = 0.5, by = - 0.1),
FUN = mergeTankaUpperLower,
tanka_upper = normalize_tanka_text %>%
dplyr::filter(
u1 == "あたらしき" &
(u2 == "としのはしめに" & u3 == "とよのとし") |
(u2 == "としのはしめの" & u3 == "うれしきは")
) %>%
head(n = 2),
result = model$predict(x = org_x[, , , drop = FALSE])[, seq(from = 1, to = SET_TEXT_PARAM$MAX_LEN - SET_TEXT_PARAM$STEP ), ],
chars = chars, target_num = 2
)
[[1]]
# A tibble: 2 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 あたらしき としのはしめに とよのとし かをよのかゆに なかぬわもかき
2 あたらしき としのはしめの うれしきは むほらのかかる きめみさてかと
[[2]]
# A tibble: 2 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 あたらしき としのはしめに とよのとし なにたなみまに しまになのねれ
2 あたらしき としのはしめの うれしきは ゆなもふかしに あけしなみすし
[[3]]
# A tibble: 2 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 あたらしき としのはしめに とよのとし かしてとたきく かまりあきやむ
2 あたらしき としのはしめの うれしきは あしのなこらり あほといにけを
[[4]]
# A tibble: 2 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 あたらしき としのはしめに とよのとし とれもかおとの おみくもぬなま
2 あたらしき としのはしめの うれしきは おちちのかなの おとをならひむ
[[5]]
# A tibble: 2 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 あたらしき としのはしめに とよのとし たみをつかりに うけらからかし
2 あたらしき としのはしめの うれしきは とゆしのはりの あすのかのらめ
[[6]]
# A tibble: 2 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 あたらしき としのはしめに とよのとし おきやきことも かかほみりかな
2 あたらしき としのはしめの うれしきは ききはふはれの こみしなりしに
# GRUモデル
set.seed(seed = 71)
lapply(
X = seq(from = 1.0, to = 0.5, by = - 0.1),
FUN = mergeTankaUpperLower,
tanka_upper = normalize_tanka_text %>%
dplyr::filter(
u1 == "あたらしき" &
(u2 == "としのはしめに" & u3 == "とよのとし") |
(u2 == "としのはしめの" & u3 == "うれしきは")
) %>%
head(n = 2),
result = gru_model$predict(x = org_x[, , , drop = FALSE])[, seq(from = 1, to = SET_TEXT_PARAM$MAX_LEN - SET_TEXT_PARAM$STEP ), ],
chars = chars, target_num = 2
)
[[1]]
# A tibble: 2 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 あたらしき としのはしめに とよのとし かゑよのかゆに なかぬまわけき
2 あたらしき としのはしめの うれしきは むほらのかかる きめみさのとな
[[2]]
# A tibble: 2 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 あたらしき としのはしめに とよのとし よものきゆほる いのなねれしむ
2 あたらしき としのはしめの うれしきは よよつしけこし ゆたすしかしや
[[3]]
# A tibble: 2 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 あたらしき としのはしめに とよのとし おたきくかまに ちきやらしなり
2 あたらしき としのはしめの うれしきは あすろわととに みつかなりとな
[[4]]
# A tibble: 2 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 あたらしき としのはしめに とよのとし いみみくつつと なたすにちけな
2 あたらしき としのはしめの うれしきは ななにのみらも をひちならかを
[[5]]
# A tibble: 2 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 あたらしき としのはしめに とよのとし ぬけゆみとゆの くみろはるなし
2 あたらしき としのはしめの うれしきは かきよはなとは やるよみりかな
[[6]]
# A tibble: 2 × 5
u1 u2 u3 l1 l2
<chr> <chr> <chr> <chr> <chr>
1 あたらしき としのはしめに とよのとし ききのかみみや なるこまてかを
2 あたらしき としのはしめの うれしきは まかつのみせの ふきのしとかる
結果に満足がいかなかったので、"あたらしきとしのはしめのうれしきは"に限定し、かつ多様性パラメータを1.0でたくさん生成してみました。
たくさん生成してみる}
set.seed(seed = 71)
> dplyr::bind_rows(
lapply(
X = rep(x = 1.0, times = 50),
FUN = mergeTankaUpperLower,
tanka_upper = normalize_tanka_text %>%
dplyr::filter(u1 == "あたらしき" & u2 == "としのはしめの" & u3 == "うれしきは") %>%
head(n = 2),
result = gru_model$predict(x = org_x[, , , drop = FALSE])[, seq(from = 1, to = SET_TEXT_PARAM$MAX_LEN - SET_TEXT_PARAM$STEP ), ],
chars = chars, target_num = 2
)
) %>%
as.data.frame()
u1 u2 u3 l1 l2
1 あたらしき としのはしめの うれしきは かゑよのかゆに なかぬまわけき
2 あたらしき としのはしめの うれしきは むほらのかかる きめみさのとな
3 あたらしき としのはしめの うれしきは よもみよへらの こつとよれける
4 あたらしき としのはしめの うれしきは かふつしけこし ゆたすしかしや
5 あたらしき としのはしめの うれしきは おたきくかまに ちきやわつけむ
6 あたらしき としのはしめの うれしきは ふたもへととと あをろなもとを
7 あたらしき としのはしめの うれしきは たくのさとらす おちちまるみむ
8 あたらしき としのはしめの うれしきは やくはきつくる らきれそゑのけ
9 あたらしき としのはしめの うれしきは ねすのとおむに すしつこにけも
10 あたらしき としのはしめの うれしきは かほはおかろる けとそかられら
11 あたらしき としのはしめの うれしきは なみなほのみの ふなもへしかる
12 あたらしき としのはしめの うれしきは おなねれこるの せなのきれねき
13 あたらしき としのはしめの うれしきは いきのるきへを ひそやつりりむ
14 あたらしき としのはしめの うれしきは かまこてられは こねもみのなむ
15 あたらしき としのはしめの うれしきは かくちしちかる のもかたらかな
16 あたらしき としのはしめの うれしきは ひらたはもはの おたのなるかに
17 あたらしき としのはしめの うれしきは あしもすはろに みかにいしけな
18 あたらしき としのはしめの うれしきは おのおみすなる あはむさせろて
19 あたらしき としのはしめの うれしきは たためのとめの とへひへすけな
20 あたらしき としのはしめの うれしきは きかすかつたと ほてひなくれつ
21 あたらしき としのはしめの うれしきは かろふやまくも ゆらのちほかな
22 あたらしき としのはしめの うれしきは にかのたかての むゑれねならて
23 あたらしき としのはしめの うれしきは もやはぬとしも わつはかりかし
24 あたらしき としのはしめの うれしきは みつてこしけと こけしなるこむ
25 あたらしき としのはしめの うれしきは みはなりおきく はきみくるかな
26 あたらしき としのはしめの うれしきは おほのそしらの かこはへもしの
27 あたらしき としのはしめの うれしきは みふかまたかの なるのつるはき
28 あたらしき としのはしめの うれしきは みとこやとあも まもすこすなり
29 あたらしき としのはしめの うれしきは こはのるみりに おらみほはよむ
30 あたらしき としのはしめの うれしきは そもしこつまの あきかかのつし
31 あたらしき としのはしめの うれしきは すとてをうれの みふれつそまな
32 あたらしき としのはしめの うれしきは ふきはそのふも みまのさもらむ
33 あたらしき としのはしめの うれしきは ひもをあもりに にらみけひらむ
34 あたらしき としのはしめの うれしきは うかりしたちの まほるくこけな
35 あたらしき としのはしめの うれしきは しきいるなれそ いふほらえなる
36 あたらしき としのはしめの うれしきは まかるはひとそ もとはれるしし
37 あたらしき としのはしめの うれしきは かはるましとる たたれつこかく
38 あたらしき としのはしめの うれしきは もなしかいこす まらろなるなる
39 あたらしき としのはしめの うれしきは たのもたゆとの かはほたなける
40 あたらしき としのはしめの うれしきは あへのすあよを いとたとりつく
41 あたらしき としのはしめの うれしきは なにみしつるは うるなかをくる
42 あたらしき としのはしめの うれしきは のとやみねやむ わちのこりみな
43 あたらしき としのはしめの うれしきは あかへはあにや うちぬそりえは
44 あたらしき としのはしめの うれしきは はのおもつけぬ やえもこねとさ
45 あたらしき としのはしめの うれしきは みたのてひしに うひとそりなむ
46 あたらしき としのはしめの うれしきは そやにおいれそ こそひかにしる
47 あたらしき としのはしめの うれしきは こくののみしを ならひつるけむ
48 あたらしき としのはしめの うれしきは かこゆもたはき あけはかろかき
49 あたらしき としのはしめの うれしきは おもせはふなの かろやなりらな
50 あたらしき としのはしめの うれしきは たもひきなれの あれほもるつて
51 あたらしき としのはしめの うれしきは あましみかえき ゆもやかれよな
52 あたらしき としのはしめの うれしきは いれくもふとは さすちめかろく
53 あたらしき としのはしめの うれしきは かちむてもゆも もはれをたゆし
54 あたらしき としのはしめの うれしきは にくこくしこを なまのわりかの
55 あたらしき としのはしめの うれしきは うえるれもやの あふはしにさな
56 あたらしき としのはしめの うれしきは われひのくこの まねかきもなは
57 あたらしき としのはしめの うれしきは そゆしとこさる かほなしけかり
58 あたらしき としのはしめの うれしきは いふにやあせの あまなみしそれ
59 あたらしき としのはしめの うれしきは いほこかいふに みえとしらしは
60 あたらしき としのはしめの うれしきは ちらのきたゆの ふきれこらはせ
61 あたらしき としのはしめの うれしきは きほにるなけむ うかやほふかむ
62 あたらしき としのはしめの うれしきは もかたとたねの むとりなつかき
63 あたらしき としのはしめの うれしきは くつのるきこも やてからこへな
64 あたらしき としのはしめの うれしきは むままとれかは あをたしりせな
65 あたらしき としのはしめの うれしきは まかのつみおの やみひをるなを
66 あたらしき としのはしめの うれしきは せましりほらの あるにもそこむ
67 あたらしき としのはしめの うれしきは さはたつしくの うかむたにらり
68 あたらしき としのはしめの うれしきは きないてさつの ひつさあろつを
69 あたらしき としのはしめの うれしきは むひのはみたぬ よまのにものり
70 あたらしき としのはしめの うれしきは それひひほはと あるになけたる
71 あたらしき としのはしめの うれしきは くかまへとくに すかかとのけし
72 あたらしき としのはしめの うれしきは しすにてゆある かきれしらなて
73 あたらしき としのはしめの うれしきは うもはろしらに けるやわもなて
74 あたらしき としのはしめの うれしきは けたひてりたさ つまのかりるめ
75 あたらしき としのはしめの うれしきは つらきももさも ゆちひやるそは
76 あたらしき としのはしめの うれしきは あたひのむなは かとにすくかに
77 あたらしき としのはしめの うれしきは みかりにもはも かそななりかり
78 あたらしき としのはしめの うれしきは まくかのはまの ちらもうのやな
79 あたらしき としのはしめの うれしきは みきいもつらむ ちとやかはさと
80 あたらしき としのはしめの うれしきは いはききいきも なみもてまなも
81 あたらしき としのはしめの うれしきは かつはふめふは ちてれえにぬな
82 あたらしき としのはしめの うれしきは せへせにかえを まめてよちれゆ
83 あたらしき としのはしめの うれしきは ゆすかしきのも みろるやにらと
84 あたらしき としのはしめの うれしきは なさりるほまき からまなのらな
85 あたらしき としのはしめの うれしきは なみたそあくや こちひきりねり
86 あたらしき としのはしめの うれしきは つきれもしとに なとそしゆほは
87 あたらしき としのはしめの うれしきは もよしををゆも やひいなきぬむ
88 あたらしき としのはしめの うれしきは みやへゆとなふ こもたたととる
89 あたらしき としのはしめの うれしきは ふのうにこかは ゆるちなもへむ
90 あたらしき としのはしめの うれしきは ちすひききかは あひしからねけ
91 あたらしき としのはしめの うれしきは いさはとかしる みわもこやすむ
92 あたらしき としのはしめの うれしきは あゆをこくへの みかたしるかむ
93 あたらしき としのはしめの うれしきは うめかすすろも おれてそるにゑ
94 あたらしき としのはしめの うれしきは ひきせのせれの はきたかりらは
95 あたらしき としのはしめの うれしきは くしたのあさは みもそたはすれ
96 あたらしき としのはしめの うれしきは こもちとかかも たてりままもき
97 あたらしき としのはしめの うれしきは くほひいたねも あきもわりなて
98 あたらしき としのはしめの うれしきは おくはのやたや てたらなこかや
99 あたらしき としのはしめの うれしきは みるみやらちよ あらそをりみる
100 あたらしき としのはしめの うれしきは あらのきさけに かれしみりしせ
非常に残念ですが、いい感じの句は見当たりません。
まとめ
{tensorflow}のimport関数を利用してR上からKerasを用いたモデルを構築し、短歌のデータを適用して下の句を生成することに挑戦しました。モデル自体は動作して生成自体は可能でしたが、及第点を与えられるような歌はできませんでした。
うまくいかなかった要因として、Epoch数が少ない点が考えられます。もっと学習を回してみたくGPUパワーを欲していますが、高いマネーが必要なって一個人では手が出せそうにありません。
また、モデルの一新も改善案に挙げられます。今回はRNN-LSTM/GRUをベースにしていますが、タスクとしてはSequence-to-Sequenceのアプローチの方が適していると考えられます。Sequence-to-Sequenceに関してはKerasのIssueが立っており、今後の取り込みを期待しています（Attensionモデルとかも）。
加えて今回は「句数 × 文字のOne-hot表現」のデータを上の句と下の句で対応づけるようにしているので、画像でよく採用されているCNNによるアプローチも使えるかもしれません。もちろん、系列データとしてSTEPサイズで句を切り、一文字ずつ生成するようにしてもいいと思います（むしろこちらの方を試してみるべきでした）。
いろいろと試せそうなので折を見て触ってみます。
gensimに続いてKerasをR上で活用した所感をまとめると、残念ながらPythonで使える機能をそのままというわけではありません。手軽に試す分にはよいですが、いくつかの関数が利用できなかったり（gensimを利用した記事も参照のこと。ただし、実行環境によって利用できたので調査が必要）、Pythonのlist形式への型変換ができず、パラメータを与えられないという壁にぶちあたりました。これにより、複雑なモデルをKerasで作成する際に役立つcallbackやmergeなどの機能が~利用できなくて、あれこれ試しましたがPythonで書くというのがシンプルでベストな解になりそうです（こちらはtensowflowないしは{tensowflow}のバージョンをあげる、または再インストールで実行可能になり、EarlyStoppingもTensorBoardも動作しました）。
無理やりKerasを呼び出すよりも、Rで使うなら{tensowflow}や{mxnet}がいいかもしれませんね。
ということで、今年はPythonを勉強しましょう。
参考
-
Multi-layer Recurrent Neural Networks (LSTM, GRU, RNN) for character-level language models in Torch
-
Implementation of Sequence Generative Adversarial Nets with Policy Gradient
-
Google Magentaが新たに公開した2つの作曲ニューラルネットワーク(Lookback RNN,Attention RNN)
実行環境
R実行環境}
> devtools::session_info()
Session info -------------------------------------------------------------------------------------
setting value
version R version 3.3.2 (2016-10-31)
system x86_64, darwin15.6.0
ui RStudio (1.0.136)
language (EN)
collate ja_JP.UTF-8
tz Asia/Tokyo
date 2017-01-03
Packages -----------------------------------------------------------------------------------------
package * version date source
assertthat 0.1 2013-12-06 CRAN (R 3.3.2)
car 2.1-4 2016-12-02 CRAN (R 3.3.2)
caret * 6.0-73 2016-11-10 CRAN (R 3.3.2)
codetools 0.2-15 2016-10-05 CRAN (R 3.3.2)
colorspace 1.3-2 2016-12-14 CRAN (R 3.3.2)
devtools 1.12.0 2016-12-05 CRAN (R 3.3.2)
digest 0.6.10 2016-08-02 CRAN (R 3.3.2)
foreach 1.4.3 2015-10-13 CRAN (R 3.3.1)
ggplot2 * 2.2.0 2016-11-11 CRAN (R 3.3.2)
gtable 0.2.0 2016-02-26 CRAN (R 3.3.2)
iterators 1.0.8 2015-10-13 CRAN (R 3.3.1)
lattice * 0.20-34 2016-09-06 CRAN (R 3.3.2)
lazyeval 0.2.0 2016-06-12 CRAN (R 3.3.2)
lme4 1.1-12 2016-04-16 CRAN (R 3.3.2)
magrittr 1.5 2014-11-22 CRAN (R 3.3.2)
MASS 7.3-45 2016-04-21 CRAN (R 3.3.2)
Matrix 1.2-7.1 2016-09-01 CRAN (R 3.3.2)
MatrixModels 0.4-1 2015-08-22 CRAN (R 3.3.2)
memoise 1.0.0 2016-01-29 CRAN (R 3.3.2)
mgcv 1.8-15 2016-09-14 CRAN (R 3.3.2)
minqa 1.2.4 2014-10-09 CRAN (R 3.3.2)
ModelMetrics 1.1.0 2016-08-26 CRAN (R 3.3.2)
munsell 0.4.3 2016-02-13 CRAN (R 3.3.2)
nlme 3.1-128 2016-05-10 CRAN (R 3.3.2)
nloptr 1.0.4 2014-08-04 CRAN (R 3.3.2)
nnet 7.3-12 2016-02-02 CRAN (R 3.3.2)
pbkrtest 0.4-6 2016-01-27 CRAN (R 3.3.2)
plyr 1.8.4 2016-06-08 CRAN (R 3.3.2)
quantreg 5.29 2016-09-04 CRAN (R 3.3.2)
Rcpp 0.12.8 2016-11-17 CRAN (R 3.3.2)
reshape2 1.4.2 2016-10-22 CRAN (R 3.3.2)
RevoUtils 10.0.2 2016-11-22 local
scales 0.4.1 2016-11-09 CRAN (R 3.3.2)
SparseM 1.74 2016-11-10 CRAN (R 3.3.2)
stringi 1.1.2 2016-10-01 CRAN (R 3.3.2)
stringr 1.1.0 2016-08-19 CRAN (R 3.3.2)
tensorflow * 0.3.0 2017-01-03 Github (rstudio/tensorflow@7920fb3)
tibble 1.2 2016-08-26 CRAN (R 3.3.2)
withr 1.0.2 2016-06-20 CRAN (R 3.3.2)
Python実行環境}
$ python --version
Python 2.7.12
$ pip list --format=columns | grep -e "tensorflow" -e "Keras"
Keras 1.1.1
tensorflow 0.12.1