からっぽのしょこ

読んだら書く!書いたら読む!同じ事は二度調べ(たく)ない

R言語でツイート数をヒートマップ化する

はじめに

 rtweetパッケージを利用して、指定したアカウントのタイムラインインを収集し、設定した期間(年・月・日・時)ごとのツイート数を集計し、ヒートマップによる可視化を行います。

f:id:anemptyarchive:20200512203143p:plain
ヒートマップ

【目次】

ツイート数のヒートマップを作成

# 利用パッケージ
library(rtweet) # ツイート収集:get_timeline()
library(dplyr) # データフレーム操作
library(tidyr) # データフレーム操作:replace_na()
library(lubridate) # 時間データ操作:floor_date(), as_date(), now()
library(ggplot2) # 作図

 利用するパッケージを読み込みます。

・ツイート収集

 まずはrtweetパッケージを利用して、ツイートを集めます。

# アカウントを指定
screen_name <- "anemptyarchive"

# アカウント指定でツイートを収集
tw_data <- get_timeline(screen_name, n = 10000, include_rts = FALSE)

 get_timeline()にアカウント(@○○○の○○○)を指定して、ツイートを取得します。引数nは収集するツイート数、include_rtsは取得ツイートにリツイートを含めるかです(デフォルトはTRUE)。

 特定の単語を含むツイートを収集するのであれば、search_tweets("検索ワード")を使います。

 どちらも取得できるツイートの数に制限があったりします。

 ツイート数の推移をみるにはツイート日時の情報があればいいので、取得したツイートデータのうちcreated_at列のみを使います。それではcreated_at列のデータを確認してみましょう。

tw_data[["created_at"]][1:10]
##  [1] "2020-05-11 04:33:38 UTC" "2020-05-11 03:17:49 UTC"
##  [3] "2020-05-10 17:23:28 UTC" "2020-05-10 15:26:52 UTC"
##  [5] "2020-05-10 14:11:34 UTC" "2020-05-09 05:34:26 UTC"
##  [7] "2020-05-08 10:57:19 UTC" "2020-05-08 08:01:25 UTC"
##  [9] "2020-05-08 01:01:32 UTC" "2020-05-08 00:59:04 UTC"

 取得したツイート日時のタイムゾーンが協定世界時(UTC)です。これを日本標準時(JST)に変換にする必要があります。

# ツイート日時データを変換
tw_time <- tw_data[["created_at"]] %>% # ツイート日時を抽出
  as.POSIXct(tz = "Etc/GMT") %>% # POSIXct型の協定世界時を明示
  as.POSIXlt(tz = "Asia/Tokyo") # POSIXlt型の日本標準時に変換

 as.POSIXlt()でPOSIXct型からPOSIXlt型に変換します。またtz引数に"Japan"あるいは"Asia/Tokyo"を指定して、タイムゾーンを日本標準時に変更します。(多分2行目はなくていい)

 変換後のデータを確認しておきましょう。

tw_time[1:10]
##  [1] "2020-05-11 13:33:38 JST" "2020-05-11 12:17:49 JST"
##  [3] "2020-05-11 02:23:28 JST" "2020-05-11 00:26:52 JST"
##  [5] "2020-05-10 23:11:34 JST" "2020-05-09 14:34:26 JST"
##  [7] "2020-05-08 19:57:19 JST" "2020-05-08 17:01:25 JST"
##  [9] "2020-05-08 10:01:32 JST" "2020-05-08 09:59:04 JST"

 これでツイートデータの取得と前処理は完了です。次からは可視化のための処理を行っていきます。

・年・月・日別に可視化

 ここからは、指定した期間(年・月・日)ごとにツイート数を集計し、ヒートマップを作図していきます。

# セルの単位(区切る期間)を指定
term <- "year"
term <- "mon"
term <- "day"

 ヒートマップにする際のタイル(セル?)の単位(期間)を指定します。「年」単位であればyear、「月」単位ならmon、「日」単位ならdayとします。これは主にfloor_date()unit引数に指定するためのものなので、このままの文字列を使用してください。

 指定した期間ごとのツイートを数を集計します。

# 指定した期間ごとにツイート数を集計
tw_count1 <- tw_time %>% 
  floor_date(unit = term) %>% # 指定した期間に切り捨て
  as_date() %>% # Date型に変換
  tibble(terms = .) %>% # データフレームに変換
  count(terms) # ツイート数をカウント

 floor_date()で指定した期間ごとに日時を丸めて(切り捨て)ます。
 時刻情報も不要なのでas_date()でPOSIXlt型からDate型に変換することで落とします。
 次にtibble()でデータフレームに変換して、count()で各期間のツイート数を集計します。

