からっぽのしょこ

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

ツイート頻度によるクラスタリング

はじめに

 ツイートする時間帯から生活サイクルの近い人が分かるのでは?という思い付きをR言語でやってみます。

【処理の流れ】

  1. rtweetパッケージを使って、ツイート収集
  2. ggplot2パッケージを使って、ツイート頻度をヒートマップ化
  3. ggdendroパッケージを使って、ツイート頻度のクラスタリングおよび樹形図作成


・ツイート頻度によるクラスタリング

# 利用パッケージ
library(rtweet) # ツイート収集:get_timeline()
library(dplyr) # データフレーム操作
library(tidyr) # データフレーム操作:pivot_longer()
library(lubridate) # 時間データ操作:floor_date()
library(ggplot2) # 作図
library(ggdendro) # 樹形図:dendro_data(), ggdendrogram()

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

・ツイート収集

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

 アカウントのスクリーンネーム(@○○○の○○○)を指定します。そこから1アカウントずつget_timeline()に渡して、ツイートデータを取得します(取得できるツイートに制限があったりします)。

# アカウントを指定
screen_names <- c(
  "MorningMusumeMg", "angerme_upfront", "JuiceJuice_uf", 
  "tsubakifac_uf", "BEYOOOOONDS_", "kenshusei_uf"
)

# ツイート収集と集計
tw_count <- tibble(terms = floor_date(Sys.time(), "hour")) ## (本当は列名だけを持つ空のdfを作りたい)
for(i in seq_along(screen_names)) {
  
  # ツイートを収集
  tw_data <- get_timeline(screen_names[i], n = 10000, include_rts = FALSE)

  # 指定した期間ごとにツイート数を集計
  tmp_tw_count <- tw_data[["created_at"]] %>% # ツイート日時を抽出
    as.POSIXct(tz = "Asia/Tokyo") %>% # 日本標準時に変換
    floor_date(unit = "hour") %>% # 1時間ごとに切り捨て
    tibble(terms = .) %>% # データフレームに変換
    group_by(terms) %>% # グループ化
    summarise(!!screen_names[i] := n()) # ツイート数をカウント
  
  # 集計結果を結合
  tw_count <- full_join(tw_count, tmp_tw_count, by = "terms")
  
  # おまじない
  Sys.sleep(1)
  print(paste0(screen_names[i], "...", round(i / length(screen_names) * 100, 1), "%"))
}

 取得したツイートデータの内、ツイート日時(created_at列)を利用します。

 取得したツイート日時は世界共通時(UTC)なので、as.POSIXlt()tz引数に"Asia/Tokyo"を指定することで日本標準時(JST)に変換します。
 また1時間ごとのツイート数を集計するために、日時データをfloor_date(., unit = "hour")で分と秒の情報を切り捨てます。
 ここまではベクトルとして扱っているので、これをtibble()でデータフレームとします。

 あとは、グループ化してカウントしたものを全てのアカウント分結合していきます。

head(tw_count)
## # A tibble: 6 x 7
##   terms               MorningMusumeMg angerme_upfront JuiceJuice_uf
##   <dttm>                        <int>           <int>         <int>
## 1 2020-05-26 01:00:00              NA              NA            NA
## 2 2019-11-04 11:00:00               1               1            NA
## 3 2019-11-04 12:00:00               4              NA             6
## 4 2019-11-04 13:00:00               3               1             1
## 5 2019-11-05 08:00:00               2              NA             2
## 6 2019-11-05 09:00:00               1              NA             3
## # ... with 3 more variables: tsubakifac_uf <int>, BEYOOOOONDS_ <int>,
## #   kenshusei_uf <int>

 ツイートがない日時はNAになります。

 アカウントによって取得できたツイートの期間にばらつきがあるかもしれないため、利用する期間を絞っておきます。

# 期間を指定してツイート数を抽出
tw_count2 <- seq(
  as.POSIXct("2020/04/01", tz = "Japan"), # から
  as.POSIXct("2020/05/01", tz = "Japan"), # まで
  by = "hour"
) %>% 
  tibble(terms = .) %>% # 指定した範囲のdfを作成
  left_join(tw_count, by = "terms") # 範囲内のツイート数を結合

# ツイートがないと値がNAとなるので0に置換
tw_count2[is.na.data.frame(tw_count2)] <- 0

 seq()に始まり(第1引数)と終わり(第2引数)の日時を指定してby引数を"hour"とすることで、1時間ごとに日時データが並んだベクトルとなります。
 それをデータフレームに変換し、left_join()で先ほどの頻度データと結合します。

 ここでもツイートがない日時がNAとなるので、0に置換しておきます。NAのままだとヒートマップとしたときに表示されません。

