Using RVest to Create HTML Table And Then Using Manipulating and Cleaning into DF-CodePudding

The

As you can see, I am taking the information from each individual play and translating the information to specific columns. Was it a rush play? Was it a pass play? How many yards were gained? Down, distance, yardline_100, etc.

And then doing that process for the entire play-by-play of the game.

Any suggestions and/or pointers on how to start the process would be appreciated. Scraping is certainly not my core strength when it comes to R.

CodePudding user response：

Here's a way to achieve your result using functions from the tidyverse. There are a lot of different ways to get the same results, this is just one way. The code is structured in two main parts: first, removing the useless rows that were in the original dataframe, and second create all the variables.

The tab dataframe is also slightly different from your page original input, see the code in the data and functions part. I basically changed the column names so that they are not the same and rename them col1 and col2.

Only a few different functions are actually used. I created extract_digit, which extracts the nth occurrence of a number from a string. str_extract and str_match extract the specified pattern from a string, while str_detects only detects (and returns a logical, TRUE or FALSE). word gets the nth word from a string.

library(tidyverse) tab %>% # Keep only rows that starts with a number filter(str_detect(col1, '^[0-9]')) %>% # Create some variables mutate(quarter = 1, drive_start = str_extract(col2, '[0-9][0-9]:[0-9][0-9]')[1]) %>% # Remove duplicated rows in the first column, keeping the ones with the longest string group_by(col1) %>% slice_max(nchar(col2)) %>% ungroup() %>% # Mutating part, creation of new variables mutate(posteam = ifelse(str_detect(col1, "ASM"), "ASM", "KTZ"), defteam = ifelse(str_detect(col1, "ASM"), "KTZ", "ASM"), yardline_100 = 100 - extract_digit(col1, 3), down = extract_digit(col1, 1), ydstogo = extract_digit(col1, 2), play_type = word(col2, 2), rush = (play_type == "rush"), pass = (play_type == "pass"), special = (!play_type %in% c("rush", "pass")), passer = ifelse(pass == 1, word(col2, 1), NA), rusher = ifelse(rush == 1, word(col2, 1), NA), ydsgained = -c(diff(ydstogo), 0), tackle = str_match(col2, "(?<=\$). ?(?=\$)")[,1], #Get word between parentheses complete_pass = case_when(str_detect(col2, "incomplete") & pass == 1 ~ 0, pass == 1 ~ 1, TRUE ~ NA_real_), pass_breakup = word(col2, 2, sep = "broken up by "), punt = (play_type == "punt"), punter = ifelse(punt == 1, word(col2, 1), NA)) %>% select(-col1, -col2)

output

# A tibble: 4 x 19 quarter drive_start posteam defteam yardline_100 down ydstogo play_type rush pass special passer rusher ydsgained tackle complete_pass pass_breakup punt punter <dbl> <chr> <chr> <chr> <dbl> <dbl> <dbl> <chr> <int> <int> <int> <chr> <chr> <dbl> <chr> <dbl> <chr> <int> <chr> 1 1 15:00 ASM KTZ 81 1 10 rush 1 0 0 NA Turner,Easton -2 Justice,Amani NA NA 0 NA 2 1 15:00 ASM KTZ 83 2 12 rush 1 0 0 NA Exum-Strong,Khaleed 9 Justice,Amani NA NA 0 NA 3 1 15:00 ASM KTZ 74 3 3 pass 0 1 0 Turner,Easton NA 0 NA 0 Meyers,Ryan. 0 NA 4 1 15:00 ASM KTZ 74 4 3 punt 0 0 1 NA NA 0 NA NA NA 1 Bertolazzo,Gabriel

data and functions

tab <- page %>% html_table() %>% pluck(27) %>% tibble(.name_repair = "universal") %>% rename_with(~ str_c("col", 1:2)) # col1 col2 # 1 Down & Distance Play # 2 Assumption at 15:00 Assumption at 15:00 # 3 1st and 10 at ASM19 Assumption drive start at 15:00. # 4 1st and 10 at ASM19 Turner,Easton rush for 2 yards loss to the ASM17 (Justice,Amani). # 5 2nd and 12 at ASM17 Exum-Strong,Khaleed rush for 9 yards gain to the ASM26 (Justice,Amani). # 6 3rd and 3 at ASM26 Turner,Easton pass incomplete to Collier,Bailey broken up by Meyers,Ryan. # 7 4th and 3 at ASM26 Bertolazzo,Gabriel punt 46 yards to the KTZ28. extract_digit <- function(x, n) as.numeric(sapply(str_extract_all(x, "[0-9] "), `[`, n)) # This function is a wrapper to get the nth occurrence of a number in a string.

CodePudding user response：