tail(tw_count1, 10)
## # A tibble: 10 x 2
##    terms          n
##    <date>     <int>
##  1 2020-05-01     1
##  2 2020-05-03     2
##  3 2020-05-04     6
##  4 2020-05-05     2
##  5 2020-05-06     6
##  6 2020-05-07     7
##  7 2020-05-08     4
##  8 2020-05-09     1
##  9 2020-05-10     1
## 10 2020-05-11     4

 このままだと、ツイートがなかったタイミングが(ツイート数0ではなく)抜け落ちてしまいます(5月2日そのものがない)。あとで日時データを文字列型に変換して扱うため、ツイート数0の期間としておかないとグラフに表示されません。
 その対処として、全ての期間が含まれるデータフレームを作成し、そこにツイート数の情報を移します。

# ツイートがない期間が欠落する対策
term_df <- seq(
  floor_date(tail(tw_time, 1), term), # 一番古い日時
  floor_date(now(), term), # 現在日時
  by = term
) %>% # 指定した期間刻みのベクトルを作成
  as_date() %>% # Date型に変換
  tibble(terms = .)# データフレームに変換

# 集計結果を結合
tw_count2 <- left_join(term_df, tw_count1, by = "terms") %>% 
  mutate(n = replace_na(n, 0)) # NAを0に置換

 seq()で、一番古いツイート日時から現在の日時までのベクトルを作ります。このときベクトルの要素は、引数by指定した間隔となります。一番古いツイート日時はtw_timeの最後の要素なので、tail()またはtw_time[length(tw_time)]で取り出して渡します。現在時刻はnow()で取得できます。
 これを先ほどと同様に、日時データをDate型に変換し、また全体をデータフレームに変換します。

 これを受け皿として、left_join()で先ほどのデータフレームのツイート数と結合します。
 このときツイートがなかった期間はNAとなるので、それをmutate()replace_na()を使って0に置換します。

 集計結果を確認しましょう。

tail(tw_count2, 10)
## # A tibble: 10 x 2
##    terms          n
##    <date>     <dbl>
##  1 2020-05-02     0
##  2 2020-05-03     2
##  3 2020-05-04     6
##  4 2020-05-05     2
##  5 2020-05-06     6
##  6 2020-05-07     7
##  7 2020-05-08     4
##  8 2020-05-09     1
##  9 2020-05-10     1
## 10 2020-05-11     4

 5月2日のツイート数が0という行が含まれていることが確認できます。

 次はこのデータフレームを作図用に加工します。ただし、指定した期間によって処理が多少変わるため、if()で場合分けしています。

# 軸ラベル用にデータフレームを整形
if(term == "day") {
  
  tw_count2 <- tw_count2 %>% 
    mutate(year_mon = format(terms, "%Y-%m")) %>% # 年月を抽出
    mutate(day = format(terms, "%d")) # 日を抽出

} else if(term == "mon") {
  
  tw_count2 <- tw_count2 %>% 
    mutate(year = format(terms, "%Y")) %>% # 年を抽出
    mutate(mon = format(terms, "%m")) # 月を抽出
  
} else if(term == "year") {
  
  tw_count2 <- tw_count2 %>% 
    mutate(year = format(terms, "%Y")) # 年を抽出
  
}

 指定した期間をy軸ラベル、それより大きな単位をx軸目盛とするために、それぞれformat()でツイート日の列(terms)から必要な情報を取り出し、mutate()で新しい列とします。

 作図用のデータフレームができたので、これを用いて作図します。作図の処理も指定した期間によって異なるため、場合分けします。

# ヒートマップを作図
if(term == "day") {
  
  ggplot(tw_count2, aes(x = year_mon, y = day, fill = n)) + 
    geom_tile() + # ヒートマップ
    scale_fill_gradient(low = "white" , high = "#00A968") + # 塗りつぶしの濃淡
    theme(axis.text.x = element_text(angle = 90, hjust = 1)) + # 軸目盛の傾き
    labs(title = paste0("@", screen_name, "のツイート数"), 
         x = "year-mon", y = "day") # ラベル
  
} else if(term == "mon") {
  
  ggplot(tw_count2, aes(x = year, y = mon, fill = n)) + 
    geom_tile() + # ヒートマップ
    scale_fill_gradient(low = "white" , high = "#00A968") + # 塗りつぶしの濃淡
    labs(title = paste0("@", screen_name, "のツイート数"), 
         x = "year", y = "mon") # ラベル
  
} else if(term == "year") {
  
  ggplot(tw_count2, aes(x = year, y = 0, fill = n)) + 
    geom_tile() + # ヒートマップ
    scale_fill_gradient(low = "white" , high = "#00A968") + # 塗りつぶしの濃淡
    ylim(c(-1, 1)) + # y軸の範囲
    labs(title = paste0("@", screen_name, "のツイート数"), 
         x = "year", y = "") # ラベル
  
}

 geom_tile()でヒートマップを作図します。
 タイルの色はscale_fill_gradient()lowhighにそれぞれ色を指定することで、ツイート数(fill引数の値)に応じたグラデーションとなります。

