trends.Rmd

---
title: "NCAA Tournament Historical Outcomes"
author: "Matt O'Neil"
date: "2/22/2022"
output: slidy_presentation
runtime: shiny
---

```{r setup, include=FALSE}
#historically, what have teams that fit each criteria done? i.e. how far does a team that fits the championship profile typically go? are they basically locks to make the S16? E8?
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 
library(tidyverse)
library(hoopR)
library(janitor)
library(rvest)
library(stringi)
library(DataExplorer)
library(tidytable)
library(furrr)
library(ggplot2)
library(glue)
library(collapse)
library(dplyr)
library(ggrepel)
library(gtExtras)
library(gt)
library(gghighlight)
library(RCurl)
library(readr)
library(gridExtra)
library(shiny)
```

```{r constraints, include=FALSE}
ch_od <- 20
final_od <- 40
f4_od <- 65
e8_od <- 85
s16_od <- 100
s16_one <- 35
s16_elite <- 10
```

## The Idea

You've probably heard the statistic that every national champion in the Kenpom era has had a top-20 AdjO and AdjD, other than 2014 UConn. That can be informative when you're filling out the rest of your bracket, but I wanted a better sense of broader trends.

For example:


* What does the typical Final 4 team look like?
  * What percentage of Final 4 teams fit the mold of the Kenpom champion?
  * For those that don't, what trends stick out?
* You probably know to pick a couple 12 and 13 seeds to win a game and maybe even get to the Sweet 16, but how do you determine which ones?
  * Are there certain metrics, such as an elite offense or an elite defense, that makes them more likely to go far?
  * Does it require a star, like Oral Roberts' Max Abmas?
  * Are upsets more matchup dependent, such as Texas, a team that turned it over frequently, against Abilene Christian, a team that forces turnovers in droves?
* What is a sign of a high sided team likely to be upset early?
  * Like Texas, does it show up in the matchup?
  * Is it a team that isn't as respected by Kenpom's metrics as it is by polls and record?
  * Is it a team with an elite offense and a bad defense that has a really bad shooting day?




