R関連のアドベントカレンダーに穴が空いているかをRから知る

これはR Advent Calendar 2017 2日目の記事です。R Advent Calendar 2017が今日の担当者不在のままだったので、「あいてたら埋める」というホクソエムの誓いに従って急遽記事を書いています。

にしても、Rという人気言語のアドベントカレンダーで、担当者が埋まらないなんていうことがなぜあるんでしょう。小一時間考えて、「ははあ、みんなRに夢中でアドベントカレンダーがあいてるのかどうかチェックする時間がないのか」と思い至りました。なるほどそうですよね。

ということで、今日はRからアドベントカレンダーの空きをチェックする方法を紹介します。

まずはデータ取得です。私のまわりのR界隈の人が参加してそうなアドベントカレンダーはこのあたりです。

Qiitaのアドベントカレンダーのデータを取得

Qiitaのアドベントカレンダーは、↓の赤で示した部分のデータを取り出します。ここはadventCalendarItemというクラスの<div>要素です。

f:id:yutannihilation:20171119145555p:plain:w450

library(rvest)

x <- read_html("https://qiita.com/advent-calendar/2017/rstudio")

entries <- x %>%
  html_nodes("div.adventCalendarItem")

ひとつ覗いてみると以下のように2つの要素を含んでいます。

entries[[1]]
#> {xml_node}
#> <div class="adventCalendarItem">
#> [1] <div class="adventCalendarItem_date">12 / 1</div>\n
#> [2] <div class="adventCalendarItem_calendarContent">\n<a class="adventCalendarItem_author" href="/hoxo_m"><img alt="hoxo_m" class ...

このそれぞれの要素から、日付、著者、タイトルを抜き出す関数をつくり、map_dfr()で一気に適用します。

library(lubridate)

extract_one_row <- function(e) {
  date <- e %>%
    html_node("div.adventCalendarItem_date") %>%
    html_text() %>%
    parse_date_time("md")
  year(date) <- 2017
  
  author <- e %>%
    html_node("a.adventCalendarItem_author") %>%
    html_text(trim = TRUE)
  
  comment <- e %>%
    html_node("div.adventCalendarItem_comment") %>%
    html_text(trim = TRUE)
  
  data.frame(date, author, comment,
             stringsAsFactors = FALSE)
}

d <- purrr::map_dfr(entries, extract_one_row)

こんな感じです。1行目がNAになってるのは、公開済みの日とそうでない日でHTMLの構造が違うからですが、まあ今回は気にしないことにします。

knitr::kable(head(d))
date author comment
2017-12-01 hoxo_m NA
2017-12-02 y__mattu EmacsでつくるオレオレRStudioから1年、自分の分析環境の変化について
2017-12-03 Med_KU
2017-12-04 kosugitti RStudioの俺の好きな機能ランクTop5を書きます
2017-12-05 psycle44 アカデミアのためのRStudio: 論文原稿を書き上げるまで他ソフトへの浮気は絶対に許さない。
2017-12-06 kozo2 vdiffr でプロットもテストしよう

これを全カレンダー分取得して結合しておきましょう

urls <- c(R = "https://qiita.com/advent-calendar/2017/rlang",
          RStudio = "https://qiita.com/advent-calendar/2017/rstudio",
          Shiny = "https://qiita.com/advent-calendar/2017/shiny",
          Stan = "https://qiita.com/advent-calendar/2017/stan",
          hoxo_m = "https://qiita.com/advent-calendar/2017/hoxo-m")

xmls <- purrr::map(urls, read_html)
entries <- purrr::map(xmls, html_nodes, css = "div.adventCalendarItem")
d_qiita <- purrr::map_dfr(entries, purrr::map_dfr, extract_one_row, .id = "calendar")

Adventarのアドベントカレンダーのデータを取得

Adventarのデータも同じく↓の赤の部分を取ってきます。

f:id:yutannihilation:20171119145630p:plain:w450

が、Qiitaとは異なり、HTMLの構造からデータを取り出すことはできません。具体的には、以下のようにdata-react-propsという要素にエスケープされたJSON文字列として格納されています。

<div data-react-class="CalendarContainer" data-react-props="{&quot;calendar&quot;:{&quot;id&quot;:2188,&quot;year&quot;:2017},&quot;...