f:id:anemptyarchive:20200512203143p:plain
ヒートマップ:日

f:id:anemptyarchive:20200512203316p:plain
ヒートマップ:月

f:id:anemptyarchive:20200512203357p:plain
ヒートマップ:年

・時別に可視化

 続いて、1時間ごとのツイート数をヒートマップ化します。
 基本的な処理は同様です。こちらは可視化に時刻データを用いるため、ツイート日時をPOSIXct型で扱うところが異なります。

# 1時間ごとにツイート数を集計
tw_count1 <- tw_time %>% 
  floor_date(unit = "hour") %>% # 1時間単位で切り捨て
  as.POSIXct() %>% # POSIXct型に変換
  tibble(terms = .) %>% # データフレームに変換
  count(terms) # ツイート数をカウント

# ツイートがない期間が欠落する対策
term_df <- seq(
  floor_date(tw_time[length(tw_time)], "hour"), # 一番古い時刻
  floor_date(now(), "hour"), # 現在時刻
  by = "hour"
) %>% # 1時間刻みのベクトルを作成
  tibble(terms = .) # データフレームに変換

# 作図用にデータフレームを加工
tw_count2 <- left_join(term_df, tw_count1, by = "terms") %>% # 集計結果を結合
  mutate(n = replace_na(n, 0)) %>%  # NAを0に置換
  mutate(year_mon_day = as_date(terms)) %>% # 年月日を抽出
  mutate(hour = format(terms, "%H")) # 時間を抽出

 floor_date(., unit = "hour")で1時間単位で丸めて(切り捨て)、as.POSIXct()でPOSIXct型に変換します。
 またtibble()でデータフレームに変換して、count()で各期間のツイート数を集計します。

 期間内にツイートがなかった場合に欠落する問題の対処や、作図用のデータフレームの加工も概ね同じ流れです。

 期間を指定する際に"hour"とする点に注意しましょう。

 では、完成したデータフレームを確認しておきましょう。

tail(tw_count2, 10)
## # A tibble: 10 x 4
##    terms                   n year_mon_day hour 
##    <dttm>              <dbl> <date>       <chr>
##  1 2020-05-11 11:00:00     0 2020-05-11   11   
##  2 2020-05-11 12:00:00     1 2020-05-11   12   
##  3 2020-05-11 13:00:00     1 2020-05-11   13   
##  4 2020-05-11 14:00:00     0 2020-05-11   14   
##  5 2020-05-11 15:00:00     0 2020-05-11   15   
##  6 2020-05-11 16:00:00     0 2020-05-11   16   
##  7 2020-05-11 17:00:00     0 2020-05-11   17   
##  8 2020-05-11 18:00:00     0 2020-05-11   18   
##  9 2020-05-11 19:00:00     0 2020-05-11   19   
## 10 2020-05-11 20:00:00     0 2020-05-11   20

 これを用いて作図します。

# ヒートマップを作図
ggplot(tw_count2, aes(x = year_mon_day, y = hour, fill = n)) + 
  geom_tile() + # ヒートマップ
  scale_fill_gradient(low = "white", high = "#00A968") + # 塗りつぶしの濃淡
  scale_x_date(breaks = seq(tw_count2[["year_mon_day"]][1], 
                            tw_count2[["year_mon_day"]][nrow(tw_count2)], 
                            by = "1 week")) + # x軸目盛(日付)
  theme(axis.text.x = element_text(angle = 90)) + # x軸目盛の傾き
  labs(title = paste0("@", screen_name, "のツイート数"), 
       x = "year-mon-day", y = "hour") # ラベル

 x軸に表示するデータ数が多くなるため、必要に応じてscale_x_date()で、x軸ラベルを表示する位置を間引きます(ここに表示されるラベルデータは文字列型なので自動調整されない?)。
 scale_x_date()breaks引数に、表示する位置のベクトルを渡すことで表示数を絞ることができます。そのベクトルは、seq()tw_count2year_mon_day列の1行目と最終行の要素を渡して作成します。by引数に指定する間隔を変更して調整してください。

f:id:anemptyarchive:20200512203426p:plain
ヒートマップ:時

以上!

おわりに

 これかなり楽しい!課題はツイート収集です。過去ツイをもっと集められれば...。Twitter API的にはできる筈なのですがね。
 このノリでツイートデータを期間ごとに振り分けられるのなら、色々と活用できそうです。もっとテキストマイニング的なことをしたい。

 お読みいただきありがとうございます。次もよろしくお願いします。

2020.5.12:加筆修正しました。ずっと数式とコードをイジイジしてばかりで生データの類を触ってません。。。