```{r history_function, eval=FALSE, include=FALSE}
kp_team_history <- function(team){
  
  tryCatch(
    expr = {
      if (!has_kp_user_and_pw()) stop("This function requires a KenPom subscription e-mail and password combination,\n      set as the system environment variables KP_USER and KP_PW.", "\n       See ?kp_user_pw for details.", call. = FALSE)
      
      browser <- login()
      
      # Check teams parameter in teams list names
      if(!(team %in% hoopR::teams_links$Team)){
        cli::cli_abort( "Incorrect team name as compared to the website, see hoopR::teams_links for team name parameter specifications.")
      }
      teams_links <- hoopR::teams_links[hoopR::teams_links$Year == as.integer(format(Sys.Date(), "%Y")),]
      team_name = teams_links$team.link.ref[teams_links$Team == team]
      
      ### Pull Data
      url <- paste0("https://kenpom.com/history.php?",
                    "t=",team_name)
      
      page <- rvest::session_jump_to(browser, url)
      
      header_cols<- c('Year','Team.Rk','Coach',	'Conf','WL',	'AdjT', 'AdjO',	'AdjD',
                      'Off.eFG.Pct',	'Off.TO.Pct',	'Off.OR.Pct','Off.FTRate',
                      'Off.FG_2.Pct',	'Off.FG_3.Pct',	'Off.FT.Pct',	'Off.FG_3A.Pct',
                      'Off.A.Pct',	'Off.APL',
                      'Def.eFG.Pct', 'Def.TO.Pct',	'Def.OR.Pct',	'Def.FTRate',
                      'Def.FG_2.Pct',	'Def.FG_3.Pct',
                      'Def.Blk.Pct',	'Def.FG_3A.Pct',	'Def.A.Pct',
                      'Def.APL',	'Foul2Partic.Pct')
      
      x<- (page %>%
             xml2::read_html() %>%
             rvest::html_elements(css='#player-table'))[[1]]
      
      ## removing national rankings for easier manipulation
      ## TODO: Add these rankings back as columns
      conf <- (page %>%
                 xml2::read_html() %>%
                 rvest::html_elements(css='#player-table'))[[1]]
      
      conf_record <- (page %>%
                        xml2::read_html() %>%
                        rvest::html_elements("td:nth-child(5) > span"))
      conf_record <- bind_rows.(lapply(rvest::html_text(conf_record),
                                       function(x){
                                         data.frame(x, stringsAsFactors=FALSE)
                                       }))
      conf_record <- conf_record %>% dplyr::rename(WL.Conf = x)
      tmrank <- conf %>% rvest::html_elements(".tmrank")
      
      # xml2::xml_remove(tmrank)
      
      conf <- conf %>% rvest::html_table()
      
      colnames(conf) <- header_cols
      
      x <- x %>% rvest::html_table()
      
      colnames(x) <- header_cols
      
      
      suppressWarnings(
        conf <- conf %>% filter.(!is.na(as.numeric(AdjT))) %>%
          as.data.frame()
      )
      x <- x %>% select.(-WL) %>%
        as.data.frame()
      x <- x %>%
        filter(!is.na(Year)) %>%
        mutate.(
          AdjT.Rk = as.numeric(stri_sub(AdjT, -nchar(sub('.*\\.', '', AdjT))+1)),
          AdjO.Rk = as.numeric(stri_sub(AdjO, -nchar(sub('.*\\.', '', AdjO))+1)),
          AdjD.Rk = as.numeric(stri_sub(AdjD, -nchar(sub('.*\\.', '', AdjD))+1)),
          Off.eFG.Pct.Rk = as.numeric(stri_sub(Off.eFG.Pct, -nchar(sub('.*\\.', '', Off.eFG.Pct))+1)),
          Off.TO.Pct.Rk = as.numeric(stri_sub(Off.TO.Pct, -nchar(sub('.*\\.', '', Off.TO.Pct))+1)),
          Off.OR.Pct.Rk = as.numeric(stri_sub(Off.OR.Pct, -nchar(sub('.*\\.', '', Off.OR.Pct))+1)),
          Off.FTRate.Rk = as.numeric(stri_sub(Off.FTRate, -nchar(sub('.*\\.', '', Off.FTRate))+1)),
          Off.FG_2.Pct.Rk = as.numeric(stri_sub(Off.FG_2.Pct, -nchar(sub('.*\\.', '', Off.FG_2.Pct))+1)),
          Off.FG_3.Pct.Rk = as.numeric(stri_sub(Off.FG_3.Pct, -nchar(sub('.*\\.', '', Off.FG_3.Pct))+1)),
          Off.FT.Pct.Rk = as.numeric(stri_sub(Off.FT.Pct, -nchar(sub('.*\\.', '', Off.FT.Pct))+1)),
          Off.FG_3A.Pct.Rk = as.numeric(stri_sub(Off.FG_3A.Pct, -nchar(sub('.*\\.', '', Off.FG_3A.Pct))+1)),
          Off.A.Pct.Rk = as.numeric(stri_sub(Off.A.Pct, -nchar(sub('.*\\.', '', Off.A.Pct))+1)),
          Off.APL.Rk =  as.numeric(stri_sub(Off.APL, -nchar(sub('.*\\.', '', Off.APL))+1)),
          Def.eFG.Pct.Rk = as.numeric(stri_sub(Def.eFG.Pct, -nchar(sub('.*\\.', '', Def.eFG.Pct))+1)),
          Def.TO.Pct.Rk = as.numeric(stri_sub(Def.TO.Pct, -nchar(sub('.*\\.', '', Def.TO.Pct))+1)),
          Def.OR.Pct.Rk = as.numeric(stri_sub(Def.OR.Pct, -nchar(sub('.*\\.', '', Def.OR.Pct))+1)),
          Def.FTRate.Rk = as.numeric(stri_sub(Def.FTRate, -nchar(sub('.*\\.', '', Def.FTRate))+1)),
          Def.FG_2.Pct.Rk = as.numeric(stri_sub(Def.FG_2.Pct, -nchar(sub('.*\\.', '', Def.FG_2.Pct))+1)),
          Def.FG_3.Pct.Rk = as.numeric(stri_sub(Def.FG_3.Pct, -nchar(sub('.*\\.', '', Def.FG_3.Pct))+1)),
          Def.Blk.Pct.Rk = as.numeric(stri_sub(Def.Blk.Pct, -nchar(sub('.*\\.', '', Def.Blk.Pct))+1)),
          Def.FG_3A.Pct.Rk = as.numeric(stri_sub(Def.FG_3A.Pct, -nchar(sub('.*\\.', '', Def.FG_3A.Pct))+1)),
          Def.A.Pct.Rk = as.numeric(stri_sub(Def.A.Pct, -nchar(sub('.*\\.', '', Def.A.Pct))+1)),
          Def.APL.Rk = as.numeric(stri_sub(Def.APL, -nchar(sub('.*\\.', '', Def.APL))+1)),
          Foul2Partic.Pct.Rk = as.numeric(stri_sub(Foul2Partic.Pct, -nchar(sub('.*\\.', '', Foul2Partic.Pct))+1)),
          
          AdjT = substr(sprintf("%.*f",2, as.numeric(AdjT)), 1,
                        nchar(sprintf("%.*f",2, as.numeric(AdjT))) - 1),
          
          AdjO = substr(sprintf("%.*f",2, as.numeric(AdjO)), 1,
                        nchar(sprintf("%.*f",2, as.numeric(AdjO))) - 1),
          AdjD = substr(sprintf("%.*f",2, as.numeric(AdjD)), 1,
                        nchar(sprintf("%.*f",2, as.numeric(AdjD))) - 1),
          Off.eFG.Pct = substr(sprintf("%.*f",2, as.numeric(Off.eFG.Pct)), 1,
                               nchar(sprintf("%.*f",2, as.numeric(Off.eFG.Pct))) - 1),
          Off.TO.Pct = substr(sprintf("%.*f",2, as.numeric(Off.TO.Pct)), 1,
                              nchar(sprintf("%.*f",2, as.numeric(Off.TO.Pct))) - 1),
          Off.OR.Pct = substr(sprintf("%.*f",2, as.numeric(Off.OR.Pct)), 1,
                              nchar(sprintf("%.*f",2, as.numeric(Off.OR.Pct))) - 1),
          
          Off.FTRate = substr(sprintf("%.*f",2, as.numeric(Off.FTRate)), 1,
                              nchar(sprintf("%.*f",2, as.numeric(Off.FTRate))) - 1),
          Off.FG_2.Pct = substr(sprintf("%.*f",2, as.numeric(Off.FG_2.Pct)), 1,
                                nchar(sprintf("%.*f",2, as.numeric(Off.FG_2.Pct))) - 1),
          Off.FG_3.Pct = substr(sprintf("%.*f",2, as.numeric(Off.FG_3.Pct)), 1,
                                nchar(sprintf("%.*f",2, as.numeric(Off.FG_3.Pct))) - 1),
          Off.FT.Pct = substr(sprintf("%.*f",2, as.numeric(Off.FT.Pct)), 1,
                              nchar(sprintf("%.*f",2, as.numeric(Off.FT.Pct))) - 1),
          Off.FG_3A.Pct = substr(sprintf("%.*f",2, as.numeric(Off.FG_3A.Pct)), 1,
                                 nchar(sprintf("%.*f",2, as.numeric(Off.FG_3A.Pct))) - 1),
          Off.A.Pct = substr(sprintf("%.*f",2, as.numeric(Off.A.Pct)), 1,
                             nchar(sprintf("%.*f",2, as.numeric(Off.A.Pct))) - 1),
          Off.APL = substr(sprintf("%.*f",2, as.numeric(Off.APL)), 1,
                           nchar(sprintf("%.*f",2, as.numeric(Off.APL))) - 1),
          
          Def.eFG.Pct = substr(sprintf("%.*f",2, as.numeric(Def.eFG.Pct)), 1,
                               nchar(sprintf("%.*f",2, as.numeric(Def.eFG.Pct))) - 1),
          Def.TO.Pct = substr(sprintf("%.*f",2, as.numeric(Def.TO.Pct)), 1,
                              nchar(sprintf("%.*f",2, as.numeric(Def.TO.Pct))) - 1),
          Def.OR.Pct = substr(sprintf("%.*f",2, as.numeric(Def.OR.Pct)), 1,
                              nchar(sprintf("%.*f",2, as.numeric(Def.OR.Pct))) - 1),
          Def.FTRate = substr(sprintf("%.*f",2, as.numeric(Def.FTRate)), 1,
                              nchar(sprintf("%.*f",2, as.numeric(Def.FTRate))) - 1),
          Def.FG_2.Pct = substr(sprintf("%.*f",2, as.numeric(Def.FG_2.Pct)), 1,
                                nchar(sprintf("%.*f",2, as.numeric(Def.FG_2.Pct))) - 1),
          Def.FG_3.Pct = substr(sprintf("%.*f",2, as.numeric(Def.FG_3.Pct)), 1,
                                nchar(sprintf("%.*f",2, as.numeric(Def.FG_3.Pct))) - 1),
          Def.Blk.Pct = substr(sprintf("%.*f",2, as.numeric(Def.Blk.Pct)), 1,
                               nchar(sprintf("%.*f",2, as.numeric(Def.Blk.Pct))) - 1),
          
          Def.FG_3A.Pct = substr(sprintf("%.*f",2, as.numeric(Def.FG_3A.Pct)), 1,
                                 nchar(sprintf("%.*f",2, as.numeric(Def.FG_3A.Pct))) - 1),
          Def.A.Pct = substr(sprintf("%.*f",2, as.numeric(Def.A.Pct)), 1,
                             nchar(sprintf("%.*f",2, as.numeric(Def.A.Pct))) - 1),
          Def.APL = substr(sprintf("%.*f",2, as.numeric(Def.APL)), 1,
                           nchar(sprintf("%.*f",2, as.numeric(Def.APL))) - 1),
          Foul2Partic.Pct = substr(sprintf("%.*f",2, as.numeric(Foul2Partic.Pct)), 1,
                                   nchar(sprintf("%.*f",2, as.numeric(Foul2Partic.Pct))) - 1),
          
          Team.Finish = stringr::str_extract(Coach, stringr::regex("R1|R2|S16|E8|F4|2nd|CH",ignore_case = FALSE)),
          Coach = stringr::str_replace(Coach, stringr::regex("R1|R2|S16|E8|F4|2nd|CH",ignore_case = FALSE),""),
          NCAA_Seed = NA_integer_) %>%
        as.data.frame()
      x <- mutate(x,
                  "NCAA_Seed" = sapply(Coach, function(arg) { as.numeric(gsub("[^0-9]", "", arg)) }),
                  "Coach" = sapply(Coach, function(arg) {
                    stringr::str_trim(stringr::str_replace(stringr::str_remove(arg,'\\d+| \\*| \\*+'),'\\*+','')) }))
      
      suppressWarnings(
        x <- x %>%
          dplyr::filter(!is.na(as.numeric(AdjT))) %>%
          dplyr::mutate_at(c('Year','Team.Rk','AdjT', 'AdjO',	'AdjD',
                             'Off.eFG.Pct',	'Off.TO.Pct',	'Off.OR.Pct','Off.FTRate',
                             'Off.FG_2.Pct',	'Off.FG_3.Pct',	'Off.FT.Pct',	'Off.FG_3A.Pct',
                             'Off.A.Pct',	'Off.APL',
                             'Def.eFG.Pct', 'Def.TO.Pct',	'Def.OR.Pct',	'Def.FTRate',
                             'Def.FG_2.Pct',	'Def.FG_3.Pct',
                             'Def.Blk.Pct',	'Def.FG_3A.Pct',	'Def.A.Pct',
                             'Def.APL',	'Foul2Partic.Pct',
                             'Off.eFG.Pct.Rk',	'Off.TO.Pct.Rk',	'Off.OR.Pct.Rk','Off.FTRate.Rk',
                             'Off.FG_2.Pct.Rk',	'Off.FG_3.Pct.Rk',	'Off.FT.Pct.Rk',	'Off.FG_3A.Pct.Rk',
                             'Off.A.Pct.Rk',	'Off.APL.Rk',
                             'Def.eFG.Pct.Rk', 'Def.TO.Pct.Rk',	'Def.OR.Pct.Rk',	'Def.FTRate.Rk',
                             'Def.FG_2.Pct.Rk',	'Def.FG_3.Pct.Rk',
                             'Def.Blk.Pct.Rk',	'Def.FG_3A.Pct.Rk',	'Def.A.Pct.Rk',
                             'Def.APL.Rk',	'Foul2Partic.Pct.Rk'
          ), as.numeric)
      )
      
      
      x <- x %>%
        dplyr::mutate(Team = team_name) %>%
        dplyr::select(.data$Year, .data$Team.Rk,.data$Team,tidyr::everything())
      ### Store Data
      kenpom <- x %>%
        janitor::clean_names()
      
    }
  )
  return(kenpom)
}

teams <- teams_links %>%
  filter(Year == 2022 & Team != 'St. Thomas') %>%
  distinct(Team) %>%
  as.data.frame()


team_list <- map_dfr(teams[1:nrow(teams),], kp_team_history)

all_hist <- do.call(bind_rows, team_list) %>%
  filter(year >= 2002) %>%
  select(-c(coach,conf,off_apl,off_apl_rk,def_apl,def_apl_rk, foul2partic_pct, foul2partic_pct_rk))

all_hist$team_finish <- factor(all_hist$team_finish,levels = c('R1','R2','S16','E8','F4','2nd','CH'))

tourney_teams <- all_hist %>%
  filter(!is.na(team_finish)) %>%
  as.data.frame()
```


