rvest::html_table()的なものを自作する(分割編)

前回の続き。

対象のテーブル

試しにこういうテーブルを考えてみましょう。(この場合colspanは必要ないんですけど、以後の説明のためつけています)

<table>
  <!-- 1つ目のテーブルここから -->
  <tr bgcolor="#bbddff">
    <td rowspan="3">属性情報</td>
    <td colspan="3">属性名</td>
    <td>説明</td>
    <td>属性の型</td>
  </tr>
  <tr>
    <td colspan="3">位置</td>
    <td>位置です。</td>
    <td>点型(GM_Point)</td>
  </tr>
  <tr>
    <td colspan="3">項目1</td>
    <td>項目1です。</td>
    <td>コードリスト型「<a href="./path/to/codelist.html">項目1コード</a></td>
  </tr>
  <!-- 1つ目のテーブルここまで -->


  <!-- 2つ目のテーブルここから -->
  <tr>
    <td bgcolor="#bbddff" rowspan="4">属性情報</td>
    <td bgcolor="#bbddff" colspan="3">属性名</td>
    <td bgcolor="#bbddff">説明</td>
    <td bgcolor="#bbddff">属性の型</td>
  </tr>
  <tr>
    <td colspan="3">項目2</td>
    <td>項目2です。</td>
    <td>文字列型</td>
  </tr>
  <tr>
    <td colspan="3">項目3</td>
    <td>項目3です。</td>
    <td>実数型</td>
  </tr>
  <tr>
  <td colspan="3">項目4</td>
    <td>項目4です。</td>
    <td>実数型</td>
  </tr>
  <!-- 2つ目のテーブルここまで -->

  <!-- 3つ目のテーブル(関係ないやつ)ここから -->
  <tr>
    <td bgcolor="#bbddff">注意書き</td>
    <td colspan="5">備えよう。</td>
  </tr>
  <!-- 3つ目のテーブルここまで -->
</table>

ブラウザで表示するとこんな感じになるはずです。

f:id:yutannihilation:20170902132819p:plain

1つ目のテーブルと2つ目のテーブルは、ヘッダに相当する行があります。1つ目は<tr>bgcolorが設定されているパターンで、2つ目はすべての<td>bgcolorが設定されているパターンです。

3つ目のテーブルは注意書きなので無視していいやつです。

読み込み

まずは上のHTMLを読み込みましょう。

library(rvest)
library(dplyr, warn.conflicts = FALSE)
library(purrr, warn.conflicts = FALSE)  # pluck conflicts

html <- read_html("test.html", encoding = "UTF-8")
tables <- html_nodes(html, css = "table")

tables
#> {xml_nodeset (1)}
#> [1] <table>\n<!-- 1つ目のテーブルここから --><tr bgcolor="#bbddff">\n<td rowspan="3">属性情報</td>\n    <td colspan="3">属性名</td>\n     ...

ここから<tr>タグを抜き出します。

list_of_rows <- html_nodes(tables, "tr")

list_of_rows
#> {xml_nodeset (8)}
#> [1] <tr bgcolor="#bbddff">\n<td rowspan="3">属性情報</td>\n    <td colspan="3">属性名</td>\n    <td>説明</td>\n    <td>属性の型</td> ...
#> [2] <tr>\n<td colspan="3">位置</td>\n    <td>位置です。</td>\n    <td>点型(GM_Point)</td>\n  </tr>\n
#> [3] <tr>\n<td colspan="3">項目1</td>\n    <td>項目1です。</td>\n    <td>コードリスト型「<a href="./path/to/codelist.html">項目1コード</a>」< ...
#> [4] <tr>\n<td bgcolor="#bbddff" rowspan="4">属性情報</td>\n    <td bgcolor="#bbddff" colspan="3">属性名</td>\n    <td bgcolor= ...
#> [5] <tr>\n<td colspan="3">項目2</td>\n    <td>項目2です。</td>\n    <td>文字列型</td>\n  </tr>\n
#> [6] <tr>\n<td colspan="3">項目3</td>\n    <td>項目3です。</td>\n    <td>実数型</td>\n  </tr>\n
#> [7] <tr>\n<td colspan="3">項目4</td>\n    <td>項目4です。</td>\n    <td>実数型</td>\n  </tr>\n
#> [8] <tr>\n<td bgcolor="#bbddff">注意書き</td>\n    <td colspan="5">備えよう。</td>\n  </tr>\n

html_attr()bgcolor要素を取り出し

これを、bgcolor属性を見つつ、3つに分割します。ノードから属性を取り出すにはhtml_attr()を使います。

html_attr(list_of_rows[[1]], "bgcolor")
#> [1] "#bbddff"
html_attr(list_of_rows[[2]], "bgcolor")
#> [1] NA

# デフォルト値を設定することもできる
html_attr(list_of_rows[[2]], "bgcolor", default = "foo")
#> [1] "foo"

分割する

さて、分割するには左端のセルを見ます。ここが着色されていれば、別のテーブルの始まりです。

f:id:yutannihilation:20170902132956p:plain

これには以下の2つのパターンがあります。

# 1) <tr>タグにbgcolorが設定されている
has_bgcolor_tr <- map_lgl(list_of_rows, ~ !is.na(html_attr(., "bgcolor")))

