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

oogrdqng  于 5个月前  发布在  其他
关注(0)|答案(1)|浏览(72)

我的目标是将我的代码生成的嵌套列表转换成一个嵌套框架。我有下面的代码,它在一个循环中从几个url中提取一些数据,并将它们存储在列表中。

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名单并排。我其实很卡住,至于如何才能解决这个问题?

2izufjch

2izufjch1#

你可以通过不创建一个嵌套列表来更容易地实现你想要的结果。我重构了你的代码,首先将主要的抓取代码放在一个函数中,以便于调试和测试。在这个函数中,我已经使用dplyr::bind_rows将团队表绑定到一个框架中。这个函数也应该更有效,因为它避免了像你的代码那样阅读两次HTML。
对于循环部分,我切换到purrr::map。为此,创建一个包含日期和相应URL的嵌套框架。这样,您可以直接在URL上循环,而不需要嵌套for循环。因此,您将获得一个嵌套框架列表,您最终可以按行绑定在一起。
最后,请注意,我删除了tryCatch,并使用purrr::safely来处理错误。

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

make_url <- function(year, month, day) {
  paste0(
    "https://www.baseball-reference.com/boxes/ARI/ARI",
    year, month, day, ".shtml"
  )
}

scrape_table <- function(url) {
  html <- read_html(url)

  nodes <- html |>
    html_elements(xpath = '//div[starts-with(@id, "all_") and contains(@id, "batting")]')

  teams <- html %>%
    html_elements(xpath = "//td/a") %>%
    html_text()

  nodes |>
    purrr::set_names(teams) |>
    purrr::map(\(x) {
      x |>
        as.character() |>
        str_remove_all("<!--|-->") |>
        read_html() |>
        html_table()
    }) |>
    unlist(recursive = FALSE) |>
    dplyr::bind_rows(.id = "Team")
}

# declare variables
month <- c("07", "09")
year <- c("2022")
day <- c("040")

dates <- expand.grid(
  year = year, month = month, day = day
)

urls <- dates |>
  mutate(
    url = make_url(year, month, day),
    date = paste(year, month, day, sep = "-"),
    .keep = "unused"
  )

safe_scrape_table <- purrr::safely(scrape_table)

final <- purrr::map(urls$url, \(url) {
  Sys.sleep(5)
  safe_scrape_table(url)
}) |>
  set_names(urls$date)

final <- final |>
  purrr::transpose() |>
  pluck("result") |>
  bind_rows(.id = "Date")

head(final)
#> # A tibble: 6 × 26
#>   Date       Team  Batting    AB     R     H   RBI    BB    SO    PA    BA   OBP
#>   <chr>      <chr> <chr>   <int> <int> <int> <int> <int> <int> <int> <dbl> <dbl>
#> 1 2022-07-0… San … Austin…     2     0     0     0     1     1     3 0.243 0.367
#> 2 2022-07-0… San … Mike Y…     2     0     0     0     0     1     2 0.236 0.338
#> 3 2022-07-0… San … Wilmer…     3     1     0     0     0     2     4 0.242 0.331
#> 4 2022-07-0… San … Darin …     2     1     0     0     1     2     4 0.22  0.335
#> 5 2022-07-0… San … Evan L…     3     1     1     0     1     0     4 0.248 0.333
#> 6 2022-07-0… San … LaMont…     4     0     1     2     0     0     4 0.22  0.313
#> # ℹ 14 more variables: SLG <dbl>, OPS <dbl>, Pit <int>, Str <int>, WPA <dbl>,
#> #   aLI <dbl>, `WPA+` <dbl>, `WPA-` <chr>, cWPA <chr>, acLI <dbl>, RE24 <dbl>,
#> #   PO <int>, A <int>, Details <chr>

字符串

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

final_result <- final |>
  purrr::transpose() |>
  pluck("result")

# Data Cleaning
final <- map(
  final_result,
  \(x) {
    x |> 
      mutate(across(!c(Team, Batting, Details) & where(is.character), readr::parse_number))
  }
)

# Bind
final <- final |>
  bind_rows(.id = "Date")

相关问题