まあ、とはいえJSONなので、これをRで扱えるデータ形式に変換するのは難しくありません。jsonlite::fromJSON()するだけです(flatten = TRUEを付ける理由はメモ:data.frameはdata.frameの列として使えるけどtibbleの列には使えない - Technically, technophobic.を参照)。

x <- read_html("https://adventar.org/calendars/2188")

data_json <- x %>%
  html_node(xpath = "//div[@data-react-class='CalendarContainer']") %>%
  html_attr("data-react-props") %>%
  jsonlite::fromJSON(flatten = TRUE)

構造はこんな風になっています。

str(data_json)
#> List of 3
#>  $ calendar    :List of 2
#>   ..$ id  : int 2188
#>   ..$ year: int 2017
#>  $ entries     :'data.frame':    16 obs. of  9 variables:
#>   ..$ id        : int [1:16] 40378 39169 37760 37601 37591 37587 37585 37522 37438 37437 ...
#>   ..$ date      : chr [1:16] "2017-12-03" "2017-12-17" "2017-12-21" "2017-12-14" ...
#>   ..$ comment   : chr [1:16] "tidyverseをロードするときに歌うポケ○ンの替え歌日本語版テンプレート(ポエムが入る)を作る" NA "less tidy world" "真夜中のタイディ~俺は生きている~" ...
#>   ..$ url       : chr [1:16] "" NA "" "" ...
#>   ..$ title     : logi [1:16] NA NA NA NA NA NA ...
#>   ..$ image     : logi [1:16] NA NA NA NA NA NA ...
#>   ..$ user.id   : int [1:16] 15704 15304 9671 14593 14580 14716 14716 14580 6314 14659 ...
#>   ..$ user.name : chr [1:16] "kyusque" "niszet0" "R_Linux" "hoxo_m" ...
#>   ..$ user.image: chr [1:16] "http://pbs.twimg.com/profile_images/911413093804081152/MxB0I-xx_normal.jpg" "http://pbs.twimg.com/profile_images/851014262138953729/XKw_7h9P_normal.jpg" "http://pbs.twimg.com/profile_images/727390025864761344/YChj2dXk_normal.jpg" "http://pbs.twimg.com/profile_images/848317965132906497/4i7_WLWT_normal.jpg" ...
#>  $ current_user: NULL

必要な部分だけ取り出すと、こんな感じになるでしょう。

d_adventar <- transmute(data_json$entries,
                             date = lubridate::ymd(date), author = user.name, comment = comment)

knitr::kable(head(d_adventar))
date author comment
2017-12-01 yutannihilation 月がtidyですね。
2017-12-19 kyusque てでぃてでぃーでぃて、てっててでぃてて!
2017-12-18 kyusque 風の夜に馬を駆けり行く者あり、腕にtidy帯びゆるをしっかとばかり抱きけり
2017-12-03 kyusque あぁ憧れのtidyマスターになりたいなならなくちゃ絶対なってやる
2017-12-17 niszet0 NA
2017-12-21 R_Linux less tidy world

結果を結合

両方の結果を結合します。

# 列を合わせるためcalendar列を追加し、date列をPOSIXctに変換
d_adventar <- mutate(d_adventar, calendar = "tidyポエム")

# 結合
d <- bind_rows(d_qiita, d_adventar)

結果を表示

必要なカラムだけに絞ってspread()します。

d %>%
  dplyr::transmute(calendar, date, maru = "〇") %>%
  tidyr::spread(calendar, maru) %>%
  # 見やすくするためNAを空文字に置き換え
  mutate_at(vars(-date), stringr::str_replace_na, replacement = "")
date hoxo_m R RStudio Shiny Stan tidyポエム
2017-12-01
2017-12-02
2017-12-03
2017-12-04
2017-12-05
2017-12-06
2017-12-07
2017-12-08
2017-12-09
2017-12-10
2017-12-11
2017-12-12
2017-12-13
2017-12-14
2017-12-15
2017-12-16
2017-12-17
2017-12-18
2017-12-19
2017-12-20
2017-12-21
2017-12-22
2017-12-23
2017-12-24
2017-12-25

これで丸が付いていないところが担当者がまだ決まっていないアドベントカレンダーです。

さあ、これでもうRに夢中でアドベントカレンダーがあいてるのに気づかないなんてことはないですね?

さいごに

明日はMed_KUさんです。楽しみにしています!