{"cells":[{"metadata":{},"cell_type":"markdown","source":"# A journey through the data and simple models"},{"metadata":{"_uuid":"051d70d956493feee0c6d64651c6a088724dca2a","_execution_state":"idle","trusted":true},"cell_type":"code","source":"library(tidyverse)\n\n# show files\nlist.files(path = '../input/nfl-playing-surface-analytics')","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"# Injury Data"},{"metadata":{"trusted":true},"cell_type":"code","source":"t1 <- Sys.time()\ndf_injury <- read.csv('../input/nfl-playing-surface-analytics/InjuryRecord.csv')\nt2 <- Sys.time()\nprint(t2-t1)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"df_injury <- as.data.frame(df_injury)\n\n# type conversion\ncats <- c('PlayerKey', 'GameID', 'PlayKey', 'BodyPart', 'Surface', 'DM_M1', 'DM_M7', 'DM_M28', 'DM_M42')\nfor (c in cats) {\n  df_injury[,c] <- as.factor(df_injury[,c])\n}\n\nsummary(df_injury)\n\nprint(paste0('Number of rows: ', nrow(df_injury)))","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# we have one game_id twice, let's have a look\ndf_game_twice <- dplyr::filter(df_injury, GameID=='47307-10')\nprint(df_game_twice)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Player \"47307\" had two injuries in the same game and play."},{"metadata":{"trusted":true},"cell_type":"code","source":"# other poor guys with multiple injuries\ntab_player <- as.data.frame(table(df_injury$PlayerKey))\ncolnames(tab_player) <- c('PlayerKey','Freq')\ntab_player <- dplyr::filter(tab_player, Freq > 1)\nmulti_select <- as.character(tab_player$PlayerKey)\ndf_injury_player_2 <- dplyr::filter(df_injury, PlayerKey %in% multi_select)\ndf_injury_player_2 <- df_injury_player_2[order(df_injury_player_2$PlayerKey),] # sort by PlayerKey\nprint(df_injury_player_2)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"### Look at some plots"},{"metadata":{"trusted":true},"cell_type":"code","source":"ggplot(data=df_injury, aes(BodyPart, fill=BodyPart)) + geom_bar()","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"ggplot(data=df_injury, aes(Surface, fill=Surface)) + geom_bar()","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Ok, more injuries on Synthetic? We have to be careful as we have not yet seen the info about how many games have been played on which surface. We have a look at that a little bit later."},{"metadata":{"trusted":true},"cell_type":"code","source":"# evaluate injury by surface type\ntab_by_surface <- table(df_injury$Surface, df_injury$BodyPart)\nprint(tab_by_surface)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# mosaic plot\nmosaicplot(tab_by_surface)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# association plot\nassocplot(tab_by_surface)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"#### Hmm, synthetic surface seems to be bad for the toes?"},{"metadata":{},"cell_type":"markdown","source":"### Evaluate duration of injury"},{"metadata":{"trusted":true},"cell_type":"code","source":"# convert 0/1 encoding into level 1/7/28/42\ninj_duration <- as.numeric(df_injury$DM_M1)-1 +\n  as.numeric(df_injury$DM_M7)-1 +\n  as.numeric(df_injury$DM_M28)-1 +\n  as.numeric(df_injury$DM_M42)-1\n\ninj_duration[inj_duration == 3] <- 42\ninj_duration[inj_duration == 2] <- 28\ninj_duration[inj_duration == 1] <- 7\ninj_duration[inj_duration == 0] <- 1\n\ndf_injury$Duration <- as.factor(inj_duration)\n\n# DM_xx now redundant => remove\ndf_injury$DM_M1 <- NULL\ndf_injury$DM_M7 <- NULL\ndf_injury$DM_M28 <- NULL\ndf_injury$DM_M42 <- NULL","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# show distribution of durations\nplot(df_injury$Duration)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# evalute duration by injured body part\ntab_dur_by_part <- table(df_injury$BodyPart, df_injury$Duration)\ntab_dur_by_part","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"mosaicplot(tab_dur_by_part)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# show distribution of durations for KNEE injuries\nplot(df_injury$Duration[df_injury$BodyPart=='Knee'], main='Knee')\nsummary(as.numeric(as.character(df_injury$Duration[df_injury$BodyPart=='Knee'])))","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# show distribution of durations for ANKLE injuries\nplot(df_injury$Duration[df_injury$BodyPart=='Ankle'], main='Ankle')\nsummary(as.numeric(as.character(df_injury$Duration[df_injury$BodyPart=='Ankle'])))","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"# Play List Data"},{"metadata":{"trusted":true},"cell_type":"code","source":"t1 <- Sys.time()\ndf_playlist <- read.csv('../input/nfl-playing-surface-analytics/PlayList.csv')\nt2 <- Sys.time()\nprint(t2-t1)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"df_playlist <- as.data.frame(df_playlist)\n\n# type conversion\ncats <- c('PlayerKey', 'PlayKey', 'GameID', 'RosterPosition', 'StadiumType',\n          'FieldType', 'Weather', 'PlayType', 'Position', 'PositionGroup')\nfor (c in cats) {\n  df_playlist[,c] <- as.factor(df_playlist[,c])\n}","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"summary(df_playlist)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"### Revisit injuries by surface type. Now we will also take number of games into account to get a fair comparison."},{"metadata":{"trusted":true},"cell_type":"code","source":"# Revisit injuries by surface type\n\n# number of games\nn_games <- length(unique(df_playlist$GameID))\nn_games_natural <- length(unique(df_playlist$GameID[df_playlist$FieldType=='Natural']))\nn_games_synthetic <- length(unique(df_playlist$GameID[df_playlist$FieldType=='Synthetic']))\n\nn_games_natural_perc <- n_games_natural / n_games\nn_games_synthetic_perc <- n_games_synthetic / n_games\n\nprint(paste0('Games on natural surface  : ', n_games_natural, ' ~ ', 100*round(n_games_natural_perc,4), '%'))\nprint(paste0('Games on synthetic surface: ', n_games_synthetic, ' ~ ', 100*round(n_games_synthetic_perc,4), '%'))\n\n# injury by surface\ntab_by_field_type <- table(df_injury$BodyPart, df_injury$Surface)\nprint(tab_by_field_type)\n\n# calc relative frequency\ntab_by_field_type_rel <- tab_by_field_type\ntab_by_field_type_rel[,1] <- tab_by_field_type_rel[,1] / n_games_natural\ntab_by_field_type_rel[,2] <- tab_by_field_type_rel[,2] / n_games_synthetic\nprint(tab_by_field_type_rel)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"perc_inj_natural <- sum(tab_by_field_type_rel[,1])\nperc_inj_synthetic <- sum(tab_by_field_type_rel[,2])\n\nprint(paste0('Injuries per Game - Natural Surface:   ', 100*round(perc_inj_natural,4),'%'))\nprint(paste0('Injuries per Game - Synthetic Surface: ', 100*round(perc_inj_synthetic,4),'%'))","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# Let's make a nice plot...\nbarplot(tab_by_field_type_rel, col=topo.colors(5),\n        legend.text=rownames(tab_by_field_type_rel),\n        args.legend = list(x = \"bottomright\"),\n        main = 'Injuries per Game')\ngrid()","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"### Ok, synthetic surface causes significantly more injuries when normalized by the number of games!"},{"metadata":{"trusted":true},"cell_type":"code","source":"# Stadium type is pretty messy...\nsummary(df_playlist$StadiumType)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"category_fuzzy <- c('', 'Domed', 'Retractable Roof')\ncategory_open <- c('Bowl', 'Cloudy', 'Domed, open', 'Domed, Open', 'Heinz Field', 'Indoor, Open Roof',\n                   'Open', 'Oudoor', 'Ourdoor', 'Outddors', 'Outdoor', 'Outdoor Retr Roof-Open', 'Outdoors', 'Outdor', 'Outside',\n                   'Retr. Roof-Open')\ncategory_closed <- c('Closed Dome', 'Dome', 'Dome, closed', 'Domed, closed', 'Indoor', 'Indoor, Roof Closed',\n                    'Indoors', 'Retr. Roof - Closed', 'Retr. Roof - Open', 'Retr. Roof Closed', 'Retr. Roof-Closed')","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"levels(df_playlist$StadiumType) <- c(levels(df_playlist$StadiumType),'Open','Closed','Fuzzy')\ndf_playlist$StadiumType[df_playlist$StadiumType %in% category_open] <- 'Open'\ndf_playlist$StadiumType[df_playlist$StadiumType %in% category_closed] <- 'Closed'\ndf_playlist$StadiumType[df_playlist$StadiumType %in% category_fuzzy] <- 'Fuzzy'\ndf_playlist$StadiumType <- droplevels(df_playlist$StadiumType)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"summary(df_playlist$StadiumType)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# Weather is even worse...\nsummary(df_playlist$Weather)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# the following has no unique solution, feel free to change...\ndf_playlist$Weather[df_playlist$Weather=='N/A (Indoors)'] <- 'Indoors'\ndf_playlist$Weather[df_playlist$Weather=='Indoor'] <- 'Indoors'\ndf_playlist$Weather[df_playlist$Weather=='N/A Indoor'] <- 'Indoors'\ndf_playlist$Weather[df_playlist$Weather=='Controlled Climate'] <- 'Indoors'\n\ndf_playlist$Weather[df_playlist$Weather=='Sunny and clear'] <- 'Sunny'\ndf_playlist$Weather[df_playlist$Weather=='Sunny and cold'] <- 'Sunny'\ndf_playlist$Weather[df_playlist$Weather=='Sunny and warm'] <- 'Sunny'\ndf_playlist$Weather[df_playlist$Weather=='Sunny Skies'] <- 'Sunny'\ndf_playlist$Weather[df_playlist$Weather=='Sunny, highs to upper 80s'] <- 'Sunny'\ndf_playlist$Weather[df_playlist$Weather=='Sunny, Windy'] <- 'Sunny'\n\ndf_playlist$Weather[df_playlist$Weather=='Mostly Sunny Skies'] <- 'Mostly Sunny'\ndf_playlist$Weather[df_playlist$Weather=='Mostly sunny'] <- 'Mostly Sunny'\n\ndf_playlist$Weather[df_playlist$Weather=='Partly sunny'] <- 'Partly Sunny'\n\ndf_playlist$Weather[df_playlist$Weather=='cloudy'] <- 'Cloudy'\ndf_playlist$Weather[df_playlist$Weather=='Coudy'] <- 'Cloudy'\ndf_playlist$Weather[df_playlist$Weather=='Cloudy and cold'] <- 'Cloudy'\ndf_playlist$Weather[df_playlist$Weather=='Cloudy, 50% change of rain'] <- 'Cloudy'\ndf_playlist$Weather[df_playlist$Weather=='Cloudy, chance of rain'] <- 'Cloudy'\ndf_playlist$Weather[df_playlist$Weather=='Cloudy, fog started developing in 2nd quarter'] <- 'Cloudy'\ndf_playlist$Weather[df_playlist$Weather=='Cloudy and Cool'] <- 'Cloudy'\n\ndf_playlist$Weather[df_playlist$Weather=='Mostly cloudy'] <- 'Mostly Cloudy'\ndf_playlist$Weather[df_playlist$Weather=='Mostly Coudy'] <- 'Mostly Cloudy'\n\ndf_playlist$Weather[df_playlist$Weather=='Partly cloudy'] <- 'Partly Cloudy'\ndf_playlist$Weather[df_playlist$Weather=='Party cloudy'] <- 'Partly Cloudy'\ndf_playlist$Weather[df_playlist$Weather=='Party Cloudy'] <- 'Partly Cloudy'\ndf_playlist$Weather[df_playlist$Weather=='Partly Clouidy'] <- 'Partly Cloudy'\n\ndf_playlist$Weather[df_playlist$Weather=='Clear skies'] <- 'Clear'\ndf_playlist$Weather[df_playlist$Weather=='Clear Skies'] <- 'Clear'\ndf_playlist$Weather[df_playlist$Weather=='Clear and cold'] <- 'Clear'\ndf_playlist$Weather[df_playlist$Weather=='Clear and Cool'] <- 'Clear'\ndf_playlist$Weather[df_playlist$Weather=='Clear and sunny'] <- 'Clear'\ndf_playlist$Weather[df_playlist$Weather=='Clear and warm'] <- 'Clear'\ndf_playlist$Weather[df_playlist$Weather=='Fair'] <- 'Clear'\n\ndf_playlist$Weather[df_playlist$Weather=='Cloudy, Rain'] <- 'Rain'\ndf_playlist$Weather[df_playlist$Weather=='Rain shower'] <- 'Rain'\ndf_playlist$Weather[df_playlist$Weather=='Cloudy, Rainy'] <- 'Rain'\ndf_playlist$Weather[df_playlist$Weather=='Cloudy, Rain'] <- 'Rain'\ndf_playlist$Weather[df_playlist$Weather=='Light Rain'] <- 'Rain'\ndf_playlist$Weather[df_playlist$Weather=='Scattered Showers'] <- 'Rain'\ndf_playlist$Weather[df_playlist$Weather=='Rainy'] <- 'Rain'\ndf_playlist$Weather[df_playlist$Weather=='Cloudy with periods of rain, thunder possible. Winds shifting to WNW, 10-20 mph.'] <- 'Rain'\ndf_playlist$Weather[df_playlist$Weather=='Showers'] <- 'Rain'\n\ndf_playlist$Weather[df_playlist$Weather=='Cloudy, light snow accumulating 1-3\"'] <- 'Snow'\ndf_playlist$Weather[df_playlist$Weather=='Heavy lake effect snow'] <- 'Snow'\n\ndf_playlist$Weather <- droplevels(df_playlist$Weather)\n\ntab_weather <- as.data.frame(table(df_playlist$Weather))\ntab_weather <- tab_weather[order(-tab_weather$Freq),]\nprint(tab_weather)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# collect the rest\nweather_unalloc <- c('Hazy', 'Overcast', 'Partly clear', 'Rain Chance 40%',\n                     'Clear and Sunny', 'Rain likely, temps in low 40s.', 'Cold',\n                     'Clear to Partly Cloudy', 'Heat Index 95', '10% Chance of Rain',\n                     'Sun & clouds', '30% Chance of Rain')\n\nlevels(df_playlist$Weather) <- c(levels(df_playlist$Weather), 'NOT_ALLOCATED', 'MISSING')\n\ndf_playlist$Weather[df_playlist$Weather %in% weather_unalloc] <- 'NOT_ALLOCATED'\ndf_playlist$Weather[df_playlist$Weather == ''] <- 'MISSING'\n\ndf_playlist$Weather <- droplevels(df_playlist$Weather)\n\nsummary(df_playlist$Weather)\n\nggplot(data=df_playlist, aes(Weather, fill=Weather)) + geom_bar() + theme(axis.text.x = element_text(angle = 90))","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"hist(df_playlist$PlayerDay, 50)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"hist(df_playlist$PlayerGame, 100)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Temperature"},{"metadata":{"trusted":true},"cell_type":"code","source":"hist(df_playlist$Temperature,100)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# Ok, -999 seems to represent missing values; show plot w/o missings:\nhist(df_playlist$Temperature[df_playlist$Temperature>-999],25)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# convert temperature to factor\ndf_playlist$TemperatureClass <- cut(df_playlist$Temperature, c(-1000,0,10,20,30,40,50,60,70,80,90,100))\nlevels(df_playlist$TemperatureClass)[1] <- 'MISSING'\nsummary(df_playlist$TemperatureClass)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# plot(df_playlist$TemperatureClass, las=2)\nggplot(data=df_playlist, aes(TemperatureClass, fill=TemperatureClass)) + geom_bar() + scale_fill_manual(values=topo.colors(11))","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# remove numeric version now\ndf_playlist$Temperature <- NULL","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"hist(df_playlist$PlayerGamePlay, 100)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"# Combine injuries with play list"},{"metadata":{"trusted":true},"cell_type":"code","source":"# common features\nfeatures_common <- intersect(colnames(df_playlist), colnames(df_injury))\nprint(features_common)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# features only in play list\nfeatures_playlist_only <- setdiff(colnames(df_playlist), colnames(df_injury))\nprint(features_playlist_only)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# join tables (avoid duplicate columns)\nsuppressWarnings(df_inj_pl <- dplyr::left_join(df_injury, df_playlist[,c(features_playlist_only, 'PlayKey')], by='PlayKey'))\ndf_inj_pl$PlayKey <- as.factor(df_inj_pl$PlayKey)\n\n# check number of rows to verify if join works properly\nnrow(df_inj_pl)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"summary(df_inj_pl)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"### Some more evaluations"},{"metadata":{"trusted":true},"cell_type":"code","source":"# ínjury by stadium type\ntab_by_stadium <- table(df_inj_pl$StadiumType, df_inj_pl$BodyPart)\nprint(tab_by_stadium)\nmosaicplot(tab_by_stadium)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# ínjury by roster position\ntab_by_roster <- table(df_inj_pl$RosterPosition, df_inj_pl$BodyPart)\nprint(tab_by_roster)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# ínjury by position group\ntab_by_posgroup <- table(df_inj_pl$PositionGroup, df_inj_pl$BodyPart)\nprint(tab_by_posgroup)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# ínjury by play type\ntab_by_playtype <- table(df_inj_pl$PlayType, df_inj_pl$BodyPart)\nprint(tab_by_playtype)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# No toe injuries anymore?\ndplyr::filter(df_inj_pl, BodyPart=='Toes')","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Reason is that we have no PlayKey in this case, so we cannot join the additional data from the PlayList table..."},{"metadata":{"trusted":true},"cell_type":"code","source":"tab_by_temperature <- table(df_inj_pl$TemperatureClass, df_inj_pl$BodyPart)\nprint(tab_by_temperature)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"plot(df_inj_pl$TemperatureClass, las=2, main='Overall injuries by temperature class')","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"mosaicplot(tab_by_temperature)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# Make combined table available for download as RData\nsave(df_inj_pl, file='df_inj_pl.RData')","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"# Combine play list with injuries (=> can we predict something?)"},{"metadata":{"trusted":true},"cell_type":"code","source":"suppressWarnings(df_pl_inj <- dplyr::left_join(df_playlist, df_injury[,c('PlayKey','BodyPart')], by='PlayKey'))\ndf_pl_inj$PlayKey <- as.factor(df_pl_inj$PlayKey)\ndf_pl_inj$BodyPart <- droplevels(df_pl_inj$BodyPart)\n\nlevels(df_pl_inj$BodyPart) <- c(levels(df_pl_inj$BodyPart),'NONE')\ndf_pl_inj[is.na(df_pl_inj)] <- 'NONE'\nsummary(df_pl_inj$BodyPart)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"#### This is extremely imbalanced, therefore let's reduce to a binary view injury (1) / no injury (0)"},{"metadata":{"trusted":true},"cell_type":"code","source":"df_pl_inj$Target <- ifelse(df_pl_inj$BodyPart=='NONE',0,1)\ndf_pl_inj$Target <- as.factor(df_pl_inj$Target)\nsummary(df_pl_inj$Target)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"### Let's check out a few plots if we can see some predictive power of the attributes"},{"metadata":{"trusted":true},"cell_type":"code","source":"plot(df_pl_inj$PositionGroup, df_pl_inj$Target, ylim=c(0.999,1), main='Injury(y/n) vs PositionGroup')","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"plot(as.factor(df_pl_inj$PlayerGame), df_pl_inj$Target, ylim=c(0.999,1), main='Injury(y/n) vs PlayerGame')","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"#### Ok, this seems to be a nice trend. The more games the less likely an injury."},{"metadata":{"trusted":true},"cell_type":"code","source":"plot(df_pl_inj$Weather, df_pl_inj$Target, ylim=c(0.999,1), main='Injury(y/n) vs Weather')","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"plot(df_pl_inj$PlayType, df_pl_inj$Target, ylim=c(0.998,1), main='Injury(y/n) vs PlayType')","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"plot(df_pl_inj$TemperatureClass, df_pl_inj$Target, ylim=c(0.999,1), main='Injury(y/n) vs TemperatureClass')","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"plot(df_pl_inj$StadiumType, df_pl_inj$Target, ylim=c(0.999,1), main='Injury(y/n) vs StadiumType')","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"plot(df_pl_inj$FieldType, df_pl_inj$Target, ylim=c(0.999,1), main='Injury(y/n) vs FieldType')\n","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# Make combined table available for download as RData\nsave(df_pl_inj, file='df_pl_inj.RData')","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"# Run a first predictive model to find out relevant variables"},{"metadata":{"trusted":true},"cell_type":"code","source":"# use H2O\nlibrary(h2o)\n\nh2o.init()\n\n# select predictors\npredictors <- c(# 'RosterPosition',\n                # 'PlayerDay',\n                'PlayerGame',\n                'StadiumType',\n                'FieldType',\n                'Weather',\n                'PlayType',\n                'PlayerGamePlay',\n                'Position',\n                # 'PositionGroup',\n                'TemperatureClass')\n\n# upload training data to H2O environment\n# don'T care about train/test split here, as we have very few data and it is only about a first impression\ntrain.hex <- as.h2o(df_pl_inj[,c(predictors,'Target')])","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# show selected predictors\nprint(predictors)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# try GBM model (use 5 fold cross-validation)\nn.cv <- 5\nset.seed(1234)\n\nt1 <- Sys.time()\nprint(t1)\nfit_1 <- h2o.gbm(x=predictors, y='Target', training_frame=train.hex,\n                 nfolds = n.cv,\n                 learn_rate = 0.05,\n                 sample_rate = 1,\n                 max_depth = 4,\n                 min_rows = 10,\n                 col_sample_rate = 0.8,\n                 ntrees = 250,\n                 stopping_metric = 'AUC',\n                 stopping_rounds = 10,\n                 stopping_tolerance = 0.00001,\n                 score_each_iteration = TRUE,\n                 balance_classes = TRUE, # extremely imbalanced => use balancing feature\n                 seed = 1234 # make reproducible\n)\nt2 <- Sys.time()\nprint(t2-t1)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"print(fit_1)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# compare training and cross-validation metric\nprint(paste0('AUC on Training: ', round(h2o.auc(fit_1, train=TRUE),4)))\nprint(paste0('AUC on CV      : ', round(h2o.auc(fit_1, xval=TRUE),4)))","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# which are the important variables => show variable importance plot\nh2o.varimp_plot(fit_1)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# ... and the corresponding figures\nvi <- h2o.varimp(fit_1)\nprint(vi)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"# Try GLM model as (robust) alternative"},{"metadata":{"trusted":true},"cell_type":"code","source":"n.cv <- 5\nset.seed(1234)\n\nt1 <- Sys.time()\nprint(t1)\nfit_2 <- h2o.glm(x=predictors, y='Target', training_frame=train.hex,\n                 nfolds = n.cv,\n                 family = 'binomial',\n                 alpha = 0.5,\n                 lambda = NULL,\n                 lambda_search = TRUE,\n                 balance_classes = TRUE,\n                 seed = 1234\n)\nt2 <- Sys.time()\nprint(t2-t1)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"print(fit_2)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# compare training and cross-validation metric\nprint(paste0('AUC on Training: ', round(h2o.auc(fit_2, train=TRUE),4)))\nprint(paste0('AUC on CV      : ', round(h2o.auc(fit_2, xval=TRUE),4)))","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# which are the important variables => show variable importance plot\nh2o.varimp_plot(fit_2)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# ... and the corresponding figures\nvi2 <- h2o.varimp(fit_2)\nprint(vi2)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"# Now let's go for the track data..."},{"metadata":{"trusted":true},"cell_type":"code","source":"# be patient, loading takes a few minutes...\nt1 <- Sys.time()\ndf_track <- read.csv('../input/nfl-playing-surface-analytics/PlayerTrackData.csv')\nt2 <- Sys.time()\nprint(t2-t1)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"nrow(df_track)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# type conversion\ndf_track$PlayKey <- as.factor(df_track$PlayKey)\ndf_track$event <- as.factor(df_track$event)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"summary(df_track)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"hist(df_track$time)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# directions, peaks at 0, 90, 180 and 270 degrees\nhist(df_track$dir,100)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# which events are described?\ntable(df_track$event)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# heatmap of locations\nsmoothScatter(df_track$x,df_track$y)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# show location of specific events, e. g. field goals\nmy_events <- dplyr::filter(df_track, event=='field_goal')\n\n# heatmap\nsmoothScatter(my_events$x, my_events$y, main='Location of Field Goals')","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# \"classic\" plot\nplot(my_events$x, my_events$y, col='#00000040')\ngrid()","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"### Evaluate one play that lead to an injury"},{"metadata":{"trusted":true},"cell_type":"code","source":"# look e. g. at one of the foot injuries\ndplyr::filter(df_injury, BodyPart=='Foot')","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# select data subset via PlayKey\ndf_track_example <- dplyr::filter(df_track, PlayKey=='36621-13-58')","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"summary(df_track_example)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# what was happening?\nmy_events <- dplyr::filter(df_track_example, event != \"\")\nmy_events","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# show movement of player\ntackle_loc <- dplyr::filter(my_events, event=='tackle')\nplot(df_track_example$x, df_track_example$y, pch=3)\npoints(df_track_example$x[1], df_track_example$y[1], col='green', pch=16) # mark start with green symbol\npoints(tackle_loc$x, tackle_loc$y, col='red', pch=16) # mark tackle with red symbol\ngrid()","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# show speed as well as bubble size\nggplot(df_track_example, aes(x=x, y=y, size=s)) + geom_point(alpha=0.2) + scale_size(range = c(0.1,5))","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# distribution of directions\nhist_data <- hist(df_track_example$dir, 20, plot=FALSE)\ndf_hist_data <- data.frame(mids=hist_data$mids, counts=hist_data$counts)\ndf_hist_data$mids = as.factor(df_hist_data$mids)\n\ng <- ggplot(data=df_hist_data, aes(mids,counts)) + geom_col()\ng\n","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# plot in POLAR COORDINATES\ng + coord_polar()","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# some more evaluations\nplot(df_track_example$time, df_track_example$o, main='Orientation (black) and Direction (blue)', xlab='Time')\npoints(df_track_example$time, df_track_example$dir, col='blue')\ngrid()\n\nplot(df_track_example$time, df_track_example$s, main='Speed', xlab='Time')","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"### All tracks with injuries at once ####"},{"metadata":{"trusted":true},"cell_type":"code","source":"df_injury_select <- dplyr::filter(df_injury, PlayKey!='')\ninjury_keys <-as.character(df_injury_select$PlayKey)\n\ndf_tracks_w_inj <- dplyr::filter(df_track, PlayKey %in% injury_keys)\n\n# plot(df_tracks_w_inj$x, df_tracks_w_inj$y, pch='.')\n# grid()\n\n# plot tracks including speed and PlayKey (as color)\nggplot(df_tracks_w_inj, aes(x=x, y=y, size=s, col=PlayKey)) + \n  geom_point(alpha=0.2) + scale_size(range = c(0.1,5)) + theme(legend.position = \"none\") + ggtitle(\"Plays with injury\")","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# filter by knee injuries\ndf_injury_select_knee <- dplyr::filter(df_injury, PlayKey!='' & BodyPart=='Knee')\ninjury_keys_knee <- as.character(df_injury_select_knee$PlayKey)\ndf_tracks_w_inj_knee <- dplyr::filter(df_track, PlayKey %in% injury_keys_knee)\nggplot(df_tracks_w_inj_knee, aes(x=x, y=y, size=s, col=PlayKey)) + \n  geom_point(alpha=0.2) + scale_size(range = c(0.1,5)) + theme(legend.position = \"none\") + ggtitle(\"Plays with KNEE injury\")","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"# filter by ankle injuries\ndf_injury_select_ankle <- dplyr::filter(df_injury, PlayKey!='' & BodyPart=='Ankle')\ninjury_keys_ankle <- as.character(df_injury_select_ankle$PlayKey)\ndf_tracks_w_inj_ankle <- dplyr::filter(df_track, PlayKey %in% injury_keys_ankle)\nggplot(df_tracks_w_inj_ankle, aes(x=x, y=y, size=s, col=PlayKey)) + \n  geom_point(alpha=0.2) + scale_size(range = c(0.1,5)) + theme(legend.position = \"none\") + ggtitle(\"Plays with ANKLE injury\")","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":1}