所以我正在嘗試從網站獲取農場補貼資料，我已經想出了如何抓取我正在尋找的內容，現在我正在嘗試遍歷州 (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)
歡迎任何和所有建議！
uj5u.com熱心網友回復：
您可以向地理檔案發出請求，以首先收集與給定州相關聯的所有縣代碼和名稱。這可以通過輔助函式來完成。然后，您可以撰寫一個額外的輔助函式來整理從每個請求回傳到給定網頁（其中 url 由與縣 ID/代碼連接的基本字串構建）的 html，并將其整理到包含感興趣資訊的單個 DataFrame 中。使用future_map_dfr, from映射后一個函式furrr以回傳單個 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 包(v2.0.1)于 2021 年 11 月 3 日創建
uj5u.com熱心網友回復：
您顯示的代碼不起作用，因此我在下面進行了對我有意義的最快更正。
這里的想法是捕獲您想要在自定義函式中回圈的步驟，其中進入的變數是您想要回圈的任何內容。然后使用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")
轉載請註明出處，本文鏈接：https://www.uj5u.com/qiye/347921.html
上一篇：Terraform決議回圈