前回の続き。
対象のテーブル
試しにこういうテーブルを考えてみましょう。（この場合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>
ブラウザで表示するとこんな感じになるはずです。
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"
分割する
さて、分割するには左端のセルを見ます。ここが着色されていれば、別のテーブルの始まりです。
これには以下の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 #>
できました！
次回に続く
という感じで、またもやテーブルを作る前で長くなってきたのでここらで記事を分けます。。
