cucumber flesh

Rを中心としたデータ分析・統計解析らへんの話題をしていくだけ

本日発表!ほくぽえむ大賞2017 俳句の部

f:id:u_ribo:20171207065706p:plain

ホクソエムといえばポエムです(要出典)。今日はTwitterでのホクソエム氏の投稿から、俳句を探してこようと思います。そして、今年のベスト俳句を独断と偏見により決めます。戦略としては、Twitterから投稿を取得、日本語形態素解析システム JUMAN++により形態素解析、単語の読みの文字数から俳句の定型を判定、というものです。

それでは早速データを取得するところから始めましょう。データの利用に際して、ホクソエム氏から許可をいただいております。

言葉にするのって難しいですね。

データ取得と前処理

ツイッターAPIを利用するため、rtweetパッケージを用います。認証を済ませ、タイムラインから投稿を取得します。

library(magrittr)
library(tidyverse)
library(rtweet)

get_timeline()でユーザを指定し、取得件数を決定します。他の引数からAPIのパラメータを変更可能なようですが、下記の例ではうまくいかなかったです。

df_hoxom <- get_timeline("hoxo_m", n = 3000, 
    exclude_replies = TRUE, include_rts = FALSE)

取得したデータから、今年の投稿を抽出します。また、RTやリプライ、URLを含んだ投稿等を除外します。加えて今回の俳句判定には、アルファベットを含むとカウントを正常に行えないという課題がありましたのでこれも除外します。その他の空白や記号の除去も次のコードで実行します。

df_hoxom$created_at %>% range()
## [1] "2016-09-24 14:21:10 UTC" "2017-12-06 13:15:42 UTC"
df_hoxom %<>% # 今年の投稿、RTやメンションを取り除く
filter(between(created_at, lubridate::ymd_hms("20170101 00:00:00"), 
    lubridate::ymd_hms("20171231 23:59:59")), 
    is_retweet == FALSE, is.na(reply_to_status_id), 
    is.na(urls_url), !grepl("^@", text)) %>% 
    # 記号、空白の除去
mutate(text = str_replace_all(text, "[:punct:]", 
    "") %>% str_replace_all(., "[:space:]", 
    "")) %>% filter(!grepl("[A-Za-z]", text)) %>% 
    # 余分な列を削除
# 投稿のID、投稿日時、投稿文に制限
select(status_id, created_at, text)

俳句の判定

肝となる俳句の判定は、次の条件で行います。

  • 投稿文を平仮名読みに直し、文字数を数える
  • 単語の文字数で5,7,5のリズム(17文字)になるものを「俳句」とする
"古池や蛙飛び込む水の音" %>% str_count()
## [1] 11
"ふるいけやかわずとびこむみずのおと" %>% 
    str_count()
## [1] 17
df_hoxom$text[1]
## [1] "謙虚さと学び"
df_hoxom$text[1] %>% str_count()
## [1] 6

柿食えば鐘が鳴るなり法隆寺」のように17文字ではないものも俳句になりますが、今回は厳密に17文字のものを俳句とみなしています。

肝心の自然言語処理の部分はJUMAN++にやってもらいます。JUMAN++のRラッパパッケージrjumanppid:songcunyouzai (y__mattu) が開発してくれているのでそれを使います。サンキューマッツ!

