ill-identified diary

所属組織の見解などとは一切関係なく小難しい話しかしません

トップ > Twitter > [Twitter] [R] ツイッター選挙分析 (黎明篇)

[Twitter] [R] ツイッター選挙分析 (黎明篇)

Twitter R ggplot2 視覚化
この記事は最終更新日から3年以上が経過しています

概要

  • 以前 紹介した streamR を利用して, 選挙前11日分のツイートを取得していた.
  • しかし活用方法が分からないので簡単な集計結果のみ公開
  • ggplot2, dplyr などを使ってグラフにまとめる例を示す

streamR でツイートを集める

1時間単位でツイートを収集し, tweet_201412DD_HHMM.json というファイル名で保存するコードを書いた. HHMM は収集開始時刻である. これをバックグラウンドで流していた. streamR は Twitter API にアクセスしてツイートを取得するだけなので, 負荷は小さい. また, ダウンロードしたデータをそのままファイルに書き込むため, メモリを圧迫することもなく, 容量の十分にあるディスクに保存するように設定しておけば問題ない. 以下が, 実際に使用したコードである. ただし, 実際に使用する場合は, ROauth オブジェクトの用意と, パスの適宜変更が必要である. ROauth オブジェクトの作り方は, 前回を参照.

########################################
# streamR.auto.R
# fetch tweets about voting automatically
#######################################

library(twitteR)
library(streamR)
Sys.setlocale("LC_TIME", "en_US.utf-8")
load("source/twit.oauth.RData") # ROauth オブジェクト読み込み 
registerTwitterOAuth(twit.oauth)

setwd("/media/HOGEHOGE") # 保存先ディレクトリ名
times <- 24  # 何時間取得するか
for (i in 1:times ){
  print( paste("Start at", Sys.time(), paste(i, "/", times, sep=""), sep=" "))
  filterStream(file.name = paste("tweet", format(x = Sys.time(), format = "%Y%m%d_%H%M"),  ".json", sep=""), track ="選挙, 衆院選, 党" , timeout=3600, oauth=twit.oauth, language = "ja")
  print(paste("Done at", Sys.time(), sep=" ") )
}

上記のコードでは, 24回繰り返し取得するため, 1回実行すればまる1日ぶんのツイートを取得できる. ここでは, 「選挙」「衆院選」「党」のいずれかの語を含むツイートのみ抽出した. 自然言語処理には詳しくないので, 他にもっと良い方法があったかもしれないが, 思いつかなかったのでこうした.

この streamR.auto.R を, ターミナルを開いてRのバッチモードで以下のように実行した.

R --no-save < .../streamR.auto.R

ただし, ... には適当なパスを入れている. --no-save は終了時にワークスペースを保存しない, というオプションで, バッチモードで 実行する際にはこれか, --save, --vanilla のいずれかを必ず指定しなければならない. なお, これは UNIXの場合で, Windows ではこの方法ではできないようだ. 未確認だが, windowsからバッチ処理でRを利用する方法 に Windows でバッチモードを実行する方法が書かれており, Rterm.exe を実行すればいいらしい.

さて, 自分はPCを1つしか持ってないので, 24時間ごとにこれを手動で実行していたが, 漏れ無く取得したければ, times を増やしたり, シェルの方でループさせるようにするなど変更すればいい.

データの概観

このようにして, 12月3日から12月13日までのツイートを取得した.

まず, R にデータを読み込み, 集計する前の前処理について. 集計したツイートは .json ファイルとして保存しておいたので, これを parseTweets() 関数で順に読み込んでいった. この関数で, .json ファイルをデータフレーム形式に変換できる. データの中には, ツイートの投稿時刻が created_at という変数で含まれている. 読み込んだ直後は単なる文字列なので, POSIXct オブジェクトに変換する.

Sys.setlocale(category = "LC_TIME", locale = "en_US.UTF-8") 
df$POSIXt <- as.POSIXlt(df$created_at, format="%a %b %d %H:%M:%S %z %Y", tz = "Asia/Tokyo")
df$Date      <- as.Date(df$POSIXt)
df$wkday     <- weekdays(df$Date, abbreviate = T)
df$weekend   <- ifelse(df$wkday %in% c("Sat", "Sun"), "土日", "平日")

created_at は, "Sun Dec 14 00:00:00 +0000 2014" のように, 曜日が英語で書かれているが, as.POSIClt() 関数*1が判断できる曜日や月の文字は, システムロケールに依存する. これを読んでいる人間の多くは日本語になってるだろうから, このままでは読み込めず, 欠損扱いになる. よって, Sys.setlocale() で英語に設定しなおしている. また, この時刻は全て UTC で記録されている*2.

