使用变量和函数从站点抓取数据并将表绑定到一个数据框

问题描述 投票:0回答:1

这是我问题的后续这里

提供的代码非常有帮助,使我能够以更快、更有效的方式获取我想要的数据。然而,自从运行这个以来,我遇到了两个我似乎无法解决的问题。

首先,我想向提供的函数添加一个团队变量,以便它可以循环包含团队名称的网页(而不仅仅是日、月和年的变量)。所以我改变了这个:

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

像这样:

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

我创建了一个像这样的团队变量:

team = c('ARI','WAS')

我还调整了这部分,将团队包含在功能中:

urls <- dates |>
  mutate(
    url = make_url(year, month, day),
    date = paste(year, month, gsub('.{1}$', '', day), sep = '-'),
    .keep = 'unused'
  )

对此:

urls <- dates |>
  mutate(
    url = make_url(**team**, year, month, day),
    date = paste(year, month, gsub('.{1}$', '', day), sep = '-'),
    .keep = 'unused'
  )

但不幸的是,它并没有保留被抓取的初始数据,而且似乎会被最后一条记录覆盖。

第二个问题是我现在正在寻找提取投球表(最初的代码是提取击球表)。

所以我在

scrape_table
函数中更改了这部分:

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

对此:

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

但它只会产生一个空白表格。

不幸的是,我的网络抓取能力不是那么强,但是当我检查页面时,它确实显示了包含

div-id
all
pitching
,所以我很困惑为什么它没有捕获正确的表格?

完整的代码可以在最初的问题中找到这里

r dplyr purrr rvest
1个回答
0
投票

这个答案中的代码适应您的情况是一种解决方案,可以一次性获取所有表格。然而,在下面的代码中我只检索击球表和投球表。因此,对于团队和日期的每个组合,您现在将获得一个必须单独处理和清理的表格列表。

library(rvest)
library(purrr)
library(stringi)
library(dplyr)
library(xml2)

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

get_tables <- function(html) {
  # https://stackoverflow.com/a/43481001/12993861
  alt_tables <- xml2::xml_find_all(html, "//comment()") %>%
    {
      # Find only commented nodes that contain the regex for html table markup
      raw_parts <- as.character(.[grep("\\</?table", as.character(.))])
      # Remove the comment begin and end tags
      strip_html <- stringi::stri_replace_all_regex(
        raw_parts, c("<\\!--", "-->"), c("", ""),
        vectorize_all = FALSE
      )
      lapply(grep("<table", strip_html, value = TRUE), function(i) {
        read_html(i) |>
          rvest::html_table()
      })
    }

  list(
    batting = list(
      alt_tables[[2]][[1]],
      alt_tables[[3]][[1]]
    ),
    pitching = alt_tables[[4]]
  )
}

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

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

  tbls <- get_tables(html)

  tbls <- lapply(tbls, \(x) {
    names(x) <- teams
    x |>
      dplyr::bind_rows(.id = "Team")
  })
}


# declare variables
month <- c("07")
year <- c("2022")
day <- c("040")
team <- c("ARI")

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

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

safe_scrape_table <- purrr::safely(scrape_table)

foo <- purrr::map(urls$url, \(url) {
  Sys.sleep(5)
  safe_scrape_table(url)
}) |>
  set_names(paste(urls$team, urls$date, sep = "-"))

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

final_result
#> $`ARI-2022-07-040`
#> $`ARI-2022-07-040`$batting
#> # A tibble: 35 × 25
#>    Team      Batting    AB     R     H   RBI    BB    SO    PA    BA   OBP   SLG
#>    <chr>     <chr>   <int> <int> <int> <int> <int> <int> <int> <dbl> <dbl> <dbl>
#>  1 San Fran… Austin…     2     0     0     0     1     1     3 0.243 0.367 0.417
#>  2 San Fran… Mike Y…     2     0     0     0     0     1     2 0.236 0.338 0.412
#>  3 San Fran… Wilmer…     3     1     0     0     0     2     4 0.242 0.331 0.405
#>  4 San Fran… Darin …     2     1     0     0     1     2     4 0.22  0.335 0.344
#>  5 San Fran… Evan L…     3     1     1     0     1     0     4 0.248 0.333 0.473
#>  6 San Fran… LaMont…     4     0     1     2     0     0     4 0.22  0.313 0.366
#>  7 San Fran… Yermin…     4     0     2     0     0     0     4 0.444 0.444 0.667
#>  8 San Fran… David …     4     0     2     1     0     1     4 0.5   0.5   0.75 
#>  9 San Fran… Curt C…     2     0     0     0     0     1     2 0.231 0.325 0.37 
#> 10 San Fran… Austin…     1     0     1     0     0     0     1 0.227 0.292 0.341
#> # ℹ 25 more rows
#> # ℹ 13 more variables: 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>
#> 
#> $`ARI-2022-07-040`$pitching
#> # A tibble: 9 × 28
#>   Team      Pitching    IP     H     R    ER    BB    SO    HR   ERA    BF   Pit
#>   <chr>     <chr>    <int> <int> <int> <int> <int> <int> <int> <dbl> <int> <int>
#> 1 San Fran… Carlos …     5     5     4     4     2     7     0  2.87    22   101
#> 2 San Fran… Tyler R…     1     3     2     2     0     0     0  4.86     6    19
#> 3 San Fran… Maurici…     2     3     2     2     0     3     0  5.4      9    38
#> 4 San Fran… Team To…     8    11     8     8     2    10     0  9       37   158
#> 5 Arizona … Madison…     5     5     3     3     3     4     0  3.74    24   100
#> 6 Arizona … Sean Po…     1     1     0     0     0     0     0  3.04     3    19
#> 7 Arizona … Joe Man…     2     1     0     0     0     4     0  1.13     7    32
#> 8 Arizona … Mark Me…     1     0     0     0     0     0     0  5.27     3    10
#> 9 Arizona … Team To…     9     7     3     3     3     8     0  3       37   161
#> # ℹ 16 more variables: Str <int>, Ctct <int>, StS <int>, StL <int>, GB <int>,
#> #   FB <int>, LD <int>, Unk <int>, GSc <int>, IR <int>, IS <int>, WPA <dbl>,
#> #   aLI <dbl>, cWPA <chr>, acLI <dbl>, RE24 <dbl>
© www.soinside.com 2019 - 2024. All rights reserved.