### 1. Intro and explaination ### Set out to understand at what point primary and partner players collide and with what amount of force during concussion plays ### So, the first step was to combine all of the data to create one file with each player's information and NGS coordinates ### The files were too big for my computer, so had to combine and export them in 4 chunks ### The four files (2016 primary, 2016 partner, 2017 primary, 2017 partner) were then combined in Excel ### I've tried several times to run all 4 files on this, but there doesn't appear to be enough memory. ### So I will load one and then leave the code commented out for the others so you know what it would be ### Then the data manipulation done in Excel will be detailed below before loading the files back in ### 2. Combining the Raw data into workable form ## Loading necessary packages library(readr) library(sqldf) library(plyr) library(dplyr) library(lubridate) library(corrplot) library(glmnet) ### This section will be used for all four files, so only need to load and code once ## Load play information first # This should in theory be all punts Play_Info <- read.csv("../input/play_information.csv",stringsAsFactors = FALSE) # 6,681 # Plays <- Play_Info %>% distinct(PlayID) # 3,273 total punt plays ## Loading video data Video_Control <- read.csv("../input/video_footage-control.csv",stringsAsFactors = FALSE) # 37 # Adding a column for concussions Video_Control$Concussed <- 0 Video_Injury <- read.csv("../input/video_footage-injury.csv",stringsAsFactors = FALSE) # 37 # Adding a column for concussions Video_Injury$Concussed <- 1 # Changing column names before join colnames(Video_Injury)[which(names(Video_Injury) == "Type")] <- "Season_Type" colnames(Video_Injury)[which(names(Video_Injury) == "PREVIEW.LINK..5000K.")] <- "Preview.Link" Punt_Videos <- rbind(Video_Control,Video_Injury) Video_Review <- read.csv("../input/video_review.csv",stringsAsFactors = FALSE) # 37 Videos_All <- left_join(x = Punt_Videos, y = Video_Review, by = c("gamekey" = "GameKey", "playid" = "PlayID", "season" = "Season_Year")) # Changing column names before join colnames(Videos_All)[which(names(Videos_All) == "gamekey")] <- "GameKey" colnames(Videos_All)[which(names(Videos_All) == "playid")] <- "PlayID" # Joining punt play information to video data OnlyPunts_wVideo <- merge(x = Videos_All, y = Play_Info, by = c("GameKey","PlayID","Season_Type", "Week","PlayDescription"), all.x = TRUE) ### This is where files will start to change for season (2016/2017 and player type (primary/partner) ## 2016 primary and partner first (partner files will be the exact same but with a two next to them) OnlyPunts_wVideo_2016 <- filter(OnlyPunts_wVideo, season == "2016") # Primary (didn't need to do this step, but keeping it anyway) # OnlyPunts_wVideo_2016$GSISID <- # as.integer(OnlyPunts_wVideo_2016$Primary_Partner_GSISID) # Partner # OnlyPunts_wVideo_20162 <- filter(OnlyPunts_wVideo, # season == "2016") # Making the primary player GSISID the actual GSISID (looking back, I regret doing this bc it's confusing, but it works) #OnlyPunts_wVideo_20162$GSISID <- #as.integer(OnlyPunts_wVideo_2016$Primary_Partner_GSISID) ## Now 2017 # Primary #OnlyPunts_wVideo_2017 <- filter(OnlyPunts_wVideo, #season == "2017") # Making the primary player GSISID the actual GSISID (looking back, I regret doing this bc it's confusing, but it works) #OnlyPunts_wVideo_20172 <- filter(OnlyPunts_wVideo, #season == "2017") # Making the primary player GSISID the actual GSISID (looking back, I regret doing this bc it's confusing, but it works) #OnlyPunts_wVideo_20172$GSISID <- #as.integer(OnlyPunts_wVideo_2017$Primary_Partner_GSISID) ### Each load will still only happen once, but each manipulation will happen four times now that there are 4 differnt files ## Loading play player role data Player_Roles <- read.csv("../input/play_player_role_data.csv",stringsAsFactors = FALSE) # 146,573 ## Joining player roles to player punt data # 2016 Primary Punts_wPlayerRoles_16 <- merge(x = OnlyPunts_wVideo_2016, y = Player_Roles, by = c("GSISID" = "GSISID", "GameKey" = "GameKey", "PlayID" = "PlayID", "Season_Year" = "Season_Year"), all.x = TRUE) # 2016 Partner #Punts_wPlayerRoles_162 <- merge(x = OnlyPunts_wVideo_20162, y = Player_Roles, #by = c("GSISID" = "GSISID", # "GameKey" = "GameKey", # "PlayID" = "PlayID", # "Season_Year" = "Season_Year"), #all.x = TRUE) # 2017 Primary #Punts_wPlayerRoles_17 <- merge(x = OnlyPunts_wVideo_2017, y = Player_Roles, # by = c("GSISID" = "GSISID", # "GameKey" = "GameKey", # "PlayID" = "PlayID", # "Season_Year" = "Season_Year"), # all.x = TRUE) # 2017 Partner #Punts_wPlayerRoles_172 <- merge(x = OnlyPunts_wVideo_20172, y = Player_Roles, # by = c("GSISID" = "GSISID", # "GameKey" = "GameKey", # "PlayID" = "PlayID", # "Season_Year" = "Season_Year"), # all.x = TRUE) ## Loading player punt data Punt_Players <- read.csv("../input/player_punt_data.csv",stringsAsFactors = FALSE) # 3,259 ## Joining on player number and position # 2016 Primary Punts_wPlayers16 <- merge(x = Punts_wPlayerRoles_16, y = Punt_Players, by = c("GSISID" = "GSISID"), all.x = TRUE) # 2016 Partner #Punts_wPlayers162 <- merge(x = Punts_wPlayerRoles_162, y = Punt_Players, # by = c("GSISID" = "GSISID"), all.x = TRUE) # 2017 Primary #Punts_wPlayers17 <- merge(x = Punts_wPlayerRoles_17, y = Punt_Players, # by = c("GSISID" = "GSISID"), all.x = TRUE) # 2016 Partner #Punts_wPlayers172 <- merge(x = Punts_wPlayerRoles_172, y = Punt_Players, # by = c("GSISID" = "GSISID"), all.x = TRUE) ## Now time to join NGS from each game one by one to these punt plays ## Loading 2016 season (this will take awhile) Pre_16 <- read.csv("../input/NGS-2016-pre.csv",stringsAsFactors = FALSE) # 6,824,901 Reg_1to6_16 <- read.csv("../input/NGS-2016-reg-wk1-6.csv",stringsAsFactors = FALSE) # 8,706,352 Reg_7to12_16 <- read.csv("../input/NGS-2016-reg-wk7-12.csv",stringsAsFactors = FALSE) # 8,382,659 Reg_13to17_16 <- read.csv("../input/NGS-2016-reg-wk13-17.csv",stringsAsFactors = FALSE) # 7,611,809 Post_16 <- read.csv("../input/NGS-2016-post.csv",stringsAsFactors = FALSE) # 963,324 ## Joining all of 2016 PreReg1 <- rbind(Pre_16,Reg_1to6_16) PreReg12 <- rbind(PreReg1,Reg_7to12_16) PreReg123 <- rbind(PreReg12,Reg_13to17_16) All_2016 <- rbind(PreReg123,Post_16) # 32,489,045 ## Creating final files for 2016 # Primary Punts_NGS_Primary_2016 <- merge(x = Punts_wPlayers16, y = All_2016, by = c("Season_Year" = "Season_Year", "GameKey" = "GameKey", "PlayID" = "PlayID", "GSISID" = "GSISID"), all.x = TRUE) # 4,438 rows ### Export file write.csv(Punts_NGS_Primary_2016, "Punts_NGS_Primary_2016.csv") # Primary #Punts_NGS_Partner_2016 <- merge(x = Punts_wPlayers162, y = All_2016, # by = c("Season_Year" = "Season_Year", # "GameKey" = "GameKey", # "PlayID" = "PlayID", # "GSISID" = "GSISID"), # all.x = TRUE) # 4,438 rows ### Export file #write.csv(Punts_NGS_Partner_2016, "Punts_NGS_Partner_2016.csv") ## Now loading 2017 NSG (this is what takes so long and isn't able to load...would need to be run in a different kernel) #Pre_17 <- read.csv("NGS-2017-pre.csv",stringsAsFactors = FALSE) # 6,824,901 #Reg_1to6_17 <- read.csv("NGS-2017-reg-wk1-6.csv",stringsAsFactors = FALSE) # 9,433,922 #Reg_7to12_17 <- read.csv("NGS-2017-reg-wk7-12.csv",stringsAsFactors = FALSE) # 8,670,288 #Reg_13to17_17 <- read.csv("NGS-2017-reg-wk13-17.csv",stringsAsFactors = FALSE) # 8,252,492 #Post_17 <- read.csv("NGS-2017-post.csv",stringsAsFactors = FALSE) # 1,037,158 ## Joining all of 2017 #PreReg1_17 <- rbind(Pre_17,Reg_1to6_17) ##PreReg12_17 <- rbind(PreReg1_17,Reg_7to12_17) #PreReg123_17 <- rbind(PreReg12_17,Reg_13to17_17) #All_2017 <- rbind(PreReg123_17,Post_17) # 34,003,445 #Punts_NGS_Primary_2017 <- merge(x = Punts_wPlayers17, y = All_2017, # by = c("Season_Year" = "Season_Year", # "GameKey" = "GameKey", # "PlayID" = "PlayID", # "GSISID" = "GSISID"), # all.x = TRUE) ### Export file #write.csv(Punts_NGS_Primary_2017, "Punts_NGS_Primary_2017.csv") #Punts_NGS_Partner_2017 <- merge(x = Punts_wPlayers172, y = All_2017, # by = c("Season_Year" = "Season_Year", # "GameKey" = "GameKey", # "PlayID" = "PlayID", # "GSISID" = "GSISID"), # all.x = TRUE) ### Export file # write.csv(Punts_NGS_Partner_2017, "Punts_NGS_Partner_2017.csv") ### There was a joining error in the code above, resulting in a few plays loading without NGS bc the Season key was NA ### Below is the code to fix that, again commented out bc of loading issues ### Feel free to run all together in seperate kernels or if you have a GPU ### Some plays had NA in the Season column, so NGS didn't get pulled in ### This piece of code is meant to correct those couple of plays ### Then will be combined into the final Excel file (to be loaded back in next) ## Correcting 2016 missing plays first # First missing play: 1976, primary 32214, partner 32807 #Play_1976 <- filter(Reg_wk7to12_16, PlayID == 1976 & GSISID == 32214 # | PlayID == 1976 & GSISID == 32807) #PlayDetails_1976 <- merge(x = Play_Info, y = Play_1976, # by.x = c("PlayID","GameKey","Season_Year"), # by.y = c("PlayID","GameKey","Season_Year")) #Final_1976 <- merge(x = Player_Roles, y = PlayDetails_1976, # by.x = c("PlayID","GameKey","Season_Year","GSISID"), # by.y = c("PlayID","GameKey","Season_Year","GSISID")) # 752 for both players #write.csv(Final_1976, "Final_1976.csv") # Second missing play: 3278, primary 28620, partner 27860 #Play_3278 <- filter(Reg_wk7to12_16, PlayID == 3278 & GSISID == 28620 # | PlayID == 3278 & GSISID == 27860) #PlayDetails_3278 <- merge(x = Play_Info, y = Play_3278, # by.x = c("PlayID","GameKey","Season_Year"), # by.y = c("PlayID","GameKey","Season_Year")) #Final_3278 <- merge(x = Player_Roles, y = PlayDetails_3278, # by.x = c("PlayID","GameKey","Season_Year","GSISID"), # by.y = c("PlayID","GameKey","Season_Year","GSISID")) # 680 for both players #write.csv(Final_3278, "Final_3278.csv") # Third missing play: 2341, primary 32007, partner 32998 #Play_2341 <- filter(Reg_wk13to17_16, PlayID == 2341 & GSISID == 32007 # | PlayID == 2341 & GSISID == 32998) #PlayDetails_2341 <- merge(x = Play_Info, y = Play_2341, # by.x = c("PlayID","GameKey","Season_Year"), # by.y = c("PlayID","GameKey","Season_Year")) #Final_2341 <- merge(x = Player_Roles, y = PlayDetails_2341, # by.x = c("PlayID","GameKey","Season_Year","GSISID"), # by.y = c("PlayID","GameKey","Season_Year","GSISID")) # 502 for both players #write.csv(Final_2341, "Final_2341.csv") # Fourth missing play: 2902, primary 23564, partner 31844 #Play_2902 <- filter(Reg_wk13to17_16, PlayID == 2902 & GameKey == 266 & GSISID == 23564 # | PlayID == 2902 & GameKey == 266 & GSISID == 31844) #PlayDetails_2902 <- merge(x = Play_Info, y = Play_2902, # by.x = c("PlayID","GameKey","Season_Year"), # by.y = c("PlayID","GameKey","Season_Year")) #Final_2902 <- merge(x = Player_Roles, y = PlayDetails_2902, # by.x = c("PlayID","GameKey","Season_Year","GSISID"), # by.y = c("PlayID","GameKey","Season_Year","GSISID")) # 2123 for both players #write.csv(Final_2902, "Final_2902.csv") # Fifth missing play: 3609, primary 23742, partner 31785 #Play_3609 <- filter(Reg_wk13to17_16, PlayID == 3609 & GameKey == 274 & GSISID == 23742 # | PlayID == 3609 & GameKey == 274 & GSISID == 31785) #PlayDetails_3609 <- merge(x = Play_Info, y = Play_3609, # by.x = c("PlayID","GameKey","Season_Year"), # by.y = c("PlayID","GameKey","Season_Year")) #Final_3609 <- merge(x = Player_Roles, y = PlayDetails_3609, # by.x = c("PlayID","GameKey","Season_Year","GSISID"), # by.y = c("PlayID","GameKey","Season_Year","GSISID")) # 740 for both players # write.csv(Final_3609, "Final_3609.csv") ## Now 2017 play fixes (due to the same season joining error) # First missing play: 183, primary 33813, partner 33841 # Play_183 <- filter(Pre_2017, PlayID == 183 & GameKey == 384 & GSISID == 33813 # | PlayID == 183 & GameKey == 384 & GSISID == 33841) #PlayDetails_183 <- merge(x = Play_Info, y = Play_183, # by.x = c("PlayID","GameKey","Season_Year"), # by.y = c("PlayID","GameKey","Season_Year")) #Final_183 <- merge(x = Player_Roles, y = PlayDetails_183, # by.x = c("PlayID","GameKey","Season_Year","GSISID"), # by.y = c("PlayID","GameKey","Season_Year","GSISID")) # 796 for both players #write.csv(Final_183, "Final_183.csv") # Second missing play: 1088, primary 32615, partner 31999 #Play_1088 <- filter(Pre_2017, PlayID == 1088 & GameKey == 392 & GSISID == 32615 # | PlayID == 1088 & GameKey == 392 & GSISID == 31999) #PlayDetails_1088 <- merge(x = Play_Info, y = Play_1088, # by.x = c("PlayID","GameKey","Season_Year"), # by.y = c("PlayID","GameKey","Season_Year")) #Final_1088 <- merge(x = Player_Roles, y = PlayDetails_1088, # by.x = c("PlayID","GameKey","Season_Year","GSISID"), # by.y = c("PlayID","GameKey","Season_Year","GSISID")) # 1072 for both players #write.csv(Final_1088, "Final_1088.csv") # Third missing play: 3630, primary 30171, partner 29384 #Play_3630 <- filter(Pre_2017, PlayID == 3630 & GameKey == 357 & GSISID == 30171 # | PlayID == 3630 & GameKey == 357 & GSISID == 29384) #PlayDetails_3630 <- merge(x = Play_Info, y = Play_3630, # by.x = c("PlayID","GameKey","Season_Year"), # by.y = c("PlayID","GameKey","Season_Year")) #Final_3630 <- merge(x = Player_Roles, y = PlayDetails_3630, # by.x = c("PlayID","GameKey","Season_Year","GSISID"), # by.y = c("PlayID","GameKey","Season_Year","GSISID")) # 830 for both players #write.csv(Final_3630, "Final_3630.csv") # Fourth missing play: 602, primary 33260, partner 31697 #Play_602 <- filter(Reg_wk13to17_17, PlayID == 602 & GameKey == 601 & GSISID == 33260 # | PlayID == 602 & GameKey == 601 & GSISID == 31697) #PlayDetails_602 <- merge(x = Play_Info, y = Play_602, # by.x = c("PlayID","GameKey","Season_Year"), # by.y = c("PlayID","GameKey","Season_Year")) #Final_602 <- merge(x = Player_Roles, y = PlayDetails_602, # by.x = c("PlayID","GameKey","Season_Year","GSISID"), # by.y = c("PlayID","GameKey","Season_Year","GSISID")) # 786 for both players #write.csv(Final_602, "Final_602.csv") # Fifth missing play: 978, primary 29793, partner 32114 #Play_978 <- filter(Reg_wk13to17_17, PlayID == 978 & GameKey == 607 & GSISID == 29793 # | PlayID == 978 & GameKey == 607 & GSISID == 32114) #PlayDetails_978 <- merge(x = Play_Info, y = Play_978, # by.x = c("PlayID","GameKey","Season_Year"), # by.y = c("PlayID","GameKey","Season_Year")) #Final_978 <- merge(x = Player_Roles, y = PlayDetails_978, # by.x = c("PlayID","GameKey","Season_Year","GSISID"), # by.y = c("PlayID","GameKey","Season_Year","GSISID")) # 1192 for both players #write.csv(Final_978, "Final_978.csv") ##### Ok, now loading the Excel file back in ### Basically, each play was it's own Excel tab. with primary and partner player data both together, joined by the play timestamp ### This way I could see each players x and y coordinates for every tenth of a second of each play ### Then, using the absolute difference between the x,y coordinates for both players, I found the point point of impact ### The point of impact was is defined as the tenth of a second the two player coordinates were closest together ### To calculate force, this row and the row directly before it were used to calculate deceleration or acceleration ### The distance column was used to calculate velocity at the time of impact ### Below is the Excel file for each head to head or head to body concussion play in 2016 and 2017 that I was given # FinalFile <- read.csv("../input/Combined Punt Plays_Excel.csv",stringsAsFactors = FALSE) ### Ok this isn't working either, so there will just be a screenshot of 2016 and 2017 in the slides ### Sorry for all this. This is my first kernel and I didn't leave enough time to troubleshoot