Блог

Я пытаюсь выполнить веб-очистку из footballdb.com чтобы получить данные, связанные с травмами игроков НФЛ, для модели, которую я создаю, используя такие ссылки, как эта: https://www.footballdb.com/transactions/injuries.html?yr=2016amp;wk=1amp;type=reg который затем будет выведен в таблицу данных. Наряду с данными, относящимися к информации об отдельных игроках о травмах (т. Е. Их Имени, травме и статусе в течение недели, предшествующей игре), я также хочу включить сезон и неделю травмы, о которой идет речь, для каждого игрока. Я начал с использования вложенных циклов for для генерации URL-адреса для каждой рассматриваемой веб-страницы вместе с сезоном и неделей, соответствующими каждой веб-странице, которые были сохранены в таблице данных со столбцами: ссылка, сезон и неделя.

Затем я попытался использовать функции map_df(), read_html() и html_nodes() для извлечения нужной мне информации с каждой веб-страницы, но я столкнулся с ошибками, поскольку read_html() не работает для объектов класса data table или data frame. Затем я попытался использовать различные типы индексации и оператор $, но тоже безуспешно. Могу ли я в любом случае изменить код, который я создал до сих пор, чтобы извлечь нужную мне информацию из таблицы данных? Ниже приведено то, что я написал до сих пор:

 library(purrr) 
library(rvest)
library(data.table)

#Remove file if file already exists
if (file.exists("./project/volume/data/interim/injuryreports.csv")) {
  file.remove("./project/volume/data/interim/injuryreports.csv")}

#Declare variables and empty data tables
path1<-("https://www.footballdb.com/transactions/injuries.html?yr=")
seasons<-c("2016", "2017", "2020")
weeks<-1:17
result<-data.table()
temp<-NULL

#Use nested for loops to get the url, season, and week for each webpage of interest, store in result data table
for(s in 1:length(seasons)){
  for(w in 1:length(weeks)){
    temp$link<- paste0(path1, seasons[s],"amp;wk=", as.character(w), "amp;type=reg")
    temp$season<-as.numeric(seasons[s])
    temp$week<-weeks[w]
    result<-rbind(result,temp)
  }
}

#Get rid of any potential empty values from result
result<-compact(result) 

###Errors Below####
DT <- map_df(result, function(x){ 
  page <- read_html(x[[1]])
  data.table(
    Season = x[[2]],
    Week = x[[3]],
    Player = page %>% html_nodes('.divtable .td:nth-child(1) b') %>% html_text(),
    Injury = page %>% html_nodes('.divtable .td:nth-child(2)') %>% html_text(),
    Wed = page %>% html_nodes('.divtable .td:nth-child(3)') %>% html_text(),
    Thu = page %>% html_nodes('.divtable .td:nth-child(4)') %>% html_text(),
    Fri = page %>% html_nodes('.divtable .td:nth-child(5)') %>% html_text(),
    GameStatus = page %>% html_nodes('.divtable .td:nth-child(6)') %>% html_text()
  )
}
)
#####End of Errors###

#Write out injury data table
fwrite(DT,"./project/volume/data/interim/injuryreports.csv")

 

Проблема в том, что ваш фрейм входных данных result является объектом данных. При передаче этого map_df параметра он будет перебирать столбцы (!!) таблицы данных, а не строки.

Один из способов заставить ваш код работать split result link — это перебирать и перебирать результирующий список.

Примечание: Для reprex я перебираю только первые два элемента списка. Кроме того, я поместил вашу функцию за пределы оператора map, что упростило отладку.

 library(purrr) 
library(rvest)
library(data.table)

#Declare variables and empty data tables
path1<-("https://www.footballdb.com/transactions/injuries.html?yr=")
seasons<-c("2016", "2017", "2020")
weeks<-1:17
result<-data.table()
temp<-NULL

#Use nested for loops to get the url, season, and week for each webpage of interest, store in result data table
for(s in 1:length(seasons)){
  for(w in 1:length(weeks)){
    temp$link<- paste0(path1, seasons[s],"amp;wk=", as.character(w), "amp;type=reg")
    temp$season<-as.numeric(seasons[s])
    temp$week<-weeks[w]
    result<-rbind(result,temp)
  }
}

#Get rid of any potential empty values from result
result<-compact(result) 

result <- split(result, result$link)

get_table <- function(x) { 
  page <- read_html(x[[1]])
  data.table(
    Season = x[[2]],
    Week = x[[3]],
    Player = page %>% html_nodes('.divtable .td:nth-child(1) b') %>% html_text(),
    Injury = page %>% html_nodes('.divtable .td:nth-child(2)') %>% html_text(),
    Wed = page %>% html_nodes('.divtable .td:nth-child(3)') %>% html_text(),
    Thu = page %>% html_nodes('.divtable .td:nth-child(4)') %>% html_text(),
    Fri = page %>% html_nodes('.divtable .td:nth-child(5)') %>% html_text(),
    GameStatus = page %>% html_nodes('.divtable .td:nth-child(6)') %>% html_text()
  )
}
  
DT <- map_df(result[1:2], get_table)
DT
#>      Season Week          Player     Injury     Wed     Thu     Fri
#>   1:   2016    1   Justin Bethel       Foot Limited Limited Limited
#>   2:   2016    1     Lamar Louis       Knee     DNP Limited Limited
#>   3:   2016    1   Kareem Martin       Knee     DNP     DNP     DNP
#>   4:   2016    1     Alex Okafor     Biceps    Full    Full    Full
#>   5:   2016    1  Frostee Rucker       Neck Limited Limited    Full
#>  ---                                                               
#> 437:   2016   10   Will Blackmon      Thumb Limited Limited Limited
#> 438:   2016   10   Duke Ihenacho Concussion    Full    Full    Full
#> 439:   2016   10  DeSean Jackson   Shoulder     DNP     DNP     DNP
#> 440:   2016   10    Morgan Moses      Ankle Limited Limited Limited
#> 441:   2016   10 Brandon Scherff   Shoulder    Full    Full    Full
#>                       GameStatus
#>   1:  (09/09) Questionable vs NE
#>   2:  (09/09) Questionable vs NE
#>   3:           (09/09) Out vs NE
#>   4:                          --
#>   5:                          --
#>  ---                            
#> 437: (11/11) Questionable vs Min
#> 438: (11/11) Questionable vs Min
#> 439:     (11/11) Doubtful vs Min
#> 440: (11/11) Questionable vs Min
#> 441:                          --