{"cells":[{"metadata":{},"cell_type":"markdown","source":"**Objective: Understanding the NFL Injury patterns and defining the right insights and recommendations for prevention**\n\n***Date: 2nd January, 2019***\n\n***Author:*** \n- Jigyasu Juneja(jigyasu10: https://www.kaggle.com/datasj) \n\n- Pavan Shah(PShah: https://www.kaggle.com/pshah27)\n***\n\n**Data used:**\n\nThere are three files provided in the dataset, as described below:\n\n1. Injury Record: The injury record file contains information on 105 lower-limb injuries that occurred during regular season games over the two seasons. Injuries can be linked to specific records in a player history using the PlayerKey, GameID, and PlayKey fields.\n\n2. Play List: – The play list file contains the details for the 267,005 player-plays that make up the dataset. Each play is indexed by PlayerKey, GameID, and PlayKey fields. Details about the game and play include the player’s assigned roster position, stadium type, field type, weather, play type, position for the play, and position group.\n\n3. Player Track Data: player level data that describes the location, orientation, speed, and direction of each player during a play recorded at 10 Hz (i.e. 10 observations recorded per second).\n***\nSubmissions will be judged by the NFL based on how well they address:\n\n1. Representation of player movement, including, but not limited to, the development of novel metrics that characterize player movement on the field:\n2. Identification of specific variables that present an elevated risk of injury:\n3. Evaluation of differences in player movement between playing surfaces:\n\nSubmissions will be scored using the following rubric:\n\n1. Creativity and Presentation (5 points)\n2. Methodology (5 points)\n3. Application (5 points)"},{"metadata":{},"cell_type":"markdown","source":"<h1> Recommendations and Next Steps"},{"metadata":{},"cell_type":"markdown","source":"\nBased on the insights we have seen there are multiple ways we can reduce the injury or chances of injury\n\n***Field Type***\n- If we can replace the synthetic field type with natural it will be have a significant effect on reducing the injuries. \n\n   ***Detailed recommendation***\n   - However, we understand there may be cost challenges to replace synthetic fields everywhere, thus if we can get more data around injuries before synthetic fields were introduced and why specifically synthetic fields are harmful for players. \n   - It will also be good to understand do players who dont train on them get injured like what is their home field type if it is not synthetic\n   \n***Weather and Stadium type***\n\n- Although we see controlled climate and indoor stadium leads to more injuries, we understand it is something which can not be controlled easily but we can simulate these conditions in training and prepare players accordingly\n\n- If there are equipments (eg cloth material, leather type) which can help players get accustomed these conditions like it seems ventilation is an issue with both controlled climate and indoor stadium, \n\n***Player movement***\n\n- In the play itself, tell players where the orientation and acceleration are beyond critical limits which can lead to injury which sort of gives them an alert to balance or change their current movement pattern\n- Include balance + acceleration strength trainins in their regime for the players such as WR, DB and RB which are generally the faster ones to balance more pre and post impact\n\n***Data Science Analysis***\n\n1. Using clustering on the players profiles to identify how they are similar to each other for both injured and non injured player\n\n2. If we can get the player info, their mass, age, height, how many people tackled the player if someone did to understand and define impact of hit (like for example gmax/gforce of the hit) and see how it affects the injury or not\n\n3. Using a detailed data to create an ML/DL model with further features which may impact injury and also study interaction movements \n\n4. We can also use image/video data to predict the sequence of movements and how it relates to injuries eventually and use the simulations in the practice sessions"},{"metadata":{},"cell_type":"markdown","source":"<h2> Executive Summary"},{"metadata":{},"cell_type":"markdown","source":"***Field Type***\n\n\n - Synthetic field type presents a greater and more severe risk of injury than natural type.\n - Most of the injured players tend to be defensive players (LBs, DBs, DLs). WRs tend to be the most injured offensive players.\n - Injuries resulting in greater number of games missed occur on synthetic field type. Of the injuries recorded, implied games missed have been greater (+45) on synthetic field type than natural.\n - 0.88% more chance of injury per game on synthetic turf than natural\n - Synthetic leads to on an average higher injury game plays\n \n***Play Type***\n\n\n - Most of the injuries occur on passing plays.\n - Greater proportion of plays involving punts and PATs\\nend in injury on Synthetic\n - Pass and Rush have 50% and 100% more chances in leading to injury on Synthetic than Natural field\n \n***Stadium Type***\n\n - Overwhelming # of injuries occur in outdoor stadiums. \n - Chance of injuries are 100% higher in both indoor closed and open as compared to outdoor.\n\n***Injury Type***\n\n  - Most of the games missed are due to injuries to knee and ankle.\n  - Foot injuries generally longer recovery times\n  - Body part injured seems to differ based on player's position on the play \n  - 86% of the injury records made up by knees and ankles\n \n***Movement Insights***\n\n***Speed***\n\n - Average Player Speed is higher on plays where injuries occur\n\n***Acceleration***\n\n  - On an average the median de acceleration for injured players was less than those not injured\n\n***Orientation***\n\n - The average dispersion of the orientation of injured players is 15 points more than non injured players. However, we dont see this difference in direction for the same metric.\n\n***Position Type*** \n\n  - WRs and DBs are the fastest of any player that has gotten injured with median speed of > 8 yards/sec.\n  - WRs,DBs and RBs tend to be faster on synthetic field type \n  - Knee and ankle injuries on synthetic field type are correlated with higher median speed.\n \n***Time of Play***\n - Players most likely injured in week8. The injury rate peaks at week 3 to 3.6%\n \n***Temp and Weather*** \n  - While injuries tend to occur in slightly higher temperatures, doesn't look significant\n  - Controlled climate and rain have 100% higher chances of injury than other weather conditions\n  \n  \n "},{"metadata":{},"cell_type":"markdown","source":"<h2> Statistical Tests Summary and GBM model output </h2>\n\n\n- To quantify potential relationship between categorical variables and if the injury happens or not we used the [chi square](https://en.wikipedia.org/wiki/Chi-squared_test) and [Cramer V](http://changingminds.org/explanations/research/analysis/cramers_v.htm) as a baseline test. We get the following insights:\n  -  For field type and injury the p value comes out to be significant which means that the field type has an effect on injury for the   players at the same time cramer V shows some correlation\n\n\n- The important features from the baseline gbm with 1500 trees come out to be the following:\n  - Play Type\n  - Weather\n  - Position\n  - Stadium Type\n  - Field Type\n  - Max acceleration\n  - Minimum orientation\n  - Median acceleration\n  - Max orientation\n  - Standard deviation of orientation\n\nin the descending order or relative importance\n"},{"metadata":{},"cell_type":"markdown","source":"<h1> Solution Approach"},{"metadata":{},"cell_type":"markdown","source":"The notebook is divided across multiple sections with the following approach to work on the competition and answer the following questions\n\n<h3> Data Integrity and Quality </h3>\n\n- How does the data look like at the base level?\n\n- What does the variables mean?\n\n- Can we join these datasets? If yes, how?\n\n- What is the data quality post joins? \n\n- Do we have duplicates in our data?\n\n<h3> EDA </h3>\n\n- Can we answer all major questions using plots?\n\n- Do we need to aggregated various fields after creating master dataset?\n\n- What is the relationship between injury and following:\n    - Field Type\n    \n    - Play Type\n    \n    - Stadium Type\n    \n    - Weather\n    \n    - Temp\n    \n    - Position of player\n\n- How does the injury vary by following:\n    \n    - Field Type\n    \n    - Play Type\n    \n    - Stadium Type\n    \n    - Weather\n    \n    - Temp\n    \n    - Position of player\n    \n- How are the following movement variable affect the injuries:\n    \n    - Acceleration (Max, Min, Median)\n    \n    - Speed (Max, Min, Median)\n    \n    - Difference in acc across play (Max, Min, Median)\n    \n    - Orientation (Max, Min, Median)\n\n<h3> Statistical Tests and Models </h3>\n\n- Can we use basic statistical tests to understand relationship between categorical variables and injury?\n\n- Can we use basic models like gmb to predict injury and use feature importance to define relationship between variables and injury/not?\n    "},{"metadata":{"trusted":true},"cell_type":"code","source":"# Loading all the necessary packages\n\nlibrary(tidyverse)\nlibrary(ggplot2)\nlibrary(data.table)\nlibrary(RColorBrewer)\nlibrary(formattable)\nlibrary(gbm)\n","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"<h1> Data Quality and Integrity\n    "},{"metadata":{"trusted":true},"cell_type":"code","source":"# Loading the datasets\ninjury_record <- data.table::fread(\"../input/nfl-playing-surface-analytics/InjuryRecord.csv\", stringsAsFactors = F)\nplayer_track <- data.table::fread(\"../input/nfl-playing-surface-analytics/PlayerTrackData.csv\", stringsAsFactors = F)\nplay_list <- data.table::fread(\"../input/nfl-playing-surface-analytics/PlayList.csv\", stringsAsFactors = F)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"<h2> Preprocess the raw input data"},{"metadata":{"trusted":true},"cell_type":"code","source":"#Remove couple of variables that are otherwise useless\nplay_list <- play_list[,RosterPosition:= NULL]","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"<h2> Perform sanity checks, i.e. check for size, uniqueness, etc"},{"metadata":{"trusted":true},"cell_type":"code","source":"Check_Uniqueness<- function(...){\n    print(\"The number of unique PlayKeys in PlayerTrack Data are\") \n    print(player_track[,.(length(unique(PlayKey)))])\n    \n    print (\"The number of records in PlayerTrack Data are\")\n    print(player_track[,.N])\n    \n    print(\"The number of unique PlayKeys in PlayList Data are\")\n    print(play_list[,.(length(unique(PlayKey)))])\n    \n    print(\"The number of records in PlayList Data are\") \n    print(play_list[, .N])\n    \n    print(\"The number of unique PlayKeys in InjuryRecord Data are\")\n    print(injury_record[, .(length(unique(PlayKey)))])\n    \n    print(\"The number of records in Injury_Records Data are\") \n    print(injury_record[, .N])\n    \n    print(\"The number of unique PlayerKeys in PlayList Data are\")\n    print(play_list[,.(length(unique(PlayerKey)))])\n    \n    print(\"The number of unique GameIDs in PlayList Data are\")\n    print(play_list[,.(length(unique(GameID)))])\n    \n    print(\"The number of unique PlayerKeys in InjuryRecord Data are\")\n    print(injury_record[, .(length(unique(PlayerKey)))])\n    \n    \n    print(\"The number of unique GameID in InjuryRecord Data are\")\n    print(injury_record[, .(length(unique(GameID)))])\n}\n","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"#Run the check_uniqueness function\nCheck_Uniqueness()","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"**Understanding the datasets**"},{"metadata":{"trusted":true},"cell_type":"code","source":"head(play_list,2)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"head(injury_record,2)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"play_list %>%\n  count(StadiumType) %>%\n  rename(Count = n) %>%\n  mutate(Count = comma(Count)) %>% \n  head()","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"***We can club the categories here as there is lot of repetition***"},{"metadata":{"trusted":true},"cell_type":"code","source":"play_list %>%\n  count(Weather) %>%\n  rename(Count = n) %>%\n  mutate(Count = comma(Count)) %>% \n  head()","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"**Combining categories for stadium and weather**"},{"metadata":{"trusted":true},"cell_type":"code","source":"rain <- c('10% Chance of Rain','30% Chance of Rain','Cloudy with periods of rain, thunder possible. Winds shifting to WNW, 10-20 mph.','Cloudy, 50% change of rain','Cloudy, Rain','Light Rain','Rain','Rain Chance 40%','Rain likely, temps in low 40s.','Rain shower','Rainy','Scattered Showers','Showers')\nclear <- c('Clear','Clear and cold','Clear and Cool','Clear and Sunny','Clear and warm','Clear skies','Clear Skies','Clear to Partly Cloudy','Cold','Fair','Heat Index 95','Mostly sunny','Mostly Sunny','Mostly Sunny Skies','Partly clear','Partly sunny','Partly Sunny','Sun % clouds','Sunny','Sunny and clear','Sunny and cold','Sunny and warm','Sunny Skies','Sunny, highs to upper 80s','Sunny, Windy')\novercast <- c('cloudy','Cloudy','Cloudy and cold','Cloudy and Cool','Cloudy, chance of rain','Cloudy, fog started developing in 2nd quarter','Coudy','Hazy','Mostly cloudy','Mostly Cloudy','Mostly Coudy','Overcast','Partly cloudy','Partly Cloudy','Partly Clouidy','Party Cloudy')\ncontrolled_climate <- c('Controlled Climate','Indoor','Indoors','N/A (Indoors)','N/A Indoor')\nsnow <- c('Cloudy, light snow accumulating 1-3\"', 'Heavy lake effect snow','Snow')\n\nclean_weather <- function(x) {\n  if (x %in% rain) {\n    \"Rain\"\n  } else if(x %in% clear) {\n    \"Clear\"\n  } else if(x %in% overcast){\n    \"Overcast\"\n  } else if(x %in% controlled_climate){\n    \"Controlled Climate\"\n  } else if(x %in% snow){\n    \"Snow\"\n  }\n  else {\n    \"unknown\"\n  }\n}\n\n# Set Categories for Stadium Type\noutdoor <- c('Bowl','Cloudy','Heinz Field','Oudoor','Ourdoor','Outddors','Outdoors','Outdor','Outside','Outdoor')\nindoor_closed <- c('Indoor','Indoor, Roof Closed', 'Indoors','Retr. Rood - Closed','Retr. Roof Closed', 'Retr. Roof-Closed', 'Retractable Roof', 'Closed Dome','Dome','Dome, closed','Domed','Domed, closed')\nindoor_open <- c('Indoor, Open Roof','Retr. Roof - Open', 'Retr. Roof-Open', 'Open','Domed, open', 'Domed, Open','Outdoor Retr Roof-Open')\n\n# Transform Data\nclean_stadiums <- function(x) {\n  if (x %in% outdoor) {\n    \"Outdoor\"\n  } else if(x %in% indoor_closed) {\n    \"Indoor Closed\"\n  } else if(x %in% indoor_open){\n    \"Indoor Open\"\n  } else {\n    \"Unknown\"\n  }\n}\n\n      \nplay_list <- play_list %>%\n  mutate(weather = mapply(clean_weather, Weather))\n    \nplay_list <- play_list %>%\n  mutate(stadium_type = mapply(clean_stadiums, StadiumType))","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"head(play_list,2)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"<h2>Identification of specific variables that present an elevated risk of injury</h2>\n\n1. Are there specific movement patterns that correlate with the acute onset of injury (in general or by specific injury location)?\n2. Are there summary metrics of player movement which influence risk of injury?\n3. How do playing surface, game scenario, player movement, and weather interact to influence the risk of injury?\n\n<h2>Evaluation of differences in player movement between playing surfaces</h2>\n\n1. For any metrics of player movement shown to influence risk of injury, do differences in these metrics exist across playing surfaces for the non-injured player population?\n2. Do any of the environmental or game scenario variables influence player movement in the non-injured player population?"},{"metadata":{"trusted":true},"cell_type":"code","source":"# Pre-Processing\n# Player tracking data underwent pre-processing to get it in to a useable state.\n\n# Some of the steps taken are:\n\n#Variable created indicating whether an injury occured on the play:\nplayer_track <- player_track %>% \n  mutate(isInjured = PlayKey %in% injury_record$PlayKey) ","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"player_track %>% select(isInjured) %>% summary()","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# solution for the below function taken from here: https://stackoverflow.com/questions/7735647/replacing-nas-with-latest-non-na-value\nrepeat.before <- function(x) {   # repeats the last non NA value. Keeps leading NA\n    ind = which(!is.na(x))      # get positions of nonmissing values\n    if(is.na(x[1]))             # if it begins with a missing, add the \n          ind = c(1,ind)        # first position to the indices\n    rep(x[ind], times = diff(   # repeat the values at these indices\n       c(ind, length(x) + 1) )) # diffing the indices + length yields how often \n}  \n\nplayer_track$event <- ifelse(player_track$event == \"\", NA, player_track$event)\nplayer_track <- player_track %>% group_by(PlayKey) %>% mutate(event_clean = repeat.before(event)) %>% ungroup()\n","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"player_track %>% \n    group_by(event_clean) %>%\n    summarize(count_injury_event = n()) %>%\n    arrange(-count_injury_event) %>% \n   head()","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"line_set <- c('line_set')\ntackle <- c('tackle')\nhuddle <- c('huddle_break_offense','huddle_start_offense')\npass <- c('pass_outcome_incomplete','pass_arrived','pass_forward','pass_outcome_caught','pass_outcome_touchdown')\nclean_event_grouped <- function(x) {\n  if (x %in% line_set) {\n    \"line_set\"\n  } else if(x %in% tackle) {\n    \"Indoor Closed\"\n  } else if(x %in% pass){\n    \"pass\"  \n  } \n    else if(x %in% huddle) {\n    \"huddle\" \n  }\n    else if(is.na(x)) {\n    \"NA\" \n  }\n    else {\n    \"Others\"\n  }\n}\n\n      \nplayer_track <- player_track %>%\n  mutate(event_grouped = mapply(clean_event_grouped, event_clean))\n    ","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"***Are there specific movement patterns that correlate with the acute onset of injury (in general or by specific injury location)?***"},{"metadata":{"trusted":true},"cell_type":"code","source":"player_track %>% head(,2)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# create vector of values for in_play\nin_play <- c(\"tackle\", \"ball_snap\", \"pass_outcome_incomplete\", \"out_of_bounds\", \"first_contact\", \"handoff\", \"pass_forward\", \"pass_outcome_caught\", \"touchdown\", \"qb_sack\", \"touchback\", \"kickoff\", \"punt\", \"pass_outcome_touchdown\", \"pass_arrived\", \"extra_point\", \"field_goal\", \"play_action\", \"kick_received\", \"fair_catch\", \"punt_downed\", \"run\", \"punt_received\", \"qb_kneel\", \"pass_outcome_interception\", \"field_goal_missed\", \"fumble\", \"fumble_defense_recovered\", \"qb_spike\", \"extra_point_missed\", \"fumble_offense_recovered\", \"pass_tipped\", \"lateral\", \"qb_strip_sack\", \"safety\", \"kickoff_land\", \"snap_direct\", \"kick_recovered\", \"field_goal_blocked\", \"punt_muffed\", \"pass_shovel\", \"extra_point_blocked\", \"pass_lateral\", \"punt_blocked\", \"run_pass_option\", \"free_kick\", \"punt_fake\", \"end_path\", \"drop_kick\", \"field_goal_fake\", \"extra_point_fake\", \"xp_fake\")\n\nplayer_track <- player_track %>% \n  mutate(play_stage = ifelse(event_clean %in% in_play, \"in_play\", \"dead_ball\"))","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"<h2> Creating a aggregated dataset with major features for the movements for the player tracking data at the play key level </h2>"},{"metadata":{"trusted":true},"cell_type":"code","source":"player_track_agg <- player_track %>%\n    group_by(PlayKey) %>%\n    summarize(total_time = max(time),\n              event_grouped = max(event_grouped),\n              play_stage = max(play_stage),\n              max_o = max(o),\n              min_o = min(o),\n              diff_o = max_o - min_o,\n              sd_o = sd(o),\n              median_o = median(o),\n              mean_o = mean(o),\n              max_s = max(s),\n              min_s = min(s),\n              diff_s = max_s - min_s,\n              sd_s = sd(s),\n              median_s = median(s),\n              max_dir = max(dir),\n              min_dir = min(dir),\n              diff_dir = max_dir - min_dir,\n              sd_dir = sd(dir),\n              median_dir = median(dir),\n              median_acc = median((s - lag(s)/time - lag(time)), na.rm = TRUE),\n              max_acc = max((s - lag(s)/time - lag(time)), na.rm = TRUE),\n              min_acc = min((s - lag(s)/time - lag(time)), na.rm = TRUE),\n              mean_acc = mean((s - lag(s)/time - lag(time)), na.rm = TRUE),\n              is_injured = max(isInjured))\n              \n        \n              ","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"player_track_agg$is_injured <- as.factor(player_track_agg$is_injured)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"player_track_agg %>% head(,2)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"player_track_agg %>% select(is_injured) %>% summary()","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"\na <- play_list %>% filter(!is.na(Position), Position != \"Missing Data\") %>% distinct(PlayerKey, Position)\n\n# join to data\ninjury_record_master <- injury_record %>% left_join(a, by = \"PlayerKey\")\n\n# remove the duplicate occurrence of where players have multiple positions\ninjury_record_master <- injury_record_master %>% \n  distinct(PlayKey, GameID, BodyPart, .keep_all = T) \n\n\n# join variables that can be joined at the game level:\ninjury_record_master <- injury_record_master %>% \n  left_join(play_list %>% select(GameID, StadiumType, FieldType, Temperature, Weather), by = \"GameID\") %>% \n  distinct(.keep_all = T)\n\n\n# join per play variables\ninjury_record_master <- injury_record_master %>% \n  left_join(play_list %>% select(PlayKey, PlayerDay, PlayerGame, PlayType, PlayerGamePlay), by = \"PlayKey\")\n\n","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"rm(a)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"<h2> Creating a master dataset using features from all datasets"},{"metadata":{"trusted":true},"cell_type":"code","source":"master_data = left_join(player_track_agg,injury_record_master, by = \"PlayKey\")","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"<h2> Exploratory Data Analysis"},{"metadata":{"trusted":true},"cell_type":"code","source":"master_data %>%\n    group_by(is_injured) %>%\n      summarize(median_speed = median(max_s),\n               median_orientation = median(median_o),\n               median_acc = median(median_acc),\n                \n               ) %>%\n    ggplot(aes(x = is_injured, y = median_speed ) ) +\n    geom_col(aes(fill = is_injured)) +theme_classic() +\n    geom_text(aes(label = round(median_speed,2), vjust = -0.5 )) +\n    theme(axis.ticks.x=element_blank()) +\n    labs(title= \"Understanding median speed by injury or not\",\n        subtitle= \"The median speed is higher for injured players by 1.73 y/s.\") +\n    ylab(\"Median Speed (y/s)\") +\n    xlab(\"Is_Injured\")  \n  \n","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"master_data %>%\n    group_by(is_injured) %>%\n      summarize(median_speed = median(median_s),\n               median_orientation = median(median_o),\n               median_acc = median(median_acc)\n               ) %>%\n    ggplot(aes(x = reorder(is_injured, median_acc), y = median_acc ) ) +\n    geom_col(aes(fill = is_injured)) +\n    theme_classic() +\n    geom_text(aes(label = round(median_acc,2), vjust = 0.9 )) +\n    theme(axis.ticks.x=element_blank()) +\n    labs(title= \"Understanding median acc by injury or not\",\n        subtitle= \"The median de acceleration for injured players was less than those not injured.\") +\n    ylab(\"Median Acceleration (y/s/s)\") +\n    xlab(\"Is_Injured\")  \n  \n","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"master_data %>%\n    group_by(is_injured) %>%\n      summarize(median_speed = median(median_s),\n               median_orientation = median(sd_o, na.rm = TRUE),\n               median_acc = median(median_acc)\n               ) %>%\n    ggplot(aes(x = reorder(is_injured, median_orientation), y = median_orientation, fill= is_injured ) ) +\n    geom_col() +\n    theme_classic() +\n    geom_text(aes(label = round(median_orientation,2), vjust = -0.5 )) +\n    theme(axis.ticks.x=element_blank()) +\n    labs(title= \"Understanding unbiased variation of orientation by injury or not\",\n        subtitle= \"The standard deviation is higher for injured players vs not injured players\") +\n    ylab(\"Average variation of orientation\") +\n    xlab(\"Is_Injured\")  ","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"master_data %>%\n    group_by(is_injured) %>%\n      summarize(median_speed = median(median_s),\n               median_dir = median(sd_dir, na.rm = TRUE),\n               median_acc = median(median_acc)\n               ) %>%\n    ggplot(aes(x = reorder(is_injured, median_dir), y = median_dir, fill= is_injured ) ) +\n    geom_col() +\n    theme_classic() +\n    geom_text(aes(label = round(median_dir,2), vjust = -0.5 )) +\n    theme(axis.ticks.x=element_blank()) +\n    labs(title= \"Understanding unbiased variation of direction by injury or not\",\n        subtitle= \"The standard deviation is direction for injured players vs not injured players\") +\n    ylab(\"Average variation of direction\") +\n    xlab(\"Is_Injured\")  ","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Understanding the metric: <h3> Median of the max orientation means that if we look at the max orientation for the players across plays together than we see similar behavior across both injured and non injured players"},{"metadata":{},"cell_type":"markdown","source":"<h2> Understanding speed variable more for injured players"},{"metadata":{},"cell_type":"markdown","source":"<h4> Study the movement of players involved in plays resulting in an injury by defining several additional variables such as </h4>\n\n***Play_Duration= total length of each play (s)***\n\n***Acceleration = Mean(change in speed) (y/s/s)***\n\n***Distance = total distance accumulated in each play (y)***\n\n***Maximum/Minimum Velocity reached in each play***\n\n***Direction/Orientation that a player spent for most of the play***"},{"metadata":{"trusted":true},"cell_type":"code","source":"#Perform InnerJoin between IR_Sep and Player_Track\n#When do most players get injured? At which play in their respective games?\n\n\n#Mutate the Injury_Record DF to include games missed atleast\ngames = vector(\"numeric\",length = nrow(injury_record))\n    for (i in 1: nrow(injury_record)) {\n                if (sum(injury_record[i,6:9]) == 4){ \n                    games[i]= 42/7\n                    }\n                else if(sum(injury_record[i,6:9]) == 3){\n                    games[i]= 28/7\n                }\n                else if (sum(injury_record[i,6:9]) == 2){\n                    games[i]= 7/7\n                }\n                else {\n                    games[i]= 0\n                }\n        }\n\ninjury_record <- setDT(injury_record %>%\n                mutate(Games_Missed = games, Injury= TRUE))\n\nIR_Sep<- injury_record %>% \n         dplyr::inner_join(y = play_list,by = \"PlayKey\" )\nhead(IR_Sep)\nInjPlayers_Mvnt<- dplyr::inner_join(x = player_track,y = IR_Sep,by = \"PlayKey\")\n","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"Mvnt_Study<- InjPlayers_Mvnt %>% \n    group_by(PlayKey, BodyPart, StadiumType, FieldType, PlayType, PositionGroup, Weather) %>%\n    summarize(Games_Missed = max(Games_Missed),Play_Duration= max(time/10, na.rm = TRUE),Accel= mean(diff(s),na.rm = TRUE), AvgVel = mean(s, na.rm = TRUE), Max_Vel = max(s, na.rm = TRUE),\n            Min_Vel = min(s,na.rm = TRUE), Distance = sum(dis,na.rm = TRUE), Direction= quantile(dir,0.75), Orientation= quantile(o, 0.75))\nMvnt_Study %>%\n    group_by(BodyPart) %>%\n    summarize(Games_Missed = sum(Games_Missed)) %>%\n    ggplot() +\n    geom_col(aes(x= reorder(BodyPart, -Games_Missed), y=Games_Missed, fill = BodyPart)) +\n    theme_classic() +\n    labs(title= \"Distribution of games missed due to an injured body part\",\n        subtitle= \"Most games missed are due to injuries recorded to knee or ankle.\",\n        x= \"BodyPart\") +\n    geom_text(aes(BodyPart,Games_Missed, label= Games_Missed))\n\nhead(Mvnt_Study)\n\n\nMvnt_Study %>% \n    arrange(desc(Games_Missed)) %>%\n    ggplot() +\n    geom_point(aes(Distance,Max_Vel, color= FieldType, size = Games_Missed)) +\n    theme_classic() +\n    labs(title = \"Maximum velocity is positvely correlated with distance accumulated in\\neach play. Some of the plays with top velocity recorded are special teams plays\\non synthetic field with speed ~ 10y/s.\",\n        y= \"Maximum_Velocity (y/s)\",\n        x= \"Distance(yards)\")\n#Test for normality of continuous variables\n#Mvnt_Study %>% map_if(.p = is.numeric, .f = shapiro.test)\n\n","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"<h2> Velocity Curves </h2>\n\n<h3> What are velocity curves? - Understading speed vs the position on the field by following: </h3>\n    <h4> - Play Type\n    <h4> - Position Group"},{"metadata":{"trusted":true},"cell_type":"code","source":"InjPlayers_Mvnt %>% \n    ggplot() +\n    geom_point(aes(x= x, y= s, color= PositionGroup)) +\n    facet_wrap( ~ PlayType) +\n    theme_classic()+\n    labs(title= \"Velocity curves by playtypes and position group of players involved\\nin a recorded injury\",\n         subtitle= \"Special teams plays show some of the highest speed observed compared to other play types.\",\n        x= \"X-Position on the field(yards)\",\n        y= \"Speed (y/s)\") \n    \n","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"<h3> Example of a specific play by position group and play type to understand the movement and see if we can fit a functional relationship over the same"},{"metadata":{"trusted":true},"cell_type":"code","source":"InjPlayers_Mvnt %>% \n    dplyr::filter(PlayKey == \"47813-8-19\") %>% \n    ggplot() +\n    geom_point(aes(x= time, y= s, color= PositionGroup, size = o)) +\n    geom_smooth(aes(x= time, y= s),formula = y ~ sin(pi/16*x +5)) +\n    facet_wrap( ~ PlayType) +\n    theme_classic()","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"<h3> Understanding median speeds for players by playtype, position, field type and body part"},{"metadata":{"trusted":true},"cell_type":"code","source":"#Study the speed per key attributes\nInjPlayers_Mvnt %>%\n    group_by(PlayKey, PositionGroup, FieldType, PlayType) %>%\n    summarize(MedSpeed = median(s, na.rm = TRUE)) %>%\n    ggplot() +\n    geom_col(aes(x = reorder(PositionGroup, -MedSpeed), y = MedSpeed, fill= PositionGroup)) +\n    facet_wrap(~PlayType)+\n    theme_classic() +\n    labs(title= \"Median speed of players during an injury resulting play by playtype\",\n         subtitle= \"WRs and DBs are the fastest of any player that has gotten injured with median speed\\nof > 8 yards/sec.\",\n        x= \"PositionGroup\",\n        y= \"Median Speed (y/s)\")\n\nInjPlayers_Mvnt %>%\n    group_by(PlayKey, PositionGroup, FieldType) %>%\n    summarize(MedSpeed = median(s, na.rm = TRUE)) %>%\n    ggplot() +\n    geom_col(aes(x = reorder(PositionGroup, -MedSpeed), y = MedSpeed, fill= PositionGroup)) +\n    facet_wrap(~FieldType)+\n    theme_classic() +\n    labs(title= \"Median speed of players during an injury resulting play by fieldtype\",\n         subtitle= \"WRs,DBs and RBs tend to be faster on synthetic field type.\",\n        x= \"PositionGroup\",\n        y= \"Median Speed (y/s)\") \n\nInjPlayers_Mvnt %>%\n    group_by(PlayKey, BodyPart, FieldType) %>%\n    summarize(MedSpeed = median(s, na.rm = TRUE)) %>%\n    ggplot() +\n    geom_col(aes(x = reorder(BodyPart, -MedSpeed), y = MedSpeed, fill= BodyPart)) +\n    facet_wrap(~FieldType)+\n    theme_classic() +\n    labs(title= \"Median speed of players during an injury resulting play by bodypart and fieldtype\",\n         subtitle= \"Knee and ankle injuries on synthetic field type are correlated with higher median speed.\",\n        x= \"BodyPart\",\n        y= \"Median Speed (y/s)\")","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"<h3> Deep dive further into only injuries"},{"metadata":{"trusted":true},"cell_type":"code","source":"injury_record %>% \n  count(BodyPart) %>% \n  ggplot(aes(x= reorder(BodyPart,n), y= n)) +\n  geom_col(aes(col = BodyPart, fill = BodyPart )) +\n  labs(x= \"Body Part\", y= \"Num Injuries\") +\n  ggtitle(\"Number of injuries by body part\", subtitle = \"86% of the injury records made up by knees and ankles\") +\n  coord_flip() +\n  theme_classic() +\n  geom_text(aes(BodyPart,n,label =n))","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"p1 <- play_list %>% \n  distinct(GameID, FieldType) %>% \n  count(FieldType) %>% \n  ggplot(aes(x= FieldType, y= n)) +\n  geom_col(aes(fill = FieldType, colour = FieldType )) +\n  labs(x= \"Surface\", y= \"Games Played\") +\n  ggtitle(\"Games played on turf\", subtitle = \"58% of games in our data played on Natural Turf\") +\n  scale_y_continuous(labels = comma) +\n  coord_flip() +\n  theme_classic() +\n  geom_text(aes(FieldType, n, label= n ))\n\np2 <- injury_record %>% \n  count(Surface) %>% \n  ggplot(aes(x= Surface, y= n)) +\n  geom_col(aes(fill = Surface, colour = Surface)) +\n  labs(x= \"Surface\", y= \"Num Injuries\") +\n  ggtitle(\"Number of injuries by surface\", subtitle = \"Synthetic surfaces have slightly more injuries in absolute terms\") +\n  coord_flip() +\n  theme_classic() +\n  geom_text(aes(Surface, n, label= n ))\n\ngridExtra::grid.arrange(p1, p2)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# create a variable to indicate whether an injury occurred \nplay_list <- play_list %>% \n  mutate(IsInjured = GameID %in% injury_record$GameID)\n\n\nplay_list %>% \n  distinct(GameID, FieldType, IsInjured) %>% \n  group_by(FieldType, IsInjured) %>% \n  summarise(n = n()) %>% \n  mutate(perc_injured = n / sum(n)) %>% \n  filter(IsInjured == TRUE)  %>% \n  ggplot(aes(x= FieldType, y= perc_injured)) +\n  geom_col(aes(fill = FieldType, colour = FieldType)) +\n  geom_text(aes(label = percent(perc_injured)), vjust=-0.5, size = 4) +\n  ggtitle(\"Field vs injury\", subtitle = \"0.88% more chance of injury per game on synthetic turf than natural\") +\n  labs(y= \"Percent_Injured\")+ \n  theme_classic()\n","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"injury_record %>% \n  ggplot(aes(x=BodyPart, fill = Surface, colour = Surface)) +\n  geom_bar(stat = \"count\", position = \"fill\") +\n  scale_y_continuous(labels = percent) +\n  labs(y = \"Proportion\", title = \"Body type vs surface vs injury\", subtitle = \"60% of ankle injuries occur on Synthetic, while\\nknee injuries occur with identical frequency on both surfaces\") +\n  theme_classic()","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"<h3> Understanding severity of injury using the days features"},{"metadata":{"trusted":true},"cell_type":"code","source":"# create a variable to indicate the severity of the injury (time missed)\ninjury_record <- injury_record %>% \n  mutate(severity = ifelse(DM_M42 == 1, \"42\", \n                           ifelse(DM_M42 == 0 & DM_M28 == 1, \"28\",\n                                  ifelse(DM_M42 == 0 & DM_M28 == 0 & DM_M7 == 1, \"7\", \"1\"))))","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"injury_record %>% \n  mutate(severity = factor(severity, levels = c(\"42\", \"28\", \"7\", \"1\"))) %>%\nggplot(aes(x=BodyPart, fill = severity, colour = severity)) +\n  geom_bar(stat = \"count\", position = \"fill\") +\n  scale_y_continuous(labels = percent) +\n  ggtitle(\"Body part vs severity\", subtitle = \"Foot injuries generally require longer recovery times\") +\n  labs(y= \"Percent\") + \n  theme_classic()","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"injury_record %>% \n mutate(severity = factor(severity, levels = c(\"42\", \"28\", \"7\", \"1\"))) %>%\n  ggplot(aes(x=Surface, fill = severity, colour =  severity)) +\n  geom_bar(stat = \"count\", position = \"fill\") +\n  scale_y_continuous(labels = percent) +\n  labs(y = \"proportion\", title= \"Severity based on surface\", subtitle = \"The time missed because of injury doesn't really differ\\nbetween playing surfaces\") +\n  theme_classic()","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# because there are some injuries without a playID, I will derive the player's position from the play_list df,\n# then join on to injury_record\na <- play_list %>% filter(!is.na(Position), Position != \"Missing Data\") %>% distinct(PlayerKey, Position)\n\n# join to data\ninjury_record <- injury_record %>% left_join(a, by = \"PlayerKey\")\nrm(a)\n# remove the duplicate occurrence of where players have multiple positions\ninjury_record <- injury_record %>% \n  # mutate(Position = ifelse(is.na(Position), CleanPosition, Position)) %>% \n  distinct(PlayKey, GameID, BodyPart, .keep_all = T) \n\n\n# join variables that can be joined at the game level:\ninjury_record_master <- injury_record %>% \n  left_join(play_list %>% select(GameID, StadiumType, FieldType, Temperature, Weather), by = \"GameID\") %>% \n  distinct(.keep_all = T)\n\n\n# join per play variables\ninjury_record <- injury_record %>% \n  left_join(play_list %>% select(PlayKey, PlayerDay, PlayerGame, PlayType, PlayerGamePlay), by = \"PlayKey\")\n\n# fill in missing game number variable where there was no playID in the injury report\ninjury_record_master <- injury_record %>% \n  mutate(PlayerGame = ifelse(is.na(PlayerGame), as.numeric(str_extract(GameID, \"[^-]*$\")), PlayerGame))","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"p2 <- master_data %>% \n  count(Position, BodyPart) %>% \n  ggplot(aes(x= reorder(Position,n), y= n, fill = BodyPart, colour = BodyPart)) +\n  geom_bar(stat = \"identity\", position = \"fill\") +\n  scale_y_continuous(labels = percent) +\n  ggtitle(\"Injury by body part and position on play\", subtitle = \"Body part injured seems to differ based on player's position on the play\") +\n  labs(x= \"Position on Play\", y= \"Injury Proportion\") +\n  coord_flip() +\n  theme_classic()\n\np2\n","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"play_list %>% \n  filter(!PlayType %in% c(\"\", \"0\")) %>% \n  group_by(PlayType, FieldType, IsInjured) %>% \n  summarise(n_Plays = n_distinct(PlayKey)) %>% \n  mutate(proportion_plays = round(n_Plays / sum(n_Plays), 2)) %>%\n  group_by(PlayType, FieldType) %>% \n  mutate(total_plays = sum(n_Plays)) %>%\n  ungroup() %>%\n  filter(IsInjured == TRUE) %>%\n  ggplot(aes(x= reorder(PlayType, total_plays), y= total_plays, color = PlayType)) +\n  geom_col(aes(fill = PlayType)) + \n  geom_text(aes(label = percent(proportion_plays)), hjust=-0, size =3, ) +\n  scale_y_continuous(labels = comma, name = \"Total Plays\") +\n  labs(x = \"PlayType\", title = \"Field Type vs Play Type vs Injury\", subtitle = \"Greater proportion of plays involving punts and PATs end in injury on Synthetic\") +\n  coord_flip() +\n  theme_classic() +\n  facet_wrap(~ FieldType)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"master_data %>% \n  ggplot(aes(x= FieldType, y= PlayerGamePlay, fill = FieldType)) +\n  geom_boxplot() +\n  ggtitle(\"Game Play vs Field Type distribution\", subtitle = \"Synthetic leads to on an average higher injury game plays\") +\n  labs(x= \"Field Type\", y= \"Game Play\") +\n  theme_classic()","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"p1 <- master_data %>% \n  group_by(PlayerGame) %>% summarise(num_players = n_distinct(PlayerKey)) %>% \n  ggplot(aes(x=PlayerGame, y=num_players)) +\n  geom_line( size = 1) +\n  geom_point( size = 3) +\n  labs(x= \"Game Number\", y= \"Number Injuries\") +\n  ggtitle(\"NUMBER OF INJURIES DECREASING THROUGH GAMES\", subtitle = \"Week 3 has the most injuries (n=9)\") +\n  theme_classic()\n\n\np2 <- play_list %>% \n  group_by(PlayerGame) %>% summarise(num_players = n_distinct(PlayerKey)) %>% \n  ggplot(aes(x=PlayerGame, y=num_players)) +\n  geom_line( size = 1) +\n  geom_point(size = 3) +\n  labs(x= \"Game Number\", y= \"Number Players\") +\n  ggtitle(\"NUMBER OF PLAYERS ALSO DECREASING\", subtitle = \"Need to see whether the proportion is increasing or decreasing\") +\n  theme_classic()\n\ngridExtra::grid.arrange(p1, p2, ncol = 1)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"master_data %>% \n  group_by(PlayerGame) %>% summarise(num_injured = n_distinct(PlayerKey)) %>% ungroup() %>% \n  left_join(play_list %>% group_by(PlayerGame) %>% summarise(num_players = n_distinct(PlayerKey)) %>% ungroup(), by = \"PlayerGame\") %>% \n  mutate(prop_injured = num_injured / num_players) %>% \n  ggplot(aes(x=PlayerGame, y=prop_injured)) +\n  geom_line(aes(colour =PlayerGame ), size = 1) +\n  geom_point(aes(colour = PlayerGame), size = 3) +\n  labs(x= \"Week Number\", y= \"Injury Rate\") +\n  scale_y_continuous(labels = percent) +\n  ggtitle(\"Players injury by weeks\", subtitle = \"Players are most likely to be injured in week 8. The injury rate peaks at week 3 to 3.6%\") +\n  theme_classic()\n","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"play_list %>% \n  filter(Temperature != -999) %>% \n  distinct(GameID, Temperature, IsInjured) %>% \n  ggplot(aes(y= Temperature, x = IsInjured, fill = IsInjured)) +\n  geom_boxplot() +\n  labs(x= \"Player Injured?\") +\n  ggtitle(\"TEMPERATURE vs Injury\", subtitle = \"While injuries tend to occur in slightly higher temperatures, doesn't look significant\") +\n  coord_flip() +\n  theme_classic()","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"play_list %>% \n\n  filter(weather != \"indoors\") %>% \n  group_by(weather, IsInjured) %>% \n  summarise(n_Plays = n_distinct(PlayKey)) %>% \n  mutate(proportion_plays = round(n_Plays / sum(n_Plays), 2)) %>% \n  filter(IsInjured == TRUE) %>%\n  ggplot(aes(x= reorder(weather, proportion_plays), y= proportion_plays, fill = IsInjured)) +\n  geom_col(aes(fill = weather)) +\n  geom_text(aes(label = percent(proportion_plays)), hjust= 1, size =5) +\n  scale_y_continuous(labels = comma, name = \"% Plays\") +\n  ggtitle(\"Injury vs Climate\", subtitle = \"Injuries more likely to occur in rain or controlled climate\") +\n  labs(caption = \"*Indoor stadiums excluded\", x= \"Weather\") +\n  coord_flip() +\n  theme_classic()","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"play_list %>% \n  group_by(stadium_type, IsInjured) %>% \n  summarise(n_Plays = n_distinct(PlayKey)) %>% \n  mutate(proportion_plays = round(n_Plays / sum(n_Plays), 2)) %>% \n  filter(IsInjured == TRUE) %>%\n  ggplot(aes(x= reorder(stadium_type, proportion_plays), y= proportion_plays, fill = IsInjured)) +\n  geom_col(aes(fill = stadium_type)) +\n  geom_text(aes(label = percent(proportion_plays), color = stadium_type), hjust= 1, size =5) +\n  scale_y_continuous(labels = comma, name = \"% Plays\") +\n  ggtitle(\"Stadium Type vs Injury\", subtitle = \"Injuries are more likely to occur in indoor stadiums\") +\n  coord_flip() +\n  theme(axis.title.y = element_blank(), axis.text.x = element_blank()) +\n  theme_classic() +\n  labs(x= \"StadiumType\")","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"play_list %>% \n  group_by(stadium_type,FieldType, IsInjured) %>% \n  summarise(n_Plays = n_distinct(PlayKey)) %>% \n  mutate(proportion_plays = round(n_Plays / sum(n_Plays), 2)) %>% \n  filter(IsInjured == TRUE) %>%\n  ggplot(aes(x= reorder(stadium_type, -n_Plays), y= proportion_plays, fill = stadium_type)) +\n  geom_col() +\n  geom_text(aes(label = percent(proportion_plays)), hjust= 1, size =5) +\n  scale_y_continuous(labels = comma, name = \"% Plays\") +\n  ggtitle(\"Roof type vs injury\", subtitle = \"Injuries are more likely to occur in indoor stadiums with the roof open\") +\n  labs(x= \"Stadium Type\") +\n  coord_flip() +\n  facet_wrap(~ FieldType) +\n  theme_classic() \n  ","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"rm(player_track)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"<h1> Statistical Tests and Models"},{"metadata":{},"cell_type":"markdown","source":"<h4> Considering we have multiple categorical variables we can use multiple statistical tests to define the potential significant relationships betwee the variables and injury type"},{"metadata":{},"cell_type":"markdown","source":"<h4> Chi Squared test and Cramer V"},{"metadata":{"trusted":true},"cell_type":"code","source":"cv.test = function(x,y) {\n  CV = sqrt(chisq.test(x, y, correct=FALSE)$statistic /\n    (length(x) * (min(length(unique(x)),length(unique(y))) - 1)))\n  print.noquote(\"Cramér V / Phi:\")\n  return(as.numeric(CV))\n}","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"<h3> The p value comes out to be significant which means that the field type has an effect on injury for the players at the same time cramer V shows some correlation"},{"metadata":{"trusted":true},"cell_type":"code","source":"master_data %>%\n    ggplot(aes(x=PlayerGamePlay)) + \n    geom_density(aes(fill=FieldType),alpha = 0.7) + \n    ggtitle(\"Distribution of Injuries by Plays in Game\",subtitle = \"Injuries Occur Earlier in Games Overall\") + \n    theme(plot.title = element_text(face=\"bold\")) + \n    labs(x=\"Game Play of Injured Player\",y=\"Distribution\",fill=\"Field Type\") +\n    theme_classic()","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"<h3> As the distribution is not normal we cannot use t test to study the relationship between field type and games missed but we can\nuse wilcox test for the same"},{"metadata":{"trusted":true},"cell_type":"code","source":"wilcox.test(master_data$PlayerGamePlay ~ master_data$FieldType)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"rm(player_track)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"<h2> Baseline Gradient Boosting Model"},{"metadata":{},"cell_type":"markdown","source":"Running a vanilla [Gradient Boosting Machines](https://en.wikipedia.org/wiki/Gradient_boosting) model to see what is the effect of variables on the injury classification variable"},{"metadata":{"trusted":true},"cell_type":"code","source":"set.seed(123)\nmaster_data <- mutate_if(master_data, is.character, as.factor)\n# train GBM model\ngbm.fit <- gbm(\n  formula = is_injured ~ PlayType  + Weather + FieldType + StadiumType + Position + median_o + max_o + min_o +\n    median_s + max_s + min_s + median_acc + max_acc + min_acc + diff_s + sd_s + sd_o \n    ,\n  distribution = \"gaussian\",\n  data = master_data,\n  n.trees = 50, # Tested with 1500 trees\n  interaction.depth = 6,\n  shrinkage = 0.001,\n  n.cores = NULL, # will use all cores by default\n  verbose = FALSE\n  )  \n\n# print results\nprint(gbm.fit)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"gbm.perf(gbm.fit)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"<h3> The variables coming out to be important are the following in the descending order"},{"metadata":{"trusted":true},"cell_type":"code","source":"summary(gbm.fit)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"<h2> Appendix"},{"metadata":{"trusted":true},"cell_type":"code","source":"rm(gbm.fit)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"<h3> There seems to be ~286 timestamped snapshots of each play which equates to 28.6 seconds of duration of a play."},{"metadata":{},"cell_type":"markdown","source":"<h2> Study the severity of injuries, i.e. Games Missed and its relationship with other attributes such as\n    Field Type, Stadium Type, and Position Group"},{"metadata":{},"cell_type":"markdown","source":"<h4> Games Missed = (DM_MX)/7\n<h4> Note: Injury_Record dataframe provides us with \"at-least days missed in variables DM_MX\".\n<h4> Generally speaking, NFL games are 7 days apart. Therefore, we transformed the one-hot encoded variable into a numeric integer       <h4> variable Games_Missed to determine severity of injuries and its relationship with other variables.\n<h4> For example, if DM_M42 ==1, => Games_Missed = >= 6."},{"metadata":{"trusted":false},"cell_type":"code","source":"","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"<h2> Study the distribution of injured players by position group."},{"metadata":{"trusted":true},"cell_type":"code","source":"#The injured players are the unique PlayerKeys within InjuryRecord DataFrame\nInjured_Players<- play_list %>% \n         dplyr::inner_join(y = injury_record,by = \"GameID\" )\n\n\nInjured_Players %>%\n    group_by(PositionGroup) %>%\n    summarize(Count = n_distinct(PlayerKey.x)) %>%\n    arrange(desc(Count)) %>%\n    ggplot() +\n    geom_col(aes(x= reorder(PositionGroup, -Count),y= Count, fill= PositionGroup)) +\n    theme_classic() +\n    labs(title= \"Distribution of injured players by position group\",\n         subtitle= \"Most of the injured players are defensive players\", \n        x= \"Position Group\") +\n    geom_text(mapping = aes(x = PositionGroup, y= Count, label= Count))\n    ","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"<h2> When do most players get injured? At which play in their respective games? And during which type of play?\n    In which stadium type?\n"},{"metadata":{"trusted":true},"cell_type":"code","source":"#When do most players get injured? At which play in their respective games?\n\n\n#Median PlayerGamePlay when injury was recorded\nIR_Sep %>%\n    group_by(BodyPart,PlayType,PositionGroup) %>%\n    summarize(Injuries = sum(DM_M1), MedianPlay = median(PlayerGamePlay))%>%\n    ggplot() +\n    geom_boxplot(aes(PositionGroup, MedianPlay, fill= PositionGroup)) +\n    theme_classic() +\n    labs(title= \"Distribution of injuries by key attributes\",\n         subtitle= \"Typical Offensive Linemen get injured later on in a game compared to other position groups.\\nTight ends seem to get injured early on in a game.\") \n\n#Play Type Distribution Among Injured Plays\nIR_Sep %>%\n    group_by(PlayType) %>%\n    summarize(Injuries = sum(DM_M1), MedianPlay = median(PlayerGamePlay))%>%\n    arrange(desc(Injuries)) %>%\n    ggplot() +\n    geom_col(aes(x= reorder(PlayType,-Injuries),y= Injuries,fill= PlayType), position = \"dodge\") +\n    theme_classic() +\n    labs(title= \"Distribution of injuries by play types\",\n         subtitle= \"Most of the plays that result in an injury are passing and rushing plays.\\nAnd key players involved in these plays are DBs, LBs, WRs and RBs.\",\n         x= \"PlayType\") +\n    geom_text(aes(x=PlayType,y= Injuries, label = Injuries)) \n\n#Stadium Type Distribution Among Injured Plays\nIR_Sep %>%\n    group_by(StadiumType) %>%\n    summarize(Injuries = sum(DM_M1), MedianPlay = median(PlayerGamePlay))%>%\n    arrange(desc(Injuries)) %>%\n    head() %>%\n    ggplot() +\n    geom_col(aes(x= reorder(StadiumType,-Injuries),y= Injuries,fill= StadiumType), position = \"dodge\") +\n    theme_classic() +\n    labs(title= \"Distribution of injuries by 6 most frequent stadium types\",\n         subtitle= \"Most of the plays that result in an injury occur in an outdoor stadium.\",\n         x= \"StadiumType\") +\n    geom_text(aes(x=StadiumType,y= Injuries, label = Injuries)) \n","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"IR_Sep %>%\n    group_by(FieldType) %>%\n    summarize(Games_Missed = sum(Games_Missed)) %>%\n    ggplot() +\n    geom_col(aes(FieldType, Games_Missed, fill= FieldType), position = \"dodge\") +\n    theme_classic() +\n    labs(title= \"Games Missed as a function of FieldType\",\n         subtitle= \"Synthetic fieldtype has accounted for 45+ games missed over natural type.\") +\n    geom_text(aes(FieldType, Games_Missed,label = Games_Missed))\n\nIR_Sep %>%\n    group_by(FieldType, PositionGroup) %>%\n    summarize(Games_Missed = sum(Games_Missed)) %>%\n    ggplot() +\n    geom_col(aes(FieldType, Games_Missed, fill= FieldType), position = \"dodge\") +\n    theme_classic() +\n    labs(title= \"Games Missed as a function of FieldType and PositionGroup\",\n         subtitle= \"Synthetic fieldtype has accounted for significant # of games missed over natural type for WRs,\\nDBs, and LBs.\") +\n    geom_text(aes(FieldType, Games_Missed,label = Games_Missed)) +\n    facet_wrap(.~ PositionGroup)\n\nIR_Sep %>%\n    group_by(StadiumType, FieldType) %>%\n    summarize(Games_Missed = sum(Games_Missed)) %>%\n    ggplot() +\n    geom_col(aes(FieldType, Games_Missed, fill= StadiumType)) +\n    theme_classic() +\n    labs(title= \"Distribution of Games_Missed by Stadium Type\",\n         subtitle= \"Outdoor stadiums present greater risk of injury as most severe injuries tend to happen in outdoor\\nstadiums.\") ","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"IR_Sep %>%\n    group_by(FieldType) %>%\n    summarize(Games_Missed = sum(Games_Missed)) %>%\n    ggplot() +\n    geom_col(aes(FieldType, Games_Missed, fill= FieldType), position = \"dodge\") +\n    theme_classic() +\n    labs(title= \"Games Missed as a function of FieldType\",\n         subtitle= \"Synthetic fieldtype has accounted for 45+ games missed over natural type.\") +\n    geom_text(aes(FieldType, Games_Missed,label = Games_Missed))\n\nIR_Sep %>%\n    group_by(FieldType, PositionGroup) %>%\n    summarize(Games_Missed = sum(Games_Missed)) %>%\n    ggplot() +\n    geom_col(aes(FieldType, Games_Missed, fill= FieldType), position = \"dodge\") +\n    theme_classic() +\n    labs(title= \"Games Missed as a function of FieldType and PositionGroup\",\n         subtitle= \"Synthetic fieldtype has accounted for significant # of games missed over natural type for WRs,\\nDBs, and LBs.\") +\n    geom_text(aes(FieldType, Games_Missed,label = Games_Missed)) +\n    facet_wrap(.~ PositionGroup)\n","execution_count":null,"outputs":[]}],"metadata":{"kernelspec":{"display_name":"R","language":"R","name":"ir"},"language_info":{"codemirror_mode":"r","file_extension":".r","mimetype":"text/x-r-source","name":"R","pygments_lexer":"r","version":"3.6.1"}},"nbformat":4,"nbformat_minor":1}