cucumber flesh

Rを中心としたデータ分析・統計解析らへんの話題をしていくだけ

📝2015年の思い出

三が日を過ぎて仕事始まりを迎えてからの投稿というところに私という人間の姿が現れているような...そんな気がするポエットです。

いくつかの項目に分けて考えてみました。

生活

  • 夜型だったり朝型だったり、不定期でした。相変わらず研究室暮らしでした。
    • そんなせいか、土日に寝溜めしてしまうことがしばしばありました。ヨクナサソウ...。
  • 二回目の小笠原。前回は冬だったので今回は夏でした。とはいえ最初の印象が強すぎて今回はあまり印象に残っていません。宴会ばっかりで遊んでいたせいかな
  • 大学院時代の友人たちと尾瀬へ旅行してきました。いい思い出です。
  • 映画三昧。子供の頃に見た「ミュータントタートルズ」に始まり、「スターウォーズ」で締める、良い年でした。
  • 寿司と焼肉とケーキが食べたい。何ヶ月も前からお願いしていますがかないません。
  • 一身上の都合により一時坊主になりました。気に入っているので短髪は継続しています。
  • 北陸旅行。こっそり行きました。新幹線の中では原稿がどんどん書けることに気がつけてよかったです
  • iPhone 6SとApple Watchを購入してAppleにお布施しました。Apple Musicも契約しているので信者の務めは果たせている気がいます。
  • 全体的にQOLが高かった気がします

健康

  • 忘れ物をしやすくなった(年のせいっぽい)
  • 注意力・集中力の低下(年のせいっぽい)
  • 筋トレ... 時々しています。調査地の中では筋トレが捗ります。一人の時にこっそりやっていました。
  • 軽鬱。受け入れることで少し楽になった気がします

研究

  • D論
    • モチベーションの低下
    • ボスの一言がグサリ(言い訳)
  • 2015年も論文が出せなかった。ただただそれだけです。
  • 今年も八甲田の調査に参加させてもらいました
  • 日光でスウェーデンの学生たちと共同の調査に混ぜてもらいました
  • モニ1000の調査をやりました
  • 大学院おやすみ
    • 授業料、奨学金、意欲、現在の成果、将来性あれこれを考えての結果です。復帰は未定です
    • 就職活動、本気出す
    • 世話になった、面倒をかけた人たちへ挨拶...という仕事が残っている...
  • 後輩指導できず... 自身がしっかりしていないせいでしょうが、頼られる人間になりたいものです。

仕事・活動

  • 6月頃からあるプロジェクトに混ぜてもらっています。進捗、あまりよくないのですが、頑張っています
    • どこへ向かっているのか...人生に迷走している感があります
    • でも楽しい・勉強になる
  • 研究室でうまくいかないので、R記事やブログを書く機会が増えました。これもヨクナサソウ。
  • よくわかりませんが(自己申請で)ホクソエムの一員になりました。ホクソエムらしい活動をするようになりました。
  • Japan.Rの運営を手伝いました。日本のRコミュニティに少し貢献できたのでよしとします。
  • 勢力的なストーキング活動
  • 健康おじさん、ログおじさん

家宝となった「Rデータ自由自在」

Photo

Twitterのつぶやきから振り返る2015年

さて、昨年末に面白い記事をみました。興味をもったので調べてみると、もっとも前にTokyo.Rで発表されている方がいたり、この辺の分野ではポピュラーな分析手法であることがわかりました。こちらがこの記事の本題ですです。

表題の通り、昨年のTwitter上でのつぶやきから去年を振り返るとともに感情分析 Sentiment Analysis などをしてみたいと思います。N番煎じですが、あくまでも自分の振り返りなので...。コードは最後にまとめます。

つぶやき数

月、曜日、時間ごとに。

f:id:u_ribo:20160106081059p:plain

夏から秋にかけては調査が増えるのでつぶやきもやりますね。月平均で去年は70、最大の月は91(6月)でした。

f:id:u_ribo:20160106081128p:plain

日曜日はリア充を装ってつぶやかない多分他の曜日よりも寝ている時間が多いので減っています。忙しいはずの火曜日が多くなっているのが意外でした。

f:id:u_ribo:20160106081046p:plain

タイムラインにRユーザーが多いとどこからともなく現れます。帰宅する時間帯(24 ~ 26時)は少ないです。というか帰宅してからは基本的にTwitter見ないです。

感度分析

各月のつぶやきから求めた感情極性実数値の平均値は次のようになりました。基本的に後ろ向きなのですが、その中でも浮き沈みがあるっぽいですね。

f:id:u_ribo:20160106090550p:plain

ワードクラウド

感情極性実数値に基づく前向き、後ろ向き、それぞれの形態素でワードクラウドを作成しました。暖色が前向き、寒色系が後ろ向きな言葉です。

f:id:u_ribo:20160106090832p:plain

「進捗」「ない」... 納得のいく結果ですね!落ちがつきました。お後がよろしいようで。

Enjoy!

思い出のつぶやきたち

参考


Rコード

使用したパッケージ。

library(pforeach)
library(readr)
library(RMeCab)
library(wordcloud)
library(lubridate)
library(purrr)
library(dplyr)

作図パッケージである{ggplot2}用の設定です。日本語のフォントを指定しておきます。

theme_set(theme_classic(base_family = "YuGo"))
quartzFonts(YuGo = quartzFont(rep("YuGo-Medium", 4)))

前処理

データの取得から、分析に利用可能な形にするまでの処理。

https://twitter.com/settings/account からアカウントのつぶやきデータの取得を申請します。用意ができたらメールでその旨とダウンロード先が知らされます。自分の場合は5分ほどでした。

# パスを指定して圧縮ファイルを解答
path <- "~/Documents/twitter_activity/"
## unzip(zipfile = paste0(path, "23845411_587d8827eced95d3f6eb2f047585f6067f5ef54e.zip"),
##       exdir   = path)
(tmp_path <- tempdir())

# 昨年のつぶやきデータ (jsファイル)のファイル名を取得
log_js <- list.files(paste0(path, "data/js/tweets/")) %>% 
  grep("^2015", ., value = TRUE) %>% 
  gsub(".js$", "", .)

# 一時フォルダに月ごとのつぶやきデータファイルを保存
#   不要な先頭行を削除
#   対象外にするつぶやきを取り除く(純粋に自分のつぶやきにするため)
#     1. 誰かへのリプライ
#     2. URLを含むもの
pforeach::npforeach(i = 1:length(log_js))({
  readLines(con = paste0(path, "data/js/tweets/", log_js[i], ".js")) %>% 
    .[2:length(.)] %>% 
    jsonlite::fromJSON(txt = ., flatten = TRUE) %$%
    text %>%
    grep("@[[:alnum:]]+", ., value = TRUE, invert = TRUE) %>%
    grep("[http:|https:]+", ., value = TRUE, invert = TRUE) %>%
    write(file = paste0(tmp_path, "/", log_js[i], ".txt"))
})

# つぶやきと時間のdata.frame
#   抽出条件は先と同じ
#   タイムゾーンが異なっているので修正
#   月、曜日、時間ごとのつぶやき数を算出するために{lubridate}を利用
df_tw_tl <- pforeach::npforeach(i = 1:length(log_js), .c = rbind)({
  readLines(con = paste0(path, "data/js/tweets/", log_js[i], ".js")) %>% 
    .[2:length(.)] %>% 
    jsonlite::fromJSON(txt = ., flatten = TRUE) %>%
    .[, c("text", "created_at")] %>% 
    dplyr::filter(!grepl("@[[:alnum:]]+", text)) %>% 
    dplyr::filter(!grepl("[http:|https:]+", text)) %>% 
    dplyr::mutate(created_at = lubridate::ymd_hms(created_at, tz = "Asia/Tokyo"),
                  month = lubridate::month(created_at, label = TRUE, abbr = TRUE),
                  wday  = lubridate::wday(created_at, label = TRUE, abbr = TRUE),
                  hour  = lubridate::hour(created_at))
})

感度分析

このへんの処理はSlideShareのQiitaのものと同じです。

