NBA-foul_bias/code/gen_allfouls.R

# Extract fouls along with contextual information.
# Save for later processing.
library(tidyverse)

# load in all data files and create a single variable
# with the filename as an ID column
datafiles <- list.files("data", pattern="*_pbp.csv", full.names = FALSE)

seasons <- purrr::map_df(datafiles,
                        ~read_csv(paste0("data/", .x)),
                        .id = "filename")

# construct a new dataframe which is a subset of the original
# also ensure that SCOREMARGIN is a number and create an integer gameID
season_subset <- seasons %>%
    dplyr::select(GAME_ID, EVENTNUM, HOMEDESCRIPTION, VISITORDESCRIPTION,
                  SCORE, SCOREMARGIN, PCTIMESTRING, PERIOD,
                  PLAYER1_TEAM_ABBREVIATION, PLAYER1_TEAM_CITY,
                  PLAYER1_TEAM_NICKNAME) %>%
    mutate(SCOREMARGIN = as.numeric(SCOREMARGIN)) %>%
    mutate(GAME_ID_INT = as.integer(GAME_ID))

# find the home team foul entries
homefouls <- grep("FOUL", x = season_subset$HOMEDESCRIPTION, value=FALSE)
# and the visitor fouls (not doing pre-NA checking is faster)
visitorfouls <- grep("FOUL", x = season_subset$VISITORDESCRIPTION, value=FALSE)

# combine foul indices and get unique entries and create for only fouls
allfouls <- season_subset[unique(c(homefouls, visitorfouls)),]

# now go back and search for the game score.

# find the closest previous event number with a score margin entry (can be the
# same event number) and return the score margin
find_score_margin <- function(gameid, eventnum, colname = "SCOREMARGIN"){
    score_margin <- filter(season_subset,
                           GAME_ID_INT == gameid,
                           EVENTNUM <= eventnum,
                           !is.na(SCOREMARGIN)) %>%
        arrange(EVENTNUM) %>%
        pull(colname)
    # if no score margin found, there is no score in the game
    # return 0 (though this actually returns NA)
    tail_scoremargin <- ifelse(!is.null(score_margin),
                               yes=tail(score_margin, 1),
                               no=0)
    return(tail_scoremargin)
}

# associate score margins with the fouls
scoremargins <- purrr::map2_dbl(.x = allfouls$GAME_ID_INT,
                                .y = allfouls$EVENTNUM,
                                ~find_score_margin(gameid= .x,
                                                   eventnum = .y,
                                                   colname="SCOREMARGIN"))
# associate scores with the fouls
scores <- purrr::map2_chr(.x = allfouls$GAME_ID_INT,
                          .y = allfouls$EVENTNUM,
                          ~find_score_margin(gameid = .x,
                                             eventnum = .y,
                                             colname ="SCORE"))

allfouls$SCOREMARGIN <- replace_na(scoremargins, 0)
allfouls$SCORE <- replace_na(scores, "0-0")

# corrected score margin is for consistently plotting the number of fouls
# when either the home or visiting team is ahead
allfouls <- mutate(allfouls,
                   SCOREMARGIN_CORR = case_when(is.na(HOMEDESCRIPTION) ~ SCOREMARGIN,
                                                is.na(VISITORDESCRIPTION) ~ -1*SCOREMARGIN))
# add a total score column to the fouls data frame
sum_score <- function(scorestr) {
    parts <- str_split(scorestr, '-', simplify=TRUE)
    totalscore <- as.integer(parts[1]) + as.integer(parts[2])
}

allfouls <- mutate(allfouls,
                   TOTALSCORE = purrr::map_int(.x = allfouls$SCORE,
                                               ~sum_score(scorestr = .x)))

# add a column specifying whether the foul was on home or visitor
allfouls <- mutate(allfouls,
                   FOULTEAM = case_when(!is.na(HOMEDESCRIPTION) ~ "HOME",
                                        !is.na(VISITORDESCRIPTION) ~ "VISITOR"))

# save the derived "all fouls" dataframe
write_csv(allfouls, 'data/foulsonly.csv')