TokyoR#44でLT発表した内容について、可視化に使ったコードをメインにまとめ直した資料（＋おまけ）です。
- 当日の発表スライドはこちら
スライドにも書きましたが、やった内容は次の通りです。
- TokyoRのイベントページからHTMLファイルをダウンロード
- ダウンロードしたHTMLファイルをパース
- 各回の開催ペースや参加者数を集計して可視化
以下はコードと可視化結果（あとデータポエム）です。
kSetLoadLibName <- c("rvest", "dplyr", "tidyr", "ggvis", "Nippon", "d3Network", "igraph") # 読み込むパッケージ名
kSetFreq <- 3 # 参加回数の下限値
kSetLinkThreshold <- 0.7 # 類似度の閾値
kSetTopN <- 50 # スコア上位Nまで出力
kSetReadDir <- "/Users/yamano357/Desktop/TokyoR/" # 読み込み対象ファイルを保存したディレクトリ
## 抽出対象データのXPath
kSetXPaths <- list(
event.title = list(
"XPath" = "//div[@id='events']/hgroup[@class='title clearfix']//a"
),
member.max = list(
"XPath" = "//aside/section[@id='events-members']/div[@id='members-info']//span"
),
members.join = list(
"XPath" = "//aside/section[@id='events-members']/section[@id='members-join']/ol[@class='a-b']/li/span/a"
),
members.subjoin = list(
"XPath" = "//aside/section[@id='events-members']/section[@id='members-sub']//a"
),
members.cancel = list(
"XPath" = "//aside/section[@id='events-members']/section[@id='members-cancel']//a"
)
)パッケージの読み込み
is.road.lib <- suppressPackageStartupMessages(
sapply(kSetLoadLibName, library, character.only = TRUE, logical.return = TRUE)
)
stopifnot (any(is.road.lib))## 指定ディレクトリのファイルを読み込む
## ただし、読み込むファイルの順と開催順が異なるので後で揃える
list.files(path = kSetReadDir, full.names = TRUE)[seq(to = 3)] # ダウンロードしてきたHTMLファイルの一部## [1] "/Users/yamano357/Desktop/TokyoR//12062.html"
## [2] "/Users/yamano357/Desktop/TokyoR//13335.html"
## [3] "/Users/yamano357/Desktop/TokyoR//14967.html"source.htmls <- sapply(list.files(path = kSetReadDir, full.names = TRUE), rvest::html)
## 開催日は属性値を絞り込みが異なるためベタ書きで処理
held.date <- sapply(source.htmls,
function (source.html) {
substr(
(source.html %>%
html_nodes(xpath = "//div[@class='main']//dl[@class='clearfix']/dd/abbr") %>%
html_attr("title"))[[1]],
start = 1, stop = 10
)
}
)
## 定義したXPathに基づきデータを抽出
tokyo.r.member <- lapply(source.htmls,
function (source.html) {
lapply(kSetXPaths,
function (parse) {
## 抽出対象がない場合はNULLを返すように処理
result <- try(
source.html %>% html_nodes(xpath = parse$XPath) %>% html_text(),
silent = TRUE
)
if (class(result) == "try-error") {
return (NULL)
} else {
return (result)
}
}
)
}
)
## イベント名の整形
event.title <- sapply(tokyo.r.member, "[[", "event.title")[order(held.date)]
event.title <- substr(zen2han(event.title), start = 1, stop = regexpr("＠", event.title) - 1)
## 読み込むファイルの順とイベント開催順を揃える
tokyo.r.member <- tokyo.r.member[order(held.date)]
names(tokyo.r.member) <- event.title
title.count <- as.integer(substr(event.title, start = 2, stop = regexpr("R", event.title) - 2))data.frame(
span = factor(seq(length(title.count) - 1), labels = apply(embed(title.count, 2)[, c(2, 1)], 1, paste, collapse = " to ")),
diff = as.integer(diff(as.Date(sort(held.date), format = "%Y-%m-%d")))
) %>%
ggvis(x = ~span, y = ~diff) %>% layer_lines() %>%
add_axis("x",
properties = axis_props(
labels = list(
angle = 90, fontSize = 10
)
)
)data.frame(
date = as.Date(sort(held.date), format = "%Y-%m-%d"),
title_count = title.count
) %>%
ggvis(x = ~date, y = ~title_count) %>% layer_points()開催スパンと開催ペースについて
開催スパンで見ると時おり開きがあるように見えるが、開催ペースで見るとスパンが空いている時期は年末（Japan.Rも影響？）とわかる
それ以外は定期的に開催されている
data.frame(
"title" = title.count,
"max" = sapply(sapply(tokyo.r.member, "[[", "member.max"), as.integer), # 定員
"join" = sapply(sapply(tokyo.r.member, "[[", "members.join"), length), # 参加者
"sub" = sapply(sapply(tokyo.r.member, "[[", "members.subjoin"), length), # 補欠者
"cancel" = sapply(sapply(tokyo.r.member, "[[", "members.cancel"), length) # キャンセル
) %>% tidyr::gather(-title, key = type, value = value) %>%
ggvis(x = ~title, y = ~value, stroke = ~ type) %>% layer_lines()開催と参加状況について
第25回（2012/08/04）過ぎたあたりから参加枠数が増えはじめ、以降補欠者が出るくらい人気に
（詳しく見てないですが、「ビッグデータ」とか「データサイエンティスト」とかのトレンドと比較してみるのも面白いかもしれません。もしかしたら相互相関があるかも）
闇キャンセル（ステータス変更なしのキャンセル）の特定が難しかったので、考えないことに
懇親会の参加状況も見てみたかったけど、残念なことにデータがなかった
members.join <- unlist(sapply(tokyo.r.member, "[[", "members.join"))
members.join.tab <- table(substr(names(members.join), start = 1, stop = regexpr("R", names(members.join)) - 1), members.join)
members.join.count <- sort(colSums(members.join.tab))
data.frame(
num = as.integer(names(table(members.join.count))),
freq = as.integer(table(members.join.count))
) %>%
ggvis(x = ~num, y = ~freq) %>% layer_bars()## 5回以上参加している方々に限定
data.frame(
num = as.integer(names(table(members.join.count))),
freq = as.integer(table(members.join.count))
) %>% dplyr::filter(num >= 5) %>%
ggvis(x = ~num, y = ~freq) %>% layer_bars()## 10回以上参加している方々を勝手に表示
sort(members.join.count[members.join.count >= 10], decreasing = TRUE) yokkuns aad34210 bob3 teramonagi
28 25 25 23
atg Hiro_macchan manozo mikado_hito
19 19 19 19
holidayworking kos59125 otanet123 Prunus1350
18 17 17 17
tetsuroito gepuro sanoche16 soultoru
17 16 16 16
dubian100 itoyan mitz321 sfchaos
15 15 15 15
teru3teru6 もっちぃ＠ akiaki5516 azu-azu
15 15 14 14
hamadakoichi Yoshio Tokorosawa 所沢義男 adfive
14 14 14 13
karubi teruu kimukou_26 sstat3
13 13 12 12
takemikami yatsuta doradora09 horihorio
12 12 11 11
kenchan0130_aki quattro_4 wdkz zanjibar
11 11 11 11
faho h_chujo kenzrx nagayoshi3
10 10 10 10
Nikoriks obnym Takashi Kitano
10 10 10 参加者ごとの回数のヒストグラム
参加者の名寄せをしていないので、もう少し頻度が多い方にスライドしそうではある
（このアカウント同士が同一人物だという情報を希望）
（少なくとも、とある方はふたりいらっしゃる）
## 下限値で参加者を絞り込み
freq <- names(which(members.join.count >= kSetFreq))
length(freq) # 絞り込まれた参加者数を表示[1] 235
members.join.tab <- members.join.tab[, is.element(colnames(members.join.tab), freq)]
## 「参加者-参加回」の行列を作成して参加者間のコサイン類似度を算出
## 類似度を求めるノード数が少なかったので、高速に処理できる行列演算で算出
numerator <- crossprod(members.join.tab)
denominator <- diag(numerator)
cs <- numerator / sqrt(outer(denominator, denominator))
diag(cs) <- 0 # 自ノードへのリンクはカット（対角成分は0に）
## ノードはそのまま、リンクは指定した閾値で枝刈り
node <- data.frame(name = colnames(cs))
link <- data.frame(
to = as.integer(which(cs > kSetLinkThreshold, arr.ind = TRUE)[, 2]),
from = as.integer(which(cs > kSetLinkThreshold, arr.ind = TRUE)[, 1])
)
link <- data.frame(link, weight = cs[cs > kSetLinkThreshold])
## D3は0オリジンなので1を引いておく
link$from <- link$from - 1
link$to <- link$to - 1
d3ForceNetwork(
Links = link, Nodes = node,
Source = "from", Target = "to",
Value = "weight", NodeID = "name",
linkDistance = 80, charge = -130,
width = 950, height = 1100,
parentElement = "div",
standAlone = TRUE, zoom = TRUE,
iframe = FALSE, file = NULL
)参加者ネットワークについて
「同一の回に参加しているかどうかをベースに」しているので、必ずしも仲が良い方たちが集まっているわけではありません（あしからず）
ですので、リンクがないのは仲が悪いわけではありません（あしからず）
chunkのオプションに「results = “asis”」を指定してRPubs用のHTML内に出力
（参考サイトでは「comment = NA」も指定している）
chunkのオプションについては、第七使徒様が既にまとめてらっしゃいます（さすがです）
D3で可視化した参加者のネットワークに用いた類似度を重み付きグラフとして、ランキングアルゴリズムを適用
## HITSアルゴリズムを適用
auth <- eigen(t(cs) %*% cs)$vectors[, 1]
auth <- auth / sum(auth)
hub <- eigen(cs %*% t(cs))$vectors[, 1]
hub <- hub / sum(hub)
## 対称グラフなのでHUB値とAUTHORITY値が同じになるので、片方だけを使用
## 指定した上位N人を表示
names(auth) <- colnames(cs)
sort(auth, decreasing = TRUE)[seq(to = kSetTopN)]## もっちぃ＠ azu-azu teru3teru6 tetsuroito
## 0.009854100 0.009493337 0.009084034 0.009021721
## kos59125 atg Hiro_macchan mitz321
## 0.008917203 0.008897723 0.008751745 0.008669388
## sanoche16 faho soultoru Takashi Kitano
## 0.008544271 0.008476352 0.008368202 0.008309239
## Prunus1350 otanet123 aich_08_ h_chujo
## 0.008236855 0.008191112 0.007802279 0.007699493
## quattro_4 yamano357 hoxo_m tkhk11
## 0.007667731 0.007664208 0.007595836 0.007449785
## koppe110 ymaki okay0502 housecat442
## 0.007443024 0.007434932 0.007376386 0.007343376
## tsuna_1217 teruu srctaha siero5335
## 0.007227826 0.007164473 0.007119856 0.007001979
## mikado_hito gepuro voco queqaz
## 0.006909476 0.006908567 0.006898318 0.006807575
## photosynthesis NaOHaq wwacky Kohei.Sakamoto
## 0.006778016 0.006709662 0.006652279 0.006546070
## dubian100 Yoshio Tokorosawa fukamon_xxx aad34210
## 0.006517194 0.006502170 0.006469631 0.006333051
## takemikami teramonagi nezuQ obnym
## 0.006313556 0.006305692 0.006245732 0.006228491
## kentaroexp YMSKB yu.sekiya yuuki_0804
## 0.006222108 0.006171324 0.006158485 0.006137328
## Alan Smithee miya_1987
## 0.006077143 0.005888021ネットワークスコアについて
いろいろな参加者とお会いしている方々がスコアが高くなるので、困った相談事をするとズバッと解決できる（かもしれません）
参加者の名寄せをしないで参加者同士の類似度を算出したので、同一人物の方々をまとめると結果が変わります（という風に書いている本人も昔は違うアカウントで登録していた経験あり）
手軽に使えないデータがないと嘆く人たちがいるけれど、ご長寿勉強会のデータが目の前にあるわけで、これに手を出さないわけがないと思いつきでやってみたLTでした。
TokyoRの参加者や開催時期などについて集計（分析ってなんだっけ？）してみたけれど、個人的には発表タイトル・発表者を分析して、どういう内容だと人が集まりやすいかを見てみたかったですが、データ構造が一定でなくて抽出を断念しました。
発表者と発表タイトルを対応付けたまま情報抽出するには、単純にテキストを抜き出すだけではできません。
必要な部分を同定し抽出する作業は、Webテキストから言語処理に必要不可欠な前処理と言えます。
いやはや、言語処理って難しいですね。
前処理が大変かもしれないけれど、その先に素晴らしい（かもしれない）言語処理に興味がある方は、こちらもどうぞ。
NLP勉強会 #1
第2回（NLP勉強会 #2）は2014年12月14日（日）を予定しております。
RPubsにRStudio経由でアップロードしようとしたら、次のエラーが出てしまい公開できなかった（以前はWindows環境で支障なかった）。
readBin(conn, what = "raw", n = contentLength) AWSに立てたRStudio環境からアップロードするという方法もよぎりましたが、根本解決にならないので、今回は却下。
ということで調べてみると、同じようなアップロードできない症状を出す人がちらほら。
https://support.rstudio.com/hc/communities/public/questions/202448223-Publish-to-rpubs-Error-in-readBin-conn-what-raw-n-contentLength-invalid-n-argument
https://support.rstudio.com/hc/communities/public/questions/203058566-Publishing-html-file
http://stackoverflow.com/questions/22537180/error-while-publishing-in-r-pubs
http://d.hatena.ne.jp/teramonagi/20141108/1415406127
まずは、もしかしたら環境の影響かもしれないとMacPortsも最新版(2.3.2)に移行して（Yosemiteにしたけれど古いままだった）、ついでにR(3.1.2に)とRStudio(0.98.1091に)のアップグレードしてみる。
次に、R_HOME/etc/Rprofile.siteに下記のコマンドを記述。
options(rpubs.upload.method = "internal")
options(RCurlOptions = list(verbose = FALSE, capath = system.file("CurlSSL", "cacert.pem", package = "RCurl"), ssl.verifypeer = FALSE))Macだったので環境変数R_HOMEは「/Library/Frameworks/R.framework/Resources」を~/.bash_profileに設定（書き換えた読み込んで確認しておこう）。export R_HOME=/Library/Frameworks/R.framework/Resources
このようにしてRStudio経由で.RmdをHTML化してRPubsにアップロードしようとすると、今度は下記のエラーが発生。
以下にエラー readResponse(conn, skipDecoding = FALSE) :
Unexpected chunk length
Calls: rpubsUpload -> uploadFunction -> readResponse
追加情報: 警告メッセージ:
強制変換により NA が生成されました
実行が停止されました 下記の方法でアップロードを試してみると、今度はうまくいった（アップデートとか追記とかする前はダメだった）。
library(markdown)
res <- rpubsUpload("TokyoR44_LT", "TokyoR_LT44.html")
browseURL(res$continueUrl)なお、themeを変えてHTMLを作成してrpubsUpload()関数を適用すると最初と同じエラーが発生したり、何度かrpubsUpload()関数を適用しているとアップロードされるという症状もありました（再現性がちょっと不明）。
何が問題の解消に繋がったのか、いまいちはっきりしなくて気持ち悪いですが、ひとつの教訓を得ました。
先駆者は偉大であると。
本内容は個人の見解であり、所属する組織・団体の公式見解ではありません。
sessionInfo()## R version 3.1.2 (2014-10-31)
## Platform: x86_64-apple-darwin13.4.0 (64-bit)
##
## locale:
## [1] ja_JP.UTF-8/ja_JP.UTF-8/ja_JP.UTF-8/C/ja_JP.UTF-8/ja_JP.UTF-8
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] igraph_0.7.1 d3Network_0.5.1 Nippon_0.5.3 maptools_0.8-30
## [5] sp_1.0-16 ggvis_0.4 tidyr_0.1 dplyr_0.3.0.2
## [9] rvest_0.1
##
## loaded via a namespace (and not attached):
## [1] assertthat_0.1 DBI_0.3.1 digest_0.6.4 evaluate_0.5.5
## [5] foreign_0.8-61 formatR_1.0 grid_3.1.2 htmltools_0.2.6
## [9] httpuv_1.3.2 httr_0.5 jsonlite_0.9.13 knitr_1.8
## [13] lattice_0.20-29 lazyeval_0.1.9 magrittr_1.0.1 mime_0.2
## [17] parallel_3.1.2 plyr_1.8.1 R6_2.0.1 Rcpp_0.11.3
## [21] reshape2_1.4 rjson_0.2.15 RJSONIO_1.3-0 rmarkdown_0.3.10
## [25] shiny_0.10.2.1 stringr_0.6.2 tools_3.1.2 whisker_0.3-2
## [29] XML_3.98-1.1 xtable_1.7-4 yaml_2.1.13Sys.Date()## [1] "2014-11-14"