tail(tw_count2)
## # A tibble: 6 x 7
##   terms               MorningMusumeMg angerme_upfront JuiceJuice_uf
##   <dttm>                        <dbl>           <dbl>         <dbl>
## 1 2020-04-30 10:00:00               1               1             1
## 2 2020-04-30 11:00:00               1               2             3
## 3 2020-04-30 12:00:00               5               3             2
## 4 2020-04-30 13:00:00               3               2             0
## 5 2020-04-30 14:00:00               0               0             0
## 6 2020-04-30 15:00:00               0               0             0
## # ... with 3 more variables: tsubakifac_uf <dbl>, BEYOOOOONDS_ <dbl>,
## #   kenshusei_uf <dbl>

こんな感じになっていればOKです。

 これで必要なツイート頻度データを用意できました。次はこれをヒートマップにします。

・ヒートマップ

 ggplot2で作図するために、pivot_longer()で縦型のデータフレームに変換します。

# データフレームをlong型に変換
tw_count_long <- pivot_longer(
  tw_count2, 
  cols = -terms, # 変換しない列
  names_to = "screen_name", # 現列名を格納する列の名前
  values_to = "n" # 現セルを格納する列の名前
)

 期間を行・アカウントを列・頻度をセルとするデータフレームを、期間・アカウント・頻度の3列からなるデータフレームに変換します。それぞれy軸・x軸・値(グラデーション)に対応します。

head(tw_count_long)
## # A tibble: 6 x 3
##   terms               screen_name         n
##   <dttm>              <chr>           <dbl>
## 1 2020-03-31 15:00:00 MorningMusumeMg     0
## 2 2020-03-31 15:00:00 angerme_upfront     0
## 3 2020-03-31 15:00:00 JuiceJuice_uf       0
## 4 2020-03-31 15:00:00 tsubakifac_uf       0
## 5 2020-03-31 15:00:00 BEYOOOOONDS_        0
## 6 2020-03-31 15:00:00 kenshusei_uf        0

 このlong型のデータフレームを使って作図します。

# ヒートマップを作図
ggplot(tw_count_long, aes(x = screen_name, y = terms, fill = n)) + 
  geom_tile() + # ヒートマップ
  scale_fill_gradient(low = "white", high = "#00A968") + # 塗りつぶし色のグラデーション
  scale_y_datetime(date_breaks = "1 day", 
                   date_labels = "%Y-%m-%d %H") + # y軸目盛(日時)
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) + # x軸目盛の角度
  labs(title = "アカウントごとのツイート数", 
       y = "hour") # ラベル

 geom_tile()でヒートマップを作成します。
 タイル(?)の色の設定はscale_fill_gradient()で行えます。引数lowに頻度が少ない場合の色を、引数highに多い場合の色を指定すると、いい感じのグラデーションになります。

 データが多いとy軸目盛が潰れてしまいます。そんなときはscale_y_datetime()で調整できます。date_breaks引数に表示する間隔を指定し、date_labels引数に表示する文字列のフォーマットを指定します。

f:id:anemptyarchive:20200526154548p:plain
ツイート頻度のヒートマップ

 (これ自体はクラスタリングに必須ではないですが)アカウントごとのツイート頻度を視覚的に確認できました。ではクラスタリングを行いましょう。

・クラスタリング

 ggplot2風と組み込みplot()で作図します(どちらもいまいち上手く扱えていないです…)。

# クラスタリング
res_dendrogram <- tw_count2[, -1] %>% # 非数値の列を落とす
  t() %>% # 転置
  dist() %>% # 距離(類似度)を測る
  hclust("ward.D2") %>% # クラスタリング
  dendro_data() # 作図用にデータを変換

# 描画
ggdendrogram(res_dendrogram, theme_dendro = FALSE)

 dist()で各アカウント間の距離(非類似度)を測り、hclust()でクラスター(グループ)を作っていきます。最後にdendro_data()ggdendrogram()用のデータ型に変換します。

f:id:anemptyarchive:20200526154655p:plain
デンドログラム


# クラスタリング
res_dendrogram <- tw_count2[, -1] %>% # 非数値の列を落とす
  t() %>% # 転置
  dist() %>% # 距離(類似度)を測る
  hclust("ward.D2") %>% # クラスタリング
  as.dendrogram() # 作図用にデータを変換

# 描画
plot(res_dendrogram)

 plot()で作図する場合は最後のデータ変換に使う関数がas.dendrogram()になります。

f:id:anemptyarchive:20200526154804p:plain
デンドログラム


 これで廃人クラスタとかニートクラスタなんぞが見えてくるわけですね…

おわりに

 『トピックモデル』シリーズの記事が一区切りついたので、少しお遊び的な内容で書きたいなと思ってやってみました。数式が出てこないのは久しぶりです。
 思い付きにしては割とキレイにできた気がします。色々課題はありますが、まずはデンドログラムの並びとヒートマップの並びを揃えたいです。

 最後まで読んでいただきありがとうございます。ツイート分析シリーズはまだ続きます(ネタを思いつけば)。またよろしくお願いします。

 はてなのカテゴリ管理がぐちゃぐちゃしてきた…

2020.05.26:記事を書き直しました。

 しかしまだいい感じに樹形図をプロットできません…