时间戳

首页 > 解决方案 > 使用 lapply 和 tryCatch 只返回一条记录，而不是多条

r - 使用 lapply 和 tryCatch 只返回一条记录，而不是多条

问题描述

我还是 R 新手，我正在尝试使用 lapply 和 tryCatch 通过 pro-football-reference 站点访问数据，但我在下面使用的代码仅返回 1 个表。

我想获取所有存在的记录。某些 URL 将不存在，这就是我使用 tryCatch 跳过这些的原因。这是我的尝试：

library(rvest)
library(stringr)

#create a master dataframe to store all of the results
complete <- data.frame()

datesVector <- c("201909080", "201909050")
teamsVector <- c("chi", "crd", "car")

  for (i in 1:length(datesVector)) {
  for (j in 1:length(teamsVector)) {
    
    # create a url template 
    URL.base <- "http://www.pro-football-reference.com/boxscores/"
    URL.end <- ".htm"
    
    #create the dataframe with the dynamic values
    URL <- paste0(URL.base, datesVector[i], teamsVector[j], URL.end)
    
    tryCatch({
      
       dfList <- lapply(URL, function(i) {
        webpage <- read_html(i)
        draft_table <- html_nodes(webpage, 'table')
        draft <- html_table(draft_table)[[3]]
                   
      })
    }, error = function(e) print(URL)
    )               
    
    complete <- do.call(rbind, dfList) 
            
  }
}

我将有一个非常长的向量，其中包含许多日期和多个团队，并且想要尝试每种组合，如果页面存在，则提取表中的数据并将其添加到我的数据框中。

但是下面的代码只返回 22 个观察值，来自这个链接：

https://www.pro-football-reference.com/boxscores/201909050chi.htm

事实上，存在另一个页面（因此应该返回数据），即另外 22 个观察点：

https://www.pro-football-reference.com/boxscores/201909080car.htm

上面包含了另一个团队，以尝试测试错误并跳过它。

我在上面做错了什么？

标签： rweb-scrapingrvest

解决方案

这是您的任务的解决方案，它使用purrr和其他一些tidyverse方法。请参阅下面的说明。

library(tidyverse)

combos <- expand.grid(team = teamsVector, date = datesVector)
urls <- paste0(URL.base, combos$date, combos$team, URL.end)

output <- urls %>% 
  map(possibly(read_html, otherwise = NA_character_)) %>%
  discard(is.character) %>%
  map(function(html) html_nodes(html, 'table') %>% html_table) %>%
  pluck(3) %>%
  map_dfr(function(data) {
    col_lvl1 <- colnames(data)
    col_lvl2 <- data[1, ] %>% unname
    actual_data <- data[2:nrow(data), ] %>% unname
    col_multi_lvl <- paste(col_lvl1, col_lvl2, sep = "_")
    colnames(actual_data) <- col_multi_lvl
    return(actual_data %>% as_tibble(.name_repair = make.names))
  }) %>% 
  filter(str_detect(Passing_Cmp, "Passing|Cmp", negate = TRUE)) %>%
  mutate_at(vars(-starts_with("X_")), as.numeric)

输出：

output %>% head(15)
# A tibble: 15 x 22
   X_Player X_Tm  Passing_Cmp Passing_Att Passing_Yds...5 Passing_TD Passing_Int Passing_Sk Passing_Yds...9
   <chr>    <chr>       <dbl>       <dbl>           <dbl>      <dbl>       <dbl>      <dbl>           <dbl>
 1 Matthew… DET            27          45             385          3           0          3              24
 2 Kerryon… DET             0           0               0          0           0          0               0
 3 C.J. An… DET             0           0               0          0           0          0               0
 4 Ty John… DET             0           0               0          0           0          0               0
 5 Marvin … DET             0           0               0          0           0          0               0
 6 T.J. Ho… DET             0           0               0          0           0          0               0
 7 Danny A… DET             0           0               0          0           0          0               0
 8 Kenny G… DET             0           0               0          0           0          0               0
 9 J.D. Mc… DET             0           0               0          0           0          0               0
