在R中爬取Basketball Reference单节数据并整合至DataFrame的问题

需要从Basketball Reference爬取赛季内每日各队比赛的单节（Q1、Q2、Q3、Q4）技术统计表格，完成以下操作：

• 合并所有目标表格
• 添加单节标识列（标记Q1/Q2/Q3/Q4）
• 添加比赛标识列（格式如CHI-2024-02-22）
• 添加主客场球队列

现有基础爬取代码无法筛选出Q1-Q4的表格，也无法添加上述所需列，需要修改代码解决问题。

library(rvest)
library(tidyverse)

##sample only - ultimately this will include all teams and all months and days

month <- c('02')
year <- c('2024')
day <- c('220','270','280')   
team <- c('CHI')

make_url <- function(team, year, month, day) {
  paste0(
    'https://www.basketball-reference.com/boxscores/', year, month, day, team, '.html'
  )
}

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, gsub('.{1}$', '', day), sep = '-'),
    .keep = 'unused'
  )


scrape_table <- function(url) {
  page_html <- url %>%
    rvest::read_html()  
  
  page_html %>%
    rvest::html_nodes("table") %>%
    rvest::html_table(header = FALSE)
  
}


safe_scrape_table <- purrr::safely(scrape_table)

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


final_result <- tbl_scrape |> 
  purrr::transpose() |> 
  pluck('result')

核心修改点 #

1. 筛选Q1-Q4表格：通过表格的id属性定位单节数据表格（Basketball Reference的单节表格id格式为q1/q2/q3/q4）
2. 提取表格元信息：从表格属性或表头获取单节标识、主客场信息
3. 添加所需列：在处理每个表格时注入比赛标识、单节标识、主客场列
4. 合并所有表格：将所有处理后的表格整合成一个统一数据框

修改后的完整代码 #

library(rvest)
library(tidyverse)
library(janitor)

## 样本参数（可扩展为全量球队/日期）
month <- c('02')
year <- c('2024')
day <- c('220','270','280')   
team <- c('CHI')

make_url <- function(team, year, month, day) {
  paste0(
    'https://www.basketball-reference.com/boxscores/', year, month, day, team, '.html'
  )
}

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

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

# 重构爬取函数：只提取Q1-Q4表格并添加元数据
scrape_quarter_tables <- function(url, game_id) {
  page_html <- url %>% read_html()
  
  # 获取所有单节表格（id为q1/q2/q3/q4）
  quarter_tables <- page_html %>% 
    html_nodes("table[id^='q']") %>% 
    keep(~html_attr(., "id") %in% c("q1", "q2", "q3", "q4"))
  
  # 遍历每个单节表格处理
  map_df(quarter_tables, function(tbl) {
    # 提取单节标识（从表格id转换为大写）
    quarter_id <- html_attr(tbl, "id") %>% str_to_upper()
    
    # 提取表格数据并清洗表头
    tbl_data <- tbl %>% 
      html_table(header = TRUE) %>% 
      clean_names() %>% 
      # 过滤掉总计行（部分表格存在）
      filter(!grepl("Total", team))
    
    # 提取主客场信息：从表格表头获取Home/Away标记
    team_type <- tbl %>% 
      html_nodes("thead tr th") %>% 
      html_text() %>% 
      str_extract("Home|Away") %>% 
      na.omit()
    
    # 添加所需列
    tbl_data %>% 
      mutate(
        game_id = game_id,
        quarter = quarter_id,
        team_type = team_type,
        .before = 1
      )
  })
}

# 安全爬取包装，捕获错误
safe_scrape_quarter <- safely(scrape_quarter_tables)

# 批量爬取并合并数据
final_data <- pmap_dfr(list(urls$url, urls$game_id), function(url, game_id) {
  Sys.sleep(5) # 控制请求频率，避免被网站限制
  scrape_result <- safe_scrape_quarter(url, game_id)
  
  # 输出错误提示，不中断整体爬取
  if (!is.null(scrape_result$error)) {
    message(glue::glue("爬取失败 {game_id}: {scrape_result$error$message}"))
    return(tibble())
  }
  
  scrape_result$result
})

# 查看最终数据结构
glimpse(final_data)

代码说明 #

• 表格筛选：用html_nodes("table[id^='q']")定位所有以q开头的表格，再精准筛选id为q1-q4的目标表格，排除其他无关表格
• 元数据提取：
  • 单节标识：直接从表格id转换为大写的Q1/Q2格式
  • 主客场：从表格表头提取Home/Away标记，区分主客队
  • 比赛标识：预先生成格式为球队-日期的标识，直接传入表格
• 数据清洗：用clean_names()标准化列名，过滤总计行避免数据重复
• 错误处理：保留safely包装捕获爬取异常，输出错误提示同时保证批量爬取的连续性

内容的提问来源于stack exchange，提问作者Michael