RでIR #03 ツイート分析と機械学習
執筆者:塚本浩太 (*1)
公開日:2020/03/23
カテゴリ:
#教学IR(学修成果・学生調査・学生支援・EMなど)
#データ収集・準備・分析・可視化、各種ソフト利用におけるテクニック
#RでIR
hr.icon
ツイート分析と機械学習
Twitterで大学についてどのようなつぶやきがされているか、頻出単語リストやワードクラウドを作って見てみると、すぐに何かの役に立つわけではなくても面白いものです。しかし、例えば、“ICU”で検索をしてツイートを取得してみても、”国際基督教大学“のことではなく、”集中治療室”に関するつぶやきも引っかかってしまい、”国際基督教大学”に関する頻出単語リストやワードクラウドを作成できません。
たとえば普通に”ICU 国際基督教大学”で検索したときに作るワードクラウドは次のようになってしまいます。
https://gyazo.com/8d138b23dda6cb29b34c719e78059b55
「ICU=集中治療室」の意味で使われているツイートを多く拾ってしまっていることが推測できます。
これを、機械学習を用いて、「ICU=国際基督教大学」の意味で使われているツイートを予測してワードクラウドを作成すると、次のようになります。
https://gyazo.com/86726f2081da516fb0fc42002706e8fa
さらに日付別頻出単語リストを作ってみると次のようになります。
https://gyazo.com/ae54574744aaf3645e4837762d6a47f8
このようなグラフを機械学習を通して作成するために、今回は、
(1) Rtweetパッケージでツイートを取得する。
(2) RMeCabパッケージで形態素解析を行う。
(3) wordcloud2パッケージでワードクラウドを作成する。
(4) caretパッケージで、教師あり機械学習を行う。
(5) モデルを用いて新たに取得したツイートを分類して日付別頻出単語リストとワードクラウドを作成する。
(6) 問題点や改善すべき点
について書きます。よりよい方法や問題点などあれば教えていただければ幸いです。
(1) Rtweetパッケージでツイートを取得する
Rtweetパッケージでツイートを取得するためには、ツイッターのアカウントが必要です。初めてRtweetを使用する際は、アプリ連携が求められます。かつてtweeteRというパッケージを使う際にはTwitterAPI登録などをしなければいけなかったのですが、Rtweetパッケージであれば普通のツイッターアカウントで使用可能です。
まず、今回必要なパッケージのインストールと読み込みを行います。その他必要なパッケージもまとめて読み込みます。
形態素解析用のRMeCabパッケージを使用するためには、まずMeCab本体をインストールする必要があるので、インストールされていない場合は、RMeCabのウエブサイト(*2)のinstallのページからインストールしてください。
code:パッケージのインストールと読み込み
# まだインストールしていない場合はまずインストールします。
install.packages("rtweet") #ツイートの取得用
install.packages("RMeCab", repos = "https://rmecab.jp/R") #形態素解析用
install.packages("doParallel") #機械学習の並列処理用
install.packages("tidyverse") #データ処理・可視化用
install.packages("wordcloud2") #ワードクラウド作成用
install.packages("tm") #転置用
install.packages("caret") #機械学習用
install.packages("xlsx") #エクセルの読み込書き出し用
devtools::install_github("thomasp85/patchwork") #プロットを並べる用
install.packages("htmlwidgets") #htmlファイルの保存用
install.packages("webshot ") #htmlの画像保存用
webshot::install_phantomjs(force=TRUE) 
# インストールしてあればパッケージの読み込みをします。
library(rtweet)
library(RMeCab)
library(tidyverse)
library(doParallel)
#使えるだけ並列処理に使います
registerDoParallel(makePSOCKcluster(detectCores()))
library(wordcloud2)
library(tm)
library(caret)
library(xlsx)
library(patchwork)
library(htmlwidgets)
library(webshot)
それでは早速ツイートを取得してみます。
search_tweetsの最初の引数は検索ワードです。Twitterで普通に検索するとき検索窓に入れる内容を引用符に入れます。 “-filter:replies”の部分ではリプライを対象から除いています。”@tokoroten-daio”の部分は、存在しないアカウント名を一緒に検索すると、ユーザ名に検索対象のキーワードが入っていても対象外になるようなので入れています。ところてん大王がTwitterを始めてしまったら別の存在しないアカウント名にしてください。
code:ツイートの取得
#tweetの取得
##最初に実行すると、Twitterの認証を求められるのでお持ちのTwitterアカウントで認証をしてください。
tweet_raw <- search_tweets(
"ICU -filter:replies OR 国際基督教大 OR @tokoroten-daio", #引用符の中に検索窓に入れたい内容を入れます。
lang="ja", #簡単のため日本語のツイートのみ対象とします。
n=3000, #最新のツイートから3000件取得します
include_rts = FALSE) %>% #今回はリツイートを含まないことにします。
as.data.frame() %>%
#csvに出力して保存する際に特定の変数が入っていると型がおかしくなるようなので変数を絞っておきます。
select(created_at,text,is_quote,is_retweet,favorite_count,retweet_count,quote_count,reply_count)
#検索する度に内容が変わってしまうので、csvに保存しておきます。
write.csv(tweet_raw,"tweet_raw.csv", fileEncoding = "CP932")
#tweet_raw.csvを読み込んで今回使う変数だけ選択します。
##作業を中断して後日再開する場合はここから再開できます。
tweet_simple <- read.csv("tweet_raw.csv ") %>% select(-X, created_at,text)
# 1行に1ツイート入っているのですが、各ツイートに名前を付けておきます。
##まず、名前を作ります。
tweet_name <- data.frame(count = c(1: nrow(tweet_simple))) %>% mutate("fname" = paste("tweet_",as.character(formatC(count,width=4,flag="0")),".txt",sep="")) %>% select(-count)
## 名前とtweet_simpleをつなぎます。
tweet_simple <- data.frame(tweet_name, tweet_simple)
#検索に存在しないアカウント名(@torokoten-daio)を入れてアカウント名内に”ICU”が入っていてツイート本文に入っていないケースは除いているつもりですが、それでも本文に入っていない場合があるので、本文に”ICU”または”国際基督教大学”が入っているケースに絞ります。
tweet_ICU <- tweet_simple %>% filter(grepl("ICU|国際基督教大",text) )
#取得したツイートの日別のカウント数を見てみます。
tweet_freq <- ggplot(tweet_ICU,aes(x=as.Date(created_at))) +
geom_bar(stat="count")
tweet_freq
https://gyazo.com/7399f2e9afbc9ea1c84a81668e9af88a
2020年3月10日のお昼に取得したので上のようなグラフに、3月1日から3月10日のツイートを取得しています。3月1日分が少ないのかはそこで3,000件に達してしまったからかもしれません。
(2) RMeCabパッケージで形態素解析を行う。
RMeCabを使って単語の出現頻度を出してみます。簡単のために英語や記号は削除してしまいます(ASCII文字を抜いてしまいます)。ただし、そうすると”ICU”も削除されて文脈がわからなくなってしまうので、ICUの削除は回避します。RMeCabの形態素解析については、小林(2018) を参考にしました(*3)。
code:余分な文字の消去
tweet_analysis <- tweet_ICU %>%
#簡単のために英数字記号等(ASCII文字)を削除するのですが、その際に”ICU”の削除を回避するため、一度”ICU”を”ところてん大王”に変えておきます。
mutate(text=str_replace_all(text,"ICU","ところてん大王"),
#ASCII文字を消去します。
text=str_remove_all(text,"\\p{ASCII}"),
#”ところてん大王”を”ICU”に戻します。
text=str_replace_all(text,"ところてん大王","ICU"))
もしも、”ところてん大王”が大学名と一緒にツイートされることが観測されてしまったら、“ところてん大王”は別の観測されないであろう単語に変える必要があります。
code:形態素解析
#ツイート本文部分のみを抜き出して文字コードを変更し、本文なしのものを除きます。
#もとからCP932になっている場合、NULLになるので、UTF-8の部分もCP932にしてください。
tweet_list = iconv(tweet_analysis$text,from = "UTF-8", to = "CP932") %>% na.omit()
#mecab用の一時ファイルの作成
temp <- tempfile()
tweet_list %>% write(file=temp)
#品詞を指定するために変数を作っておきます。
meishi <- c("一般","固有名詞")
# RmeCabFreqで頻度表を作成
tweet_list %>% write(file=temp)
term_freq <- RMeCabFreq(temp) %>% filter(Term != "ICU") %>% #”ICU”は除きます。
#名詞でさらに、一般と固有名詞にしぼります。
filter(Info1=="名詞" & Info2 %in% meishi) %>%
#頻度で降順にします。
arrange(desc(Freq))
#頻出単語上位20の頻度表をみてみます。
freq_20 <- term_freq %>% head(20) %>%
ggplot(aes(x=reorder(Term,Freq),y=Freq)) +
geom_bar(stat="identity",fill ="steelblue", alpha=0.3)+
coord_flip() +
geom_text(aes(label=Freq),size=3,colour="black") +
labs(title="",x="頻度", y= "単語") +
theme(plot.title = element_text(hjust=0.5) ,
panel.background = element_rect(
fill = "transparent",color = NA),
panel.grid.minor = element_line(color = NA),
panel.grid.major = element_line(color = NA),
plot.background = element_rect(fill = "transparent",color = NA),
legend.position = 'none')
freq_20
https://gyazo.com/2a9e4c0c5aa34667b6e721be05494981
この頻度表を見ていると、”集中治療室”としての”ICU”を拾ってしまっているだろうことが想像できます。
あとで機械学習により”国際基督教大学”の”ICU”のツイートの判定をするのですが、その時のために頻出300語のリストを作っておきます。
code:頻出300語の作成
#単語が変数名になっているとエラーが起きやすいのでXX##という形の変数名を作っておきます。
xinstead <- data.frame(count = c(1:300)) %>% mutate("xterm" = paste("XX",as.character(count),sep=""))
%>% select(xterm)
#頻出300語の作成
freq_term <- data.frame(xinstead, head(term_freq,300)) %>% select(xterm,Term)
write.csv(freq_term,"freq_term.csv", fileEncoding = "CP932") #結果をcsvに残しておく
#残したcsvファイルを読み込みます。
freq_term <- read.csv("freq_term.csv") %>% select(-X)
(3) wordcloud2パッケージでワードクラウドを作成する。
頻度表を作った段階で、”集中治療室”に関するつぶやきが多くなってしまっていることはわかっているのですが、まずこのままワードクラウドを作ってみます。
code:頻出300語の作成
#ワードクラウドを作成するためには、{単語、頻度}という形のデータにする必要があります。
term_for_cloud <- term_freq %>% select(Term,Freq)
#上位40の頻度の単語でワードクラウドを作ってみます。
wordcloud2(head(term_for_cloud,40),shape="circle" ,#形を丸
size=1,#サイズは0.5
color = "random-dark") #色指定
https://gyazo.com/837d76dff2dc5fd3d6d1b9a4dcffd4b8
ICU=集中治療室の意味でつぶやかれているツイートを多く取得していて、新型コロナウイルスに関連する単語が多くなっていることがわかります。そこで、次に機械学習でICU=国際基督教大学に関するつぶやきを判定して、そのつぶやきに関するワードクラウドを作っていく作業を行います。
先に結果を見ると、次のようなワードクラウドが作れました。
https://gyazo.com/94b19152c6b61ec1df1de3140e5003a1
(4) caretパッケージで教師あり機械学習を行う。
ここから教師あり機械学習をしていきます。しかし最初は手作業で、国際基督教大学に関するつぶやきなのか、それ以外の話題なのか、ラベルをつけていく必要があります。
最初に、各ツイートの出てくる単語の回数を数えます。国際基督教大学のつぶやきなのかどうかを、各単語の頻度を変数にして、判定していきます。
code:各ツイートの単語の頻度
#先程作った頻出300語の単語部分を抜き出しておきます。
Freq_mieshi <- freq_term$Term
Freq_mieshi
#tweet_simpleの各ツイートごとの単語の出現回数を計算します。
#TERM列に単語が出てきて、例えばtweet_simpleの1行目のツイートの結果はRow1列に出てきます。
doc.DF.result <- docDF(tweet_simple,column = "text", type=1)
#一般名詞、固有名詞に絞ってから、頻出単語300語に出てくるものだけにしぼります。
doc.DF.result.2 <- filter(doc.DF.result, POS1 == "名詞",POS2 %in% meishi) %>% filter(TERM %in% Freq_mieshi)
#縦型に変換します。Row1から一番端っこのRow2984までを縦にしたいのですが、一番右端の変数名はcolnames(doc.DF.result.2)ncol(doc.DF.result.2)で取得します。
doc.DF.result.3 <- doc.DF.result.2 %>% gather(key=rowname, value = Freq_i,Row1:colnames(doc.DF.result.2)ncol(doc.DF.result.2))
#同じ単語でも一般名詞や固有名詞に区別されているのでTERMが同じならまとめてしまいます。
doc.DF.result.4 <- doc.DF.result.3 %>% group_by(rowname,TERM) %>% summarize("頻度" =sum(Freq_i))
#機械学習をするときにTERMの日本語が変数になるとエラーが起きるので、X###に変更します。
doc.DF.result.4_2 <- left_join(doc.DF.result.4,freq_term, by = c("TERM"="Term")) %>% select(-TERM)
#横型にします。またRow###の名前になっているものを、tweet_####.txtという名前にm戻します。
doc.DF.result.5 <- doc.DF.result.4_2 %>% spread(xterm,頻度) %>% ungroup() %>%
mutate(rowname = as.numeric(str_replace_all(rowname,pattern ="Row",replacement=""))) %>%
mutate(fname = paste("tweet_",as.character(formatC(rowname ,width=4,flag="0")),".txt",sep="")) %>% select(-rowname)
#doc.DF.result.5に元のツイート本文をつなぎ合わせたいので、元のtweet_simpleからfnameとtextだけ選択します。
tweet_join <- tweet_simple %>% select(fname,text)
#tweet_joinとdoc.DF.result.5をつなぎます。
#またICUという変数を作って、値はすべて0にします。
ICUtweet <- left_join(tweet_join,doc.DF.result.5, by = "fname") %>% mutate(ICU = "0")
#結果をcsvfileに残しておきます。
write.csv(ICUtweet,"rwteet_hindo.csv", fileEncoding = "CP932")
ICUtweet <- read.csv("rwteet_hindo.csv") %>% select(-X) %>% mutate(ICU =as.factor(ICU))
ICUtweetは次のような形になっています。
https://gyazo.com/9db330067a5ae856bb730f8c03541315
次に教師あり学習をするために、先程すべて0を入れた変数“ICU”に、手作業で国際基督教大学の話題なら1、そうでないなら0と入力していきます。しかし、取得したツイートすべてに対してこの作業をするのは面倒なので、半分だけ手作業でラベル付けをします。
code:手作業で国際基督教大学に関するツイートかどうか判定
#手作業でICUの判定(半分だけ)
for_Teacher <- createDataPartition(y = ICUtweet$ICU, p = 0.5, list =F) #p=0.5で半分だけ抽出します。
df_Teacher <- ICUtweetfor_Teacher,
#csvに書き出し
#これのICU列にICUの話なら1そうでないなら0を入れていく
write.csv(df_Teacher,"df_Teacher.csv", fileEncoding = "CP932")
次のようなcsvが出力されますので、text列のツイートを見て手作業でICU列に国際基督教大学の話題なら1そうでないなら0を入力する作業をします。
https://gyazo.com/123d09dddb96515a2b7482cbee266b66
code:手作業で入力したcsvの読み込み
#手作業で判定した結果の読み込みをします。ここでは手作業で入力したファイル名を"df_TrainT.csv"として保存しました。
df_Trainteacher <- read_csv("df_TeacherT.csv",locale = locale(encoding = "cp932"))
df_Trainteacher <- df_Trainteacher %>% as.data.frame() %>% mutate(ICU = as.factor(ICU))
いよいよ、機械学習をしていみます。今回はこちらのサイト(*4)を参考にXGBoostを使ってみました。
code:caretパッケージで機械学習モデルを作る
#機械学習をしてみます。勾配ブースティングでやってみます。
#モデルの作成にあたり、変数の分散が0だとエラーになるので、分散が0に近い(今回はかなり甘い判定で)変数を除きます。
non_used_xterm <- colnames(df_Trainteacher,nearZeroVar(df_Trainteacher,freqCut = 200, uniqueCut = 1))
##モデルで使用しなかった変数は、後で予測する際にも除くので保存しておきます。
write.csv(non_used_xterm,"non_used_xterm.csv", fileEncoding = "CP932")
##使用した変数も保存しておきます。
freq_term_used <- read.csv("freq_term.csv") %>% select(-X) %>% filter(!xterm %in% non_used_xterm)
write.csv(freq_term_used,"freq_term_used.csv", fileEncoding = "CP932")
##使用しない変数(分散が0に近い)を除きます。
df_Trainteacher <- df_Trainteacher,-nearZeroVar(df_Trainteacher,freqCut = 200, uniqueCut = 1)
##手作業で判定した結果をTrain用とTest用にわけます。
## 何度やっても同じになるように乱数の種を設定しておきます。
set.seed(321)
inTrain <- createDataPartition(y = df_Trainteacher$ICU, p = 0.75, list =F)
df_Train <- df_TrainteacherinTrain,  #学習用(75%分)
df_Test <- df_Trainteacher-inTrain,  #評価用(25%分)
#モデルの作成(時間がかかります)
dt_model<- train(ICU~., data = select(df_Train,-text,-fname), method = "xgbTree",
preProcess = c('center', 'scale'),
trControl = trainControl(method = "cv"),
tuneLength = 4)
#モデルの保存
saveRDS(dt_model, file = "dt_model.rds")
#Test用に分けたテーブルを使ってAccuracyを確認してみます。
pred1 <- predict(dt_model,df_Test)
confusionMatrix(pred1,df_Test$ICU)
結果の一部は次のとおりです。手作業でICU=0と判定したもののうち、モデルでICU=0で予測されたものは303件、ICU=1と判定されたものは1件でした。また、手作業でICU=1と判定したもののうち、モデルでICU=0で予測されたものは31件、ICU=1と判定されたものは36件でした。
ICUの話題でないものを0と判定する精度は高いですが、ICUの話題のうち半分近くICUの話題でないと判定しまっておりミスが多い結果になっています。
https://gyazo.com/8e2bc1bad8050370f55bcca36f9e0c34
ただ、Reference=1かつPredicition=0のツイートを見てみると、ツイート自体が非常に短いものであるなど、確かにこれはICU=国際基督教大学の話題と判定されなくても仕方ないかなと思うものもありました。モデルに問題はありますが、一旦おいておいて、このモデルを使って取得したツイート全体に対して各ツイートがICUの話題なのかどうか予測してみます。
code:予測
#予測をしてみます。
#まず機械学習に使ったモデルと変数を揃えます。使っていないtext,fnameと分散が0に近いために抜いた変数を抜きます。ICUはfactor型に変換します。
ICUtweet2 <- ICUtweet %>% select(-text,-fname,-non_used_xterm) %>% mutate(ICU = as.factor(ICU))
ICUpredict <- predict(dt_model,ICUtweet)
ICUpredict
ICUpredict_check <-data.frame(ICUpredict,ICUtweet)
ICUpredict_checkは次のような形になっています。
https://gyazo.com/7ad7541992dbfd9816005a4b294eb960
この結果を使って、ICUpredict=1の場合のワードクラウドを作ってみます。
code:予測後のワードクラウドの作成
#ワードクラウド用に整形
ICUpredict_ICU <-ICUpredict_check %>% filter(ICUpredict =="1") %>% mutate(text = as.character(text))
ICUpredict_ICUc <- ICUpredict_ICU %>%
mutate(text=str_replace_all(text,"ICU","ところてん大王"),#一度”ICU”を”ところてん大王”に変えておきます。
text=str_remove_all(text,"\\p{ASCII}"),
#ASCII文字を消去します。
text=str_replace_all(text,"ところてん大王","ICU"))
#ワードクラウドの作成
##一般名詞と固有名詞にしぼります。
res_freq_f2 <- res_freq2 %>% filter(Info1=="名詞" & Info2 %in% meishi) %>% select(Term,Freq)
##頻度で降順にしてTermとFreqのみにします。
res_freq_f2 <- res_freq_f2 %>% arrange(desc(Freq)) %>% select(Term,Freq)
##ワードクラウドを出します。
wordcloud2(head(res_freq_f2,50),shape="circle" ,#形を丸
size=1,#サイズは0.5
color = "random-dark") #色指定
大分国際基督教大学の話題らしくなりました。
https://gyazo.com/cb2d839774c16b01639fc0360c7f8c3d
(5) モデルを用いて新たに取得したツイートを分類して日付別頻出単語リストとワードクラウドを作成する。
せっかくモデルを作ったので、今後は1週間分のツイートを取得して自動的に分類をして、ぱぱっと日付別頻出単語リストとワードクラウドを作ってみたいと思います。
code:1週間分の日付別頻出単語リストとワードクラウドを作成する
######################################################
#1週間分の日付別頻出単語リストとワードクラウドを作成#
######################################################
#学習した結果を使うための変数の設定や読み込みをします。
meishi <- c("一般","固有名詞")
freq_term <- read.csv("freq_term.csv") %>% select(-X)
freq_term
Freq_mieshi <- as.character(freq_term$Term)
freq_term_used <- read.csv("freq_term_used.csv") %>% select(-X)
non_used_xterm <- as.character(read.csv("non_used_xterm.csv", fileEncoding = "CP932")$x)
dt_model <- readRDS("dt_model.rds")
#頻度表やワードクラウドから除くために興味のない単語リストを作成しておきます。
huyou_term <- c("ー","国際基督教大学","人","ICU","ICUICU","ICU","大学")
#tweetの取得
##昨日から1週間前まで検索することにします。
##まず検索ワードを作っておきます。
search <- paste0("ICU -filter:replies OR 国際基督教大 OR @tokoroten-daio since:",Sys.Date()-7,"until:",Sys.Date()-1)
##検索します。
tweet_rawN <- search_tweets(
search, #検索ワードです。
lang="ja", #日本語のツイートのみ対象とする
n=10000, #期間中のツイートから10000件取得します。足りないようなら増やしてください。
include_rts = FALSE) %>% #今回はリツイートを含まないことにします。
as.data.frame() %>%
#csvに出力して保存する際に特定の変数が入っていると型がおかしくなるようなので変数を絞っておきます。
select(created_at,text,is_quote,is_retweet,favorite_count,retweet_count,quote_count,reply_count)
#検索する度に内容が変わってしまうので、csvに保存しておきます。
filename_tweet <- paste0("tweet_raw_",Sys.Date()-7,"_",Sys.Date()-1,".csv")
filename_tweet
write.csv(tweet_rawN,filename_tweet, fileEncoding = "CP932")
# tweet_raw.csvを読み込んで今回使う変数だけ選択します。
#検索に存在しないアカウント名(@torokoten-daio)を入れてアカウント名内に”ICU”が入っていてツイート本文に入っていないケースは除いているつもりですが、それでも本文に入っていない場合があるので、本文に”ICU(icu)”または”国際基督教大学”が入っているケースに絞ります。
tweet_simpleN <- read.csv(filename_tweet) %>% select(-X, created_at,text)
tweet_simpleN <-tweet_simpleN %>% filter(grepl("ICU|icu|国際基督教大",text) )
#取得したツイートの日別のカウント数を見てみます。
tweet_freqN <- ggplot(tweet_simpleN,aes(x=as.Date(created_at))) +
geom_bar(stat="count", fill ="steelblue", alpha=0.3)+
labs(title="",x="日付", y= "Tweet数") +
stat_count(aes(label = ..count..),geom ="text",size=3,colour="black") +
scale_x_date(date_breaks = "1 days")+
theme(plot.title = element_text(hjust=0.5) ,
panel.background = element_rect(
fill = "transparent",color = NA),
panel.grid.minor = element_line(color = NA),
panel.grid.major = element_line(color = NA),
plot.background = element_rect(fill = "transparent",color = NA),
legend.position = 'none')
tweet_freqN
# 1行に1ツイート入っているのですが、各ツイートに名前を付けておきます。
##まず、名前を作ります。
tweet_nameN <- data.frame(count = c(1: nrow(tweet_simpleN))) %>% mutate("fname" = paste("tweet_",as.character(formatC(count,width=4,flag="0")),".txt",sep="")) %>% select(-count)
## 名前とtweet_simpleをつなぎます。
tweet_simpleN <- data.frame(tweet_nameN, tweet_simpleN)
## 余計な文字を除く
tweet_analysisN <- tweet_simpleN %>%
#一度”ICU”を”ところてん大王”に変えておきます。
mutate(text=str_replace_all(text,"ICU","ところてん大王"),
#簡単のためASCII文字を消去します。
text=str_remove_all(text,"\\p{ASCII}"),
#”ところてん大王”を”ICU”に戻します
text=str_replace_all(text,"ところてん大王","ICU")) %>%
#文字コードを変換します。
#もとからCP932になっている場合、NULLになるので、UTF-8の部分もCP932にしてください。
mutate(text = iconv(text,from = "UTF-8", to = "CP932"))
#tweet_analysisNのツイートごとの単語の出現回数を計算します。
#TERM列に単語が出てきて、例えばtweet_analysisNの1行目のツイートの結果はRow1列に出てきます。
doc.DF.resultN <- docDF(tweet_analysisN,column = "text", type=1)
#一般名詞、固有名詞に絞ってから、
doc.DF.resultN.2 <- filter(doc.DF.resultN, POS1 == "名詞",POS2 %in% meishi)
#縦型に変換します。Row1から一番端っこのRow####までを縦にしたいのですが、一番右端の変数名はcolnames(doc.DF.result.2)ncol(doc.DF.result.2)で取得します。
doc.DF.resultN.3 <- doc.DF.resultN.2 %>% gather(key=rowname, value = Freq_i,Row1:colnames(doc.DF.resultN.2)ncol(doc.DF.resultN.2))
#同じ単語でも一般名詞や固有名詞に区別されているのでTERMが同じならまとめてしまいます。
#またRow###の名前になっているものを、tweet_####.txtという名前にm戻します。
doc.DF.resultN.4 <- doc.DF.resultN.3 %>% group_by(rowname,TERM) %>% summarize("頻度" =sum(Freq_i)) %>% ungroup() %>%
mutate(rowname = as.numeric(str_replace_all(rowname,pattern ="Row",replacement=""))) %>%
mutate(fname = paste("tweet_",as.character(formatC(rowname ,width=4,flag="0")),".txt",sep="")) %>% select(-rowname)
#機械学習のために頻出単語300語に出てくるものだけにしぼります。またTERMの日本語が変数になるとエラーが起きるので、X###に変更します。
doc.DF.resultN.4_2 <- left_join(filter(doc.DF.resultN.4,TERM %in% Freq_mieshi) ,freq_term, by = c("TERM"="Term")) %>% select(-TERM)
#横型にします。
doc.DF.resultN.5 <- doc.DF.resultN.4_2 %>% spread(xterm,頻度) %>% ungroup()
#doc.DF.resultN.5に元のツイート本文をつなぎ合わせたいので、元のtweet_simpleからfnameとtextだけ選択します。
tweet_joinN <- tweet_analysisN %>% select(fname,text)
#tweet_joinとdoc.DF.resultN.5をつなぎます。
ICUtweetN <- left_join(tweet_joinN,doc.DF.resultN.5, by = "fname") %>% mutate(ICU = "0")
#結果をcsvfileに残しておきます。
filename_doc_result<- paste0("ICUtweet",Sys.Date()-7,"_",Sys.Date()-1,".csv")
write.csv(ICUtweetN,filename_doc_result, fileEncoding = "CP932")
ICUtweetN <- read.csv(filename_doc_result) %>% select(-X) %>% mutate(ICU =as.factor(ICU))
#機械学習で予測をします。
## freq_termに入っているxtermで、今回検索した結果に入っていないものを0ベクトルで追加
##まず何が入っていないか確認
terms_appear <- as.data.frame(colnames(ICUtweetN)) %>% rename(hensu = "colnames(ICUtweetN)")
terms_not_appear <- freq_term %>% filter(!xterm %in% terms_appear$hensu)
terms_not_appear <- terms_not_appear$xterm %>% as.vector()
##今回取得したツイートの中にない、freq_termの変数を追加
##もし全部出てきていたら(terms_not_appearがNULLならエラーになるがそれならそれで放っておけばいい)
##eval(parse ())は文字列を命令文として扱える。
for(n in 1 : length(terms_not_appear)){eval(parse(text = paste0("ICUtweetN2$",terms_not_appearn,"<- 0")))}
##モデルで使わなかったxtermを抜く
ICUtweetN2 <- ICUtweetN %>% select(-text,-fname,-non_used_xterm) %>% mutate(ICU = as.factor(ICU))
#予測
ICUpredictN <- predict(dt_model,ICUtweetN2)
ICUpredictN
ICUpredict_checkN <-data.frame(ICUpredictN,ICUtweetN)
#結果をcsvfileに残しておきます。
filename_predict<- paste0("ICUpredict",Sys.Date()-7,"_",Sys.Date()-1,".csv")
write.csv(ICUpredict_checkN,filename_predict, fileEncoding = "CP932")
#日付別のワードを見る
##データの整理
text_dateN <- tweet_analysisN %>% select(fname,created_at)
freqWord_dateN0 <- as.data.frame(ICUpredict_checkN) %>% filter(ICUpredictN == 1) %>% select(fname)
freqWord_dateN0_1 <- left_join(freqWord_dateN0,text_dateN,by = "fname")
freqWord_dateN0_2 <- inner_join(freqWord_dateN0_1,doc.DF.resultN.4,by = "fname")
freqWord_date_Ng2 <- freqWord_dateN0_2 %>% mutate(created_at = as.Date(created_at)) %>% filter(!TERM %in% huyou_term) %>% rename(Term = TERM,freq = 頻度)
##日毎の頻度表を作ります。
k <- as.numeric(max(freqWord_date_Ng2$created_at) - min(freqWord_date_Ng2$created_at))
for(i in 0 : k){
plot0 <- freqWord_date_Ng2 %>% filter(created_at == min(freqWord_date_Ng2$created_at) +i) %>% group_by(Term) %>%
summarize(Freq = sum(freq)) %>%
arrange(desc(Freq)) %>%
head(30) %>% ggplot() +
geom_bar(aes(x=reorder(Term,Freq),y=Freq),stat="identity") +
ylim(0,30) +
coord_flip() +
theme(axis.title = element_text(size=1)) +
labs(title=str_replace_all(substr(paste0(min(freqWord_date_Ng2$created_at) +i),3,10),"-",""),x="", y= "")
j <-as.character(formatC(i+1,width=2,flag="0"))
assign(paste("plotN",j,sep="_"),plot0)
}
##日毎の頻度表を並べます
##patchworkを使用するための命令文を作成します。
plotsname <- "("
for(m in 1:(k-1)){plotsname <- paste0(plotsname,"plotN_0",m,"|")}
plotsname <- paste0(plotsname,"plotN_0",k,")")
##patchworkでプロットを横に並べます。
plot_patch <- eval(parse(text = plotsname))
plot_patch
##並べた日別頻出単語リストをファイルに出力します。。
filename_plots <- paste0("日別頻出単語30_",Sys.Date()-7,"_",Sys.Date()-1,".pdf")
pdf(filename_plots,width=11.69,height=8.27,family="Japan1") # 描画デバイスを開く
plot_patch #出力するプロットを開く
dev.off() #出力修了の合図。
#ワードクラウドの作成
#ツイート本文部分のみを抜き出して文字コードを変更し、本文なしのものを除きます。
ICUpredict_checkN_f <- ICUpredict_checkN %>% filter(ICUpredictN == 1) %>% mutate(text = as.character(text))
ICUpredict_checkN_f$text
##もしも文字化けしていたらコーディングの問題かもしれません。
##UTF-8になっていたらここで直します。
##tweet_listN <- iconv(ICUpredict_checkN_f$text,from = "#UTF-8", to = "CP932") %>% na.omit()
tweet_listN <- ICUpredict_checkN_f$text
#mecab用の一時ファイルの作成
tempN <- tempfile()
tweet_listN %>% write(file=tempN)
# RmeCabFreqで頻度表を作成
tweet_listN %>% write(file=tempN)
term_freqN <- RMeCabFreq(tempN) %>%
#名詞でさらに、一般と固有名詞にしぼります。
filter(Info1=="名詞" & Info2 %in% meishi) %>%
#頻度で降順にします。
arrange(desc(Freq))
# ワードクラウド用に整形し、興味のない単語を除きます。
term_freqN_could <- term_freqN %>% arrange(desc(Freq)) %>% mutate(term = Term) %>% select(term,Freq)  %>%
filter(!term %in% huyou_term)
# ワードクラウドを作成します。
word_cloud <- wordcloud2(head(term_freqN_could,50),shape="circle" ,#形を丸
size=1,#サイズは0.5
color = "random-dark") #色指定
word_cloud
##fileに出力します。
##ファイルの名前を設定する。webshot()は日本語名を読み込めないので注意。
filename_cloud_html <- paste0("wordcloud_",Sys.Date()-7,"_",Sys.Date()-1,".html")
filename_cloud_png <- paste0("wordcloud_",Sys.Date()-7,"_",Sys.Date()-1,".png")
##htmlに保存
saveWidget(word_cloud,filename_cloud_html,selfcontained = F)
##htmlからpngに保存。描画に時間がかかるのでdelay=5で5秒待ってからpngに保存。
##webshotはうまく動かないときがあり原因がよくわかりません。もし動かない場合はhtmlファイルを開いて手動でスクリーンショットを撮ってください。
webshot(filename_cloud_html, file = filename_cloud_png, delay=5)
長いですが、一度作ってしまえば、あとはただ実行するだけで、最初にも見た次のようなグラフが作成できます。
https://gyazo.com/823d56c798ab2cf7758f48caecbb4503
https://gyazo.com/86726f2081da516fb0fc42002706e8fa
https://gyazo.com/2750e6e07914a7aba170d8039e7bba85
(6) 問題点や改善すべき点
今回の方法ではいくつかの問題点があります。
①機械学習に使用する変数について
今回は単純に2020年3月10日に取得したツイートの頻出単語300語から使用できるもの(分散が0に近くないもの)などを使いました。また、英数字は除外してしまっています。
しかし、本来は「この単語が出てきたらほぼ国際基督教大学の話題だろう」という単語も容易に羅列することができるので、そうした単語も含めるべきです(例;国際基督教大学の研究所の英字での略称など)。
そうした単語はまずmecabに辞書登録して、頻度を計測できるようにし、機械学習の変数としても使用するべきです。
②予測と日別頻出単語リストについて
実用的には、日別頻出単語リストを定期的に作って、新しく出てくる単語や頻度の変化に注目して「なぜ今この単語がICU(国際基督教大学)と一緒に出てきているのだろうか」と探っていくのが面白いと思います。
しかし、予測モデルはあくまで2020年3月10日に取得したツイートから作成したモデルです。本来、新しく出てくる単語や頻度の変化にもっとも興味があるのに、過去に作成したモデルからでは最新のツイートの予測の精度が落ちるかもしれません。例えばいまは「#春からICU」というハッシュタグを用いて部活・サークルが新歓のためのツイートをしているケースが多く見られますが、春という単語がICUの予測に役立つのは今の時期だけかもしれません。
モデルは定期的に過去の教師ありデータに新しいデータを追加して(また手作業をして)更新をしていく必要があるかもしれません。
③Twitterの利用者
現役の学生の年代ですと、もしかしたらTwitterよりInstagramを利用している方の方が主流なのかもしれません。そうするとそもそもTwitterのツイートを分析しても、あまり現役の学生のつぶやきについては見られていないかもしれません。他にもTwitterの利用者の属性には色々な特徴があると思いますので、あくまでTwitter上のつぶやきだけが対象で偏った分析であることを意識する必要があると思います。
しかし、問題点は多いものの、なんとなく面白いなとか、何かの分析の入り口に使う程度には便利かもしれません。ぜひ、他の大学名などでも試して遊んでみてください。また、いい改善方法があれば教えていただければ幸いです。
それでは、ところてん大王のアカウントを作ってきます!
hr.icon
注
(*1) この内容は私個人の見解であり、所属組織の見解ではありません。
(*2) “RMeCab”
https://sites.google.com/site/rmecab/home (2020年3月18日最終閲覧)
(*3) 小林雄一郎, 「Rによるやさしいテキストマイニング[活用事例編]」,2018年。
(*4)“XGBoostによる機械学習(R : caretパッケージを使ってみた)”
https://qiita.com/FJyusk56/items/60cd61ee344bf462609f (2020年3月18日最終閲覧)
※当コラムの文責及び著作権は、すべて投稿者に帰属します。