{"cells":[{"metadata":{},"cell_type":"markdown","source":"![upload.wikimedia.org/wikipedia/commons/9/9c/Arike_Ogunbowale_01_%28cropped%29.jpg](http://)"},{"metadata":{},"cell_type":"markdown","source":"# Introduction\nThe dataset of interest is the female NCAA dataset. The reason for exploring this particular dataset is that less attention is paid to the female team in sports in general, so this is an effort at changing the narrative. A lot of credit goes to Jason Zivkovic for some of the code adopted in this data exploration.\n\nLet's set up the generic theme for this data exploration."},{"metadata":{"trusted":true},"cell_type":"code","source":"library(tidyverse)\nlibrary(scales)\nlibrary(gridExtra)\nlibrary(knitr)\n#install.packages(\"ggExtra\")\nlibrary(ggExtra)\nlibrary(ggplot2)\n\n# set up plotting theme\ntheme_akeem <- function(legend_pos=\"top\", base_size=11, font=NA){\n  \n  # come up with some default text details\n  txt <- element_text(size = base_size+3, colour = \"black\", face = \"plain\")\n  bold_txt <- element_text(size = base_size+3, colour = \"black\", face = \"bold\")\n  \n  # use the theme_minimal() theme as a baseline\n  theme_minimal(base_size = base_size, base_family = font)+\n    theme(text = txt,\n          # axis title and text\n          axis.title.x = element_text(size = 15, hjust = 1),\n          axis.title.y = element_text(size = 15),\n          # gridlines on plot\n          panel.grid.major = element_line(linetype = 2),\n          panel.grid.minor = element_line(linetype = 2),\n          # title and subtitle text\n          plot.title = element_text(size = 18, colour = \"grey25\", face = \"bold\"),\n          plot.subtitle = element_text(size = 16, colour = \"grey44\"),\n          \n          ###### clean up!\n          legend.key = element_blank(),\n          # the strip.* arguments are for faceted plots\n          strip.background = element_blank(),\n          strip.text = element_text(face = \"bold\", size = 13, colour = \"grey35\")) +\n    \n    #----- AXIS -----#\n    theme(\n      #### remove Tick marks\n      axis.ticks=element_blank(),\n      \n      ### legend depends on argument in function and no title\n      legend.position = legend_pos,\n      legend.title = element_blank(),\n      legend.background = element_rect(fill = NULL, size = 0.5,linetype = 2)\n      \n      \n    )\n}\n\n\nplot_cols <- c(\"#498972\", \"#3E8193\", \"#BC6E2E\", \"#A09D3C\", \"#E06E77\", \"#7589BC\", \"#A57BAF\", \"#4D4D4D\") ","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"## Offloading the \"Women NCAA\" Datasets"},{"metadata":{"trusted":true},"cell_type":"code","source":"#Load the data\n\nreg_season_stats <- as.tibble(read.csv(\"../input/march-madness-analytics-2020/2020DataFiles/2020DataFiles//2020-Womens-Data/WDataFiles_Stage1/WRegularSeasonDetailedResults.csv\",\n                                       stringsAsFactors = F))\n\ntourney_stats <- as.tibble(read.csv(\"../input/march-madness-analytics-2020/2020DataFiles/2020DataFiles//2020-Womens-Data/WDataFiles_Stage1/WNCAATourneyDetailedResults.csv\",\n                          stringsAsFactors = F))\n\nteams <- as.tibble(read.csv(\"../input/march-madness-analytics-2020/2020DataFiles/2020DataFiles//2020-Womens-Data/WDataFiles_Stage1/WTeams.csv\", stringsAsFactors = F))\n\ntourney_stats_compact <- read.csv(\"../input/march-madness-analytics-2020/2020DataFiles/2020DataFiles//2020-Womens-Data/WDataFiles_Stage1/WNCAATourneyCompactResults.csv\", stringsAsFactors = F)\n\ntourney_seeds <- as.tibble(read.csv(\"../input/march-madness-analytics-2020/2020DataFiles/2020DataFiles//2020-Womens-Data/WDataFiles_Stage1/WNCAATourneySeeds.csv\",\n                          stringsAsFactors = F)) %>%\n  drop_na(Seed)\n\nteam_conferences <- as.tibble(read.csv(\"../input/march-madness-analytics-2020/2020DataFiles/2020DataFiles//2020-Womens-Data/WDataFiles_Stage1/WTeamConferences.csv\",\n                                       stringsAsFactors = F))\n\nconferences <- as.tibble(read.csv(\"../input/march-madness-analytics-2020/2020DataFiles/2020DataFiles//2020-Womens-Data/WDataFiles_Stage1/Conferences.csv\",\n                                  stringsAsFactors = F))\n\nplayers <- read.csv(\"../input/march-madness-analytics-2020/2020DataFiles/2020DataFiles/2020-Womens-Data/WPlayers.csv\",\n                     stringsAsFactors = F, na.strings = c(\"\", \"NA\")) %>% \n  filter(!is.na(LastName)) %>%\n  as.tibble()\n  \n\nglimpse(players)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"# Play_by_play Analysis \nThis section involves a logical data wrangling. Specifically, the algorithm was written to loop through the women dataset and set the tune on how the data will be explored at the granular level."},{"metadata":{"trusted":true},"cell_type":"code","source":"play_by_play <- data.frame()\n\n# loop through each seasons PlayByPlay folders and read in in the play by play files\nfor(each in list.files(\"../input/march-madness-analytics-2020/2020DataFiles/2020DataFiles//2020-Womens-Data/\")[str_detect(list.files(\"../input/march-madness-analytics-2020/2020DataFiles/2020DataFiles//2020-Womens-Data/\"), \"WEvents\")]) {\n  df <- read_csv(paste0(\"../input/march-madness-analytics-2020/2020DataFiles/2020DataFiles/2020-Womens-Data/\", each))\n  \n  \n  # Grouped shooting variables ----------------------------------------------\n  # there are some shooting variables that can probably be condensed - tip ins and dunks\n  paint_attempts_made <- c(\"made2_dunk\", \"made2_lay\", \"made2_tip\") \n  paint_attempts_missed <- c(\"miss2_dunk\", \"miss2_lay\", \"miss2_tip\") \n  paint_attempts <- c(paint_attempts_made, paint_attempts_missed)\n  \n  # create variables for field goals made (FGM), and also field goals attempted (FGA)(which includes the sum of FGs made and FGs missed)\n  FGM <- c(\"made2_dunk\", \"made2_jump\", \"made2_lay\",  \"made2_tip\",  \"made3_jump\")\n  FGA <- c(FGM, \"miss2_dunk\", \"miss2_jump\" ,\"miss2_lay\",  \"miss2_tip\",  \"miss3_jump\")\n  # variable for three-pointers\n  ThreePointer <- c(\"made3_jump\", \"miss3_jump\")\n  #  Two point jumper\n  TwoPointJump <- c(\"miss2_jump\", \"made2_jump\")\n  # Free Throws\n  FT <- c(\"miss1_free\", \"made1_free\")\n  # all shots\n  AllShots <- c(FGA, FT)\n  \n  \n  # Feature Engineering -----------------------------------------------------\n  # paste the two even variables together for FGs as this is the format for last years comp data\n  df <- df %>%\n    mutate_if(is.factor, as.character) %>% \n    mutate(EventType = ifelse(str_detect(EventType, \"miss\") | str_detect(EventType, \"made\") | str_detect(EventType, \"reb\"), paste0(EventType, \"_\", EventSubType), EventType))\n  \n  # change the unknown for 3s to \"jump\" and for FTs \"free\"\n  df <- df %>% \n    mutate(EventType = ifelse(str_detect(EventType, \"3\"), str_replace(EventType, \"_unk\", \"_jump\"), EventType),\n           EventType = ifelse(str_detect(EventType, \"1\"), str_replace(EventType, \"_unk\", \"_free\"), EventType))\n  \n  \n  df <- df %>% \n    # create a variable in the df for whether the attempts was made or missed\n    mutate(shot_outcome = ifelse(grepl(\"made\", EventType), \"Made\", ifelse(grepl(\"miss\", EventType), \"Missed\", NA))) %>%\n    # identify if the action was a field goal, then group it into the attempt types set earlier\n    mutate(FGVariable = ifelse(EventType %in% FGA, \"Yes\", \"No\"),\n           AttemptType = ifelse(EventType %in% paint_attempts, \"PaintPoints\", \n                                ifelse(EventType %in% ThreePointer, \"ThreePointJumper\", \n                                       ifelse(EventType %in% TwoPointJump, \"TwoPointJumper\", \n                                              ifelse(EventType %in% FT, \"FreeThrow\", \"NoAttempt\")))))\n  \n  \n  # Rework DF so only shots are included and whatever lead to the shot --------\n  df <- df %>% \n    mutate(GameID = paste(Season, DayNum, WTeamID, LTeamID, sep = \"_\")) %>% \n    group_by(GameID, ElapsedSeconds) %>% \n    mutate(EventType2 = lead(EventType),\n           EventPlayerID2 = lead(EventPlayerID)) %>% ungroup()\n  \n  \n  df <- df %>% \n    mutate(FGVariableAny = ifelse(EventType %in% FGA | EventType2 %in% FGA, \"Yes\", \"No\")) %>% \n    filter(FGVariableAny == \"Yes\") \n  \n  \n  # create a variable for if the shot was made, but then the second event was also a made shot\n  df <- df %>% \n    mutate(Alert = ifelse(EventType %in% FGM & EventType2 %in% FGM, \"Alert\", \"OK\")) %>% \n    # only keep \"OK\" observations\n    filter(Alert == \"OK\") \n  # replace NAs with something\n  df$EventType2[is.na(df$EventType2)] <- \"no_second_event\"\n  \n  \n  # create a variable for if there was an assist on the FGM:\n  df <- df %>% \n    mutate(AssistedFGM = ifelse(EventType %in% FGM & EventType2 == \"assist\", \"Assisted\", \n                                ifelse(EventType %in% FGM & EventType2 != \"assist\", \"Solo\", \n                                       ifelse(EventType %in% FGM & EventType2 == \"no_second_event\", \"Solo\", \"None\"))))\n  \n  # # because the FGA could be either in `EventType` (more likely) or `EventType2` (less likely), need\n  # # one variable to indicate the shot type\n  # df <- df %>% \\\n  #   mutate(fg_type = ifelse(EventType %in% FGA, EventType, ifelse(EventType2 %in% FGA, EventType2, \"Unknown\")))\n  \n  # create final output\n  df <- df %>% ungroup()\n  play_by_play <- bind_rows(play_by_play, df)\n  \n  rm(df);gc() #remove garbage content\n}\n\n#saveRDS(play_by_play, \"play_by_play15_19.rds\")\n# play_by_play <- readRDS(\"play_by_play2015_19.rds\")","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"## Play_by_play Analysis: Scoring Patterns\nOverall, the field goal (FG)  was 39.56% on 3,078,936 attempts. Suprisingly, tries on \"threes\" were only 1.3% less successful than 2-point jumpers, yet the potential payoff is 50% (3/2 x 100) more points for taking the three. That explains the clamor for a shift to threes and shots at the rim."},{"metadata":{"trusted":true},"cell_type":"code","source":"play_by_play %>%\n  filter(Season == 2019) %>%\n  as.tibble()    #2019 data\n\nlibrary(DT)\n#PlaybyPlay seasons range from 2015 to 2019\nsummary(play_by_play$Season) \n\n#Sum of field goals made and missed from 2015 to 2019\nplay_by_play %>%\n  group_by(shot_outcome) %>% \n  summarise(number_of_shots = n()) %>%\n  arrange(desc(number_of_shots)) \n\n\n# Sum of field goals made (FGM) in 2019\nfilter(play_by_play, play_by_play$Season == 2019) %>%\n  group_by(shot_outcome) %>% \n  summarise(number_of_shots = n()) %>%\n  arrange(desc(number_of_shots)) \n\n## Morey Ball in the NCAA\n\nplay_by_play %>%\n  group_by(AttemptType) %>% \n  summarise(number_of_shots = n()) %>%\n  arrange(desc(number_of_shots)) %>%\n  DT::datatable()         # Shots in descending order\n\n \n# Scoring patterns\nplay_by_play %>% \n  group_by(AttemptType) %>% \n  summarise(number_of_shots = n()) %>%\n  filter(AttemptType != \"NoAttempt\") %>% \n  ggplot(aes(x= AttemptType, y= number_of_shots)) +\n  geom_col(fill = plot_cols[1], colour = \"grey\") +\n  geom_text(aes(label = comma(number_of_shots)), y=90000, colour = \"black\", size = 6) +\n  scale_y_continuous(labels = c(\"0\", \"300,000\", \"600,000\", \"900,000\", \"1,200,000\\nattempts\")) +\n  coord_flip() +\n  ggtitle(\"Scoring Patterns in The Female NCAA\", subtitle = \">Three Pointers are closing up on the Two Pointers<\") +\n  theme_akeem() +\n  theme(axis.title.x = element_blank(), axis.title.y = element_blank(), plot.title = element_text(hjust = 0.5), plot.subtitle = element_text(hjust = 0.5))  \n\n\n\n## Scoring pattern trend over the years\np_tab <- play_by_play %>% \n  filter(AttemptType != \"FreeThrow\") %>% \n  group_by(AttemptType, Season) %>% \n  summarise(n_shots = n()) %>% \n  filter(AttemptType != \"NoAttempt\") %>%\n  filter(Season == 2019) %>% ungroup()\n\n\nplay_by_play %>% \n  filter(AttemptType != \"FreeThrow\") %>% \n  group_by(AttemptType, Season) %>% \n  summarise(n_shots = n()) %>% \n  filter(AttemptType != \"NoAttempt\") %>% \n  ggplot(aes(x= Season, y= n_shots, colour = AttemptType, group = AttemptType)) +\n  geom_line(size = 1) +\n  geom_point(size = 2) +\n  geom_text(data = p_tab, aes(label = AttemptType), hjust= 0, size=6) +\n  scale_color_manual(values = plot_cols) +\n  scale_x_continuous(labels = c(2015:2020), breaks = c(2015:2020), limits = c(2015, 2022)) +\n  scale_y_continuous(labels = c(\"125,000\", \"150,000\", \"175,000\", \"200,000\", \"225,000\", \"250,000 attempts\"), breaks = c(seq(from=125000, to= 250000, by= 25000)), limits = c(125000, 250000)) +\n  ggtitle(\"3_points Jumper Popularity Rises While 2_Points Jumper Diminishes\") +\n  theme_akeem(legend_pos = \"none\") +\n  theme(panel.grid.major.x = element_blank(), panel.grid.minor.x = element_blank(), axis.title.x = element_blank(), axis.title.y = element_blank())\n\n# Three points jumper rose over the years\n#install.packages(\"DT\") - Javascript in R\n\nplay_by_play %>% \n  filter(FGVariable == \"Yes\") %>%\n  group_by(AttemptType, shot_outcome) %>% \n  summarise(n_attempts = n()) %>% \n  mutate(shot_success = percent(n_attempts / sum(n_attempts))) %>% \n  filter(shot_outcome == \"Made\") %>% select(-shot_outcome) %>% \n  DT::datatable()\n\n#Graphical illustration of shot_success_percentage by attempt type\n\nplay_by_play %>% \n  filter(FGVariable == \"Yes\") %>%\n  group_by(AttemptType, shot_outcome) %>% \n  summarise(n_attempts = n()) %>% \n  mutate(shot_success = percent(n_attempts / sum(n_attempts))) %>% \n  filter(shot_outcome == \"Made\") %>% \n  ggplot(aes(x = AttemptType , y = shot_success))+\n  geom_bar(stat = \"identity\")+  #identity was the winning strategy, lol\n  coord_flip() +\n  theme_akeem(legend_pos = \"none\") +\n  theme(panel.grid.major.x = element_blank(), panel.grid.minor.x = element_blank(), axis.title.x = element_blank(), axis.title.y = element_blank())\n\n\n\n\n\nplay_by_play %>% \n  filter(FGVariable == \"Yes\") %>%\n  group_by(AttemptType, shot_outcome) %>% \n  summarise(n_attempts = n()) %>% \n  mutate(shot_failure = percent(n_attempts / sum(n_attempts))) %>% \n  filter(shot_outcome == \"Missed\") %>% select(-shot_outcome) %>% #shot outcome is redundant in the dataset\n  DT::datatable()\n\n#Graphical illustration of shot_failure_percentage by attempt type\n\nplay_by_play %>% \n  filter(FGVariable == \"Yes\") %>%\n  group_by(AttemptType, shot_outcome) %>% \n  summarise(n_attempts = n()) %>% \n  mutate(shot_failure = percent(n_attempts / sum(n_attempts))) %>% \n  filter(shot_outcome == \"Missed\") %>% \n  ggplot(aes(x = AttemptType , y = shot_failure))+\n  geom_bar(stat = \"identity\")+  #identity was the winning strategy, lol\n  coord_flip()","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"## Expected Points from each Scoring Pattern\nThe data suggested that the ladies sparingly made an attempt at a 2-pointer dunk. The table suggested that a 2_tip is by far the most successful strategy. It’s pretty obvious to see why basketball analytics junkies are always screaming at players to stop shooting jumpers from inside the three point line - these shot types have an expected 0.67 (.334 x 2) points per attempt, which is considerably less than the expected 0.95 (.315 x 3) points for attempted shots outside the three-points line"},{"metadata":{"trusted":true},"cell_type":"code","source":"glimpse(play_by_play)\n\nshot_values <- play_by_play %>% \n  filter(FGVariable == \"Yes\") %>% \n  mutate(EventType = str_remove(EventType, \"made\"), EventType = str_remove(EventType, \"miss\")) %>% \n  group_by(EventType, shot_outcome) %>% \n  summarise(n_attempts = n()) %>% \n  mutate(shot_success = n_attempts / sum(n_attempts),\n         n_attempts = sum(n_attempts)) %>% \n  filter(shot_outcome == \"Made\") %>% select(-shot_outcome) \n\nshot_values %>% \n  mutate(n_attempts = comma(n_attempts),\n         shot_success = percent(shot_success)) %>% \n  rename('No_of_Attempts' = n_attempts)%>%\n  DT::datatable()\n\n\n\nshot_values %>% \n  mutate(Point = as.numeric(str_extract(EventType, \"[[:digit:]]\"))) %>% \n  mutate(ExpectedPoints = shot_success * Point) %>% \n  ggplot(aes(x=reorder(EventType, ExpectedPoints), y= ExpectedPoints)) +\n  geom_col(fill = plot_cols[1], colour = \"grey\") +\n  geom_text(aes(label = round(ExpectedPoints, 2)), vjust =  1.2, colour = \"white\", size=6) +\n  ggtitle(\"TWO POINT JUMPERS: LEAST EFFICIENT SHOT TYPE\", subtitle = \"Tips yielded a massive 1.23 points per attempt,\\nwhile 2-point jumpers yielded approx. half\")+\n  theme_akeem() +\n  theme(panel.grid.major.x = element_blank(), panel.grid.minor.x = element_blank(), axis.title.x = element_blank(), axis.title.y = element_blank())","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"# Assists Vs Solo Attempts \nThe graph summarises the entire information on solo (hero) ball attempt by the ladies. Successful solo  three-points attempt forms the least proportion of unassisted field goals. "},{"metadata":{"trusted":true},"cell_type":"code","source":"play_by_play %>% \n  filter(AssistedFGM != \"None\", shot_outcome == \"Made\") %>% \n  group_by(EventType, AssistedFGM) %>% \n  summarise(n = n()) %>% \n  mutate(perc = n / sum(n)) %>% \n  filter(AssistedFGM == \"Solo\") %>% \n  ggplot(aes(x=EventType, y= perc, fill = AssistedFGM)) +\n  geom_hline(yintercept = mean(play_by_play$AssistedFGM[play_by_play$AssistedFGM != \"None\"] == \"Solo\"), linetype = 2) +\n  geom_col(fill = plot_cols[1], colour = \"grey\") +\n  geom_text(aes(label = ifelse(AssistedFGM == \"Solo\", percent(perc), \"\")), hjust = 1.2, colour = \"white\", size=6) +\n  scale_y_continuous(labels = c(\"0%\", \"25%\", \"50%\", \"75%\", \"100% solo\")) +\n  annotate(\"text\", x=5, y= 0.56, label = paste0(percent(mean(play_by_play$AssistedFGM[play_by_play$AssistedFGM != \"None\"] == \"Solo\")), \" solo\\nattempts overall\"), size = 6) +\n  coord_flip() +\n  ggtitle(\"HERO BALL MORE FREQUENT FOR SOME SHOTS\", subtitle = \"Solo 2pt jump shots are much more frequent that 3pt jumpers\") +\n  theme_akeem(legend_pos = \"none\") +\n  theme(axis.title.x = element_blank(), axis.title.y = element_blank())","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Delving deeper into the evolution of hero balls patterns over the years, the trend of successful solo field goals types over the years was explored and the result is as illustrated in the plot below.\n\nThe solo ball attempt trend presented interesting outcomes. First, a zig-zag scoring pattern was observed in the \"dunk\" hero balls. The solo \"dunk\" hero balls rose from 40% in 2015 to 100% in 2016, then fell sharply to approximately 33% in 2017, then rose again to 100% in 2019. The other hero ball types were almost consistent over the years, except the three-point hero balls that slightly rose by 3% between the 2018 and 2019 season."},{"metadata":{"trusted":true},"cell_type":"code","source":"solo_tab <- play_by_play %>% \n  filter(AssistedFGM != \"None\") %>% \n  group_by(Season, EventType, AssistedFGM) %>% \n  summarise(n = n()) %>% \n  mutate(perc = n / sum(n)) %>% \n  filter(AssistedFGM == \"Solo\") %>%\n  filter(Season == 2019) %>% ungroup()\n\n\nplay_by_play %>% \n  filter(AssistedFGM != \"None\") %>% \n  group_by(Season, EventType, AssistedFGM) %>% \n  summarise(n = n()) %>% \n  mutate(perc = n / sum(n)) %>% \n  filter(AssistedFGM == \"Solo\") %>% \n  ggplot(aes(x= Season, y= perc, colour = EventType)) +\n  geom_line(size= 1) +\n  geom_point(size = 2) +\n  geom_text(data = solo_tab, aes(label = EventType), hjust= 0, size=6) +\n  scale_color_manual(values = plot_cols) +\n  scale_x_continuous(labels = c(2015:2020), breaks = c(2015:2020), limits = c(2015, 2022)) +\n  scale_y_continuous(labels = c(\"0%\", \"10%\", \"20%\", \"30%\", \"40%\", \"50%\", \"60%\", \"70%\", \"80%\", \"90%\", \"100% Solo\"),\n                     breaks = c(seq(0,1, .1)),\n                     limits = c(0,1)) +\n  ggtitle(\"Hero Ball Evolution\") +\n  theme_akeem(legend_pos = \"none\")","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"# Teamwork Or Personal Glory?\n\nThe average proportion of teams in favor of solo attempts is approximately 45%. The solo field goals across the teams follows a normal distribution, with all teams lying between 26% and 60%.\n\nNext is a quick peak of top 12 teams deploying solo attempt strategy;"},{"metadata":{"trusted":true},"cell_type":"code","source":"play_by_play %>% \n  filter(AssistedFGM != \"None\") %>% \n  group_by(EventTeamID, AssistedFGM) %>% \n  summarise(n = n()) %>% \n  mutate(perc = n / sum(n)) %>% \n  filter(AssistedFGM == \"Solo\") %>% arrange(desc(perc)) %>%\n  ggplot(aes(x= perc)) +\n  geom_histogram(fill = plot_cols[1], colour = \"grey\") +\n  scale_x_continuous(labels = c(\"20%\",\"30%\", \"40%\", \"50%\", \"60% solo\", \"\"), limits = c(0.2, 0.7)) +\n  labs(y= \"Number of Teams\") +\n  ggtitle(\"Solo Field Goal Distribution\") +\n  theme_akeem() +\n  theme(axis.title.x = element_blank(), plot.title = element_text(hjust = 0.5))","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"The table generated from the data suggested that the top 12 teams utilizing the solo ball technique are not the traditional bigwigs in female basketball college team."},{"metadata":{"trusted":true},"cell_type":"code","source":"play_by_play %>% \n  filter(AssistedFGM != \"None\") %>% \n  group_by(EventTeamID, AssistedFGM) %>% \n  summarise(n = n()) %>% \n  mutate(perc = n / sum(n)) %>% \n  filter(AssistedFGM == \"Solo\") %>% ungroup() %>% \n  left_join(teams %>% select(TeamID, TeamName), by = c(\"EventTeamID\" = \"TeamID\")) %>% arrange(desc(perc)) %>% \n  select(TeamName, PercentSolo = perc) %>% \n  mutate(PercentSolo = percent(PercentSolo)) %>% head(12) %>% \n  DT::datatable()","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Conversely, top female college basketball teams like Iowa and Connecticut are not disposed to solo attempts, or aptly put, personal glory."},{"metadata":{"trusted":true},"cell_type":"code","source":"play_by_play %>% \n  filter(AssistedFGM != \"None\") %>% \n  group_by(EventTeamID, AssistedFGM) %>% \n  summarise(n = n()) %>% \n  mutate(perc = n / sum(n)) %>% \n  filter(AssistedFGM == \"Solo\") %>% ungroup() %>% \n  left_join(teams %>% select(TeamID, TeamName), by = c(\"EventTeamID\" = \"TeamID\")) %>% arrange(perc) %>% \n  select(TeamName, PercentSolo = perc) %>% \n  mutate(PercentSolo = percent(PercentSolo)) %>% head(12) %>% \n  DT::datatable()","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"# Teamwork or Personal Glory: A Player Perspective\nEventPlayerID is a column of interest in the play- by -play data frame created at the outset of the analysis. A quick view of the column revealed rows containing \"zero\" value. This could could either be a random error, or an impute value for missing data. Since the missing records form just 0.2% (6780/3135775 x 100) of the entire column data, they were excluded from the analysis."},{"metadata":{"trusted":true},"cell_type":"code","source":"summary(play_by_play$EventPlayerID) # Zero is an indication of an error in the input data or a misssing value\nsum(play_by_play$EventPlayerID == 0) #6780 likely missing data\n\nshot_attempts <- play_by_play %>% \n  filter(EventPlayerID != 0 | EventPlayerID2 != 0 | EventPlayerID2 != \"NA\" ) %>% # Missing records exclusion\n  filter(FGVariable == \"Yes\") %>% \n  group_by(EventPlayerID) %>% \n  summarise(n_attempts = n(),\n            n_games = n_distinct(GameID),\n            n_seasons = n_distinct(Season)) %>% ungroup() %>%\n  mutate(avg_attempts = n_attempts / n_games) %>% \n  arrange(desc(n_attempts)) %>% \n  left_join(players, by = c(\"EventPlayerID\" = \"PlayerID\")) %>% \n  mutate(TeamID = as.integer(TeamID)) %>% \n  left_join(teams %>% select(TeamID, TeamName), by = \"TeamID\")","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"On the average, players made 278 shots since the 2015 season. However, if every player started their career in 2015 and played from 2015 - 2019, then the average shot attempts would naturally be higher."},{"metadata":{"trusted":true},"cell_type":"code","source":"shot_attempts %>%\n  ggplot(aes(x= n_attempts)) +\n  geom_histogram(fill = plot_cols[1], colour = \"grey\") +\n  geom_vline(xintercept = mean(shot_attempts$n_attempts), linetype = 2) +\n  annotate(\"text\", x=600, y= 1600, label = paste0(\"Average player\\ntook \", round(mean(shot_attempts$n_attempts)), \" shots\"), colour = \"blue\", size = 5) +\n  labs(x= \"Shot Attempts\", y= \"Number of players\") +\n  scale_x_continuous(labels = comma) +\n  scale_y_continuous(labels = comma) +\n  ggtitle(\"SOME VOLUME SHOOTERS SINCE 2015\") +\n  theme_akeem()","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Exploring the shooting volume further, the highest 10 shot takers by volume from 2015 - 2019 is diplayed below. All players on the list, with the exception of Kelsey Plum played for the entire four seasons. As a Nigerian-American, it was a joy to see a compatriot - Arike Ogunbowale on the prestigious list. \n\nArike's presence in the top 10 shot takers further reinforces the hypothesis that players whose college basketball career spanned the entire 4 seasons stood a better chance of being among the top shot takers. Arike's impressive record earned her draft pick for the Dallas Wings."},{"metadata":{"trusted":true},"cell_type":"code","source":"shot_attempts %>% \n  arrange(desc(n_attempts)) %>% head(10) %>% \n  ggplot(aes(x= reorder(paste0(FirstName, \" \", LastName), n_attempts), y= n_attempts)) +\n  geom_col(fill = plot_cols[1], colour = \"grey\") +\n  geom_text(aes(label = paste(\"(\", n_seasons, \" seasons)\")), y=250, colour = \"white\", size = 5, hjust = 0) +\n  ggtitle(\"10 HIGHEST SHOT TAKERS\") +\n  labs(y= \"Number of attempts\") +\n  coord_flip() +\n  theme_akeem() +\n  theme(axis.title.y = element_blank(), plot.title = element_text(hjust = 0.5))","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Data can be deceptful if explored in a biased manner or through a myopic mindset. Hence, the top 10 shot takers was explored again by giving consideration to average shot attempts over the 4 seasons i.e. 2015 - 2019. As shown in the histogram below, the list is dominated by different college class except Senior year (4 years/seasons). This suggest that some promising talents are on their way to getting drafted after college. "},{"metadata":{"trusted":true},"cell_type":"code","source":"shot_attempts %>% \n  arrange(desc(avg_attempts)) %>% head(10) %>% \n  ggplot(aes(x= reorder(paste0(FirstName, \" \", LastName), avg_attempts), y= avg_attempts)) +\n  geom_col(fill = plot_cols[3], colour = \"grey\") +\n  geom_text(aes(label = paste(\"(\", n_seasons, \" seasons)\")), y=3, colour = \"white\", size = 5, hjust = 0) +\n  ggtitle(\"10 HIGHEST AVERAGE SHOT TAKERS\", subtitle = \"Dominated by Freshwomen, Sopohomores, \\nand Juniors\") +\n  labs(y= \"Average attempts\") +\n  coord_flip() +\n  theme_akeem() +\n  theme(axis.title.y = element_blank())","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"# What type of shots are the top players taking?\nTop players like Jess Kovatch and Kelsey Mitchell shots are mostly 3-point field goals, which explains why they made it to the top scorers list. Arike Ogunbowale's favorite shot type seems to be 2-point jump. Generally, the popular shot types among the the top 10 players are 2-point and 3-point jumps.\n"},{"metadata":{"trusted":true},"cell_type":"code","source":"top_10_fga <- shot_attempts %>% \n  arrange(desc(n_attempts)) %>% head(10) %>% pull(EventPlayerID)\n\n\nplay_by_play %>% \n  filter(EventPlayerID %in% top_10_fga) %>% \n  filter(FGVariable == \"Yes\") %>% \n  select(GameID, EventPlayerID, EventType, shot_outcome, AttemptType, AssistedFGM) %>% \n  left_join(players, by = c(\"EventPlayerID\" = \"PlayerID\")) %>% \n  group_by(GameID, EventPlayerID, FirstName, LastName, AttemptType) %>% \n  summarise(n_attempts = n()) %>% \n  mutate(perc_shots = n_attempts / sum(n_attempts)) %>%  ungroup() %>% \n  ggplot(aes(x= AttemptType, y= n_attempts, fill = AttemptType)) +\n  geom_boxplot(colour = \"grey\") + \n  scale_fill_manual(values = plot_cols[c(1,4,5)]) +\n  facet_wrap(~ paste0(FirstName, \" \", LastName), scales = \"free_y\") +\n  ggtitle(\"WHERE DO THEIR SHOTS COME FROM?\", subtitle = \"The per game distribution of shot types by the top 10 shot takers\") +\n  theme_akeem() +\n  theme(axis.text.x = element_blank(), axis.title.x = element_blank(), axis.title.y = element_blank())","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"## Unassisted Attempts\nThe solo field goals chart showed that Kelsey Plum is the top unasssisted shot taker. What makes this information more interesting is that the record only accounted for three three (3) seasons of her college career. According to a wikipedia report, She enrolled at the University of Washington in 2014 and became the first overall pick in the 2017 Women National Basketball Association (WNBA) draft. Going by the chart, that feat did not come as a surprise."},{"metadata":{"trusted":true},"cell_type":"code","source":"play_by_play %>% \n  filter(EventPlayerID %in% top_10_fga) %>% \n  filter(FGVariable == \"Yes\") %>% \n  filter(AssistedFGM != \"None\") %>% \n  select(GameID, EventPlayerID, EventType, shot_outcome, AttemptType, AssistedFGM) %>% \n  left_join(players, by = c(\"EventPlayerID\" = \"PlayerID\")) %>% \n  group_by(EventPlayerID, FirstName, LastName, AssistedFGM) %>% \n  summarise(n_attempts = n()) %>% \n  mutate(perc_shots = n_attempts / sum(n_attempts)) %>%  ungroup() %>% \n  filter(AssistedFGM == \"Solo\") %>% \n  ggplot(aes(x= reorder(paste0(FirstName, \" \", LastName),perc_shots), y= perc_shots)) +\n  geom_col(fill = plot_cols[1], colour = \"grey\") +\n  geom_text(aes(label = percent(round(perc_shots, 2))), hjust=1, size = 5, color = \"white\") +\n  scale_y_continuous(limits = c(0,1.1)) +\n  coord_flip() +\n  ggtitle(\"Solo Field Goals Percentage \\nby Top 10 Shot Takers\") +\n  theme_akeem(legend_pos = \"none\") +\n  theme(axis.title.y = element_blank(), axis.title.x = element_blank(), axis.text.x = element_blank(), \n        panel.grid.major = element_blank(), panel.grid.minor = element_blank())\n","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"# NCAA Tournament Analysis\nThe first section will be focused on exploring some high level analysis of the NCAA tournament over the last 34 seasons. Specifically, the top winners and the biggest bridesmaides of the tournament history. Further, the winning seed will be explored, same as the strong conferences.\n\n\n## Historical Top Winners and Runner-ups?\nStats tells a bunch. Notre Dame has always being a force to reckon with in college female basketball. Same school produced the superstar Arike Ogunbowale!"},{"metadata":{"trusted":true},"cell_type":"code","source":"# Join team names to tourney compact dataset\n\nglimpse(tourney_stats_compact)\nglimpse(teams)\ntourney_stats_compact <- tourney_stats_compact %>%\n  left_join(teams, by = c(\"WTeamID\" = \"TeamID\")) %>%\n  left_join(teams, by = c(\"LTeamID\" = \"TeamID\"))\n \n\ntourney_stats_compact <- tourney_stats_compact %>%\n  rename(WTeamName = TeamName.x,\n         LTeamName = TeamName.y)\n\ntourney_stats_compact$season_day <- paste(tourney_stats_compact$Season, tourney_stats_compact$DayNum, sep = \"_\")\n\n# then create a feature to label the round of the tournament\ntourney_stats_compact <- tourney_stats_compact %>%\n  mutate(TourneyRound = ifelse(DayNum %in% c(136, 137), \"First Round\", ifelse(DayNum %in% c(138, 139), \"Second Round\", ifelse(DayNum %in% c(143, 144), \"Sweet 16\", ifelse(DayNum %in% c(145, 146), \"Elite 8\", ifelse(DayNum == 152, \"Final Four\", \"Championship Game\")))))) %>%\n  mutate(TourneyRound = factor(TourneyRound, levels = c(\"First Round\", \"Second Round\", \"Sweet 16\", \"Elite 8\", \"Final Four\", \"Championship Game\")))\n\nncaa_champs <- tourney_stats_compact %>%\n  group_by(Season) %>%\n  summarise(max_days = max(DayNum)) %>%\n  mutate(season_day = paste(Season, max_days, sep = \"_\")) %>%\n  left_join(tourney_stats_compact, by = \"season_day\") %>% ungroup() %>%\n  select(-Season.y) %>%\n  rename(Season = Season.x)\n\nwin_plot <- ncaa_champs %>%\n  group_by(WTeamName) %>%\n  summarise(n = n()) %>%\n  ggplot(aes(x=reorder(WTeamName,n), y=n)) +\n  geom_bar(stat = \"identity\", fill = plot_cols[1], color = \"grey\") +\n  labs(title = \"NOT HARD TO IDENTIFY POWER SCHOOLS\", subtitle = \"Most Tourney Wins \\nsince 1985\") +\n  coord_flip() +\n  theme_akeem() +\n  theme(axis.title.x = element_blank(), axis.title.y = element_blank())\n\n\nlose_plot <- ncaa_champs %>%\n  group_by(LTeamName) %>%\n  summarise(n = n()) %>%\n  ggplot(aes(x=reorder(LTeamName, n), y=n)) +\n  geom_bar(stat = \"identity\", fill = plot_cols[3], colour = \"grey\") +\n  labs(title = \"\", subtitle = \"Most Tourney Runner-Ups \\nsince 1985\") +\n  coord_flip() +\n  theme_akeem() +\n  theme(axis.title.x = element_blank(), axis.title.y = element_blank())\n\ngrid.arrange(win_plot, lose_plot, ncol = 2)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"# Conferences with the most wins?\nThe Big East Conference and Southeastern Conference are the top two leading female college basketball conferences."},{"metadata":{"trusted":true},"cell_type":"code","source":"ncaa_champs %>%\n  select(Season, TeamID = WTeamID) %>%\n  left_join(team_conferences, by = c(\"Season\", \"TeamID\")) %>%\n  left_join(conferences, by = \"ConfAbbrev\") %>%\n  count(Description) %>%\n  ggplot(aes(x= reorder(Description, n), y= n)) +\n  geom_col(fill = plot_cols[1], color = \"grey\") +\n  geom_text(aes(label = n), hjust = 1, size = 6, color = \"white\") +\n  labs(title = \"POWER CONFERENCES LEAD THE WAY\", subtitle = \"Conferences with the most titles since 1985\") +\n  coord_flip() +\n  theme_akeem() +\n  theme(axis.title.x = element_blank(), axis.title.y = element_blank(), axis.text.x = element_blank()) ","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"## Seeds with the most titles\nThe chart showed that seed 1 won most of the titles (18) over the years, followed closely by seed 2."},{"metadata":{"trusted":true},"cell_type":"code","source":"\ntourney_seeds$Seed <- as.integer(str_extract_all(tourney_seeds$Seed, \"[0-9]+\"))\n\nglimpse(tourney_seeds)\n\nncaa_champs %>%\n  select(Season, TeamID = WTeamID) %>%\n  left_join(tourney_seeds, by = c(\"Season\", \"TeamID\")) %>%\n  count(Seed, sort = T) %>%\n  mutate(Seed = as.character(Seed)) %>%\n  ggplot(aes(x= reorder(Seed, n), y= n)) +\n  geom_segment(aes(x= Seed, xend = Seed, y= 0, yend = n), color = plot_cols[2], size = 1) +\n  geom_point(size = 4, color = plot_cols[3]) +\n  scale_y_continuous(labels = c(\"0\", \"5\", \"10\", \"15 Titles\", \"\")) +\n  coord_flip() +\n  theme_akeem() +\n  theme(axis.title.x = element_blank(), axis.title.y = element_blank()) +\n  ggtitle(\"Seeds with the Most Titles\")","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"## Averages Per Season\nThis section is dedicated to analysing the average team stats per regular season. The individual team stats were first summarised for each season, then the average for each season was computed."},{"metadata":{"trusted":true},"cell_type":"code","source":"## calculate possessions per game statistic: field goal attempts + 0.475 x free throw attempts - offensive rebounds + turnovers\n\n# regular season\nreg_season_stats <- reg_season_stats %>%\n  mutate(WPoss = WFGA + (WFTA * 0.475) + WTO - WOR,\n         LPoss = LFGA + (LFTA * 0.475) + LTO - LOR)\n\n\n# Tourney\ntourney_stats <- tourney_stats %>%\n  mutate(WPoss = WFGA + (WFTA * 0.475) + WTO - WOR,\n         LPoss = LFGA + (LFTA * 0.475) + LTO - LOR)\n\n\n#---------- tidy data for regular season totals ----------#\n\n# First I will define a function that will take the detailed results data and reshape it so that it results in a dataframe where \n# each observation is a team for that season and their totals statistics for that season. It will also calculate the statistics allowed\n# for the season. This function only requires one parameter to be passed to it: either the regular season or Tourney detailed data.\n\n# IMPORTANT: #\n# The data required for this function to work is either the regular season or tourney detailed stats, and the \"teams\" dataset\n\nreshape_detailed_results <- function(detailed_dataset) {\n  \n  season_team_stats_tot <- rbind(\n    detailed_dataset %>%\n      select(Season, DayNum, TeamID=WTeamID, Score=WScore, OScore=LScore, WLoc, NumOT, Poss=WPoss, FGM=WFGM, FGA=WFGA, FGM3=WFGM3,  FGA3=WFGA3, FTM=WFTM, FTA=WFTA, OR=WOR,\n             DR=WDR, Ast=WAst, TO=WTO, Stl=WStl, Blk=WBlk, PF=WPF, OPoss=LPoss, OFGM=LFGM, OFGA=LFGA, OFGM3=LFGM3, OFGA3=LFGA3, OFTM=LFTM, OFTA=LFTA, O_OR=LOR, ODR=LDR,\n             OAst=LAst, OTO=LTO, OStl=LStl, OBlk=LBlk, OPF=LPF) %>%\n      mutate(Winner=1),\n    \n    detailed_dataset %>%\n      select(Season, DayNum, TeamID=LTeamID, Score=LScore, OScore=WScore, WLoc, NumOT, Poss=LPoss, FGM=LFGM, FGA=LFGA, FGM3=LFGM3,  FGA3=LFGA3, FTM=LFTM, FTA=LFTA, OR=LOR,\n             DR=LDR, Ast=LAst, TO=LTO, Stl=LStl, Blk=LBlk, PF=LPF, OPoss=WPoss, OFGM=WFGM, OFGA=WFGA, OFGM3=WFGM3, OFGA3=WFGA3, OFTM=WFTM, OFTA=WFTA, O_OR=WOR, ODR=WDR,\n             OAst=WAst, OTO=WTO, OStl=WStl, OBlk=WBlk, OPF=WPF) %>%\n      mutate(Winner=0)) %>%\n    group_by(Season, TeamID) %>%\n    summarise(GP = n(),\n              wins = sum(Winner),\n              TotPoints = sum(Score),\n              TotPointsAllow = sum(OScore),\n              NumOT = sum(NumOT),\n              TotPos = sum(Poss),\n              TotFGM = sum(FGM),\n              TotFGA = sum(FGA),\n              TotFGM3 = sum(FGM3),\n              TotFGA3 = sum(FGA3),\n              TotFTM = sum(FTM),\n              TotFTA = sum(FTA),\n              TotOR = sum(OR),\n              TotDR = sum(DR),\n              TotAst = sum(Ast),\n              TotTO = sum(TO),\n              TotStl = sum(Stl),\n              TotBlk = sum(Blk),\n              TotPF = sum(PF),\n              TotPossAllow = sum(OPoss),\n              TotFGMAllow = sum(OFGM),\n              TotFGAAllow = sum(OFGA),\n              TotFGM3Allow = sum(OFGM3),\n              TotFGA3Allow = sum(OFGA3),\n              TotFTMAllow = sum(OFTM),\n              TotFTAAllow = sum(OFTA),\n              TotORAllow = sum(O_OR),\n              TotDRAllow = sum(ODR),\n              TotAstAllow = sum(OAst),\n              TotTOAllow = sum(OTO),\n              TotStlAllow = sum(OStl),\n              TotBlkAllow = sum(OBlk),\n              TotPFAllow = sum(OPF))\n  \n}\n\n## Store the results to a dataframe\nseason_team_stats_tot <- reshape_detailed_results(reg_season_stats)\n\n## calculate win percentage\nseason_team_stats_tot$WinPerc <- season_team_stats_tot$wins / season_team_stats_tot$GP\n\n\n\n#---------- Create a dataframe of season averages for each team ----------#\n\n# Next I will define a function that takes in the totals dataframe from the above function and calculate a season averages dataset.\n# this function also only requires one parameter to be passed to it, the totals dataframe.\n\ncalculate_detailed_averages <- function(totals_dataframe) {\n  \n  averages <- totals_dataframe\n  \n  cols <- names(averages[,c(5:35)])\n  \n  for (eachcol in cols) {\n    averages[,eachcol] <- round(averages[,eachcol] / averages$GP,2)\n    \n  }\n  \n  averages <- averages %>%\n    rename(AvgPoints = TotPoints, AvgPointsAllow=TotPointsAllow, AvgOT=NumOT, AvgPoss=TotPos, AvgFGM=TotFGM,  AvgFGA=TotFGA, AvgFGM3=TotFGM3, AvgFGA3=TotFGA3, AvgFTM=TotFTM,\n           AvgFTA=TotFTA, AvgOR=TotOR, Avg_DR=TotDR, AvgAst=TotAst, AvgTO=TotTO, AvgStl=TotStl, Avg_Blk=TotBlk, AvgPF=TotPF, AvgPossAllow=TotPossAllow, AvgFGMAllow=TotFGMAllow, \n           AvgFGAAllow=TotFGAAllow,  AvgFGM3Allow=TotFGM3Allow, AvgFGA3Allow=TotFGA3Allow,  AvgFTMAllow=TotFTMAllow, AvgFTAAllow=TotFTAAllow, \n           AvgORAllow=TotORAllow, AvgDRAllow=TotDRAllow,  AvgAstAllow=TotAstAllow, AvgTOAllow=TotTOAllow, AvgStlAllow=TotStlAllow,  AvgBlkAllow=TotBlkAllow,\n           AvgPFAllow=TotPFAllow) %>%\n    mutate(PointsPerPoss = AvgPoints / AvgPoss,\n           PointsPerPossAllow = AvgPointsAllow / AvgPossAllow)\n  \n  return(averages)\n  \n}\n\n\n# create an averages dataframe\nseason_team_stats_averages <- calculate_detailed_averages(season_team_stats_tot)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"1. Points per Game \nThe average points per game suffered a decline between 2010 and 2012, and then reached an all time high in 2013. \n\n2. Possessions per Game\nThe Possessions per Game followed a similar trend as the Points per Game. This is expected since scoring is contigent on ball possession. It will be interesting to see if possessions goes up in the 2020 season after the shot clock has been shortened in certain situations.\n\n3. Three Pointers Made and Attempted\nIt’s a fairly well known trend that the average number of threes attempted and made has been steadily increasing over the years. This trend continued in the 2019 season. It will be interesting to see the 2020 data once released, as the NCAA instituted a change this season that pushed the three-point line back to the international distance.\n\n4. Average Free Throws Made and Attempted\nThe Average Free Throws Made and Attempted has been consistent over the years, but an upshoot in the numbers was seen in the 2013 season. This is not unusual since the same 2013 season recorded the highest number of Points per Game and Possessions per Game.\n\n5. Average Assists\nThe stats mirrored the typical upward trend of a stock in a stock exchange market. There are some dips, but overall, the average asssists per season has been on the rise.\n\n6. Average Defensive Rebounds\nThere are on average more defensive rebounds occurring. This could be attributed to the increase in field goals attempt over the years."},{"metadata":{"trusted":true},"cell_type":"code","source":"a1 <- season_team_stats_averages %>%\n  group_by(Season) %>%\n  summarise(AvgPoints = mean(AvgPoints)) %>%\n  ggplot(aes(x= Season, y= AvgPoints, group = 1)) +\n  geom_line(color = plot_cols[1], size = 1) +\n  geom_point(size = 2, color = plot_cols[2]) +\n  labs(title = \"Average Points \\nPer Game\") +\n  theme_akeem() +\n  theme(axis.title.y = element_blank())\n\na2 <- season_team_stats_averages %>%\n  group_by(Season) %>%\n  summarise(AvgPoss = mean(AvgPoss)) %>%\n  ggplot(aes(x= Season, y= AvgPoss, group = 1)) +\n  geom_line(color = plot_cols[1], size = 1) +\n  geom_point(size = 2, color = plot_cols[2]) +\n  labs(title = \"Average Possession \\nPer season\") +\n  theme_akeem() +\n  theme(axis.title.y = element_blank())\n\na3 <- season_team_stats_averages %>% ungroup() %>%\n  select(Season, AvgFGA3, AvgFGM3) %>%\n  gather(key = \"Stat\", value = \"Average\", -Season) %>%\n  group_by(Season, Stat) %>%\n  summarise(Average = mean(Average)) %>%\n  ggplot(aes(x= Season, y= Average, group = Stat, colour = Stat)) +\n  geom_line(size = 1) +\n  geom_point(size = 2) +\n  scale_color_manual(values = c(plot_cols[1], plot_cols[3])) +\n  labs(title = \"Average threes \\nmade & attempted\") +\n  theme_akeem() +\n  theme(axis.title.y = element_blank())\n\na4 <- season_team_stats_averages %>% ungroup() %>%\n  select(Season, AvgFTA, AvgFTM) %>%\n  gather(key = \"Stat\", value = \"Average\", -Season) %>%\n  group_by(Season, Stat) %>%\n  summarise(Average = mean(Average)) %>%\n  ggplot(aes(x= Season, y= Average, group = Stat, colour = Stat)) +\n  geom_line(size = 1) +\n  geom_point(size = 2) +\n  scale_color_manual(values = c(plot_cols[1], plot_cols[3])) +\n  labs(title = \"Free Throws \\n Attempted\") +\n  theme_akeem() +\n  theme(axis.title.y = element_blank())\n\na5 <- season_team_stats_averages %>%\n  group_by(Season) %>%\n  summarise(AvgAst = mean(AvgAst)) %>%\n  ggplot(aes(x= Season, y= AvgAst, group = 1)) +\n  geom_point(size = 2, color = plot_cols[2]) +\n  geom_line(color = plot_cols[1], size = 1) +\n  labs(title = \"Average Assists \\nPer Season\") +\n  theme_akeem() +\n  theme(axis.title.y = element_blank())\n\na6 <- season_team_stats_averages %>% ungroup() %>%\n  select(Season, AvgOR, Avg_DR) %>%\n  gather(key = \"Stat\", value = \"Average\", -Season) %>%\n  group_by(Season, Stat) %>%\n  summarise(Average = mean(Average)) %>%\n  ggplot(aes(x= Season, y= Average, group = Stat, colour = Stat)) +\n  geom_line(size = 1) +\n  geom_point(size = 2) +\n  scale_color_manual(values = c(plot_cols[1], plot_cols[3])) +\n  labs(title = \"Defensive Rebounds\") +\n  theme_akeem() +\n  theme(axis.title.y = element_blank())\n\ngrid.arrange(a1, a2, a5, a3, a4, a6, ncol = 3)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"# Tournament Vs Regular Season\nThis section is focused on exploring the differences in the key statistics between regular season and tournament games for winning teams. It is expected that the players would be playing under different circumstances and the pressure would be different, depending on what is at stake."},{"metadata":{"trusted":true},"cell_type":"code","source":"# create a variable to distinguish between the regular season and tournament stats\nreg_season_stats$Type <- \"RegularSeason\"\ntourney_stats$Type <- \"Tournament\"\n\n# join the regular season and tourney detailed stats\njoined_reg_tourney <- rbind(reg_season_stats, tourney_stats)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"## Scoring Points\nThe margins in the regular season games are higher than tournament games. This makes sense because tournaments are generally more competitive and are comprised of strong teams. Hence, the margins are usually tight."},{"metadata":{"trusted":true},"cell_type":"code","source":"a <- joined_reg_tourney %>%\n  ggplot(aes(x= WScore, fill = Type)) +\n  geom_density(alpha = 0.5) +\n  scale_fill_manual(values = c(plot_cols[1], plot_cols[5])) +\n  ggtitle(\"POINTS & MARGINS IN THE TOURNEY vs REGULAR \\nSEASON\") +\n  labs(x= \"Winning Team Score\", y= \"\") +\n  theme_akeem() +\n  theme(legend.position = \"top\", legend.title = element_blank())\n\nb <- joined_reg_tourney %>%\n  mutate(Margin = WScore - LScore) %>%\n  ggplot(aes(x= Margin, fill = Type)) +\n  geom_density(alpha = 0.5) +\n  scale_fill_manual(values = c(plot_cols[1], plot_cols[5])) +\n  labs(y= \"\") +\n  theme_akeem() + \n  theme(legend.position = \"none\")\n\ngrid.arrange(a, b)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"## Margins over the Years\nWith the exception of 2011 and 2015 seasons, the rest of the seasons from 2010 to 2019 had significant difference in margins between regular and tournament games."},{"metadata":{"trusted":true},"cell_type":"code","source":"joined_reg_tourney %>%\n  mutate(Margin = WScore - LScore) %>%\n  ggplot(aes(x= Margin, fill = Type)) +\n  geom_density(alpha = 0.5) +\n  scale_fill_manual(values = c(plot_cols[1], plot_cols[5])) +\n  ggtitle(\"MARGINS IN THE TOURNEY vs REGULAR SEASON \\nOVER THE YEARS\") +\n  labs(y= \"\") +\n  theme_akeem() + \n  theme(legend.position = \"top\", legend.title = element_blank(), strip.text = element_text(face = \"bold\")) + \n  facet_wrap(~ Season)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"\n# Field Goals\nTHe mean of Field Goals in tournament games is higher than regular season."},{"metadata":{"trusted":true},"cell_type":"code","source":"a <- joined_reg_tourney %>%\n  ggplot(aes(x= WFGA, fill = Type)) +\n  geom_density(alpha = 0.5) +\n  scale_fill_manual(values = c(plot_cols[1], plot_cols[5])) +\n  ggtitle(\"FGA TOURNEY vs REGULAR SEASON\", subtitle = \"Field Goal Attempts by winning team in the regular \\nseason and tourney roughly the same\") +\n  labs(x= \"Winning Team FG Attempted\", y= \"\") +\n  theme_akeem() +\n  theme(legend.position = \"top\", legend.title = element_blank())\n\nb <- joined_reg_tourney %>%\n  ggplot(aes(x= WFGM, fill = Type)) +\n  geom_density(alpha = 0.5, adjust = 1.5) +\n  scale_fill_manual(values = c(plot_cols[1], plot_cols[5])) +\n  ggtitle(\"FGM TOURNEY vs REGULAR SEASON\", subtitle = \"Winning Team has more slightly more\\nField Goals Made during the tourney\") +\n  labs(x= \"Winning Team FG Made\", y= \"\") +\n  theme_akeem() +\n  theme(legend.position = \"none\")\n\ngrid.arrange(a,b)\n","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"## Field Goals Attempt over the Years\nGoing by the gaussian distribution of Field Goal Attempts (FGAs) over the years, Tournamemnt games had more FGAs over the years."},{"metadata":{"trusted":true},"cell_type":"code","source":"joined_reg_tourney %>%\n  ggplot(aes(x= WFGA, fill = Type)) +\n  geom_density(alpha = 0.5) +\n  scale_fill_manual(values = c(plot_cols[1], plot_cols[5])) +\n  ggtitle(\"FGAs TOURNEY vs REGULAR SEASON OVER \\nTHE YEARS\") +\n  labs(x= \"Winning Team FG Attempted\", y= \"\") +\n  theme_akeem() +\n  theme(legend.position = \"top\", legend.title = element_blank(), strip.text = element_text(face = \"bold\")) +\n  facet_wrap(~ Season)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"\n# Rebounds\nThe offensive rebound chart suggested that there was no remarkable difference between regular season and tournament games. However, the mean and standard deviation of defensive rebounds in tournament games are higher than regular season games."},{"metadata":{"trusted":true},"cell_type":"code","source":"a <- joined_reg_tourney %>%\n  ggplot(aes(x= WOR, fill = Type)) +\n  geom_density(alpha = 0.5, adjust = 1.5) +\n  scale_fill_manual(values = c(plot_cols[1], plot_cols[5])) +\n  ggtitle(\"OFFENSIVE REB: TOURNEY vs REGULAR SEASON\") +\n  labs(x= \"Winning Team Offensive Rebounds\", y= \"\") +\n  theme_akeem() +\n  theme()\n\nb <- joined_reg_tourney %>%\n  ggplot(aes(x= WDR, fill = Type)) +\n  geom_density(alpha = 0.5, adjust = 1.5) +\n  scale_fill_manual(values = c(plot_cols[1], plot_cols[5])) +\n  ggtitle(\"DEFENSIVE REB: TOURNEY vs REGULAR SEASON\") +\n  labs(x= \"Winning Team Defensive Rebounds\", y= \"\") +\n  theme_akeem(legend_pos = \"none\") +\n  theme()\n\ngrid.arrange(a, b)  ","execution_count":null,"outputs":[]}],"metadata":{"kernelspec":{"display_name":"R","language":"R","name":"ir"},"language_info":{"mimetype":"text/x-r-source","name":"R","pygments_lexer":"r","version":"3.4.2","file_extension":".r","codemirror_mode":"r"}},"nbformat":4,"nbformat_minor":4}