これで時刻を得られたので, そこから日付と曜日, 土日判定の変数も作成している (ただし土日判定は, 今回は結局使用しなかった).

次に, ツイートが RT かどうかを判定する変数を作成する. retweeted という変数が, そのツイートがリツイートかどうかのフラグに見えるが, 公式によると, "Indicates whether this Tweet has been retweeted by the authenticating user." つまり, 認証済ユーザにリツイートされたかどうか, という情報らしい. 実際, 17万件以上あるレコードで, これが TRUE であるツイートは1つも見つからなかった. そこで, リツイート回数を表す retweet_countからリツイートかどうかを判定する変数を作成した.

df$is.RT <- df$retweet_count > 0

このようにして加工したデータフレームを元に, 「日付ごとのツイート数」「日付ごとのツイートしたユーザのユニーク数」「24時間のツイート数の推移」を作成した. 作成には, dplyr, ggplot2, scales, RColorBrewer のパッケージを使用した.

表1

f:id:ill-identified:20141222013933p:plain

表2

f:id:ill-identified:20141222201219p:plain

表3

f:id:ill-identified:20141222013949p:plain

表1から, 選挙日が近づくにつれてツイート数が増加していることが分かる. ユニークユーザ数を表して表2と比べても, スパムのように同一のアカウントが大量に投稿しているために発生している現象ではないことが分かる*3. また, 通常のツイートよりも, RT 数のの伸びが大きいことも分かる.

最後に表3だが, 深夜から明け方にかけてのツイートが1日で最も少ないという結果になった. 【分析】日本人らしさが判明！ Twitterの曜日別・時間帯別のツイート数の統計　by Twitter4J その２ による時間帯別の日本語ツイート数の分布からも逸脱していない*4.

結論

というわけで, 入手できたデータは今のところ特におかしな点がみられない, ということが分かった. つまり特に新発見はなかった. 自然言語処理とかテキストマイニングとかそういう知識があまりないので, そのへんを調べつつなんとかこのデータを料理できないかこれから試行錯誤する.

表作成に使用したパッケージの解説

dplyr の使用例

dplyr は便利な集計用パッケージである. 例として, 日付ごとに RT のみのユーザーを数える処理を紹介する. つまり, 1. ツイート全体からRTのみを抜き出し, 2. 日付ごとにグループ化し, 3. グループ化ごとに, ユーザID の重複を削除 (ユニーク化)する. これを dplyr でおこなうと,

df.uu.RT <-  select(.data = df, user_id_str, Date, is.RT ) %>% filter(is.RT ==T ) %>% group_by(Date) %>% summarise(user_id=n_distinct(user_id_str))

だけで完了できる. しかも plyr で同様の加工をおこなう場合より高速であるという (dplyr最強伝説). 特徴として, 処理をUNIXシェルのパイプのように, %>% でつなげることができる. 上記の場合, まず, select() で 日付, ユーザーID, RT判定フラグ, 週末フラグだけを抜き出して, filter() で RT のみ抽出, group_by() で日付, RT判定でグループ化, そして summarise() 内で n_distinct() 関数を用いてグループごとにユーザーIDをユニークにしている. SQL でいうなら,

select Date, is.RT, DISTINCT user_id_str as user_id
from df
where is_RT = TRUE
group by Date;

といったところだろうか. 実際, dplyr を使ったコードは SQL と直感的に類似していて, とっつきやすさがある.

なお, ユーザーID はuser_id_str であり, id_str はツイート固有のIDであるので注意が必要だ.

ggplot2 と scales

今回利用した ggplot2 の機能は, ほとんどが以前書いた[R] 都知事選挙を題材に学ぶ ggplot2 の作例で書いたことなので, 多くは説明しないが, あらたに付け加えることとして, scales パッケージのりようが挙げられる. このパッケージは, ggplot でグラフの体裁, 特にスケールを整える際に役立つ. たとえば, 今回はグラフの縦軸の数値に, 3桁刻みのコンマを入れたが, これは scales パッケージの comma_format() 関数を利用している. 横軸は日付だが, これを MM/DD (曜日) と表したいなら, date_format("%m/%d (%a)") とすればよい. 前回は scale_*() 関数の labels= に, 手入力の目盛りのベクトルを代入したり, 自作の関数を与えたりしていたが, そのような作業の多くはこのパッケージの関数で代用できる.

使用したコード全体像

以下には, 今回は掲載しなかった, 各日付ごとの, 時間別ツイート数の推移のグラフ, 期間中のユーザー毎のツイート数の分布を作成するコードも含まれている.