10 Jesse J… DET             0           0               0          0           0          0               0
11 Nick Ba… DET             0           0               0          0           0          0               0
12 Kyler M… ARI            29          54             308          2           1          5              33
13 David J… ARI             0           0               0          0           0          0               0
14 Christi… ARI             0           0               0          0           0          0               0
15 Chase E… ARI             0           0               0          0           0          0               0
# … with 13 more variables: Passing_Lng <dbl>, Passing_Rate <dbl>, Rushing_Att <dbl>, Rushing_Yds <dbl>,
#   Rushing_TD <dbl>, Rushing_Lng <dbl>, Receiving_Tgt <dbl>, Receiving_Rec <dbl>, Receiving_Yds <dbl>,
#   Receiving_TD <dbl>, Receiving_Lng <dbl>, Fumbles_Fmb <dbl>, Fumbles_FL <dbl>

我知道这并不能完全回答你的问题，“我做错了什么？” - 我开始解决您方法中的问题，并且遇到了足够多的障碍，因此我觉得提出一个可行的解决方案并清楚地注释它可能会更容易。希望这将使您更容易了解所涉及的各种挑战，并让您对最初的尝试有所了解。

首先，要处理死 URL 的问题，我建议使用safely()or possibly()。它们是不错的tryCatch风格包装器，可为您提供如何发现错误的选项，而且它们具有直观的语法。因此，您可以从构建您感兴趣的所有 URL 的列表开始：

combos <- expand.grid(team=teamsVector, date=datesVector)
urls <- paste0(URL.base, combos$date, combos$team, URL.end)

urls
[1] "http://www.pro-football-reference.com/boxscores/201909080chi.htm"
[2] "http://www.pro-football-reference.com/boxscores/201909080crd.htm"
[3] "http://www.pro-football-reference.com/boxscores/201909080car.htm"
[4] "http://www.pro-football-reference.com/boxscores/201909050chi.htm"
[5] "http://www.pro-football-reference.com/boxscores/201909050crd.htm"
[6] "http://www.pro-football-reference.com/boxscores/201909050car.htm"

然后将其输入possibly-wrapped read_html()，使用map()：

urls %>% 
  map(possibly(read_html, otherwise = NA_character_)) # throw NA if bad URL

错误的 URL 会产生一个NAtype 的值character，所以我们可以discard()返回字符条目（其他的都是一些 HTML 对象）：

discard(is.character) %>%

这给我们留下了一个有效抓取网页的列表，我们可以map()再次使用该列表来迭代该列表并提取表格数据。该pluck()函数是一个很好的子集到列表中的方法，以获得[[3]]您想要的表索引：

map(function(html) html_nodes(html, 'table') %>% html_table) %>%
  pluck(3) %>%

这些表的一个棘手之处在于它们具有多索引列 - 顶部列包含“通过”或“接收”等类别，而子列指定统计信息（“TD”、“Int”等）。将 R 放入数据框中并不容易，因为它需要一组列名，而不是两个。这需要一些黑客攻击。我选择提取列和子列名称并将它们与下划线结合起来（例如“Passing_TD”）：

# note: map_dfr just specifies a data frame output, joined row-wise
map_dfr(function(data) {
    col_lvl1 <- colnames(data)
    col_lvl2 <- data[1, ] %>% unname
    actual_data <- data[2:nrow(data), ] %>% unname
    col_multi_lvl <- paste(col_lvl1, col_lvl2, sep = "_")
    colnames(actual_data) <- col_multi_lvl
    return(actual_data %>% as_tibble(.name_repair = make.names))
  }) %>%

最后还有一个额外的问题，即表在每个表的中途重复列名。我不确定您想如何处理它，因为看起来每个子表中的信息可能非常不同。因为我只是想演示方法，所以我选择将这些行排除在外，就好像所有行都属于一个大表一样。之后，我将数字列恢复为数字数据类型（所有数字列都被重新定义为字符数据类型，因为它们的行中包含列名，它们是字符串）。

  filter(str_detect(Passing_Cmp, "Passing|Cmp", negate = TRUE)) %>%
  mutate_at(vars(-starts_with("X_")), as.numeric)

推荐阅读