Как выполнить парсинг с помощью Map_dfr, не пропуская его, когда он ломается из-за того, что не находит элемент определенной страницы

К сожалению, данные на этом сайте организованы довольно непоследовательно. Похоже, ваша основная проблема заключается в том, что вы пытаетесь заполнить NA при возникновении ошибки, но rvest не всегда выдает ошибку, когда данные не найдены, а иногда вместо этого возвращает NULL. Если бы я попытался очистить сайт, я мог бы использовать что-то вроде приведенного ниже, где есть реальная (неанонимная) функция, которая определена и затем может быть применена к каждому URL-адресу.

Вам также действительно не нужен RSelenium для очистки этого сайта, поскольку данные загружаются вместе со страницей, вместо того, чтобы делать что-то необычное с Javascript за кулисами, поэтому я удалил это, чтобы изолировать саму проблему.

library(rvest)
library(dplyr)

getGameData <- function(url){
  page <- read_html(url)
  
  szn <- page |> 
    html_elements(xpath = "//*[@class='hoversmooth']/li[2]") |> 
    html_text2() |> 
    readr::parse_number()
  
  game_data <- page %>%
    html_elements(xpath = "//table[@class='linescore nohover stats_table no_freeze']") %>%
    html_table() %>%
    as.data.frame() %>%
    setNames(c("trash", "team", 'q1', "q2", "q3", "q4", "final")) %>%
    select(team:final)
  
  offense_elem <- html_element(page, xpath = "//*[@id='all_player_offense']")
  if (is(offense_elem, "xml_node")){
    offense_data <- html_table(offense_elem, header = FALSE) %>%
      filter(X3! = "Passing") %>%
      filter(X1! = "Player") %>%
      setNames(c("Player", "Tm", "Cmp", "Att", "Yds", "TD", "Int", "Sk", "Yds", 
                 "Lng", "Rate", "Att", "Yds", "TD", "Lng", "Rec", "Yds", "TD", 
                 "Lng")) %>%
      split(.$Tm)
  } else {
    offense_data <- list(NA, NA)
  }
  game_data$offense <- offense_data
  
  defense_elem <- html_element(page, xpath = "//*[@id='all_player_defense']")
  if (is(defense_elem, "xml_node")){
    defense_table <- html_table(defense_elem, header = FALSE)
    if (nrow(defense_table)>0){
      defense_data <- defense_table %>%
        filter(X3! = "Passing") %>%
        filter(X1! = "Player") %>%
        setNames(c("Player", "Tm", "Cmp", "Att", "Yds", "TD", "Int", "Sk", "Yds", 
                   "Lng", "Rate", "Att", "Yds", "TD", "Lng", "Rec", "Yds", "TD", 
                   "Lng")) %>%
        split(.$Tm)
    } else {
      defense_data <- list(NA, NA)
    }
  } else {
    defense_data <- list(NA, NA)
  }
  game_data$defense <- defense_data
  return(game_data)
}

games <- c("https://www.pro-football-reference.com/boxscores/197301140mia.htm",
           "https://www.pro-football-reference.com/boxscores/196010230was.htm")
all_game_data <- lapply(games, getGameData) %>%
  bind_rows()

С помощью полной функции мы можем определить лучшую логику обработки ошибок, когда узел не существует (class="xml_missing" вместо "xml_node"), а также когда узел существует, но возвращает пустую таблицу.

К сожалению, похоже, что на обеих страницах, которыми вы поделились, отсутствовал узел all_player_defense, поэтому мне пришлось немного догадаться об ожидаемом формате.

• purrr::possibly() отлично подходит для обработки ошибок в таких случаях, и его значение по умолчанию может быть более совместимым с желаемым выходным значением;
• мы можем извлекать HTML-комментарии с помощью XPath comment();
• map_dfr() был заменен в purrr 1.0;
• обычно left_join() было бы немного более надежным для объединения кадров, но, видимо, построить надежную справочную таблицу несколько сложнее; отредактировано для использования bind_cols() вместо этого.

Функции разбора:

library(dplyr, warn.conflicts = FALSE)
library(rvest, warn.conflicts = FALSE)
library(readr, warn.conflicts = FALSE)
library(janitor, warn.conflicts = FALSE)
library(stringr)
library(purrr)

# hide type_convert() spec message
options(readr.num_columns = 0)

