R言語でワードクラウドを作る『呪術廻戦』編

Twitterのツイート解析の準備をします

R言語の「wordcloud2」を使ってワードクラウドを作ります。
今回は、少年ジャンプ掲載の「呪術廻戦」というワードを含むツイートを形態素解析にかけて作ることにしました。

（※プログラムはFORTRAN以来久しぶりなので、検証しながら進めました。冗長性のあるコードだと思いますがご容赦ください）

Twitter APIの認証情報設定を設定します。

#Twitter API認証情報設定
consumerKey <- "************"
consumerSecret <- "******************"
accessToken <- "*******************"
accessSecret <- "*********************"

Twitter APIにログインします。

library("twitteR")
options(httr_oauth_cache = TRUE)
setup_twitter_oauth(consumerKey, consumerSecret, accessToken, accessSecret)

指定したキーワードを含むツイートを取得します

「呪術廻戦」を含む日本語ツイートを取得します。
テレビ放送のあった翌日３月７日に取得しました。
（この後、3月8日のツイートも取得しました。後述）

##TwitterAPIにログイン
library("twitteR")
options(httr_oauth_cache = TRUE)
setup_twitter_oauth(consumerKey, consumerSecret, accessToken, accessSecret)

#「呪術廻戦」を含む日本語ツイートを10000件取得。2021年3月7日（日）から
tweets <- searchTwitter('呪術廻戦', n = 10000, since = "2021-03-07" , lang="ja" , locale="ja")
#日本語とロケールを指定（日本なら"ja")
#resultTypeを目的に応じて"popular","recent","mixed"を指定。詳細な使い方がわからなかったので、今回は使いませんでした

加工しやすいようにデータフレーム 型に変換します。

#データフレームに変換
tweetsdf <- twListToDF(tweets) 
#変換前後の型を確認
class(tweetsdf)
[1] "list"
class(tweets)
[1] "data.frame"

#データフレームの内容を確認
library(dplyr)
tweetsdf  %>% head()

リツイートされたもの（TRUE）、そうでないツイート（FALSE）の数を確認します。
とりあえず、リツイートされたものも含めて形態素解析をします。

#リツイートされたもの（TRUE）、そうでないもの（FALSE）の数を確認
table(tweetsdf$isRetweet)
FALSE  TRUE 
 3521  6479 

RMeCabを使い形態素解析をかけます

形態素解析をかけるために、データフレームのテキスト列（ツイートテキスト）をピックアップし、一時ファイルに保存します。

#データフレームのテキスト列だけ抽出
texts <- tweetsdf$text

#後々使うのでテキスト処理のためのライブラリを呼び出す
library(stringr)
library(magrittr)

#複数の（リスト型）テキストを結合。テキストとテキストの間にはブランクを入れる
texts2 <- paste(texts, collapse = "")

#一時ファイルを作り、xfileという名前で保存
xfile <- tempfile()
write(texts2, xfile)

xfileに対し、形態素解析を実行します。

##形態素解析のライブラリー
library(RMeCab)

#形態素解析。頻度（Freq）を集計
frq_Tw <- RMeCabFreq(xfile)
#上位50を確認（↓その一部）
frq_Tw %>% arrange(Freq) %>% tail(50)
        Term  Info1    Info2  Freq