# 2) 左端の<td>タグにbgcolorが設定されている
has_bgcolor_tds <- list_of_rows %>%
  # 各<tr>から<td>を取り出す
  map(html_nodes, "td") %>%
  # 各<tr>の各<td>からbgcolor要素を取り出す
  map(map_chr, html_attr, "bgcolor") %>%
  map(~ !is.na(.))

has_bgcolor_first_td <- map_lgl(has_bgcolor_tds, first)

結果はこうです。

has_bgcolor_tr
#> [1]  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE

has_bgcolor_first_td
#> [1] FALSE FALSE FALSE  TRUE FALSE FALSE FALSE  TRUE

これのORを取れば、その行が別のテーブルの始まりかどうかがわかるので、それを使って分割します。

is_start_of_different_table <- has_bgcolor_tr | has_bgcolor_first_td

table_id <- cumsum(is_start_of_different_table)

list_of_tables <- split(list_of_rows, table_id)

ちなみに、このcumsum()の使い方は「前の行と違うかどうか、を足し合わせていけばグループIDとして使える」というものですが、以下のSOの回答を見て知りました。なるほどなあ、という感じ。

中身を見てみるとちゃんと分割できています。

list_of_tables
#> $`1`
#> {xml_nodeset (3)}
#> [1] <tr bgcolor="#bbddff">\n<td rowspan="3">属性情報</td>\n    <td colspan="3">属性名</td>\n    <td>説明</td>\n    <td>属性の型</td> ...
#> [2] <tr>\n<td colspan="3">位置</td>\n    <td>位置です。</td>\n    <td>点型(GM_Point)</td>\n  </tr>\n
#> [3] <tr>\n<td colspan="3">項目1</td>\n    <td>項目1です。</td>\n    <td>コードリスト型「<a href="./path/to/codelist.html">項目1コード</a>」< ...
#> 
#> $`2`
#> {xml_nodeset (4)}
#> [1] <tr>\n<td bgcolor="#bbddff" rowspan="4">属性情報</td>\n    <td bgcolor="#bbddff" colspan="3">属性名</td>\n    <td bgcolor= ...
#> [2] <tr>\n<td colspan="3">項目2</td>\n    <td>項目2です。</td>\n    <td>文字列型</td>\n  </tr>\n
#> [3] <tr>\n<td colspan="3">項目3</td>\n    <td>項目3です。</td>\n    <td>実数型</td>\n  </tr>\n
#> [4] <tr>\n<td colspan="3">項目4</td>\n    <td>項目4です。</td>\n    <td>実数型</td>\n  </tr>\n
#> 
#> $`3`
#> {xml_nodeset (1)}
#> [1] <tr>\n<td bgcolor="#bbddff">注意書き</td>\n    <td colspan="5">備えよう。</td>\n  </tr>\n
#> 

ヘッダがないテーブルを捨てる

また、そのテーブルがヘッダを持っているかどうかを調べて、ヘッダがなければ無視します。今回で言えば3つ目のやつですね。

上に書いたように、ヘッダは以下のように判別します。

# 1) <tr>タグにbgcolorが設定されている
# これはさっきのhas_bgcolor_trを使う

# 2) 左端の<td>タグにbgcolorが設定されている
has_bgcolor_all_td <- map_lgl(has_bgcolor_tds, all)

先ほどと同じく、これのORを取ればその行がヘッダかどうかわかります。

is_header <- has_bgcolor_tr | has_bgcolor_all_td

is_header
#> [1]  TRUE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE

知りたいのは、各テーブルの先頭行がヘッダかどうか、なので、さっきのis_start_of_different_tableを使ってこれのサブセットを取ります。

has_header <- is_header[is_start_of_different_table]
has_header
#> [1]  TRUE  TRUE FALSE

ちゃんと3つ目だけFALSEになってますね。

これを使ってヘッダがあるテーブルだけに絞り込みます。

list_of_tables[has_header]
#> $`1`
#> {xml_nodeset (3)}
#> [1] <tr bgcolor="#bbddff">\n<td rowspan="3">属性情報</td>\n    <td colspan="3">属性名</td>\n    <td>説明</td>\n    <td>属性の型</td> ...
#> [2] <tr>\n<td colspan="3">位置</td>\n    <td>位置です。</td>\n    <td>点型(GM_Point)</td>\n  </tr>\n
#> [3] <tr>\n<td colspan="3">項目1</td>\n    <td>項目1です。</td>\n    <td>コードリスト型「<a href="./path/to/codelist.html">項目1コード</a>」< ...
#> 
#> $`2`
#> {xml_nodeset (4)}
#> [1] <tr>\n<td bgcolor="#bbddff" rowspan="4">属性情報</td>\n    <td bgcolor="#bbddff" colspan="3">属性名</td>\n    <td bgcolor= ...
#> [2] <tr>\n<td colspan="3">項目2</td>\n    <td>項目2です。</td>\n    <td>文字列型</td>\n  </tr>\n
#> [3] <tr>\n<td colspan="3">項目3</td>\n    <td>項目3です。</td>\n    <td>実数型</td>\n  </tr>\n
#> [4] <tr>\n<td colspan="3">項目4</td>\n    <td>項目4です。</td>\n    <td>実数型</td>\n  </tr>\n
#> 

できました!

次回に続く

という感じで、またもやテーブルを作る前で長くなってきたのでここらで記事を分けます。。

notchained.hatenablog.com