尝试使用 r 抓取合并的 Html 表答案

【问题标题】：Trying to web scrape a merged Html table with r尝试使用 r 抓取合并的 Html 表
【发布时间】：2018-07-23 08:19:11
【问题描述】：

我正在尝试抓取劳工统计局任何页面上的所有表格（尤其是这个：https://www.bls.gov/news.release/empsit.htm）。但是，我在该站点的特定表上遇到了 R 问题。最后一个表被标记为表 7。使用包 rvest，我使用递归循环，该循环将首先创建从网站获取的 tableID 矩阵，过滤掉那些没有实际用途的表，然后将其放入 html_table功能（）。由于有合并的单元格，我为循环保留了 fill = TRUE，并且我还添加了额外的条件以说明一些实际具有 html 表但仍具有表 id 的表（图表 4、6 和 7）。问题在于，对于最终表格，第二行实际上没有足够的输入来满足给定的列数量，并且 rvest 函数以一种奇怪的方式填充它。第二行不应该在 May 和 Jun 列之间包含 2016 年，并且会弄乱我以后所做的任何查询。有人可以帮忙吗？

输出：

            Benchmark 2017 2016 2016 2016 2016 2016 2016 2016 2016 2016 2017 2017 2017 Total
1           Benchmark 2017  Apr  May 2016  Jun  Jul  Aug  Sep  Oct  Nov  Dec  Jan  Feb   Mar
2   Actual Net Birth/Death  404  180   15  244  105  -38  255  -14  -35 -179   98   76 1,111
3 Forecast Net Birth/Death  255  231   99  154  113  -58  237    7  -17 -247  124   32   930
4               Difference  149  -51  -84   90   -8   20   18  -21  -18   68  -26   44   181
5    Cumulative Difference  149   98   14  104   96  116  134  113   95  163  137  181

代码如下：

webpage<- read_html("https://www.bls.gov/web/empsit/cesbmart.htm")
links <- html_nodes(webpage, "table")

titleMat <- bind_rows(lapply(xml_attrs(links), function(x) 
data.frame(as.list(x), stringsAsFactors=FALSE)))
tableExtract <- list()
tableNames <- array()
tableCap <- array()  
emptyArr <- array()

takeOut <- array()
counter <-0


for(i in 1:nrow(titleMat)){
  bool1 <- (titleMat[i,"class"] == "NA")

  if(is.na(bool1)){
    counter <- counter+1
    takeOut[counter] <- i
    }


}

tableID <- bind_rows(lapply(xml_attrs(links), function(x) data.frame(as.list(x), stringsAsFactors=FALSE)))[,"id"]
tableID
if (counter > 0){
tableID <- tableID[-c(takeOut)]
}

emptyCheck <- 0
for (cnt in 1:length(tableID)){


  capCheck <-webpage %>% html_nodes(paste("#",tableID[cnt],sep="")) %>% html_nodes("caption") %>% html_text()

  if (nchar(capCheck)>0){

    changedCap <-trimws(capCheck)

    tableCap[cnt] <- changedCap
  }



  thead <-webpage %>% html_nodes(paste("#",tableID[cnt],sep="")) %>% html_nodes("thead") %>% html_text()
  tbody <- webpage %>% html_nodes(paste("#",tableID[cnt],sep="")) %>% html_nodes("tbody") %>% html_text()
  tfoot <- webpage %>% html_nodes(paste("#",tableID[cnt],sep="")) %>% html_nodes("tfoot") %>% html_text()

  if( isTRUE(nchar(thead) > 0) || isTRUE(nchar(tbody) > 0) || isTRUE(nchar(tfoot) > 0)   ){

    tableExtract[[cnt]] <- webpage %>% html_nodes(paste("#",tableID[cnt],sep="")) %>% html_table(fill = TRUE) %>% .[[1]]
    tableExtract[[cnt]]
    tableNames[cnt] <- paste(tableID[cnt]," - v",sep="")
  }
  else{
    tableExtract[[cnt]] <- matrix("There are no recent updates for this table",1,1)
    tableNames[cnt] <- paste(tableID[cnt]," - v",sep="")

    emptyCheck <- emptyCheck + 1
    emptyArr[emptyCheck] <- cnt
  }
}

【问题讨论】：

标签： html r web-scraping rvest

【解决方案1】：

您可以尝试带有 FILL 参数的 html_table 函数：

library(rvest)

url <- "https://www.bls.gov/news.release/empsit.htm"
page <- read_html(url)

tables <- page %>% html_nodes("table")

for (i in 1:length(tables)) {
 content <- try(tables[i] %>% html_table(fill=T))
   if( typeof(content) == 'list' ) content <- data.frame(content) else {
      content <- matrix(content)[[1]]
      content <- content[-c(1,length(content[,1])-1,length(content[,1])),]
   }
 assign(paste0("table_",i),content)
}

希望对你有所帮助

哥达维亚诺尼

【讨论】：