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 in result)
# 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"),
rush = +str_detect(Play, "rush"),
punt = +str_detect(Play, "punt"),
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 = str_extract(Play, "(.*)(?=\\spass)"),
rusher = str_extract(Play, "(.*)(?=\\srush)"),
punter = str_extract(Play, "(.*)(?=\\spunt)"),
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 ~ NA_real_),
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
Giving:
# A tibble: 170 × 20
Quarter drive_start posteam defteam yardline_100 down ydstogo play_type pass rush
<chr> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> <dbl> <dbl>
1 1st 15:00 ASM KTZ 81 1st 10 other 0 0
2 1st 15:00 ASM KTZ 81 1st 10 rush 0 1
3 1st 15:00 ASM KTZ 83 2nd 12 rush 0 1
4 1st 15:00 ASM KTZ 74 3rd 3 pass 1 0
5 1st 15:00 ASM KTZ 74 4th 3 punt 0 0
6 1st 13:30 KTZ ASM 72 1st 10 other 0 0
7 1st 13:30 KTZ ASM 72 1st 10 rush 0 1
8 1st 13:30 KTZ ASM 70 2nd 8 rush 0 1
9 1st 13:30 KTZ ASM 66 3rd 4 rush 0 1
10 1st 13:30 KTZ ASM 61 1st 10 rush 0 1
# … with 160 more rows, and 10 more variables: special <dbl>, passer <chr>, rusher <chr>,
# yrdsgained <dbl>, tackle <chr>, complete_pass <chr>, pass_breakup <chr>, punt <dbl>,
# punter <chr>, Play <chr>