17400 バッジ   名詞     一般  2257
17401     を   助詞   格助詞  2278
17402   譲渡   名詞 サ変接続  2346
17403      (   名詞 サ変接続  2347
17404      3   名詞       数  2453
17405     」   記号   括弧閉  2462
17406     「   記号   括弧開  2471
17407   伏黒   名詞 固有名詞  2574
17408     で   助詞   格助詞  2597
17409   です 助動詞        *  2607
17410   する   動詞     自立  2612
17411   五条   名詞 固有名詞  2643

自立語／品詞を絞ってワードを抽出します

このままワードクウドを作成すると、収集つかなくなりそうなので、今回は見栄えの検証を優先するために、（色々試した結果）「形容詞」と「固有名詞」に絞ることにしました。

#形容詞（Info1列）を抽出
frq2_Tw <- frq_Tw %>% filter(Info1 %in% c("形容詞")) 
frq2_Tw %>% arrange(Freq) %>% tail(50) #確認

#固有名詞（Info2列）を抽出 
frq3_Tw <- frq_Tw %>% filter(Info2 %in% c("固有名詞"))
frq3_Tw %>% arrange(Freq) %>% tail(50) #確認

#形容詞（Info1列）を抽出した行と、固有名詞（Info2列）を抽出した行を結合
frq4_Tw <- rbind(frq2_Tw, frq3_Tw)
frq4_Tw %>% arrange(Freq) %>% tail(50) #確認（↓その一部）
           Term  Info1    Info2  Freq
1577       七海   名詞 固有名詞  1235
1578       渋谷   名詞 固有名詞  1263
1579       真希   名詞 固有名詞  1283
1580      https   名詞 固有名詞  2101
1581       伏黒   名詞 固有名詞  2574
1582       五条   名詞 固有名詞  2643
1583         RT   名詞 固有名詞  2870
1584         譲   名詞 固有名詞  3528
1585         求   名詞 固有名詞  3530
1586         廻   名詞 固有名詞 12241

"ノイズ"になりそうなワードを外します

例えば、「http」など投稿内容に影響しないワードを外します。

#termが英語を削除。noun列が作られ「<NA>」が表示。mutateは列を追加したり修正する
library("stringr")
frq5_Tw <- frq4_Tw %>% mutate(noun=str_match((Term), '[^a-zA-Z]+'))
frq5_Tw %>% arrange(Freq) %>% tail(50) #確認
           Term  Info1    Info2  Freq       noun
1580      https   名詞 固有名詞  2101       <NA>
1581       伏黒   名詞 固有名詞  2574       伏黒
1582       五条   名詞 固有名詞  2643       五条
1583         RT   名詞 固有名詞  2870       <NA>
1584         譲   名詞 固有名詞  3528         譲
1585         求   名詞 固有名詞  3530         求
1586         廻   名詞 固有名詞 12241         廻

#削除。na.omitでNA含む行を削除。
frq5_Tw2 <- na.omit(frq5_Tw)
frq5_Tw2 %>% arrange(Freq) %>% tail(50) #確認

#termが記号を識別。noun列が作られ「<NA>」が表示。「\\W」は記号。
frq5_Tw3 <- frq5_Tw2 %>% mutate(noun=str_match((Term), '[^\\W]+'))
frq5_Tw3 %>% arrange(Freq) %>% tail(50) #確認

#削除。na.omitでNA含む行を削除。
frq5_Tw4 <- na.omit(frq5_Tw3) 
frq5_Tw4 %>% arrange(Freq) %>% tail(50) #確認

今回は使いませんでしたが、一文字のワードがノイズになることがあるので、その場合は次の手順で外します。

#Termが一文字の行を削除
frq5_Tw5 <- frq5_Tw4
index <- grep('..', frq5_Tw5[,1]) #1文字の行番号抽出
frq5_Tw5[index,] %>% arrange(Freq) %>% tail(50) #確認
frq5_Tw6 <- frq5_Tw5[index,] 
frq5_Tw6 %>% arrange(Freq) %>% tail(50) #確認

wordcloud2で描画します

wordcloud2を使います。

#wordcloud2で描画準備
frq5_Tw7 <- frq5_Tw4 #元のデータフレームに戻せるようにする

#Freqが100以上にする
frq5_Tw7 <-　frq5_Tw7$Freq >= 100
tail(frq5_Tw7) #確認
frq5_Tw8 <- frq5_Tw4[frq5_Tw7,]
frq5_Tw8 %>% arrange(Freq) %>% tail(50) #確認

#最後の行「46         廻   名詞 固有名詞 12241         廻」
#は「呪術廻戦」の一文字かつ、Freqの数が大きいので外す
frq5_Tw9 <- frq5_Tw8 %>% filter(Term != "廻")
frq5_Tw9 %>% arrange(Freq) %>% tail(50) #確認

#wordcloud2で描画。frq5_Tw9の１列目（Term）と４列目（Freq）を使う
library(wordcloud2)
frq5_Tw9[,c(1,4)] %>% wordcloud2()
frq5_Tw9[,c(1,4)] %>% wordcloud2(size=2,minSize=1) #sise=2では全体が大きすぎるので下記利用
frq5_Tw9[,c(1,4)] %>% wordcloud2(size=1.3,minSize=1,gridSize=10)  #gridSizeは文字間隔

描画したワードクラウドです。

「譲」「求」が目立ちます。
３月６日に『呪術廻戦』ミニ原画展が全国TSUTAYAで開催され、販売されていたグッズの交換を目的に、「譲る」「求める」というツイートが拡散されたことが影響したようです。

リツイートを外します

そこで、リツイートを外すことにしました。
上記で説明した手順で実施します。
今回は、（実施したのが翌日ということもあり）３月８日（月）のツイートを対象にしました。
３月７日と同様の傾向だったので、以下手順でリツイートを外し、形態素解析をかけます。

#次に3/8（月）少年発ジャンプ売日のツイート取得
#3/7と同様の傾向だったので、取得したものからリツイートされたものを外して比較します
#リツイートされたもの（TRUE）とそうでないもの（FALSE）の数を確認
table(tweetsdf2$isRetweet)
FALSE  TRUE 
 3245  6755 

#FALSEを抽出
tweetsdf3 <- tweetsdf2 %>% filter(isRetweet %in% c("FALSE"))
head(tweetsdf3) #確認
nrow(tweetsdf3) #確認

#テキスト列のみを抽出し、結合
texts2 <- tweetsdf3$text
texts2 %<>% str_replace_all("\\p{ASCII}", "") #今回はここで記号やアルファベットを削除
texts3 <- paste(texts2, collapse = "")

#一時ファイルを作り、xfile2という名前で保存
xfile2 <- tempfile()
write(texts3, xfile2)

形態素解析実行します。

#形態素解析。頻度を集計
frq_Tw2 <- RMeCabFreq(xfile2)
#上位50を確認
frq_Tw2 %>% arrange(Freq) %>% tail(50)

以下wowordcloud2を使い同様に描画しました。

frq11_Tw2a <-　frq10_Tw2a$Freq >= 25
frq12_Tw2a <- frq10_Tw2a[frq11_Tw2a,]
frq13_Tw2a <- ffrq12_Tw2a %>% filter(Term != "廻")
frq13_Tw2a[,c(1,4)] %>% wordcloud2(size=1.3,minSize=1,gridSize=10) 

了