使用“rvest”包进行网络抓取，我如何遍历一堆县级 FIPS 代码？

Question

所以我正在尝试从网站获取农场补贴数据，我已经弄清楚如何抓取我正在寻找的内容，现在我正在尝试遍历一个州 (CO) 的所有县以获取这些补贴数据来自各个县。我可以接受 (a) 在循环运行后为每个县创建一个单独的 .csv，或者 (b) 将它们全部编译到一个数据帧中，然后保存为 .csv。

以下是仅针对一个县完成的抓取示例。现在我想编写一个循环，暂时遍历 fips 代码 08003、08005、08007、08009 和 08011（我可以稍后将其推广到 CO 的其他县）。

# Starting with Adams County
library(rvest)
library(dplyr)
library(tidyr)


link = "https://farm.ewg.org/regionsummary.php?fips=08001"
page = read_html(link)

year = page %>% html_nodes("tr~ tr+ tr td:nth-child(1)") %>% html_text()
year

subs = page %>% html_nodes("td:nth-child(3)") %>% html_text()
subs

  subsidy_data <- data.frame(subs)

  subs = data.frame(do.call("rbind", strsplit(as.character(subsidy_data$subs), "$", fixed = TRUE)))
  
  sub_data <- cbind(year, subs)
  sub_data <- sub_data[-c(28),]

cons_sub_rec = page %>% html_nodes("td~ td+ td small:nth-child(1) em") %>% html_text()
cons_sub_rec <- cons_sub_rec[-c(28)]

dis_sub_rec = page %>% html_nodes("small:nth-child(3) em") %>% html_text()

comm_sub_rec = page %>% html_nodes("small:nth-child(5) em") %>% html_text()

ins_sub_rec = page %>% html_nodes("small:nth-child(7) em") %>% html_text()

  sub_data <- cbind(year, subs, cons_sub_rec, dis_sub_rec, comm_sub_rec, ins_sub_rec)
  
  sub_data$fips = 8001
  
  write.csv(sub_data,"filepath/ewg_sub_8001.csv", row.names = TRUE)  

欢迎提出任何建议！

Answer 1

您可以向地理文件发出请求，以首先收集与给定州关联的所有县代码和名称。这可以通过辅助函数来完成。然后，您可以编写一个额外的辅助函数来整理从每个请求返回到给定网页（其中 url 由与县 id/code 连接的基本字符串构造）的 html 到包含感兴趣信息的单个 DataFrame 中。使用furrr 中的future_map_dfr 映射后一个函数，以返回单个DataFrame。

注意事项：

代码使用 R 4.1.0+ 语法编写。

感谢@hrbrmstr 处理br 元素的方法。

---

library(rvest)
library(tidyverse)
library(jsonlite)
#> 
#> Attaching package: 'jsonlite'
#> The following object is masked from 'package:purrr':
#> 
#>     flatten
library(janitor)
#> 
#> Attaching package: 'janitor'
#> The following objects are masked from 'package:stats':
#> 
#>     chisq.test, fisher.test
library(furrr)
#> Loading required package: future
library(xml2)

state_county_codes <- \(state_code){
  read_html(sprintf("https://farm.ewg.org/ammap/maps/js/%sCounties.js", state_code)) |>
    html_text() |>
    stringr::str_match("(\\[.*\\])") |>
    {
      \(x) x[, 1]
    }() |>
    jsonlite::parse_json(simplifyVector = T) |>
    select(-d) |>
    mutate(
      id = substr(id, 2, 6),
      webpage = paste0("https://farm.ewg.org/regionsummary.php?fips=", id)
    ) |>
    tibble() -> df
}

county_summary <- \(county_code) {
  page <- read_html(sprintf("https://farm.ewg.org/regionsummary.php?fips=%s", county_code))

  xml_find_all(page, ".//br") |> xml_add_sibling("p", "#")
  xml_find_all(page, ".//br") |> xml_remove()

  t <- page |>
    html_element(".table") |>
    html_table()

  t <- t[-c(5)] |> clean_names()

  df <- data.frame(
    id = county_code,
    year = t$year |> stringi::stri_remove_empty() |> rep(4) |>
      {
        \(x) stringr::str_replace(x, "‡", "")
      }(),
    `subsidy_category` = stringr::str_split_fixed(t$`subsidy_category`, "#", 4) |> stringi::stri_remove_empty() |> as.vector(),
    amount = stringr::str_split_fixed(t$`subsidy_category_2`, "#", 4) |> stringi::stri_remove_empty() |> as.vector(),
    number = stringr::str_split_fixed(t$`subsidy_category_3`, "#", 4) |> stringi::stri_remove_empty() |> as.vector()
  )
}

state_code <- "co"

counties <- state_county_codes(state_code)

no_cores <- future::availableCores() - 1
future::plan(future::multisession, workers = no_cores)
results <- future_map_dfr(counties$id, .f = county_summary)

final <- dplyr::left_join(results, counties, by = "id") |>
  select(title, everything()) |>
  rename(county = title)

^{由reprex package (v2.0.1) 于 2021 年 11 月 3 日创建}

Answer 2

您显示的代码不起作用，因此我在下面进行了对我有意义的最快更正。

这里的想法是在自定义函数中捕获您想要循环的步骤，其中输入的变量是您想要循环的任何内容。然后使用purrr::map()通过这个函数映射fips代码。

library(rvest)

fips <- c(08001, 08003, 08005, 08007, 08009,  08011)

get_fips_data <- function(x) {
  url <- paste("https://farm.ewg.org/regionsummary.php?fips=", x)
  site <- read_html(url)
  
  year = site %>% html_nodes("tr~ tr+ tr td:nth-child(1)") %>% html_text()

  subs = site %>% html_nodes("td:nth-child(3)") %>% html_text()

  subsidy_data <- data.frame(subs)

  subs = data.frame(do.call("rbind", strsplit(as.character(subsidy_data$subs), "$", fixed = TRUE)))

  sub_data <- cbind(year, subs)
  sub_data <- sub_data[-28,]

  cons_sub_rec = site %>% html_nodes("small:nth-child(1) em") %>% html_text()
  cons_sub_rec <- cons_sub_rec[-28]

  dis_sub_rec = site %>% html_nodes("small:nth-child(3) em") %>% html_text()

  comm_sub_rec = site %>% html_nodes("small:nth-child(5) em") %>% html_text()

  ins_sub_rec = site %>% html_nodes("small:nth-child(7) em") %>% html_text()

  cbind(year, subs, cons_sub_rec, dis_sub_rec, comm_sub_rec, ins_sub_rec)
}


fips %>% 
  purrr::set_names() %>% 
  purrr::map_dfr(get_fips_data, .id = "fips")