###################################################################
# Vote analysis on the House of Representatives of JPN at 14DEC2014
# 
# ill-identified, 19DEC2014 
###################################################################

library(streamR) # ver. 0.2.1
setwd("/media/ks/BackUpHDD/TEMP") # ツイートを保存しておいた外付けHDD

# 時刻読み込みのため時刻のロケール変更
# 日本語ロケールの状態で英語の曜日を読み込むオプションはない?
Sys.setlocale(category = "LC_TIME", locale = "en_US.UTF-8") # Ubuntu用. Windows では locale の値が異なる

# ディレクトリには .json ファイルしかない.
flist <- list.files(include.dirs = T )
temp <- parseTweets(flist[1])
for (i in flist[-1]){
  print(i)
  temp <- rbind(temp, parseTweets(i))
}

df <- temp; rm(temp)
unique(df$time_zone) # 海外タイムゾーンが結構ある
sort(table(df$time_zone), decreasing = T)
sort(table(df$country), decreasing = T)

# データの仕様は https://dev.twitter.com/overview/api/tweets を参照.
# "created_at" (投稿時間) は UTC 
df$POSIXt <- as.POSIXlt(df$created_at, format="%a %b %d %H:%M:%S %z %Y", tz = "Asia/Tokyo")
df$Date      <- as.Date(df$POSIXt)

# rewteeted が認証済ユーザでしか判定されないらしいのでRT回数を使ってフラグを作り直す
df$is.RT <- df$retweet_count > 0

# 一旦保存
save(df, file = "tweet_df.RData")
load(file = "tweet_df.RData")


# longitude, latitude を numeric に変換
df$lon <- as.numeric(df$lon); df$lat <- as.numeric(df$lat)
# しかし位置情報を公開してるのは数件しか無い
summary(df[,c("lon","lat")] )


# 2日深夜から開始して中途半端なので, 3日以降 13日までのみ集計対象に. 14日も 0:30で停止
df <- df[as.Date("2014-12-03") <= df$Date & df$Date <= as.Date("2014-12-13"),]

library(ggplot2) # ver. 1.0.0
library(scales) # ver. 0.2.4
library(RColorBrewer) # ver. 1.1-2
library(dplyr) # ver. 0.3.0.2

# 表示のため, ロケールを日本語に戻す
Sys.setlocale(category = "LC_TIME", "ja_JP.UTF-8")

# Table 1: count num of tweets per date
# 日付ごとの行数をカウント
df.tw <- select(.data= df, Date, is.RT) %>% group_by(Date, is.RT) %>% summarise(count=n())

ggplot(data=df.tw) + geom_bar(aes(x=Date, y=count, fill=is.RT, group=is.RT), stat="identity", binwidth=1) + theme_bw() + labs(title="日毎のツイート数", x="日付", y="ツイート数")  +
  theme(axis.title.y = element_text(angle = 0, vjust = 1), axis.text.x=element_text(angle = -45, hjust = -.1, vjust = 1),  legend.title=element_blank(), legend.position= "bottom") + scale_fill_brewer(palette = "Dark2", labels = c("通常tw (非公式RT含む)", "RT")) + scale_y_continuous(labels= comma_format()) + scale_x_date(labels = date_format("%m/%d (%a)"), breaks = date_breaks("1 day")) 

# Table 2: count num of unique user per date
# 日付ごとに id を一意にしてカウント. RT しかしないユーザも集計
df.uu <- select(.data=df, user_id_str, Date ) %>% group_by(Date) %>% summarise(user_id=n_distinct(user_id_str)) 
df.uu$RT <- F
df.uu.RT <-  select(.data = df, user_id_str, Date, is.RT ) %>% filter(is.RT ==T ) %>% group_by(Date) %>% summarise(user_id=n_distinct(user_id_str)) 
df.uu.RT$RT <- T
df.uu <- rbind(df.uu, df.uu.RT)

ggplot(data=df.uu) + geom_bar(aes(x=Date, y=user_id, group=RT, fill=RT, group=RT), position="dodge", stat="identity") +
  theme_bw() + labs(title="日毎に最低1回ツイートしたユーザ数", x="日付", y="ユーザ数\n(人)") + theme(axis.title.y = element_text(angle = 0, vjust = 1), axis.text.x=element_text(angle = -45, hjust = -.1, vjust = 1),  legend.title=element_blank(), legend.position= "bottom") + scale_fill_brewer(palette = "Dark2", labels = c("全体", "RTのみ")) + scale_y_continuous(labels= comma_format()) + scale_x_date( labels =date_format("%m/%d (%a)"), breaks= date_breaks("1 day") )

# Table 3: num of tweet per hour
df.hour      <- select(.data=df, POSIXt, Date, is.RT)
df.hour$hour <- format(df.hour$POSIXt, format = "%H")
df.hour$POSIXt <- NULL                                  # dplyr は POSIXlt 型を扱えないので削除
df.hour.2    <- group_by(.data=df.hour, hour, is.RT) %>% summarise(count=n()) 
df.hour.3    <- group_by(.data=df.hour, Date, hour, is.RT) %>% summarise(count=n())

ggplot(df.hour.2) + geom_histogram(aes(x=hour, y=count, fill =is.RT, group=is.RT ), stat="identity") + 
  theme_bw() + labs(title = "時刻毎の分布", x="時間", y="総ツイート数") + theme(axis.title.y = element_text(angle = 0, vjust = 1), axis.text.x=element_text(angle = -45, hjust = -.1, vjust = 1),  legend.title=element_blank(), legend.position= "bottom") + scale_fill_brewer(palette = "Dark2", labels = c("通常tw (非公式RT含む)", "RT"))

for (i in  seq.Date(from = as.Date("2014-12-02"), to = as.Date("2014-12-13"), by="day")){
  print(
      ggplot(df.hour.3[df.hour.3$Date==i,]) + geom_histogram(aes(x=hour, y=count, group=is.RT, fill=is.RT), stat="identity") +labs(title=as.Date(i, origin=as.Date("1970-01-01") ) )
    )
}

# Table 4A: count num of tweets per account
# ユーザごとのツイート数をカウントし, ツイート数で度数集計
df.uu.tw <- select(.data = df, is.RT, user_id_str) %>% group_by(is.RT, user_id_str) %>% summarise(count = n())

ggplot(df.uu.tw) + geom_histogram(aes(x=count, group=is.RT, fill=is.RT), stat="bin", binwidth=5) + 
  theme_bw() + theme(axis.title.y = element_text(angle = 0, vjust = 1), axis.text.x=element_text(angle = -45, hjust = -.1, vjust = 1),  legend.title=element_blank(), legend.position= "bottom") + scale_fill_brewer(palette = "Dark2", labels = c("通常tw (RT含む)", "RT") ) + labs(x="ツイート数", y = "人数 (人)", title="ユーザ毎のツイート数の分布") 

# 度数表 
table(df.uu.tw$count)

# Table 4B: trimmed
qt <- quantile(df.uu.tw$count, prob=c(.01, .99))
ggplot(df.uu.tw[qt[1] <= df.uu.tw$count & df.uu.tw$count <= qt[2],]) + geom_histogram(aes(x=count, fill=is.RT, group=is.RT), binwidth=5 ) + 
  theme_bw() + theme(axis.title.y = element_text(angle = 0, vjust = 1), axis.text.x=element_text(angle = -45, hjust = -.1, vjust = 1),  legend.title=element_blank(), legend.position= "bottom") + scale_fill_brewer(palette = "Dark2", labels = c("通常tw (RT含む)", "RT") ) + labs(x="ツイート数", y = "人数 (人)", title="ユーザ毎のツイート数の分布 (両側1%トリム)")

# 度数表
table(df.uu.tw$count[qt[1] <= df.uu.tw$count & df.uu.tw$count <= qt[2]])

# count num of tweets per account, day
df.tw.uu.day <- select(.data=df, Date, is.RT, user_id_str) %>% group_by(Date, is.RT, user_id_str) %>% summarise(tw.uu.day = n() ) %>%  group_by(Date, is.RT, tw.uu.day) %>% summarise( count=n() )

for (i in seq.Date(from = as.Date("2014-12-02"), to = as.Date("2014-12-13"), by="day") ){
  print(ggplot(df.tw.uu.day[df.tw.uu.day$Date==i,]) + geom_histogram(aes(x=tw.uu.day, y=log(count, 2), fill=is.RT, group= is.RT ), stat="identity") + labs(title=as.Date(i, origin = as.Date("1970-01-01") ) ) )
}

# To Be Continued...

参考文献

R 関連

*1:後で気づいたのだが, この後で使う dplyr パッケージの関数は POSIXlt オブジェクトを扱えない. よって, 実際は後の処理を考えると as.POSIXct() を使う方が便利である

*2: 公式: https://dev.twitter.com/overview/api/tweets より

*3:今回は掲載しなかったが, ユーザごとのツイート数の分布も確認している

*4:こちらのツイートはつぶやき内容に関係なく全体の1%のサンプリングである.

ill-identified 読者になる

広告を非表示にする
コメントを書く