season.Rmd

---
title: "Season"
params:
  db: "stats.sdb"
  year: 2023
  season: 21
  out: NULL
---

```{r, setup, include=F}
library(tidyverse)
library(visNetwork)
source("stats.R")
knitr::opts_chunk$set(echo = F, fig.width = 10)
```

## Stats: `r unname(iso_season[as.character(as.integer(params$season))])` `r params$year`

```{r query}
conn <- DBI::dbConnect(RSQLite::SQLite(), params$db)

sql <- ("
  SELECT * FROM roster as x JOIN team as y ON x.team = y.id AND x.team IN (
    SELECT team1 FROM match WHERE year = ? AND season = ? UNION ALL 
    SELECT team2 FROM match WHERE year = ? AND season = ?
  );
"
)
res <- DBI::dbSendQuery(conn, sql, param = list(params$year, params$season, params$year, params$season))
df.roster <- DBI::dbFetch(res)
DBI::dbClearResult(res)

df.color <- distinct(df.roster, team, color)

res <- (
  DBI::dbSendQuery(
    conn, "SELECT * FROM point as x JOIN match as y ON x.match = y.id WHERE year = ? AND season = ?;",
    param = list(params$year, params$season)
  )
)
df.point <- DBI::dbFetch(res)
df.match <- (
  select(df.point, -id, -time) %>%
    distinct(week, game, team1, team2)
)
df.point <- select(df.point, week, game, 3:13)
DBI::dbClearResult(res)

res <- (
  DBI::dbSendQuery(
    conn, "SELECT * FROM penalty as x JOIN match as y ON x.match = y.id WHERE year = ? AND season = ?;",
    param = list(params$year, params$season)
  )
)
df.penalty <- (
  DBI::dbFetch(res) %>%
    select(week, game, 3:11)
)
DBI::dbClearResult(res)

res <- (
  DBI::dbSendQuery(
    conn, "SELECT * FROM shot as x JOIN match as y ON x.match = y.id WHERE year = ? AND season = ?;",
    param = list(params$year, params$season)
  )
)
df.shot <- (
  DBI::dbFetch(res) %>%
    select(week, game, 3:11)
)
DBI::dbClearResult(res)

DBI::dbDisconnect(conn)
```

### Results

```{r}
df.score <- (
  count(df.point, week, game, team) %>%
    arrange(week, game)
)
df.score <- (
  bind_cols(
    left_join(df.match, df.score, by = c(week = "week", game = "game", team1 = "team")) %>% select(-team2) %>% rename(G1 = n),
    left_join(df.match, df.score, by = c(week = "week", game = "game", team2 = "team")) %>% select(-team1, -week, -game) %>% rename(G2 = n),
  ) %>%
    left_join(df.color, c(team1 = "team")) %>%
    left_join(df.color, c(team2 = "team"), suffix = c("1", "2")) %>%
    replace(is.na(.), 0) %>%
    arrange(desc(week), desc(game)) %>%
    select(week, game, team1, color1, G1, G2, color2, team2)
)
datatableize(df.score)
```

### Standing

```{r}
df.standing <- (
  mutate(
    df.score,
    r1 = if_else(G1 == G2, "T", ifelse(G1 < G2, "L", "W")),
    r2 = if_else(G1 == G2, "T", ifelse(G2 < G1, "L", "W"))
  )
)
bind_rows(
  rename(count(df.standing, team1, r1), team = team1, r = r1),
  rename(count(df.standing, team2, r2), team = team2, r = r2)
) %>%
  group_by(team, r) %>%
  summarise(n = sum(n), .groups = "drop") %>%
  pivot_wider(names_from = r, values_from = n) %>%
  bind_rows(data.frame(team = character(), W = integer(), `T` = integer(), L = integer(), stringsAsFactors = F)) %>%
  replace(is.na(.), 0) %>%
  left_join(df.color, by = "team") %>%
  select(team, color, W, `T`, L) %>%
  arrange(desc(W), desc(`T`), L) %>%
  datatableize()
```

### Career (Season)

```{r, career}
overall.2(df.point, df.penalty) %>%
  mutate(A1 = EVA1 + PPA1 + SHA1, A2 = EVA2 + PPA2 + SHA2) %>%
  left_join(select(df.roster, team, player, color), by = "player") %>%
  select(player, team, color, P, G, A, A1, A2, PEN, PIM) %>%
  arrange(desc(P)) %>%
  datatableize()
```

### Goalie

```{r}
df.sh <- (
  mutate(df.shot, team = if_else(team == team1, team2, team1)) %>%
    group_by(week, game, goalie, team) %>%
    summarise("SH" = sum(SH), .groups = "drop")
)
df.ga <- (
  filter(df.point, EN == 0 & !is.na(goalie)) %>%
    count(week, game, goalie, name = "GA")
)
left_join(df.sh, df.ga, by = c("week", "game", "goalie")) %>%
  mutate(
    GA = replace_na(GA, 0),
    `SV%` = sprintf("%0.2f%%", (SH - GA) / SH * 100)
  ) %>%
  arrange(desc(week), desc(game)) %>%
  datatableize()
```

### Assist

```{r assist_network}
df.edges <- (
  bind_rows(
    mutate(
      rename(select(df.point, assist1, shooter), from = assist1, to = shooter),
      type = "A1",
      from = if_else(is.na(from), to, from),
      type = if_else(from == to, "A0", type)
    ),
    drop_na(mutate(rename(select(df.point, assist2, assist1), from = assist2, to = assist1), type = "A2"), from)
  ) %>%
    rownames_to_column("label") %>%
    mutate(
      type = if_else(is.na(from) & type == "A1", "A0", type),
      dashes = type == "A2",
      width = 2
    )
)
df.nodes <- (
  data.frame(id = unique(sort(c(pull(df.edges, from), pull(df.edges, to))))) %>%
    mutate(label = id) %>%
    left_join(df.roster, by = c(id = "player"), suffix = c("", ".team"))
)

visNetwork(df.nodes, df.edges, background = "lightgrey") %>%
  visEdges(arrows = list(to = list(enabled = T)))
```

```{r, assist_table}
datatableize(arrange(df.point, desc(week), desc(game)))
```

### Penalty

```{r, penalty}
datatableize(arrange(df.penalty, desc(week), desc(game)))
```

### Roster

```{r roster}
select(df.roster, -id) %>%
  datatableize()
```