将嵌套列表转换为 R 中的数据框

Question

我的目标是将代码生成的嵌套列表转换为数据帧。我有以下内容，它从循环中的多个网址中提取一些数据并将它们存储在列表中。

library(rvest)
library(XML)
library(purrr)
library(stringr)
library(dplyr)

# declare variables
month = c('07','09')
year = c('2022','2023')
day = c('040','050')

# initialize the empty list
final = list()

# perform the loop
for (i in year) {
  for (j in month) {
    for (k in day) {
    
    skip_to_next <- FALSE
    
    url <- paste0('https://www.baseball-reference.com/boxes/ARI/ARI', i, j, k, '.shtml')
    
    Sys.sleep(5)
    game_path <- tryCatch(url |>
                            read_html() |>
                            html_nodes(xpath = '//div[contains(@id, "batting")]') |> 
                            map(\(x) x |> 
                                  as.character() |> 
                                  str_remove_all("<!--|-->") |> 
                                  read_html() |> 
                                  html_table()) |> 
                            unlist(recursive = FALSE), error = function(e) {skip_to_next <<- TRUE} )
    
    if(skip_to_next) {next}
    
    url <- read_html(url)
    
    list_url <- url %>%
      html_nodes(xpath = "//td/a") %>% 
      html_text() 
    
    List_2_letters = as.list(list_url[nchar(list_url) > 5])
    
    game_path <- mapply(cbind, game_path, "Date" = paste(gsub('.{1}$', '', k), j, i, sep = '-'), SIMPLIFY=F)
    
    game_path <- Map(cbind, game_path, "Team" = List_2_letters)
    
    final[[i]][[j]][[k]] <- game_path
    
    }
  }
}

我得到了一堆如下所示的列表：

我想做的是将所有具有data.frame值的列表组合起来。

我尝试了所有这些：

final_2 = map_dfr(final, ~ bind_rows(.x))
final_2 <- as.data.frame(do.call(cbind, final))
final_2 <- do.call("rbind", final)

但它们都只是并排生成 2 个列表。我实际上很困惑如何解决这个问题？

Answer 1

通过不创建嵌套列表，您可以更轻松地实现所需的结果。我重构了您的代码，首先将主要的抓取代码放入一个函数中，以便于调试和测试。在此函数中，我已使用以下命令将团队表绑定到一个数据帧中：dplyr::bind_rows。该函数还应该更加高效，因为它避免了像在代码中那样读取 HTML 两次。

\n

对于循环部分我切换到purrr::map. 为此，创建一个包含日期和相​​应 URL 的数据框。这样你就可以直接循环 url，而不需要嵌套的 for 循环。结果，您将获得一个数据帧列表，您最终可以将其按行绑定在一起。

\n

最后，请注意我放弃tryCatch并使用purrr::safely它来代替错误处理。

\n

library(rvest)\nlibrary(purrr)\nlibrary(stringr)\nlibrary(dplyr)\n\nmake_url <- function(year, month, day) {\n  paste0(\n    "https://www.baseball-reference.com/boxes/ARI/ARI",\n    year, month, day, ".shtml"\n  )\n}\n\nscrape_table <- function(url) {\n  html <- read_html(url)\n\n  nodes <- html |>\n    html_elements(xpath = \'//div[starts-with(@id, "all_") and contains(@id, "batting")]\')\n\n  teams <- html %>%\n    html_elements(xpath = "//td/a") %>%\n    html_text()\n\n  nodes |>\n    purrr::set_names(teams) |>\n    purrr::map(\\(x) {\n      x |>\n        as.character() |>\n        str_remove_all("<!--|-->") |>\n        read_html() |>\n        html_table()\n    }) |>\n    unlist(recursive = FALSE) |>\n    dplyr::bind_rows(.id = "Team")\n}\n\n\n# declare variables\nmonth <- c("07", "09")\nyear <- c("2022")\nday <- c("040")\n\ndates <- expand.grid(\n  year = year, month = month, day = day\n)\n\nurls <- dates |>\n  mutate(\n    url = make_url(year, month, day),\n    date = paste(year, month, day, sep = "-"),\n    .keep = "unused"\n  )\n\nsafe_scrape_table <- purrr::safely(scrape_table)\n\nfinal <- purrr::map(urls$url, \\(url) {\n  Sys.sleep(5)\n  safe_scrape_table(url)\n}) |>\n  set_names(urls$date)\n\nfinal <- final |>\n  purrr::transpose() |>\n  pluck("result") |>\n  bind_rows(.id = "Date")\n\nhead(final)\n#> # A tibble: 6 \xc3\x97 26\n#>   Date       Team  Batting    AB     R     H   RBI    BB    SO    PA    BA   OBP\n#>   <chr>      <chr> <chr>   <int> <int> <int> <int> <int> <int> <int> <dbl> <dbl>\n#> 1 2022-07-0\xe2\x80\xa6 San \xe2\x80\xa6 Austin\xe2\x80\xa6     2     0     0     0     1     1     3 0.243 0.367\n#> 2 2022-07-0\xe2\x80\xa6 San \xe2\x80\xa6 Mike Y\xe2\x80\xa6     2     0     0     0     0     1     2 0.236 0.338\n#> 3 2022-07-0\xe2\x80\xa6 San \xe2\x80\xa6 Wilmer\xe2\x80\xa6     3     1     0     0     0     2     4 0.242 0.331\n#> 4 2022-07-0\xe2\x80\xa6 San \xe2\x80\xa6 Darin \xe2\x80\xa6     2     1     0     0     1     2     4 0.22  0.335\n#> 5 2022-07-0\xe2\x80\xa6 San \xe2\x80\xa6 Evan L\xe2\x80\xa6     3     1     1     0     1     0     4 0.248 0.333\n#> 6 2022-07-0\xe2\x80\xa6 San \xe2\x80\xa6 LaMont\xe2\x80\xa6     4     0     1     2     0     0     4 0.22  0.313\n#> # \xe2\x84\xb9 14 more variables: SLG <dbl>, OPS <dbl>, Pit <int>, Str <int>, WPA <dbl>,\n#> #   aLI <dbl>, `WPA+` <dbl>, `WPA-` <chr>, cWPA <chr>, acLI <dbl>, RE24 <dbl>,\n#> #   PO <int>, A <int>, Details <chr>\n

\n

编辑问题是各列的数据类型因日期而异，即，对于 2022-07-04，该WPA-列被读取为 a，character因为值包含符号，%而对于 2023-07-04，它仅包含一个数字，因此是读作numeric. 为了解决这个问题，我们需要在绑定表之前进行一些数据清理。以下代码将这些步骤分成几部分。首先，提取包含结果的表。然后循环数据帧列表并使用例如将应该是数字的字符列转换为数字readr::parse_number。这样做之后，绑定原则上应该可以工作。我测试了2022年和2023年。但是当然有可能出现其他问题。更安全的选择是将所有列转换为字符。然后绑定。然后进行数据清理，最后将列转换为数字。

\n

final_result <- final |>\n  purrr::transpose() |>\n  pluck("result")\n\n# Data Cleaning\nfinal <- map(\n  final_result,\n  \\(x) {\n    x |> \n      mutate(across(!c(Team, Batting, Details) & where(is.character), readr::parse_number))\n  }\n)\n\n# Bind\nfinal <- final |>\n  bind_rows(.id = "Date")\n

\n