I've had a go by creating an extract_plays function, which basically parses through the Play column using with a series of stringr::str_detect(), stringr::str_extract() and if_else() functions.

The tricky thing is that there is some inconsistency in the tables at the start of each quarter which requires some special attention, otherwise the code should be quite self-explanatory.

I'm not an American Football follower, so please check some of the assumptions I've made.

library(tidyverse) library(rvest) url <- "https://kubears.com/sports/football/stats/2021/assumption/boxscore/11837" page <- rvest::read_html(url) # set index for teams teams <- tibble(team = c("Assumption", "Kutztown"), posteam = c("ASM", "KTZ"), defteam = c("KTZ","ASM")) # grab the play pages from table plays <- page %>% html_table() %>% .[27:47] %>% # use colnames to extract teams later map(~rbind(colnames(.x),.x)) ## note that 7th and 17th elements of plays are the 2nd and 4th quarter starts - different format ## 11th element is 2nd half start, incompatible table (not included) # create plays extraction function extract_plays <- function(df){ df <- df %>% set_names(c("Downs","Play")) %>% mutate(team = str_extract(first(Downs), "^\\S "), drive_start = str_extract(first(Downs),"\\S $")) %>% filter(str_detect(Downs, "and")) %>% inner_join(teams) %>% extract(Downs, into = c("down","ydstogo","yardline_100"), regex = "(^\\d..) and (\\d ) at (.*)") %>% mutate(yardline_100 = ifelse(str_detect(yardline_100,defteam), parse_number(yardline_100), 100 - parse_number(yardline_100))) %>% mutate(pass = str_detect(Play, "pass")*1, rush = str_detect(Play, "rush")*1, punt = str_detect(Play, "punt")*1, special = ifelse(pass rush == 0,1,0)) %>% mutate(play_type = case_when(str_detect(Play, "pass") ~ "pass", str_detect(Play, "rush") ~ "rush", str_detect(Play, "punt") ~ "punt", str_detect(Play, "field goal") ~ "fieldgoal", str_detect(Play, "kickoff") ~ "kickoff", TRUE ~ "other")) %>% mutate(passer = ifelse(play_type == "pass", str_extract(Play, "(.*)(?=\\spass)"), NA), rusher = ifelse(play_type == "rush", str_extract(Play, "(.*)(?=\\srush)"), NA), punter = ifelse(play_type == "punt", str_extract(Play, "(.*)(?=\\spunt)"), NA), tackle = NA, tackle = ifelse(play_type == "pass", str_extract(Play, "(?<=\$). ?(?=\$)"), tackle), tackle = ifelse(play_type == "rush", str_extract(Play, "(?<=\$). ?(?=\$)"), tackle), yrds = ifelse(play_type == "rush", str_extract(Play, "(\\d \\syards\\s\\w{4})"),NA), yrds = ifelse(play_type == "pass", str_extract(Play, "for\\s\\d \\syards"),yrds), yrdsgained = ifelse(str_detect(yrds,"loss"),-1*parse_number(yrds),parse_number(yrds)), complete_pass = case_when(str_detect(Play, "completed") ~ "1", str_detect(Play, "incomplete") ~ "0", TRUE ~ ""), pass_breakup = str_extract(Play,"((?<=broken\\sup\\sby\\s).*$)") ) %>% select(drive_start,posteam,defteam,yardline_100,down,ydstogo,play_type,pass,rush,special,passer,rusher,yrdsgained,tackle,complete_pass,pass_breakup,punt,punter,Play) return(df) } ## Grab for each quarter Q1 <- plays %>% .[1:6] %>% map_df(extract_plays) %>% mutate(Quarter = "1st", .before = drive_start) Q2 <- plays %>% .[8:10] %>% map_df(extract_plays) %>% mutate(Quarter = "2nd", .before = drive_start) Q3 <- plays %>% .[12:16] %>% map_df(extract_plays) %>% mutate(Quarter = "3rd", .before = drive_start) Q4 <- plays %>% .[18:21] %>% map_df(extract_plays) %>% mutate(Quarter = "4th", .before = drive_start) ## Grab the special cases for 2nd and 4th quarter starts Q2.1 <- plays %>% .[[7]] %>% rbind(c("Kutztown at 15:00","Play"),.) %>% extract_plays() %>% mutate(Quarter = "2nd", .before = drive_start) Q4.1 <- plays %>% .[[17]] %>% rbind(c("Kutztown at 15:00","Play"),.) %>% extract_plays()%>% mutate(Quarter = "4th", .before = drive_start) ## Add to Q2 and Q4 Q2 <- bind_rows(Q2.1,Q2) Q4 <- bind_rows(Q4.1,Q4) #final table result <- bind_rows(list(Q1,Q2,Q3,Q4)) result