# parse box score tables, return nested tibble, 
# list column name is set by `key`
#   tm                offense
#   <chr> <list<tibble[,18]>>
# 1 PIT              [7 × 18]
# 2 WAS              [8 × 18]  
parse_bxs <- function(table_elem, key = "data"){
  html_table(table_elem, header = FALSE) %>%
    # build column names from 2-row header, magrittr pipe to acess lhs in nested calls  
    set_names(str_c(abbreviate(.[1,], minlength = 3), .[2,], sep = "_")) |>
    clean_names() |>
    filter(!player %in% c("", "Player")) |>
    type_convert(guess_integer = TRUE) |>
    # group_by /nest_by will sort grouping varibles, which can break row alignment
    # when binding columns; but factor order is maintained, so lets turn tm to factor,
    # levels in order of apparence
    mutate(tm = factor(tm, levels=unique(tm))) |>
    nest_by(tm, .key = key)
}

# collect tables from `url_`, bind columns to a single frame
collect_tables <- function(url_){
  html <- read_html(url_)
  
  #>   tm                offense
  #>   <chr> <list<tibble[,18]>>
  #> 1 PIT              [7 × 18]
  #> 2 WAS              [8 × 18]  
  tbl_off <- html |>
    html_element(xpath = "//div[@id='all_player_offense']/div/table") |>
    parse_bxs("offense")
  
  # if not found:
  #> # A tibble: 0 × 2
  #> # ℹ 2 variables: tm <chr>, defence <list>
  tbl_def <- html |>
    html_element(xpath = "//div[@id='all_player_defense']/comment()") |>
    # extract table element from html comments
    html_text() |> minimal_html() |> html_element("table") |>
    possibly(parse_bxs, 
             # let's default to 2x2 NA tibble with correct column names
             otherwise = tibble(tm = c(NA, NA), defence = c(NA, NA))
    )("defence")
  
  #>   team                   q1    q2    q3    q4 final
  #>   <chr>               <int> <int> <int> <int> <int>
  #> 1 Pittsburgh Steelers     7     3     7    10    27
  #> 2 Washington Redskins     7     3     7    10    27
  tbl_lscore <- html |> 
    html_element(xpath = "//table[@class='linescore nohover stats_table no_freeze']") |> 
    html_table() |> 
    set_names(c("trash", "team", 'q1', "q2", "q3", "q4", "final")) |> 
    select(-1)
  
  # bind collected tables, keep tm_ columns for now so it would bepossible to verify that 
  # alignment is correct
  bind_cols(tbl_lscore, 
            rename(tbl_off, tm_off = tm), 
            rename(tbl_def, tm_def = tm)
  )
}

Основной цикл:

games <- c("https://www.pro-football-reference.com/boxscores/197301140mia.htm",
           "https://www.pro-football-reference.com/boxscores/196010230was.htm",
           "https://www.pro-football-reference.com/boxscores/198509150was.htm",
           "https://www.pro-football-reference.com/boxscores/202309100atl.htm")

# limit requests to 1/sec
slow_collect <- slowly(collect_tables, rate = rate_delay(1))
games %>% 
  set_names(basename(.)) |>
  map(slow_collect) |>
  list_rbind(names_to = "src")
#> # A tibble: 8 × 11
#>   src      team     q1    q2    q3    q4 final tm_off   offense tm_def   defence
#>   <chr>    <chr> <int> <int> <int> <int> <int> <fct>  <list<ti> <fct>  <list<ti>
#> 1 1973011… Miam…     7     7     0     0    14 MIA     [8 × 21] MIA    [11 × 16]
#> 2 1973011… Wash…     0     0     0     7     7 WAS     [7 × 21] WAS    [11 × 16]
#> 3 1960102… Pitt…     7     3     7    10    27 PIT     [7 × 21] <NA>            
#> 4 1960102… Wash…     7     3     7    10    27 WAS     [8 × 21] <NA>            
#> 5 1985091… Hous…     0    10     3     0    13 HOU     [9 × 21] HOU     [5 × 16]
#> 6 1985091… Wash…    13     3     0     0    16 WAS    [10 × 21] WAS     [3 × 16]
#> 7 2023091… Caro…     0     7     3     0    10 CAR     [9 × 21] CAR    [18 × 16]
#> 8 2023091… Atla…     0     7     3    14    24 ATL     [6 × 21] ATL    [21 × 16]

Первая версия с left_join() оказалась не такой надежной - https://stackoverflow.com/revisions/78424112/1