[https://github.com/ymattu/rjumanpp:embed:cite]

[http://y-mattu.hatenablog.com/entry/2017/08/19/230432:embed:cite]

text_wakati <- rjumanpp::jum_text("かずたんがフリー素材になっている")
text_wakati[[1]]
##  [1] "かず"                     "かず"                    
##  [3] "かず"                     "名詞"                    
##  [5] "6"                        "普通名詞"                
##  [7] "1"                        "*"                       
##  [9] "0"                        "*"                       
## [11] "0"                        "\"代表表記:下図/かず"    
## [13] "自動獲得:EN_Wiktionary\""
text_wakati[[5]]
##  [1] "素材"                     "そざい"                  
##  [3] "素材"                     "名詞"                    
##  [5] "6"                        "普通名詞"                
##  [7] "1"                        "*"                       
##  [9] "0"                        "*"                       
## [11] "0"                        "\"代表表記:素材/そざい"  
## [13] "〜を〜に構成語"           "カテゴリ:人工物-その他\""

「かずたん」(もしかして: @kazutan)がうまく分かち書きできていないのが気になりますが、読みや品詞の区分が行われた結果が得られました。

この結果をデータフレームにしておくと色々捗るので関数を用意しましょう。

jum_text_separate <- function(text) {
    x <- rjumanpp::jum_text(text)
    res <- x %>% purrr::map_df(~tibble::data_frame(.[2], 
        .[4], .[6])) %>% purrr::set_names(c("yomi", 
        "hinsi_bunrui_dai", "hinsi_bunrui_sai"))
    return(res)
}

次に今作成した関数を利用し、読みの文字数が17文字となるものを抽出します。これが条件1をクリアした「俳句」の候補となります。そして、条件をクリアした投稿文に対して、単語の読みの文字数を数えます。これを足し合わせ、5,7(12),5(17)となっているものを最終的な「俳句」とみなします。

"かずたんがフリー素材になっている" %>% 
    jum_text_separate(text = .) %>% # 17文字となるものに制限
filter_at(vars("yomi"), any_vars(str_count(paste(., 
    collapse = "")) == 17)) %>% # 単語の文字数を累積
mutate(haiku = cumsum(str_count(yomi)))
## # A tibble: 8 x 4
##     yomi hinsi_bunrui_dai hinsi_bunrui_sai haiku
##    <chr>            <chr>            <chr> <int>
## 1   かず             名詞         普通名詞     2
## 2   たん             名詞         普通名詞     4
## 3     が             助詞           格助詞     5
## 4 ふりー           形容詞                *     8
## 5 そざい             名詞         普通名詞    11
## 6     に             助詞           格助詞    12
## 7 なって             動詞                *    15
## 8   いる           接尾辞     動詞性接尾辞    17

この「かずたん〜」は5,7,5になっているので条件をクリアしていることになります。ということでこれも関数化しておきましょう。先ほど書いた関数を追加して、一度に全ての処理を完結するようにします。

is_haiku <- function(text, ...) {
    x <- jum_text_separate(text) %>% filter_at(vars("yomi"), 
        any_vars(str_count(paste(., collapse = "")) == 
            17)) %>% mutate(haiku = cumsum(str_count(yomi))) %>% 
        filter(haiku %in% c(5, 12, 17))
    res <- if_else(nrow(x) == 3, TRUE, FALSE)
    return(res)
}

次のような判定結果を得ます。

c("かずたんがフリー素材になっている", 
    "謙虚さと学び", "なつくさやつわものどもがゆめのあと") %>% 
    map_lgl(is_haiku)
## [1]  TRUE FALSE  TRUE

is_haiku()の結果を投稿データに適用し、いよいよ「ほくぽえむ大賞2017 俳句の部」の作品発表です!

df_hoxom %<>% filter(pmap_lgl(., ~is_haiku(text, 
    ...)) == TRUE)

ほくぽえむ大賞2017 俳句の部

入選作品の発表です。厳しい審査の結果、今年は4件の発表が選ばれました。

df_hoxom %>% knitr::kable(format = "markdown")
status_id created_at text
917606569378017280 2017-10-10 04:23:49 ぞうさんのおすすめテーマにしてみた
874064391338999808 2017-06-12 00:42:44 エレベタやおっさんどもが臭の跡
852532562635313152 2017-04-13 14:42:56 多様体いろんなとこに潜んでる
832896107428536320 2017-02-18 10:14:41 かずたんがフリー素材になっている

佳作

どういう状況かわかりませんが、声に出して読みたい感が高評価につながりました。おめでとうございます!また、「かずたん」は入選作品に2回も登場することから俳句に適したポエットな単語であることがわかりました。

データサイエンティストとしての意識からなのか、ふとしたつぶやきに才能を感じるこの投稿が佳作です。わたしはこの作品から、星新一ショートショートを連想しました。皆さんはどうでしょう。

大賞

こちらの俳句は初夏に詠まれたものです。「エレベタ」と「おっさん」の組み合わせ、そして「息の跡」とポエム度が高いです!スペースも入れて、詠み人自身の俳句としての意識が強いこの投稿が大賞となります!おめでとうございます!!

審査委員の言葉

いかがだったでしょう。思ったりもポエム(俳句)が少ないですね。17文字という自由度の低さが原因だったのか、この辺は改良が必要そうです。また、来年は「俳句」で肝心なキレも採点基準に加えたいと思います。

来年はより多くのポエムが投稿されることをねがいます。ホクソエムアドベントカレンダー、明日は未定です!誰か〜

Enjoy!