対象のテーブル
分割は前回やったので、ここでは分割する必要がないテーブルの場合を考えましょう。その代わりちょっと複雑なやつです。
<table border="1" cellspacing="0"> <tr bgcolor="#bbddff"> <td rowspan="8">属性情報</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> <tr> <td colspan="3">大項目1</td> <td colspan="3">大項目1は大きいです</td> </tr> <tr> <td rowspan="4"> </td> <td rowspan="2">中項目1</td> <td>小項目1</td> <td>小項目1はやばいです</td> <td>時間型（TM_Instant）</td> </tr> <tr> <td>小項目2</td> <td>小項目2はダサいです</td> <td>整数型</td> </tr> <tr> <td rowspan="2">中項目2</td> <td>小項目3</td> <td>小項目3は世知辛いです</td> <td>時間型（TM_Instant）</td> </tr> <tr> <td>小項目4</td> <td>小項目4はよんどころないです</td> <td>整数型</td> </tr> <tr> <td colspan="6">※余計な説明</td> </tr> </table>
ブラウザで見るとこんな感じ。
どうするか考えないといけないのは主に以下の2点です。
- 「※余計な説明」を取る
- 大項目、中項目、小項目のセル結合をいい感じに解除する
やっていきましょう。
データを読み込む
前回と同じです。読み込みます。
library(rvest) library(dplyr, warn.conflicts = FALSE) library(purrr, warn.conflicts = FALSE) # pluck conflicts html <- read_html("test2.html", encoding = "UTF-8") tables <- html_nodes(html, css = "table") list_of_rows <- html_nodes(tables, "tr") list_of_rows #> {xml_nodeset (9)} #> [1] <tr bgcolor="#bbddff">\n<td rowspan="8">属性情報</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 colspan="3">大項目1</td>\n <td colspan="3">大項目1は大きいです</td>\n </tr>\n #> [5] <tr>\n<td rowspan="4"> </td>\n <td rowspan="2">中項目1</td>\n <td>小項目1</td>\n <td>小項目1はやばいです</td>\n <td>時間 ... #> [6] <tr>\n<td>小項目2</td>\n <td>小項目2はダサいです</td>\n <td>整数型</td>\n </tr>\n #> [7] <tr>\n<td rowspan="2">中項目2</td>\n <td>小項目3</td>\n <td>小項目3は世知辛いです</td>\n <td>時間型（TM_Instant）</td>\n </tr>\n #> [8] <tr>\n<td>小項目4</td>\n <td>小項目4はよんどころないです</td>\n <td>整数型</td>\n </tr>\n #> [9] <tr>\n<td colspan="6">※余計な説明</td>\n </tr>
ヘッダ部分と中身の部分を分けておきましょう
header_row <- list_of_rows[[1]] content_rows <- list_of_rows[-1]
関係ない行を切り詰める
上のうち、「「※余計な説明」を取る」は簡単なのでさくっとやってしまいましょう。
これは、ヘッダの左端のrowspanを見ればこのテーブルの行数がわかるので、その行数で切り詰めれば大丈夫です。
<table border="1" cellspacing="0"> <tr bgcolor="#bbddff"> <td rowspan="8">属性情報</td>
ということでこんな感じ。
# 1つ目だけ取り出せばいいのでhtml_nodes()ではなくhtml_node()で vertically_long_header_cell <- html_node(header_row, "td") vertically_long_header_cell #> {xml_node} #> <td rowspan="8"> # ヘッダの分、1を引く number_of_rows <- as.integer(html_attr(vertically_long_header_cell, "rowspan")) - 1L content_rows <- head(content_rows, number_of_rows)
このセルはこの後の処理のとき邪魔になるので消しておきましょう。
xml_remove(vertically_long_header_cell)
ちなみに、xml_remove()で消した要素は復活しないので注意が必要です。
残りの処理の流れ
さて、次に「大項目、中項目、小項目のセル結合をいい感じに解除する」です。いい感じにやるのは、一気にはできないので以下の順序でやっていきます。
- セルの情報を抜き出す
colspanで横方向の位置を修正rowspanで縦方向の位置を修正- 仮のテーブルを組み立てる
- 縦長に結合されていたセルは同じ値で埋める（横長はそのまま）
- 仮のテーブルを本当の列数に縮小する
どういうことかというと、いったんこんな感じのデータフレームを作って、
| row_index | col_index | colspan | rowspan | text | link |
|---|---|---|---|---|---|
| 1 | 1 | 3 | 1 | 位置 | NA |
| 1 | 4 | 1 | 1 | 位置です。 | NA |
| 1 | 5 | 1 | 1 | 点型（GM_Point） | NA |
| 2 | 1 | 3 | 1 | 項目1 | NA |
| 2 | 4 | 1 | 1 | 項目1です。 | NA |
| … | … | … | … | … | … |
そこからcolspanとかrowspanの修正を入れてこういうテーブルをつくって、
| 属性名 | NA | NA | 説明 | 属性の型 |
|---|---|---|---|---|
| 位置 | NA | NA | 位置です。 | 点型（GM_Point） |
| 項目1 | NA | NA | 項目1です。 | コードリスト型「項目1コード」 |
| 大項目1 | NA | NA | 大項目1は大きいです | NA |
| NA | 中項目1 | 小項目1 | 小項目1はやばいです | 時間型（TM_Instant） |
| NA | NA | 小項目2 | 小項目2はダサいです | 整数型 |
| NA | 中項目2 | 小項目3 | 小項目3は世知辛いです | 時間型（TM_Instant） |
| NA | NA | 小項目4 | 小項目4はよんどころないです | 整数型 |
縦方向に埋めて、
| 属性名 | NA | NA | 説明 | 属性の型 |
|---|---|---|---|---|
| 位置 | NA | NA | 位置です。 | 点型（GM_Point） |
| 項目1 | NA | NA | 項目1です。 | コードリスト型「項目1コード」 |
| 大項目1 | NA | NA | 大項目1は大きいです | NA |
| 大項目1 | 中項目1 | 小項目1 | 小項目1はやばいです | 時間型（TM_Instant） |
| 大項目1 | 中項目1 | 小項目2 | 小項目2はダサいです | 整数型 |
| 大項目1 | 中項目2 | 小項目3 | 小項目3は世知辛いです | 時間型（TM_Instant） |
| 大項目1 | 中項目2 | 小項目4 | 小項目4はよんどころないです | 整数型 |
最終的にこんな感じにくっつける、
| 属性名 | 説明 | 属性の型 |
|---|---|---|
| 位置 | 位置です。 | 点型（GM_Point） |
| 項目1 | 項目1です。 | コードリスト型「項目1コード」 |
| 大項目1 | 大項目1は大きいです | NA |
| 大項目1_中項目1_小項目1 | 小項目1はやばいです | 時間型（TM_Instant） |
| 大項目1_中項目1_小項目2 | 小項目2はダサいです | 整数型 |
| 大項目1_中項目2_小項目3 | 小項目3は世知辛いです | 時間型（TM_Instant） |
| 大項目1_中項目2_小項目4 | 小項目4はよんどころないです | 整数型 |
というのがやりたいことです。
ヘッダの情報を抜き出す
あとで使うので、列名、列の幅、列のインデックスなどのヘッダの情報を抜き出しておきましょう。
header_col_names <- header_row %>% html_nodes("td") %>% html_text header_col_widths <- header_row %>% html_nodes("td") %>% # colspanは設定していなければ1 html_attr("colspan", default = "1") %>% as.integer number_of_cols <- sum(header_col_widths)
header_col_widthsから、各列の左端のインデックスも計算しておきましょう。幅（colspan）とiインデックスは以下のような関係になります。
width +---- 3 ----+ 1 + 1 +
(colspan) | | | |
+-----------+---+---+
index 1 4 5
つまり計算するにはこうです。
header_col_indices <- head(cumsum(c(1L, header_col_widths)), length(header_col_widths))
セルの情報を抜き出す
まず、1つの<tr>タグからセルの情報をデータフレームとして抜き出す関数を作ります。行のインデックスは外から与えます。
extract_data_from_row <- function(row_node, row_index) { cells <- html_nodes(row_node, "td") # colspanは設定されていなければ1 colspan <- as.integer(map_chr(cells, html_attr, "colspan", default = "1")) col_index <- head(cumsum(c(1L, colspan)), length(cells)) # rowspanは設定されていなければ1 rowspan <- as.integer(map_chr(cells, html_attr, "rowspan", default = "1")) text <- html_text(cells) %>% # 空白だけのセルはNAに置き換える if_else(stringr::str_detect(., "^\\s+$"), NA_character_, .) tibble::tibble(row_index, col_index, colspan, rowspan, text) }
purrrには0.2.3からimap_*()という関数が加わりました（参考：purrr 0.2.3を使ってみる - Technically, technophobic.）。これを使えば、上の関数にrow_indexを渡せます。
table_data <- imap_dfr(content_rows, extract_data_from_row) table_data #> # A tibble: 23 x 5 #> row_index col_index colspan rowspan text #> <int> <int> <int> <int> <chr> #> 1 1 1 3 1 位置 #> 2 1 4 1 1 位置です。 #> 3 1 5 1 1 点型（GM_Point） #> 4 2 1 3 1 項目1 #> 5 2 4 1 1 項目1です。 #> 6 2 5 1 1 コードリスト型「項目1コード」 #> 7 3 1 3 1 大項目1 #> 8 3 4 3 1 大項目1は大きいです #> 9 4 1 1 4 <NA> #> 10 4 2 1 2 中項目1 #> # ... with 13 more rows
いい感じです。col_indexにはすでにcolspan（=横長のセル）の影響は反映されているので、次はrowspan（縦長のセル）の情報を反映させていきます。
テーブルを組み立てる
この時点でtable_dataに含まれるデータを反映してテーブルをつくるとどうなっているか見てみましょう。
まず、NAで埋めた行列をつくります。
result <- matrix(NA_character_, ncol = number_of_cols, nrow = number_of_rows)
列名も入れておきます。
colnames(result)[header_col_indices] <- header_col_names
行列に複数の値を代入するにはx[cbind(row, col)] <- valueとします。x[row, col] <- valueだと範囲指定になっちゃうので注意しましょう（教えていただいた方ありがとうございました）。
result[cbind(table_data$row_index, table_data$col_index)] <- table_data$text
これを表示してみると、こんな感じで、ぐちゃぐちゃです。。
knitr::kable(result)
| 属性名 | NA | NA | 説明 | 属性の型 |
|---|---|---|---|---|
| 位置 | NA | NA | 位置です。 | 点型（GM_Point） |
| 項目1 | NA | NA | 項目1です。 | コードリスト型「項目1コード」 |
| 大項目1 | NA | NA | 大項目1は大きいです | NA |
| NA | 中項目1 | 小項目1 | 小項目1はやばいです | 時間型（TM_Instant） |
| 小項目2 | 小項目2はダサいです | 整数型 | NA | NA |
| 中項目2 | 小項目3 | 小項目3は世知辛いです | 時間型（TM_Instant） | NA |
| 小項目4 | 小項目4はよんどころないです | 整数型 | NA | NA |
これをなんとかするためにrowspanの影響を反映していきましょう。
rowspanの影響を反映
たとえば、以下のようなテーブルがあるとします。
+---+---+ | A | B | +---+---+ | C | | +---+---+
ここで仮にAにrowspan=2が設定されていたとすると、Cは右に押しのけられます。
+---+---+ | A | B | + +---+ | | C | +---+---+
つまり、Aの位置がrow行col列だとすると、
- 行方向の位置が
row + 1からrow + rowspan - 1の範囲 - 列方向の位置が
colより右
セルが影響を受けます。影響というのは具体的には、列の位置がAのcolspan分だけ右にずれます（↑の図だと1）。
これをコードにするとこんな感じになります。
# rowspanが1以上のセルだけを考える vertically_long_cells_index <- which(table_data$rowspan > 1) # コピー table_data_adjusted <- table_data for (idx in vertically_long_cells_index) { col_index_left <- table_data_adjusted$col_index[idx] row_index_top <- table_data_adjusted$row_index[idx] + 1L row_index_bottom <- table_data_adjusted$row_index[idx] + table_data_adjusted$rowspan[idx] - 1L table_data_adjusted <- mutate( table_data_adjusted, col_index = if_else( col_index >= col_index_left & between(row_index, row_index_top, row_index_bottom), col_index + table_data_adjusted$colspan[idx], col_index ) ) }
さて、この情報からテーブルを組み立ててみましょう。
result <- matrix(NA_character_, ncol = number_of_cols, nrow = number_of_rows) colnames(result)[header_col_indices] <- header_col_names result[cbind(table_data_adjusted$row_index, table_data_adjusted$col_index)] <- table_data_adjusted$text knitr::kable(result)
| 属性名 | NA | NA | 説明 | 属性の型 |
|---|---|---|---|---|
| 位置 | NA | NA | 位置です。 | 点型（GM_Point） |
| 項目1 | NA | NA | 項目1です。 | コードリスト型「項目1コード」 |
| 大項目1 | NA | NA | 大項目1は大きいです | NA |
| NA | 中項目1 | 小項目1 | 小項目1はやばいです | 時間型（TM_Instant） |
| NA | NA | 小項目2 | 小項目2はダサいです | 整数型 |
| NA | 中項目2 | 小項目3 | 小項目3は世知辛いです | 時間型（TM_Instant） |
| NA | NA | 小項目4 | 小項目4はよんどころないです | 整数型 |
よさそうです。
縦長のセルの値を埋める
次は、先ほど組み立てたテーブルのうち、rowspanの影響を受けた、つまり縦長に結合されていたセルの値を埋めていきます。
ひとつだけ特別な処理は、以下の赤枠部分です。
ここは元のセルがNAなので単純に埋めるだけだとNAになってしまいます。ということで、ひとつ上から値を持ってきて埋めます。この場合だと具体的には「大項目1」ですね。
for (idx in vertically_long_cells_index) { col_idx <- table_data_adjusted$col_index[idx] row_idx <- table_data_adjusted$row_index[idx] colspan <- table_data_adjusted$colspan[idx] rowspan <- table_data_adjusted$rowspan[idx] cell_text <- table_data_adjusted$text[idx] # 元のセルがNAだったらさらにその上のセルの値を使う if (is.na(cell_text)) { if (row_idx == 1L) stop("something is wrong") cell_text <- result[row_idx - 1, col_idx] } result[row_idx:(row_idx + rowspan - 1L), col_idx:(col_idx + colspan - 1L)] <- cell_text }
結果はこんな感じです。
knitr::kable(result)
| 属性名 | NA | NA | 説明 | 属性の型 |
|---|---|---|---|---|
| 位置 | NA | NA | 位置です。 | 点型（GM_Point） |
| 項目1 | NA | NA | 項目1です。 | コードリスト型「項目1コード」 |
| 大項目1 | NA | NA | 大項目1は大きいです | NA |
| 大項目1 | 中項目1 | 小項目1 | 小項目1はやばいです | 時間型（TM_Instant） |
| 大項目1 | 中項目1 | 小項目2 | 小項目2はダサいです | 整数型 |
| 大項目1 | 中項目2 | 小項目3 | 小項目3は世知辛いです | 時間型（TM_Instant） |
| 大項目1 | 中項目2 | 小項目4 | 小項目4はよんどころないです | 整数型 |
いい感じになったので、次は複数にまたがってしまっている列を圧縮しましょう。
仮のテーブルを本当の列数に圧縮する
この例で言うと、「属性名」の列は3列分にまたがってしまっています。これを圧縮しましょう。
簡単にするため、次の2つの文字列型ベクトルを結合する場合を考えてみましょう。
col1 <- c("位置", "項目1", "大項目1", "大項目1", "大項目1", "大項目1", "大項目1") col2 <- c(NA, NA, NA, "中項目1", "中項目1", "中項目2", "中項目2")
- アンダーバーを使って
{col1}_{col2}という名前に結合する - ただし、片方が
NAなら元の値を使う
というルールでつなげることにします。
これは意外とめんどくさくて、paste()だとNAを"NA"という文字列に変換してしまいます。
paste(col1, col2, sep = "_") #> [1] "位置_NA" "項目1_NA" "大項目1_NA" "大項目1_中項目1" #> [5] "大項目1_中項目1" "大項目1_中項目2" "大項目1_中項目2"
stringr::str_c()はそんな乱暴なことはしませんが、いずれかにNAが入っているとNAを返します。
stringr::str_c(col1, col2, sep = "_") #> [1] NA NA NA "大項目1_中項目1" #> [5] "大項目1_中項目1" "大項目1_中項目2" "大項目1_中項目2"
こんなときに便利なのはdplyr::coalesce()です。
coalesce(stringr::str_c(col1, col2, sep = "_"), col1) #> [1] "位置" "項目1" "大項目1" "大項目1_中項目1" #> [5] "大項目1_中項目1" "大項目1_中項目2" "大項目1_中項目2"
これが3つ以上になったら、purrr::reduce()が使えます。
col3 <- c(NA, NA, NA, "小項目1", "小項目2", "小項目3", "小項目4") list(col1, col2, col3) %>% purrr::reduce(~ coalesce(stringr::str_c(.x, .y, sep = "_"), .x)) #> [1] "位置" "項目1" #> [3] "大項目1" "大項目1_中項目1_小項目1" #> [5] "大項目1_中項目1_小項目2" "大項目1_中項目2_小項目3" #> [7] "大項目1_中項目2_小項目4"
ということで、これを使って求めるテーブルを生成します。
result_list <- list() col_index_groups <- split(seq_len(number_of_cols), rep(seq_along(header_col_widths), header_col_widths)) for (idx in seq_along(header_col_names)) { col_name <- header_col_names[idx] col_indices <- col_index_groups[[idx]] cols_list <- map(col_indices, ~ result[, .]) if (length(col_indices) == 1L) { result_list[[col_name]] <- result[, col_indices] next } result_list[[col_name]] <- cols_list %>% reduce(~ coalesce(stringr::str_c(.x, .y, sep = "_"), .x)) }
これをデータフレームにすれば完成です。
knitr::kable(as_tibble(result_list))
| 属性名 | 説明 | 属性の型 |
|---|---|---|
| 位置 | 位置です。 | 点型（GM_Point） |
| 項目1 | 項目1です。 | コードリスト型「項目1コード」 |
| 大項目1 | 大項目1は大きいです | NA |
| 大項目1中項目1小項目1 | 小項目1はやばいです | 時間型（TM_Instant） |
| 大項目1中項目1小項目2 | 小項目2はダサいです | 整数型 |
| 大項目1中項目2小項目3 | 小項目3は世知辛いです | 時間型（TM_Instant） |
| 大項目1中項目2小項目4 | 小項目4はよんどころないです | 整数型 |
感想
どうだったでしょうか。図らずも3部作になってしまいました。結論としては、HTMLテーブルつらいです。
あと、ここまで書いておきながらなんですが、まだ国土数値情報のデータを取り出すのに成功していないので、あってるか若干自信がないです…。変な部分とか、もっと楽に書けるとかあればご指摘ください。