```{r finish_levels, include=FALSE}

tourney_teams <- read.csv("https://raw.githubusercontent.com/matt12oneil/ncaa_tournament/master/tourney_teams.csv", sep = ';')

tourney_teams$team_finish <- factor(tourney_teams$team_finish,levels = c('R1','R2','S16','E8','F4','2nd','CH'))

tourney_teams$team <- gsub('+',' ', tourney_teams$team, fixed = T)

s16_teams <- tourney_teams %>%
  filter(!(team_finish %in% c('R1','R2'))) %>%
  dplyr::select(year, team, team_rk, ends_with('rk'), team_finish, ncaa_seed) 


e8_teams <- tourney_teams %>%
  filter(!(team_finish %in% c('R1','R2','S16'))) %>%
  dplyr::select(year, team, team_rk, ends_with('rk'), team_finish, ncaa_seed)


f4_teams <- tourney_teams %>%
  filter(!(team_finish %in% c('R1','R2','S16','E8'))) %>%
  dplyr::select(year, team, team_rk, ends_with('rk'), team_finish, ncaa_seed)


final_teams <- tourney_teams %>%
  filter(!(team_finish %in% c('R1','R2','S16','E8','F4'))) %>%
  dplyr::select(year, team, team_rk, ends_with('rk'), team_finish, ncaa_seed)


champions <- tourney_teams %>%
  filter(team_finish == 'CH') %>%
  dplyr::select(year, team, team_rk, ends_with('rk'), team_finish, ncaa_seed)


ff <- kp_fourfactors(min_year = 2022, max_year = 2022) %>%
  clean_names() %>%
  filter(!is.na(ncaa_seed)) %>%
  arrange(team)

ranks <- kp_pomeroy_ratings(min_year = 2022, max_year = 2022) %>%
  clean_names() %>%
  filter(!is.na(ncaa_seed)) %>%
  arrange(desc(adj_em)) %>%
  mutate(kp_rank = min_rank(desc(adj_em))) 

all <- ff %>%
  inner_join(ranks, by = c('team','ncaa_seed','conf','adj_t','adj_t_rk','adj_o','adj_o_rk','adj_d_rk','adj_d','year')) %>%
  mutate(kp_seed = case_when(
    kp_rank >= 1 & kp_rank <= 4 ~ 1,
    kp_rank >= 5 & kp_rank <= 8 ~ 2,
    kp_rank >= 9 & kp_rank <= 12 ~ 3,
    kp_rank >= 13 & kp_rank <= 16 ~ 4,
    kp_rank >= 17 & kp_rank <= 20 ~ 5,
    kp_rank >= 21 & kp_rank <= 24 ~ 6,
    kp_rank >= 25 & kp_rank <= 28 ~ 7,
    kp_rank >= 29 & kp_rank <= 32 ~ 8,
    kp_rank >= 33 & kp_rank <= 36 ~ 9,
    kp_rank >= 37 & kp_rank <= 40 ~ 10,
    kp_rank >= 41 & kp_rank <= 45 ~ 11,
    kp_rank >= 46 & kp_rank <= 50 ~ 12,
    kp_rank >= 51 & kp_rank <= 54 ~ 13,
    kp_rank >= 55 & kp_rank <= 58 ~ 14,
    kp_rank >= 59 & kp_rank <= 62 ~ 15,
    kp_rank >= 63 & kp_rank <= 68 ~ 16,
    TRUE ~ kp_rank))
```

## Champions
* Only two teams fell out of the top-20 in either AdjO or AdjD
  * An historical outlier in UConn (2014) and last year Baylor, but they just missed with the 22nd ranked Defense on a team ravaged by Covid for a period
* Every other champion falls in the top 20 of both

```{r champions_gg, echo=FALSE}
champs <- ggplot(champions, aes(x = adj_o_rk, y = adj_d_rk)) + 
  geom_point() + 
    labs(title = 'Champions by AdjO & AdjD Rank', subtitle = glue('Offense > {ch_od} | Defense > {ch_od} is highlighted')) + 
  gghighlight(adj_o_rk > ch_od | adj_d_rk > ch_od)

plot(champs)
```

```{r champions_gt, echo=FALSE}
#this is a criteria every champion fits into
ch_history <- champions %>%
  filter((adj_o_rk > ch_od | adj_d_rk > ch_od)) %>%
  select(team, year, seed = ncaa_seed, Tempo = adj_t_rk, O = adj_o_rk, D = adj_d_rk, O_EFG = off_e_fg_pct_rk, O_TO = off_to_pct_rk, O_OR = off_or_pct_rk, O_FTR = off_ft_rate_rk, D_EFG = def_e_fg_pct_rk, D_TO = def_to_pct_rk, D_OR = def_or_pct_rk, D_FTR = def_ft_rate_rk) 

ch_history %>%
  gt()
```

## Championship Takeaways

* That leaves us with the following teams that have a chance of winning a title right now
* It's early right now so there's time for others to join
* It remains to be seen how much progress could be made, but this is not a final list right now

<br>
```{r possible_champs, echo=FALSE}
ch_possible <- all %>%
  #filter((adj_o_rk <= 20 & adj_d_rk <= 20) & (adj_o_rk <= 50 & adj_d_rk <= 50)) %>%
  filter(adj_o_rk <= ch_od & adj_d_rk <= ch_od) %>%
  select(team,seed = ncaa_seed, Rank = rk, Tempo = adj_t_rk, O = adj_o_rk, D = adj_d_rk, O_EFG = off_e_fg_pct_rk, O_TO = off_to_pct_rk, O_OR = off_or_pct_rk, O_FTR = off_ft_rate_rk, D_EFG = def_e_fg_pct_rk, D_TO = def_to_pct_rk, D_OR = def_or_pct_rk, D_FTR = def_ft_rate_rk) %>%
  arrange(seed) 

ch_possible %>%
  gt() %>%
  tab_header(title = 'Possible Champions for 2022', subtitle = glue('Offense & Defense <= {ch_od}'))
```

## Historical Championship Criteria
```{r historical_ch_criteria, echo=FALSE}
ch_criteria <- tourney_teams %>%
  filter((adj_o_rk < ch_od & adj_d_rk < ch_od)) %>%
  select(team, year, team_finish, seed = ncaa_seed, Tempo = adj_t_rk, O = adj_o_rk, D = adj_d_rk, O_EFG = off_e_fg_pct_rk, O_TO = off_to_pct_rk, O_OR = off_or_pct_rk, O_FTR = off_ft_rate_rk, D_EFG = def_e_fg_pct_rk, D_TO = def_to_pct_rk, D_OR = def_or_pct_rk, D_FTR = def_ft_rate_rk) 

ggplot(ch_criteria, aes(x=team_finish)) + geom_bar(stat = 'count')
```

## Final History

* Of teams that made the final, only four had Offensive + Defensive rank > 40
  * Butler (Gordon Hayward) made a deep run on the backs of of their stars
  * Kentucky was an underseeded young team that just took some time to get going
  * That 2014 UConn team (that beat Kentucky) was an historic outlier, both as a champion and a finalist


```{r final_gg, echo=FALSE}
final <- ggplot(final_teams, aes(x = adj_o_rk, y = adj_d_rk)) + geom_point() + gghighlight(adj_o_rk + adj_d_rk > final_od) + labs(title = 'Final Teams by AdjO & AdjD Rank', subtitle = glue('Offense + Defense > {final_od}'))
plot(final)
```



``` {r final_gt, echo=FALSE}
final_history <- final_teams %>%
  filter(adj_o_rk + adj_d_rk > final_od) %>%
  select(team, year, seed = ncaa_seed, Tempo = adj_t_rk, O = adj_o_rk, D = adj_d_rk, O_EFG = off_e_fg_pct_rk, O_TO = off_to_pct_rk, O_OR = off_or_pct_rk, O_FTR = off_ft_rate_rk, D_EFG = def_e_fg_pct_rk, D_TO = def_to_pct_rk, D_OR = def_or_pct_rk, D_FTR = def_ft_rate_rk) 

final_history %>%
  gt() %>%
  tab_header(title = 'Championship Game History', subtitle = glue('Offense + Defense > {final_od}'))
```

## Final Takeaways
```{r final_possibles, echo=FALSE}
final_possibles <- all %>%
  filter(adj_o_rk + adj_d_rk <= final_od) %>%
  select(team,seed = ncaa_seed, Rank = rk, Tempo = adj_t_rk, O = adj_o_rk, D = adj_d_rk, O_EFG = off_e_fg_pct_rk, O_TO = off_to_pct_rk, O_OR = off_or_pct_rk, O_FTR = off_ft_rate_rk, D_EFG = def_e_fg_pct_rk, D_TO = def_to_pct_rk, D_OR = def_or_pct_rk, D_FTR = def_ft_rate_rk) %>%
  arrange(seed) 

final_possibles %>%
  gt() %>%
  tab_header(title = '2022 Possible Teams to make the National Championship', subtitle = glue('Offense + Defense <= {final_od}'))
```

## Historical Final Criteria
```{r historical_final_criteria, echo=FALSE}
final_criteria <- tourney_teams %>%
  filter((adj_o_rk + adj_d_rk <= final_od)) %>%
  select(team, year, team_finish, seed = ncaa_seed, Tempo = adj_t_rk, O = adj_o_rk, D = adj_d_rk, O_EFG = off_e_fg_pct_rk, O_TO = off_to_pct_rk, O_OR = off_or_pct_rk, O_FTR = off_ft_rate_rk, D_EFG = def_e_fg_pct_rk, D_TO = def_to_pct_rk, D_OR = def_or_pct_rk, D_FTR = def_ft_rate_rk) 

ggplot(final_criteria, aes(x=team_finish)) + geom_bar(stat = 'count')
```

## Final 4 History

* Only 8 Final Four teams had Offensive Rank + Defensive Rank > 65
* Additionally, only one of the teams was a 3 seed or better, proving that most of the teams that are outliers are way outside the expected seeding line to make a Final 4
<br>
```{r final4_gg, echo=FALSE}
f4 <- ggplot(f4_teams, aes(x = adj_o_rk, y = adj_d_rk)) + 
  geom_point() + 
  #gghighlight((adj_o_rk > f4_od & adj_d_rk > f4_od)) + 
  gghighlight(adj_o_rk + adj_d_rk > f4_od) +
  #labs(title = 'Final 4 Teams by AdjO & AdjD Rank', subtitle = glue('Offense & Defense > {f4_od}'))
  labs(title = 'Final 4 Teams by AdjO & AdjD Rank', subtitle = glue('Offense + Defense > {f4_od}'))
plot(f4)
```

```{r final4_gt, echo =FALSE}
f4_history <- f4_teams %>%
  #filter((adj_o_rk > f4_od & adj_d_rk > f4_od)) %>%
  filter(adj_o_rk + adj_d_rk >= f4_od) %>%
  select(team, year, seed = ncaa_seed, Tempo = adj_t_rk, O = adj_o_rk, D = adj_d_rk, O_EFG = off_e_fg_pct_rk, O_TO = off_to_pct_rk, O_OR = off_or_pct_rk, O_FTR = off_ft_rate_rk, D_EFG = def_e_fg_pct_rk, D_TO = def_to_pct_rk, D_OR = def_or_pct_rk, D_FTR = def_ft_rate_rk) 

f4_history %>%
  gt() %>%
  tab_header(title = 'Final 4 History',subtitle = glue('Offense + Defense > {f4_od}'))
```


## Final 4 Takeaways
```{r final4_possibles, echo=FALSE}
f4_possibles <- all %>%
  #filter((adj_o_rk <= f4_od | adj_d_rk <= f4_od)) %>%
  filter(adj_o_rk + adj_d_rk <= f4_od) %>%
  select(team,seed = ncaa_seed, Rank = rk, Tempo = adj_t_rk, O = adj_o_rk, D = adj_d_rk, O_EFG = off_e_fg_pct_rk, O_TO = off_to_pct_rk, O_OR = off_or_pct_rk, O_FTR = off_ft_rate_rk, D_EFG = def_e_fg_pct_rk, D_TO = def_to_pct_rk, D_OR = def_or_pct_rk, D_FTR = def_ft_rate_rk) %>%
  arrange(seed) 

f4_possibles %>%
  gt() %>%
  tab_header(title = '2022 Teams with a Chance to Make the Final 4',subtitle = glue('Offense + Defense <= {f4_od}'))
```

## Historical Final 4 Criteria
```{r historical_f4_criteria, echo=FALSE}
f4_criteria <- tourney_teams %>%
  filter((adj_o_rk + adj_d_rk <= f4_od)) %>%
  select(team, year, team_finish, seed = ncaa_seed, Tempo = adj_t_rk, O = adj_o_rk, D = adj_d_rk, O_EFG = off_e_fg_pct_rk, O_TO = off_to_pct_rk, O_OR = off_or_pct_rk, O_FTR = off_ft_rate_rk, D_EFG = def_e_fg_pct_rk, D_TO = def_to_pct_rk, D_OR = def_or_pct_rk, D_FTR = def_ft_rate_rk) 

ggplot(f4_criteria, aes(x=team_finish)) + geom_bar(stat = 'count')
```

## Elite 8 History
```{r elite8_gg, echo=FALSE}
e8 <- ggplot(e8_teams, aes(x = adj_o_rk, y = adj_d_rk)) + geom_point() + 
  #gghighlight((adj_o_rk + adj_d_rk > 80) | (adj_o_rk > 20 & adj_d_rk > 20)) + 
  gghighlight(adj_o_rk + adj_d_rk > e8_od) +
  #labs(title = 'Elite 8 Teams by AdjO & AdjD Rank', subtitle = 'Offense + Defense > 80 & Both Outisde top-20')
  labs(title = 'Elite 8 Teams by AdjO & AdjD Rank', subtitle = glue('Offense + Defense > {e8_od}'))
plot(e8)
```

```{r elite8_gt, echo=FALSE}
e8_history <- e8_teams %>%
  #filter((adj_o_rk + adj_d_rk > 80) | (adj_o_rk > 25 & adj_d_rk > 25)) %>%
  filter(adj_o_rk + adj_d_rk > e8_od) %>%
  select(team, year, seed = ncaa_seed, Tempo = adj_t_rk, O = adj_o_rk, D = adj_d_rk, O_EFG = off_e_fg_pct_rk, O_TO = off_to_pct_rk, O_OR = off_or_pct_rk, O_FTR = off_ft_rate_rk, D_EFG = def_e_fg_pct_rk, D_TO = def_to_pct_rk, D_OR = def_or_pct_rk, D_FTR = def_ft_rate_rk) 

e8_history %>%
  gt() %>%
  #tab_header(title = 'Elite 8 History',subtitle = 'Offense + Defense > 80 or Both Outisde top-25')
  tab_header(title = 'Elite 8 History',subtitle = glue('Offense + Defense > {e8_od}'))
```


## Elite 8 Takeaways

```{r elite8_possibles, echo=FALSE}
e8_possibles <- all %>%
  #filter((adj_o_rk + adj_d_rk <= 80) & (adj_o_rk <= 25 | adj_d_rk <= 25)) %>%
  filter(adj_o_rk + adj_d_rk <= e8_od) %>%
  select(team,seed = ncaa_seed, Rank = rk, Tempo = adj_t_rk, O = adj_o_rk, D = adj_d_rk, O_EFG = off_e_fg_pct_rk, O_TO = off_to_pct_rk, O_OR = off_or_pct_rk, O_FTR = off_ft_rate_rk, D_EFG = def_e_fg_pct_rk, D_TO = def_to_pct_rk, D_OR = def_or_pct_rk, D_FTR = def_ft_rate_rk) %>% 
  arrange(seed) 

e8_possibles %>%
  gt() %>%
  #tab_header(title = '2022 Teams with a Chance to Make the Elite 8',subtitle = 'Offense + Defense <= 80 & One in top-25')
  tab_header(title = '2022 Teams with a Chance to Make the Elite 8',subtitle = glue('Offense + Defense <= {e8_od}'))
```

## Historical Elite 8 Criteria
```{r historical_e8_criteria, echo=FALSE}
e8_criteria <- tourney_teams %>%
  filter((adj_o_rk + adj_d_rk <= f4_od)) %>%
  select(team, year, team_finish, seed = ncaa_seed, Tempo = adj_t_rk, O = adj_o_rk, D = adj_d_rk, O_EFG = off_e_fg_pct_rk, O_TO = off_to_pct_rk, O_OR = off_or_pct_rk, O_FTR = off_ft_rate_rk, D_EFG = def_e_fg_pct_rk, D_TO = def_to_pct_rk, D_OR = def_or_pct_rk, D_FTR = def_ft_rate_rk) 

ggplot(e8_criteria, aes(x=team_finish)) + geom_bar(stat = 'count')
```

## Sweet 16 History


```{r sweet16_gg, echo=FALSE}
s16 <- ggplot(s16_teams, aes(x = adj_o_rk, y = adj_d_rk)) + 
  geom_point() + 
  gghighlight(((adj_o_rk + adj_d_rk > s16_od) | (adj_o_rk > s16_one & adj_d_rk > s16_one)) & (adj_o_rk > s16_elite & adj_d_rk > s16_elite)) + 
  #gghighlight(adj_o_rk + adj_d_rk > s16_od) +
  labs(title = 'Sweet 16 Teams by AdjO & AdjD Rank', subtitle = glue('Offense + Defense <= {s16_od} & One Inside top-{s16_one} or Both Outisde top-{s16_elite}'))
  #labs(title = 'Sweet 16 Teams by AdjO & AdjD Rank', subtitle = glue('Offense + Defense > {s16_od}'))
plot(s16)
```

``` {r sweet16_gt, echo=FALSE}
s16_history <- s16_teams %>%
  filter(((adj_o_rk + adj_d_rk > s16_od) | (adj_o_rk > s16_one & adj_d_rk > s16_one)) & (adj_o_rk > s16_elite & adj_d_rk > s16_elite)) %>%
  #filter(adj_o_rk + adj_d_rk > s16_od) %>%
  select(team, year, seed = ncaa_seed, Tempo = adj_t_rk, O = adj_o_rk, D = adj_d_rk, O_EFG = off_e_fg_pct_rk, O_TO = off_to_pct_rk, O_OR = off_or_pct_rk, O_FTR = off_ft_rate_rk, D_EFG = def_e_fg_pct_rk, D_TO = def_to_pct_rk, D_OR = def_or_pct_rk, D_FTR = def_ft_rate_rk) 

s16_history %>%
  gt() %>%
  tab_header(title = 'Sweet 16 History',subtitle = glue('Offense + Defense <= {s16_od} & One Inside top-{s16_one} or both Outisde top-{s16_elite}'))
  #tab_header(title = 'Sweet 16 History',subtitle = glue('Offense + Defense >= {s16_od}'))
```


## Sweet 16 Takeaways


```{r sweet16_possibles, echo=FALSE}
s16_possibles <- all %>%
  filter(((adj_o_rk + adj_d_rk <= s16_od) & (adj_o_rk <= s16_one | adj_d_rk <= s16_one)) | (adj_o_rk <= s16_elite | adj_d_rk <= s16_elite))  %>%
  #filter(adj_o_rk + adj_d_rk <= s16_od) %>%
  select(team,seed = ncaa_seed, Rank = rk, Tempo = adj_t_rk, O = adj_o_rk, D = adj_d_rk, O_EFG = off_e_fg_pct_rk, O_TO = off_to_pct_rk, O_OR = off_or_pct_rk, O_FTR = off_ft_rate_rk, D_EFG = def_e_fg_pct_rk, D_TO = def_to_pct_rk, D_OR = def_or_pct_rk, D_FTR = def_ft_rate_rk) %>%
  arrange(seed) %>%
  as.data.frame() 

s16_possibles %>%
  gt() %>%
  tab_header(title = 'Teams with a Chance to Make the Sweet 16', subtitle = glue('Offense + Defense <= {s16_od} & One Inside top-{s16_one} or One Inside top-{s16_elite}'))
  #tab_header(title = 'Teams with a Chance to Make the Sweet 16', subtitle = glue('Offense + Defense <= {s16_od}'))
```

## Historical Sweet 16 Criteria
```{r historical_s16_criteria, echo=FALSE}
s16_criteria <- tourney_teams %>%
  filter((adj_o_rk + adj_d_rk <= f4_od)) %>%
  select(team, year, team_finish, seed = ncaa_seed, Tempo = adj_t_rk, O = adj_o_rk, D = adj_d_rk, O_EFG = off_e_fg_pct_rk, O_TO = off_to_pct_rk, O_OR = off_or_pct_rk, O_FTR = off_ft_rate_rk, D_EFG = def_e_fg_pct_rk, D_TO = def_to_pct_rk, D_OR = def_or_pct_rk, D_FTR = def_ft_rate_rk) 

ggplot(s16_criteria, aes(x=team_finish)) + geom_bar(stat = 'count')
```

## Summary

```{r analysis_summary, echo=FALSE}
s16_all <- bind_cols(Round = 'S16') %>%
  bind_cols(all_teams = nrow(s16_teams)) %>%
  bind_cols(outliers = nrow(s16_history)) %>%
  bind_cols(possibles = nrow(s16_possibles)) %>%
  bind_cols(teams = 16)

e8_all <- bind_cols(Round = 'E8') %>%
  bind_cols(all_teams = nrow(e8_teams)) %>%
  bind_cols(outliers = nrow(e8_history)) %>%
  bind_cols(possibles = nrow(e8_possibles)) %>%
  bind_cols(teams = 8)

f4_all <- bind_cols(Round = 'F4') %>%
  bind_cols(all_teams = nrow(f4_teams)) %>%
  bind_cols(outliers = nrow(f4_history)) %>%
  bind_cols(possibles = nrow(f4_possibles)) %>%
  bind_cols(teams = 4)

final_all <- bind_cols(Round = 'Final') %>%
  bind_cols(all_teams = nrow(final_teams)) %>%
  bind_cols(outliers = nrow(final_history)) %>%
  bind_cols(possibles = nrow(final_possibles)) %>%
  bind_cols(teams = 2)

ch_all <- bind_cols(Round = 'CH') %>%
  bind_cols(all_teams = nrow(champions)) %>%
  bind_cols(outliers = nrow(ch_history)) %>%
  bind_cols(possibles = nrow(ch_possible)) %>%
  bind_cols(teams = 1)

bind_rows(s16_all) %>%
  bind_rows(e8_all) %>%
  bind_rows(f4_all) %>%
  bind_rows(final_all) %>%
  bind_rows(ch_all) %>%
  mutate(error_rate = outliers/all_teams) %>%
  mutate(Coverage = round(possibles/teams,2)) %>%
  select(-teams) %>%
  gt() %>%
  fmt_percent(error_rate, decimals = 2)
```

## 12+ Upsets
```{r upsets, echo=FALSE, fig.height=4, fig.width=12}
upsets <- tourney_teams %>%
  filter(team_finish != 'R1' & (ncaa_seed >= 12)) %>%
  dplyr::select(year, team, ncaa_seed, team_finish, ends_with('rk'))

team <- ggplot(upsets, aes(x=team_rk)) + geom_histogram(bins = 15, aes(y =..density..)) + geom_density() + ggtitle(label = '12+ Upsets by Team Rank') + ylim(0,.02) + xlim(0,250)
d <- ggplot(upsets, aes(x=adj_d_rk)) + geom_histogram(bins = 15, aes(y =..density..)) + geom_density() + ggtitle(label = '12+ Upsets by Adj D Rank') + ylim(0,.02) + xlim(0,250)
o <- ggplot(upsets, aes(x=adj_o_rk)) + geom_histogram(bins = 15, aes(y =..density..)) + geom_density() + ggtitle(label = '12+ Upsets by Adj O Rank') + ylim(0,.02) + xlim(0,250)

grid.arrange(team, o,d, nrow = 1)
```

## 12+ Upsets, Continued
```{r upsets_2, echo=FALSE}
upsets <- tourney_teams %>%
  filter(team_finish != 'R1' & (ncaa_seed >= 12)) %>%
  dplyr::select(year, team, ncaa_seed, team_finish, ends_with('rk'))


ggplot(upsets, aes(x = adj_o_rk, y = adj_d_rk)) + geom_point() + geom_smooth(se = FALSE)


```


## 10+ S16
```{r s16_upsets, echo=FALSE, fig.height=4, fig.width=12}
upsets <- tourney_teams %>%
  filter(team_finish != 'R1' & team_finish != 'R2' & (ncaa_seed >= 10)) %>%
  dplyr::select(year, team, ncaa_seed, team_finish, ends_with('rk'))

team <- ggplot(upsets, aes(x=team_rk)) + geom_histogram(bins = 15, aes(y =..density..)) + geom_density() + ggtitle(label = '10+ S16 or Greater by Team Rank') + ylim(0,.03) + xlim(0,250)
d <- ggplot(upsets, aes(x=adj_d_rk)) + geom_histogram(bins = 15, aes(y =..density..)) + geom_density() + ggtitle(label = '10+ S16 or Greater by Adj D Rank') + ylim(0,.03) + xlim(0,250)
o <- ggplot(upsets, aes(x=adj_o_rk)) + geom_histogram(bins = 15, aes(y =..density..)) + geom_density() + ggtitle(label = '10+ S16 or Greater by Adj O Rank') + ylim(0,.03) + xlim(0,250)

grid.arrange(team, o,d, nrow = 1)
```

## 10+ S16, Continued
```{r s16_upsets_2, echo=FALSE}
upsets <- tourney_teams %>%
  filter(team_finish != 'R1' & team_finish != 'R2' & (ncaa_seed >= 10)) %>%
  dplyr::select(year, team, ncaa_seed, team_finish, ends_with('rk'))

ggplot(upsets, aes(x = adj_o_rk, y = adj_d_rk)) + geom_point() + geom_smooth(se = FALSE)
##eventually get the teams that fit the bill of having a good defense and are lower seeded
```

## Matchup Dependencies
```{r matchups_inputs, echo=FALSE}
selectInput('team1',
            choices = all$team,
            label = 'Select Team 1')

selectInput('team2',
            choices = all$team,
            label = 'Select Team 2')

matchup_side1 <- function(team1,team2) {
  offense <- all %>%
    filter(team == team1) %>%
    select(Team = team,seed = ncaa_seed, Rank = rk, adj_em,  adj_t, Tempo = adj_t_rk, eff = adj_o, Efficiency = adj_o_rk, efg = off_e_fg_pct, `eFG%` = off_e_fg_pct_rk, to = off_to_pct, `TO%` = off_to_pct_rk, or = off_or_pct, `OReb%` = off_or_pct_rk, ftr = off_ft_rate, FTRate = off_ft_rate_rk)

  defense <- all %>%
    filter(team == team2) %>%
    select(Team = team,seed = ncaa_seed,Rank = rk, adj_em,  adj_t, Tempo = adj_t_rk, eff = adj_d, Efficiency = adj_d_rk, efg = def_e_fg_pct, `eFG%` = def_e_fg_pct_rk, to = def_to_pct, `TO%` = def_to_pct_rk, or = def_or_pct, `OReb%` = def_or_pct_rk, ftr = def_ft_rate, FTRate = def_ft_rate_rk)

offense %>%
  rbind(defense) %>%
  gt() %>%
  gt_merge_stack(col1 = Rank, col2 = adj_em) %>%
  gt_merge_stack(col1 = Tempo, col2 = adj_t) %>%
  gt_merge_stack(col1 = Efficiency, col2 = eff) %>%
  gt_merge_stack(col1 = `eFG%`, col2 = efg) %>%
  gt_merge_stack(col1 = `TO%`, col2 = to) %>%
  gt_merge_stack(col1 = `OReb%`, col2 = or) %>%
  gt_merge_stack(col1 = `FTRate`, col2 = ftr) %>%
  tab_options(
    heading.background.color = "lightgray",
    column_labels.background.color = "lightslategray",
    source_notes.background.color = "lightgray",
  ) %>%
   data_color(
    columns = Rank:FTRate,
    colors = scales::col_numeric(
      colorspace::sequential_hcl(n = 2, palette = 'Greens 2'), 
      domain = NULL
  )) %>%
  tab_header(
    title = glue('2021-2022 {team1} Offense vs. {team2} Defense'),
    subtitle = 'Big Numbers are National Rank | FF Data pulled from KenPom via hoopR')  %>% 
  cols_align(
    align = "center",
    columns = everything()
  )
}



render_gt(matchup_side1(input$team1, input$team2))



```
<br>
<br>
```{r matchups_inputs_2, echo=FALSE}

matchup_side2 <- function(team1,team2) {
  offense <- all %>%
    filter(team == team2) %>%
    select(Team = team,seed = ncaa_seed, Rank = rk, adj_em, adj_t, Tempo = adj_t_rk, eff = adj_o, Efficiency = adj_o_rk, efg = off_e_fg_pct, `eFG%` = off_e_fg_pct_rk, to = off_to_pct, `TO%` = off_to_pct_rk, or = off_or_pct, `OReb%` = off_or_pct_rk, ftr = off_ft_rate, FTRate = off_ft_rate_rk)

  defense <- all %>%
    filter(team == team1) %>%
    select(Team = team,seed = ncaa_seed, Rank = rk, adj_em,  adj_t, Tempo = adj_t_rk, eff = adj_d, Efficiency = adj_d_rk, efg = def_e_fg_pct, `eFG%` = def_e_fg_pct_rk, to = def_to_pct, `TO%` = def_to_pct_rk, or = def_or_pct, `OReb%` = def_or_pct_rk, ftr = def_ft_rate, FTRate = def_ft_rate_rk)

offense %>%
  rbind(defense) %>%
  gt() %>%
  gt_merge_stack(col1 = Rank, col2 = adj_em) %>%
  gt_merge_stack(col1 = Tempo, col2 = adj_t) %>%
  gt_merge_stack(col1 = Efficiency, col2 = eff) %>%
  gt_merge_stack(col1 = `eFG%`, col2 = efg) %>%
  gt_merge_stack(col1 = `TO%`, col2 = to) %>%
  gt_merge_stack(col1 = `OReb%`, col2 = or) %>%
  gt_merge_stack(col1 = `FTRate`, col2 = ftr) %>%
  tab_options(
    heading.background.color = "lightgray",
    column_labels.background.color = "lightslategray",
    source_notes.background.color = "lightgray",
  ) %>%
   data_color(
    columns = Rank:FTRate,
    colors = scales::col_numeric(
      colorspace::sequential_hcl(n = 2, palette = 'Greens 2'), 
      domain = NULL
  )) %>%
  tab_header(
    title = glue('2021-2022 {team2} Offense vs. {team1} Defense'),
    subtitle = 'Big Numbers are National Rank | FF Data pulled from KenPom via hoopR')  %>% 
  cols_align(
    align = "center",
    columns = everything()
  )
}


render_gt(matchup_side2(input$team1, input$team2))

```


## Citations
```{r citations, echo=FALSE}
toBibtex(citation('rmarkdown'))
toBibtex(citation('tidyverse'))
toBibtex(citation('hoopR'))
toBibtex(citation('rvest'))
toBibtex(citation('stringi'))
toBibtex(citation('furrr'))
toBibtex(citation('ggplot2'))
toBibtex(citation('glue'))
toBibtex(citation('collapse'))
toBibtex(citation('ggrepel'))
toBibtex(citation('dplyr'))
toBibtex(citation('gtExtras'))
toBibtex(citation('gt'))
toBibtex(citation('gghighlight'))
toBibtex(citation('readr'))
toBibtex(citation('gridExtra'))
toBibtex(citation('shiny'))
```