process.Rmd

---
title: "NHL Stanley Cup Playoff Predictions"
author: "Ilari Scheinin"
output: html_document
---

Previous: [1. Scrape raw data](scrape.html)  
Next: [3. Train models](model.html)

2. Process data
---------------

In order to train models on the outcomes of past playoffs, I am calculating
summary statistics on each teams performance in the regular season. This script
reads the data files produced by
[nhlscrapr](https://github.com/acthomasca/nhlscrapr) and generates these
summaries for every team and for every season. It also generates separate
statistics for away and home games, as well as an overall metric.

First, load the [dplyr](https://github.com/hadley/dplyr)
[package](http://cran.r-project.org/web/packages/dplyr/) for data manipulation:

```{r, echo=FALSE}
options(width=120)
```

```{r}
suppressMessages({
  library(dplyr)
})
```

Next, define a function to calculate the summary statistics for each season. First for each game, calculate for both the away and home teams:

* the proportion of goals scored (*e.g.* for away team:
  `away goals / (away goals + home goals)`)
* the proportion of shots
* the proportion of faceoffs won
* the proportion of penalties
* power play (*e.g.* `power play goals for away team / penalties for home team`)
* penalty kill (*e.g.*
  `power play goals for home team / penalties for away team`)

Then, calculate the average for the entire regular season. Separate averages
are calculated for each team when they are playing away, when they are playing
at home, and also the overall for both.

```{r}
process_season <- function(theseason) {
  message("Processing season ", substring(theseason, 1, 4), "-",
    substring(theseason, 5, 8), "...", appendLF=FALSE)
  load(file.path("source-data", paste0("nhlscrapr-", theseason, ".RData")))
  grand.data <- tbl_df(grand.data)
  grand.data$season <- as.character(grand.data$season)

  gamestats <- grand.data %>%
    filter(ev.team %in% unique(grand.data$hometeam)) %>%
    filter(substring(gcode, 1, 1) == "2") %>%
    mutate(season==season) %>%
    group_by(season, gcode) %>%
    summarise(
      awayteam=first(awayteam),
      hometeam=first(hometeam),
      totalgoals=sum(etype == "GOAL"),
      awaygoals=sum(ev.team == awayteam & etype == "GOAL"),
      homegoals=sum(ev.team == hometeam & etype == "GOAL"),
      totalshots=sum(etype %in% c("SHOT", "GOAL")),
      awayshots=sum(ev.team == awayteam & etype %in% c("SHOT", "GOAL")),
      homeshots=sum(ev.team == hometeam & etype %in% c("SHOT", "GOAL")),
      totalfaceoffs=sum(etype == "FAC"),
      awayfaceoffs=sum(ev.team == awayteam & etype == "FAC"),
      homefaceoffs=sum(ev.team == hometeam & etype == "FAC"),
      totalpenalties=sum(etype == "PENL"),
      awaypenalties=sum(ev.team == awayteam & etype == "PENL"),
      homepenalties=sum(ev.team == hometeam & etype == "PENL"),
      awaypp=sum(ev.team == awayteam & etype == "GOAL" &
        away.skaters > home.skaters),
      homepp=sum(ev.team == hometeam & etype == "GOAL" &
        away.skaters < home.skaters),
      awaysh=sum(ev.team == awayteam & etype == "GOAL" &
        away.skaters < home.skaters),
      homesh=sum(ev.team == hometeam & etype == "GOAL" &
        away.skaters > home.skaters))

  awaygames <- gamestats %>%
    ungroup() %>%
    transmute(
      season=season,
      team=awayteam,
      goals=awaygoals / totalgoals,
      shots=awayshots / totalshots,
      faceoffs=awayfaceoffs / totalfaceoffs,
      penalties=ifelse(totalpenalties==0, NA, awaypenalties / totalpenalties),
      pp=ifelse(homepenalties==0, NA, awaypp / homepenalties),
      pk=ifelse(awaypenalties==0, NA, homepp / awaypenalties))

  homegames <- gamestats %>%
    ungroup() %>%
    transmute(
      season=season,
      team=hometeam,
      goals=homegoals / totalgoals,
      shots=homeshots / totalshots,
      faceoffs=homefaceoffs / totalfaceoffs,
      penalties=ifelse(totalpenalties==0, NA, homepenalties / totalpenalties),
      pp=ifelse(awaypenalties==0, NA, homepp / awaypenalties),
      pk=ifelse(homepenalties==0, NA, awaypp / homepenalties))

  awaystats <- awaygames %>%
    group_by(season, team) %>%
    summarise_each(funs(mean(., na.rm=TRUE)))

  homestats <- homegames %>%
    group_by(season, team) %>%
    summarise_each(funs(mean(., na.rm=TRUE)))

  overallstats <- bind_rows(awaystats, homestats) %>%
    group_by(season, team) %>%
    summarise_each(funs(mean(., na.rm=TRUE)))

  message()
  list(away=awaystats, home=homestats, overall=overallstats)
}

```

Finally, load all available seasons and run the function defined above on each one, combine results together, and save the processed data.

```{r}
load(file.path("source-data", "nhlscrapr-core.RData"))
seasons <- unique(games$season)
rm(list=c("games", "roster.master", "roster.unique"))

seasonstats <- lapply(seasons, process_season)
gamestats <- list(
  away=bind_rows(lapply(seasonstats, "[[", "away")),
  home=bind_rows(lapply(seasonstats, "[[", "home")),
  overall=bind_rows(lapply(seasonstats, "[[", "overall")))
rm(list=c("seasons", "seasonstats"))
  
saveRDS(gamestats, "processed.rds")
```

This is what the generated summary statistics look like:

```{r, eval=FALSE}
head(gamestats[["away"]])
```

```{r, echo=FALSE, results='asis'}
knitr::kable(head(gamestats[["away"]]), digits=3)
```

```{r, eval=FALSE}
head(gamestats[["home"]])
```

```{r, echo=FALSE, results='asis'}
knitr::kable(head(gamestats[["home"]]), digits=3)
```

```{r, eval=FALSE}
head(gamestats[["overall"]])
```

```{r, echo=FALSE, results='asis'}
knitr::kable(head(gamestats[["overall"]]), digits=3)
```

Next: [3. Train models](model.html)  
Previous: [1. Scrape raw data](scrape.html)