Question

我正试图在劳工统计局的任何页面上抓取所有表格（特别是这一个：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
  }
}

Answer 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)
}

希望有所帮助

Gottavianoni

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

1 个答案: