今回、wordcloudを使って作成した下のワードクラウドと、ggplot2を使ったバーグラフ（棒グラフ）の可視化を試みました。
前回同様にツイートを取得します
ワード「呪術廻戦」を含むツイートを取得しました。
2021年3月27日以降、最大10,000としました。
前回同様の手順で取り込みました。
#TwitterAPI認証情報設定
consumerKey <- "************"
consumerSecret <- "*****************"
accessToken <- "*****************"
accessSecret <- "*********************"
##TwitterAPIにログイン
library("twitteR")
options(httr_oauth_cache = TRUE)
setup_twitter_oauth(consumerKey, consumerSecret, accessToken, accessSecret)
#「呪術廻戦」を含む日本語ツイートを10000件取得。2021年3月27日から
tweets2 <- searchTwitter('呪術廻戦', n = 10000, since = "2021-03-27" , lang="ja" , locale="ja")#日本語とロケールを指定（日本なら"ja")# 目的に応じて"popular","recent","mixed"を指定 #◼️
#データフレームに変換
tweetsdf2 <- twListToDF(tweets2)
#型を確認
class(tweets2)
[1] "data.frame"
#取得できたか確認
library(dplyr)
tweetsdf2 %>% head()
#リツイートされたもの（TRUE）、そうでないもの（FALSE）の数を確認
table(tweetsdf2$isRetweet)
FALSE TRUE
2539 7461
#今回リツイートのみ使ってみる
tweetsdf3 <- tweetsdf2 %>% filter(isRetweet %in% c("TRUE"))
head(tweetsdf3) #確認
nrow(tweetsdf3) #確認
#データフレームのテキスト列だけ抽出
texts <- tweetsdf3$text
#後々使うのでテキスト処理のためのライブラリを呼び出す
library(stringr)
library(magrittr)
#複数の（リスト型）テキストを結合。テキストとテキストの間にはブランクを入れる
texts3 <- paste(texts, collapse = "")
#一時ファイルを作り、xfileという名前で保存
xfile <- tempfile()
write(texts3, xfile)
##形態素解析のライブラリー
library(RMeCab)
#形態素解析。頻度を集計
frq_Tw2 <- RMeCabFreq(xfile)
#上位50を確認
frq_Tw2 %>% arrange(Freq) %>% tail(50)
Term Info1 Info2 Freq
9256 0 名詞 数 344
9257 譲渡 名詞 サ変接続 369
9258 ない 助動詞 * 382
9259 ？ 記号 一般 383
9260 五条 名詞 固有名詞 407
9261 https 名詞 一般 409
9262 伏黒 名詞 固有名詞 414
9263 と 助詞 格助詞 416
9264 か 助詞 副助詞／並立助詞／終助詞 427
9265 ( 名詞 サ変接続 444
9266 を 助詞 格助詞 453
9267 です 助動詞 * 467
9268 見る 動詞 自立 480
9269 てる 動詞 非自立 480
9270 虎杖 名詞 一般 483
9271 2 名詞 数 515
9272 ) 名詞 サ変接続 534
9273 映画 名詞 一般 538
前回「形容詞」と、「名詞」の中の「固有名詞」をピックアップしましたが、今回よく見ると、
9270 虎杖 名詞 一般 483
と「虎杖」という（外せない）キーワードが入っているので、今回は「名詞」をピックアップすることにしました。
frq3_Tw2 <- frq_Tw2 %>% filter(Info1 %in% c("名詞"))
frq3_Tw2 %>% arrange(Freq) %>% tail(50) #確認
7390 アニメ 名詞 一般 281
7391 ん 名詞 非自立 282
7392 バッジ 名詞 一般 287
7393 @ 名詞 サ変接続 294
7394 送料 名詞 一般 309
7395 崎 名詞 一般 326
7396 釘 名詞 一般 336
7397 # 名詞 サ変接続 343
7398 缶 名詞 一般 344
7399 0 名詞 数 344
7400 譲渡 名詞 サ変接続 369
7401 五条 名詞 固有名詞 407
7402 https 名詞 一般 409
7403 伏黒 名詞 固有名詞 414
7404 ( 名詞 サ変接続 444
7405 虎杖 名詞 一般 483
7406 2 名詞 数 515
7407 ) 名詞 サ変接続 534
7408 映画 名詞 一般 538
7409 1 名詞 数 566
7410 譲 名詞 固有名詞 602
7411 求 名詞 固有名詞 603
7412 https 名詞 固有名詞 645
7413 交換 名詞 サ変接続 679
7414 :// 名詞 サ変接続 1054
7415 co 名詞 一般 1054
7416 t 名詞 一般 1060
7417 . 名詞 サ変接続 1216
7418 / 名詞 サ変接続 1351
7419 戦 名詞 接尾 2745
7420 廻 名詞 固有名詞 2766
7421 呪術 名詞 一般 2782
ノイズになりそうなワードを外します
見やすいように整形するために、「記号」「アルファベット」を削除します。
library("stringr")
#termが英語を削除。noun列が作られ「<NA>」が表示。mutateは列を追加したり修正する
frq4_Tw2 <- frq3_Tw2 %>% mutate(noun=str_match((Term), '[^a-zA-Z]+')) #◼️
frq4_Tw2 %>% arrange(Freq) %>% tail(50)
7410 譲 名詞 固有名詞 602 譲
7411 求 名詞 固有名詞 603 求
7412 https 名詞 固有名詞 645 <NA>
7413 交換 名詞 サ変接続 679 交換
7414 :// 名詞 サ変接続 1054 ://
7415 co 名詞 一般 1054 <NA>
7416 t 名詞 一般 1060 <NA>
7417 . 名詞 サ変接続 1216 .
7418 / 名詞 サ変接続 1351 /
7419 戦 名詞 接尾 2745 戦
7420 廻 名詞 固有名詞 2766 廻
7421 呪術 名詞 一般 2782 呪術
#削除。na.omitでNA含む行を削除。
frq5_Tw2 <- na.omit(frq4_Tw2) #◼️
frq5_Tw2 %>% arrange(Freq) %>% tail(50)
4993 譲 名詞 固有名詞 602 譲
4994 求 名詞 固有名詞 603 求
4995 交換 名詞 サ変接続 679 交換
4996 :// 名詞 サ変接続 1054 ://
4997 . 名詞 サ変接続 1216 .
4998 / 名詞 サ変接続 1351 /
4999 戦 名詞 接尾 2745 戦
5000 廻 名詞 固有名詞 2766 廻
5001 呪術 名詞 一般 2782 呪術
#termが記号を識別。noun列が作られ「<NA>」が表示。「\\W」は記号
frq6_Tw2 <- frq5_Tw2 %>% mutate(noun=str_match((Term), '[^\\W]+'))
frq6_Tw2 %>% arrange(Freq) %>% tail(50)
4993 譲 名詞 固有名詞 602 譲
4994 求 名詞 固有名詞 603 求
4995 交換 名詞 サ変接続 679 交換
4996 :// 名詞 サ変接続 1054 <NA>
4997 . 名詞 サ変接続 1216 <NA>
4998 / 名詞 サ変接続 1351 <NA>
4999 戦 名詞 接尾 2745 戦
5000 廻 名詞 固有名詞 2766 廻
5001 呪術 名詞 一般 2782 呪術
#削除。na.omitでNA含む行を削除。
frq7_Tw2 <- na.omit(frq6_Tw2)
frq7_Tw2 %>% arrange(Freq) %>% tail(50)
4487 譲 名詞 固有名詞 602 譲
4488 求 名詞 固有名詞 603 求
4489 交換 名詞 サ変接続 679 交換
4490 戦 名詞 接尾 2745 戦
4491 廻 名詞 固有名詞 2766 廻
4492 呪術 名詞 一般 2782 呪術
さらに見やすくするために1文字のワードを外すことにしました。
ただ、2文字の単単語とみなされませんでしたが、以下の1文字のワードは抜き出し、後で結合することにしました。
4463 巻 名詞 一般 206 巻
4464 狗 名詞 一般 219 狗
4476 崎 名詞 一般 326 崎
4477 釘 名詞 一般 336 釘
#「狗」「巻」「釘」「崎」を後で結合できるように取り出しておく
frq7_Tw2_2 <- frq7_Tw2 %>% filter(Term %in% c("狗","巻","釘","崎"))
frq7_Tw2_2
Term Info1 Info2 Freq noun
1 崎 名詞 一般 326 崎
2 巻 名詞 一般 206 巻
3 狗 名詞 一般 219 狗
4 釘 名詞 一般 336 釘
5 巻 名詞 固有名詞 9 巻
6 巻 名詞 接尾 193 巻
#Termが1文字の行を削除。まず、1文字ワードの行番号を抽出
index <- grep('..', frq7_Tw2[,1])
frq7_Tw2[index,] %>% arrange(Freq) %>% tail(50) #確認
3636 五条 名詞 固有名詞 407 五条
3637 伏黒 名詞 固有名詞 414 伏黒
3638 虎杖 名詞 一般 483 虎杖
3639 映画 名詞 一般 538 映画
3640 交換 名詞 サ変接続 679 交換
3641 呪術 名詞 一般 2782 呪術
frq8_Tw2 <- frq7_Tw2[index,]
frq8_Tw2 %>% arrange(Freq) %>% tail(50)
3636 五条 名詞 固有名詞 407 五条
3637 伏黒 名詞 固有名詞 414 伏黒
3638 虎杖 名詞 一般 483 虎杖
3639 映画 名詞 一般 538 映画
3640 交換 名詞 サ変接続 679 交換
3641 呪術 名詞 一般 2782 呪術
先ほど抜き出した「狗」「巻」「釘」「崎」の行（データフレーム ）を結合
frq9_Tw2 <- rbind(frq8_Tw2, frq7_Tw2_2)
frq9_Tw2 %>% arrange(Freq) %>% tail(50)
3639 崎 名詞 一般 326 崎
3640 釘 名詞 一般 336 釘
3641 譲渡 名詞 サ変接続 369 譲渡
3642 五条 名詞 固有名詞 407 五条
3643 伏黒 名詞 固有名詞 414 伏黒
3644 虎杖 名詞 一般 483 虎杖
3645 映画 名詞 一般 538 映画
3646 交換 名詞 サ変接続 679 交換
3647 呪術 名詞 一般 2782 呪術
「呪術」はツイートに含まれていて当然なのと、数字（Freq：出現回数）が他と比べてかなり大きいので外すことにします。
frq10_Tw2 <- frq9_Tw2 %>% filter(Term != "呪術")
frq10_Tw2 %>% arrange(Freq) %>% tail(50)
3641 譲渡 名詞 サ変接続 369 譲渡
3642 五条 名詞 固有名詞 407 五条
3643 伏黒 名詞 固有名詞 414 伏黒
3644 虎杖 名詞 一般 483 虎杖
3645 映画 名詞 一般 538 映画
3646 交換 名詞 サ変接続 679 交換
wordcloud2での可視化に入ります
#wordcloud2で描画準備
frq11_Tw2 <- frq10_Tw2 #下記の作業でミスをした場合元のデータフレームに戻せるようにする
#Freqが100以上にする
frq12_Tw2 <- frq11_Tw2$Freq >= 100
tail(frq12_Tw2) #確認
[1] TRUE TRUE TRUE TRUE FALSE TRUE
frq13_Tw2 <- frq11_Tw2[frq12_Tw2,]
frq13_Tw2 %>% arrange(Freq) %>% tail(50)
1 手渡し 名詞 サ変接続 103 手渡し
2 東堂 名詞 固有名詞 108 東堂
・・・
30 五条 名詞 固有名詞 407 五条
31 伏黒 名詞 固有名詞 414 伏黒
32 虎杖 名詞 一般 483 虎杖
33 映画 名詞 一般 538 映画
34 交換 名詞 サ変接続 679 交換
#wordcloud2で描画。frq13_Tw2の１列目（Term）と４列目（Freq）を使う
library(wordcloud2)
frq13_Tw2[,c(1,4)] %>% wordcloud2(size=2,minSize=1) #sise=2では全体が大きすぎるので下記利用
frq13_Tw2[,c(1,4)] %>% wordcloud2(size=1.3,minSize=1,gridSize=10) #gridSizeは文字間隔
ワードクラウドの可視化ができました。
残しておきたい1文字ワードをピックアップ
なお、整形途中から気になった「交換」「譲渡」というワードですが、Twitterで検索すると、あるアイドルのつぶやきに「交換日記」「呪術廻戦」が含まれ、多くのリツイートがされたためのようです。
さらに、呪術廻戦グッズの「交換」「譲渡」目的のツイートが数多く見られました。
ということで、放送されたアニメとは関係なさそうなので、外すことにします。
「バッジ」というワードはそのグッズの1つのようですが、「交換」「譲渡」ほど目立たないのでそのままにしました。
frq14_Tw2 <- frq13_Tw2 %>% filter(Term != "交換") %>% filter(Term != "譲渡")
frq14_Tw2 %>% arrange(Freq) %>% tail(50)
27 崎 名詞 一般 326 崎
28 釘 名詞 一般 336 釘
29 五条 名詞 固有名詞 407 五条
30 伏黒 名詞 固有名詞 414 伏黒
31 虎杖 名詞 一般 483 虎杖
32 映画 名詞 一般 538 映画
再度wordcloud2で可視化します
frq14_Tw2[,c(1,4)] %>% wordcloud2(size=1.3,minSize=1,gridSize=10) #gridSizeは文字間隔
ワードクラウドの可視化ができました。
ggplot2で棒グラフ
次に、ワードの出現回数順にの棒グラフを作ります。
そのための準備をします。
#扱いやすいようにTerm（ワード）とFreq（出現回数）の2列のデータフレームに
frq15_Tw2 <- data.frame(frq14_Tw2$Term, frq14_Tw2$Freq)
frq15_Tw2 #確認
frq14_Tw2.Term frq14_Tw2.Freq
1 お願い 137
2 優先 160
3 希望 119
・・・
23 東堂 108
24 真希 199
25 好き 112
26 気軽 169
27 さん 132
28 崎 326
29 巻 206
30 狗 219
31 釘 336
32 巻 193
Freq（frq14_Tw2.Freq）の降順に並び替えます。
frq16_Tw2 <- frq15_Tw2[order(frq15_Tw2$frq14_Tw2.Freq, decreasing=T), ] #◼️
frq16_Tw2 #確認
列名も元のデータフレームから変わっているので、わかりやすい名称に変更します。
#列名を変更
colnames(frq16_Tw2) <- c("Word","Freq")
head(frq16_Tw2)
Word Freq
12 映画 538
16 虎杖 483
22 伏黒 414
21 五条 407
31 釘 336
28 崎 326
ggplot2で棒グラフを描きます。
#reorderは並び順指定
#stat="identity"はデータラベルつけるときに必要
#fill=ｰFreqにすると値が大きいほど色が濃くなる
#coord_flip()を追加すると、x軸とy軸が入れ替わる
#geom_textとlabelで棒グラフにラベル（Freq）を追加
library(ggplot2)
par(family = "HiraKakuProN-W3")
ggplot(frq16_Tw2, aes(x=reorder(Word, Freq), y=Freq))+
geom_bar(aes(y=Freq,fill=-Freq),stat="identity") +
xlab("")+
theme_gray (base_family = "HiraKakuPro-W3") +
geom_text(aes(x=reorder(Word,Freq),y=Freq,label = Freq), hjust=1.3,colour = " white") +
coord_flip()
狗巻くんの「巻」が「名詞・一般」と「名詞・接尾」と2回出てくるからか、他より長いグラフになりました。
どちらかの「巻」を外せばよいのですが、外さないでうまく処理する方法がわからなかったので、「ラベル+Word」という表記に変えることにしました。
行ラベルの番号が順番通り並んでいないので、ラベルを貼り直します
#1から行数（nrow）までの連番を行番号に差し替えます。
rownames(frq16_Tw2) <- 1:nrow(frq16_Tw2)
head(frq16_Tw2)
Word Freq
1 映画 538
2 虎杖 483
3 伏黒 414
4 五条 407
5 釘 336
6 崎 326
「連番ラベル+Word」の列を追加します。
#結局使わなかったが、cbindで連番とWordを結合しようとすると、Factor型のレベルの数字が並ぶ
#このためを文字型にする必要がある
cbind(rownames(frq16_Tw2), as.character(frq16_Tw2$Word))
#「連番ラベル+Word」列の「Word2」を追加
frq17_Tw2 <- frq16_Tw2 #元に戻しやすいようにするための処理
frq17_Tw2$Word2 <- paste(rownames(frq16_Tw2), frq16_Tw2$Word)
head(frq17_Tw2)
Word Freq Word2
1 映画 538 1 映画
2 虎杖 483 2 虎杖
3 伏黒 414 3 伏黒
4 五条 407 4 五条
5 釘 336 5 釘
6 崎 326 6 崎
#念のため型を確認
str(frq17_Tw2)
'data.frame': 32 obs. of 3 variables:
$ Word : Factor w/ 31 levels "アカ","アニメ",..: 9 16 28 17 26 20 24 5 2 25 ...
$ Freq : int 538 483 414 407 336 326 309 287 281 271 ...
$ Word2: chr "1 映画" "2 虎杖" "3 伏黒" "4 五条" ...
再度棒グラフを描画します
par(family = "HiraKakuProN-W3")
ggplot(frq17_Tw2, aes(x=reorder(Word2, Freq), y=Freq))+
geom_bar(aes(y=Freq,fill=-Freq),stat="identity") +
xlab("")+
theme_gray (base_family = "HiraKakuPro-W3") +
geom_text(aes(x=reorder(Word2,Freq),y=Freq,label = Freq), hjust=1.3,colour = " white")
coord_flip()
#（確認）Word2はchrでもfactorでもどちらでも描画可能
par(family = "HiraKakuProN-W3")
ggplot(frq17_Tw2, aes(x=reorder(as.factor(Word2), Freq), y=Freq))+
geom_bar(aes(y=Freq,fill=-Freq),stat="identity") +
xlab("")+
theme_gray (base_family = "HiraKakuPro-W3") +
geom_text(aes(x=reorder(as.factor(Word2),Freq),y=Freq,label = Freq), hjust=1.3,colour = " white") +
coord_flip()
了