MeCabのR用インターフェース{RMeCab}形態素解析を行い、東京工業大学高村さんが公開されてる単語感情極性対応表を利用させていただき、形態素ごとに感情極性実数値(その語が一般的に良い印象を持つか悪い印象を持つかを表した二値属性を実数値としたもの)を求めます。値は-1に近いほど後ろ向き(negative)、+1に近いほど前向き(positive)と考えられます。

df_dic <- read_delim("~/Downloads/pn_ja.dic",
                     delim = ":",
                     col_names = c("Term", "kana", "Info1", "value"),
                     col_types = cols(Term  = "c",
                                      kana  = "c",
                                      Info1   = "c",
                                      value = "d"),
                     locale = locale(encoding = "cp932")) %>% 
  aggregate(value ~ Term + Info1, ., mean)

# 単語感情極性表の属性を結合したRオブジェクトを生成
tw_2015 <- pforeach::npforeach(i = 1:length(log_js), .c = list)({
  RMeCabFreq(filename = paste0(tmp_path, "/", log_js[i], ".txt"),
             dic      = "/Users/uri/git/clone/mecab-ipadic-neologd/build/mecab-ipadic-2.7.0-20070801-neologd-20160104") %>% 
    dplyr::inner_join(df_dic)
})
# 各月のつぶやきは以下のようなdata.frameクラスオブジェクトとして格納される
# tw_2015[[1]] %>% head()
#       Term Info1 Info2 Freq      value
# 1   かなり  副詞  一般    1 -0.2666110
# 2     つい  副詞  一般    1 -0.5456660
# 3 ともかく  副詞  一般    1 -0.6976480
# 4 にんまり  副詞  一般    1 -0.0413582
# 5     まあ  副詞  一般    1 -0.4438480
# 6   もっと  副詞  一般    1 -0.2372620

ワードクラウド

# 月ごとのつぶやきを結合して、一年間の形態素とする
df_tw_2015 <- pforeach::npforeach(i = 1:(length(log_js) - 1), .c = rbind)({
  tw_2015[[i]] %>% dplyr::bind_rows(tw_2015[[i + 1]])
})
# 形態素ごとに頻度を求める
df_tw_2015 %<>% dplyr::inner_join(df_dic) %>% 
  dplyr::group_by(Term) %>% 
  dplyr::summarise(Freq  = sum(Freq),
                   value = mean(value))

可視化

df_tw_tl %>% dplyr::group_by(month) %>% 
  dplyr::summarise(tw = n()) %>% 
  ggplot(aes(month, tw, group = 1)) +
  geom_point() +
  geom_line() + 
  ggtitle("月ごとのつぶやき数")
df_tw_tl %>% dplyr::group_by(wday) %>% 
  dplyr::summarise(tw = n()) %>% 
  ggplot(aes(wday, tw, group = 1)) +
  geom_point() +
  geom_line() +
  ggtitle("曜日ごとのつぶやき数")
df_tw_tl %>% dplyr::group_by(hour) %>% 
  dplyr::summarise(tw = n()) %>% 
  ggplot(aes(hour, tw, group = 1)) +
  geom_point() +
  geom_line() +
  ggtitle("時間ごとのつぶやき数")
df_pol <- data.frame(month = lubridate::month(1:12, label = TRUE, abbr = TRUE),
            value = tw_2015 %>% map(~ mean(.$value)) %>% flatten())
df_pol %>% ggplot(aes(month, value, group = 1)) +
  geom_point() +
  geom_line() +
  ggtitle("各月の平均感情極性実数値")
par(mfrow = c(1, 2))
df_tw_2015 %>% dplyr::filter(value > 0) %$% 
  wordcloud(Term, Freq,
            max.words    = 100,
            random.order = FALSE,
            colors = c("lightsalmon", "darkorange", "tomato"),
            scale        = c(6, 0.5),
            rot.per      = 0.5,
            min.freq     = min(Freq) + 1, 
            font         = 2)
df_tw_2015 %>% dplyr::filter(value < 0) %$% 
  wordcloud(Term, Freq, 
            max.words    = 100,
            random.order = FALSE, 
            colors       = c("skyblue", "darkviolet"), 
            scale        = c(6, 0.5),
            rot.per      = 0.5,
            min.freq     = min(Freq) + 1, 
            font         = 2)