{"cells":[{"metadata":{"_uuid":"bd57b43138d0ceb611d9afe287f7b5e5eae295b0"},"cell_type":"markdown","source":"* [<span style=\"color:darkred\">Abstract</span>](#Abstract)\n* [<span style=\"color:darkred\">Overview</span>](#Overview)\n* [<span style=\"color:darkred\">Details:</span>](#Details:)\n    - [<span style=\"color:darkred\">1. Problem definition and main challenge</span>](#1.)\n    - [<span style=\"color:darkred\">2. Data preprocessing and trajectory characterization at player-play level</span>](#2.)\n    - [<span style=\"color:darkred\">3. Information Value with cross validated penalty: Who suffers a concussion? Who causes a concussion?</span>](#3.)\n    - [<span style=\"color:darkred\">4. Preliminary insights</span>](#4.)\n    - [<span style=\"color:darkred\">5. Focusing on the most important predictor: Initial formations</span>](#5.)\n    - [<span style=\"color:darkred\">6. Underlying patterns of riskier punt return formations</span>](#6.)\n    - [<span style=\"color:darkred; font-weight: bolder\">7. Conclusions: next steps and recommendation</span>](#7.)\n    - [<span style=\"color:darkred\">Apendix1: Can we predict a future concussion? A possible line of research</span>](#Apendix1:)\n    - [<span style=\"color:darkred\">Apendix2: R Packages citation</span>](#Apendix2:)\n  \n "},{"metadata":{"_uuid":"e182aefefa902c43e0d7b5338eeac10811b70492","_execution_state":"idle","trusted":false},"cell_type":"markdown","source":"## Abstract"},{"metadata":{"_uuid":"4511e0a659d8afa66f9c140c7cd1845ce33b56f2"},"cell_type":"markdown","source":"Information Value and Weight of Evidence are perfect tools to detect real patterns in \"rare event\" datasets.\n\nThis tools have proven effective to assess credit scoring risk. Here they will be applied to the different field: sports injury risk.\n\nThe small number of concussive cases in  the dataset poses biggest difficulty of this challenge. It is also a risk for the organizers' objectives as  actions based on \"analysis overfitting\" to random in sample patterns could misdirect  precious time and effort  with no effect on safety improvement.\n\nA disciplined approach with repeated cross validation allows to avoid this risk as progressive narrowing focus sheds light on meaningful patterns. Overfitting risk also  motivates the preprocessing decision  to compress spatial NGS as characterized trajectories.\n"},{"metadata":{"_uuid":"f5150fd880e9065f7b1bf11d36538436737f04a1"},"cell_type":"markdown","source":"## Overview"},{"metadata":{"_uuid":"0492bb9ab73a36226eceb83361eebb06230d8882"},"cell_type":"markdown","source":"**This notebook includes all code to go from raw data to relevant patterns more probably related to Punt play concussions. **\n\n> <span style=\"color:darkred; font-size:22px\"> \"Can Data Science help to reduce concussion in NFL punt plays, without spoiling the game?\" </span>\n\n\nIn this analytics competition data science community is asked to help with a serious problem: accidental concussions in NFL plays, specifically Punt plays.\n\nProvided data is Punt Plays stats of NFL seasons 2016 to 2017 at game level, play level and player level. Also included high temporal resolution NGS spatial data (\"Next Generation Stats\") that make it possible to characterize trajectories of any player with great detail.\n\nThis Kaggle competition format is unusually open. The objective is to  get actionable insights that limit the amount of accidents while preserving all essential aspects of the sport.\n\nConcussions occurrence is so scarce that most effort will be made not to overfit the analysis with attractive \"only in sample\", and thus useless, patterns. \n\nPreprocessing steps, including trajectory characterization are usual reproducible best practices. \n\nMost interesting part is assessment of importance of features related to a) suffering a concussion or b) causing a concussion in a Punt play. \n  \nOnce proper methodology is set not to be deceived by random patterns the focus is progressively narrowed to detect real actionable patterns  related to concussions.\n\n"},{"metadata":{"_uuid":"297789d7106026f30fd59ea91b7de1bf0281f75c"},"cell_type":"markdown","source":"## Details:"},{"metadata":{"_uuid":"77cd0083c16535feb0459605601688222ec7d3c9"},"cell_type":"markdown","source":"<a></a>"},{"metadata":{"_uuid":"1f61191ba8b4c80ef4c7a78a29541e30f055f071"},"cell_type":"markdown","source":"\n###  1.\n### Problem definition and main challenge "},{"metadata":{"_uuid":"d76b02df4e9a8b4b4b5464c7a796bb4fab60959f"},"cell_type":"markdown","source":"First, the bad news: Before deploying our statistical firepower enter biggest issue with this data: there are 6,670 plays, in which 22 players face a small -unknown- individual risk of concussion. This is 146573 risk events, of which only 37 are concussions. **37 \"positives\" is too few for reliable inference**. But with proper approach it should be possible to find concussion related patterns and assess how real they are as opposed to random circumstances. This is important, as any actionable measure will need the persistence of the patterns to be effective. **If there are usable patterns in the data the analysis will spot them**. For Data Science, that is as good as it gets.\n\n\nFortunately we have a perfect tool for this task, related to Information Theory;\n\n> <span style=\"color:darkred; font-size:22px\">Information Value and Weight of Evidence are perfect for assessing  uncertainty of binary predictions given a set of variables</span> \n\nRealize that we don't know yet if it is easier to predict who suffers a concussion than who is involved in causing it, or if any of them is predictable at all. So it makes sense to study separately both targets, at least in the beginning.\n\n**Any predictor with a low penalized Information Value (IV) no matter how good it may look can not be considered reliable** and hence shouldn't motivate any action. \n\nLet's get data ready:\n"},{"metadata":{"_uuid":"56f5000b73836d639ebf3cafc177bf3e5f3bc9fd"},"cell_type":"markdown","source":"### 2.\n### Data preprocessing and trajectory characterization at player-play level"},{"metadata":{"_uuid":"0588aed5cbe4fd88ac12151965e7fabb1c37a106"},"cell_type":"markdown","source":"Let's get data ready for IV screening. (Usual best practices here. You can choose to run the NGS part uncommenting it or load directly the output of linked dataset to save kernel processing time.)\n\n- Each data point is a player in a unique play of a unique game. In that observation all information about game, play and player is included.\n- Two separate targets, \"SUFFERS_CONCUSSION\" and \"CAUSES_CONCUSSION\".\n- Each player trajectory in each play will be included as its **trajectory characterization parameters**.\n- Cleaning of category names where needed.\n- Additional features: PLAY FORMATIONS (combination offense defense), FLAGS YARDLINE_IS_HOME, POSS_TEAM_IS_HOME, SCORE DIFFERENCE\n- Factor encoding of categoricals: there are not high cardinalities and simple rank frequency encoding is used\n"},{"metadata":{"_kg_hide-output":true,"_kg_hide-input":true,"trusted":true,"_uuid":"b7880f1e1cf05166911dea8644bf84f5159315b4"},"cell_type":"code","source":"# LOAD LIBRARIES\nlibrary(fst, quietly = T); library(data.table, quietly = T); library(lubridate, quietly = T); library(easycsv); `%>%` <- magrittr::`%>%` ; library(trajr); library(Information); library(ggplot2)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true,"_uuid":"80997003cdb1ff6cd23a42a1b1515cb1d5107b98"},"cell_type":"code","source":"#ITERATIONS NUMBER FOR REPEATED CROSS VALIDATION:\nrepeatedcv_niters <- 100","execution_count":null,"outputs":[]},{"metadata":{"_kg_hide-input":true,"_kg_hide-output":true,"trusted":true,"_uuid":"50780f07dc0f8bf2d40e9bc3ae3efa7366d1de1f"},"cell_type":"code","source":"#LOAD NON-NGS DATA:\nvideo_review_concussive_games <- fread('../input/NFL-Punt-Analytics-Competition/video_review.csv')\ngame_data <- fread('../input/NFL-Punt-Analytics-Competition/game_data.csv')\nplay_information <- fread('../input/NFL-Punt-Analytics-Competition/play_information.csv')\nplay_player_role_data <- fread('../input/NFL-Punt-Analytics-Competition/play_player_role_data.csv')\nplayer_punt_data <- fread('../input/NFL-Punt-Analytics-Competition/player_punt_data.csv')\n\nplayer_punt_data <- player_punt_data[, .(Position = Position[1]), by = GSISID]\n\nplay_player_role_data <- player_punt_data[play_player_role_data, on = \"GSISID\"]\n\nplay_player_role_data[, id_player_play_game := paste(GSISID, PlayID, GameKey, sep = \"_\")]\nplay_player_role_data <- play_information[, -(\"Season_Year\"), with = F][play_player_role_data, on = c(\"GameKey\", \"PlayID\")]\nplay_player_role_data <- game_data[, -c(\"Season_Year\", \"Season_Type\", \"Week\", \"Game_Date\"), with = F][play_player_role_data, on = c(\"GameKey\")]\nsetnames(video_review_concussive_games, \"GSISID\", \"Concussioned_GSISID\")\n\nplay_player_role_data <- video_review_concussive_games[, -c(\"Season_Year\"), with = F][play_player_role_data, on = c(\"GameKey\", \"PlayID\")]\n#play_player_role_data\n#play_player_role_data[!is.na(Turnover_Related)][, table(Turnover_Related)]\n\nplay_player_role_data[, Turnover_Related := NULL]\n\n#RENAME \nplayer_play_all_data <- play_player_role_data\nrm(play_player_role_data); gc()\n\n#TARGETS:  PRIMARY PLAYER & PRIMARY PARTNER \nplayer_play_all_data[GSISID == Concussioned_GSISID, SUFFERS_CONCUSSION := 1]\nplayer_play_all_data[GSISID == Primary_Partner_GSISID, CAUSES_CONCUSSION := 1]\n\nplayer_play_all_data[, c(\"Concussioned_GSISID\", \"Player_Activity_Derived\", \"Primary_Impact_Type\", \"Primary_Partner_GSISID\", \"Primary_Partner_Activity_Derived\", \"Friendly_Fire\") := NULL]\n\n#SOME MORE CLEANING\nplayer_play_all_data[, c(\"PlayDescription\", \"Season_Year\",\n                         # \"HomeTeamCode\",\"VisitTeamCode\",\n                         \"Home_Team_Visit_Team\") := NULL]\n\nplayer_play_all_data[is.na(SUFFERS_CONCUSSION), SUFFERS_CONCUSSION := 0]\nplayer_play_all_data[is.na(CAUSES_CONCUSSION), CAUSES_CONCUSSION := 0]\n\n#unique(player_play_all_data$StadiumType)\n\nplayer_play_all_data[StadiumType %in% c(\"Outdoors\", \"outdoor\", \"Outdor\", \"Oudoor\", \"Ourdoor\", \"Outddors\", \"Outside\", \"Open\", \"Retr. Roof-Open\", \"Retr. Roof - Open\", \"Retr. roof - closed\", \"\"), StadiumType := \"Outdoor\"]\nplayer_play_all_data[StadiumType %in% c(\"Dome\",\"Indoor, Roof Closed\", \"Indoor, non-retractable roof\", \"Retr. Roof-Closed\", \"Indoor, fixed roof\", \"Indoors (Domed)\", \"Domed, closed\", \"Indoors\", \"Indoor, Fixed Roof\", \"Closed Dome\", \"Retr. Roof - Closed\", \"Indoor, Non-Retractable Dome\", \"Retr. Roof Closed\", \"Dome, closed\", \"Outdoor Retr Roof-Open\", \"Retractable Roof\",\"Indoor, Open Roof\"), StadiumType := \"Indoor\"]\n#Tom Benson Hall of Fame Stadium y e Heinz Field:\nplayer_play_all_data[StadiumType %in% c(\"Turf\", \"Heinz Field\"), StadiumType := \"Outdoor\"]\n\n#unique(player_play_all_data$StadiumType)\n#unique(player_play_all_data$Turf)\n\nplayer_play_all_data[Turf %in% c(\"Grass\",\"grass\", \"Naturall Grass\", \"Natural Grass\", \"Natural Grass\", \"Natural\",\"Natrual Grass\", \"\"), Turf := \"Natural grass\"]\nplayer_play_all_data[Turf %in% c(\"FieldTurf\", \"Field Turf\", \"Synthetic\", \"FieldTurf360\",\"Artifical\", \"UBU Sports Speed S5-M\", \"UBU Speed Series S5-M\", \"FieldTurf 360\",         \"Field turf\",\"A-Turf Titan\", \"UBU Speed Series-S5-M\", \"DD GrassMaster\"), Turf := \"Artificial\" ]\n\n#unique(player_play_all_data$Turf)\n#player_play_all_data[, Turf[1], by = Stadium][order(V1)]\n\ntodos_Sunny <- c(unique(player_play_all_data$GameWeather)[grep(\"unny\", unique(player_play_all_data$GameWeather))][-1], unique(player_play_all_data$GameWeather)[grep(\"lear\", unique(player_play_all_data$GameWeather))])\ntodos_Rain <- c(unique(player_play_all_data$GameWeather)[grep(\"ain\", unique(player_play_all_data$GameWeather))][-1], unique(player_play_all_data$GameWeather)[grep(\"howers\", unique(player_play_all_data$GameWeather))], unique(player_play_all_data$GameWeather)[grep(\"torms\", unique(player_play_all_data$GameWeather))] ) \ntodos_Snow <- unique(player_play_all_data$GameWeather)[grep(\"now\", unique(player_play_all_data$GameWeather))][-2]\ntodos_Cloudy <- unique(player_play_all_data$GameWeather)[grep(\"loudy\", unique(player_play_all_data$GameWeather))][-2]\n\nplayer_play_all_data[GameWeather %in% c(todos_Sunny, \"Suny\", \"Fair\", \"Sun & clouds\", \"CLEAR\"), GameWeather := \"Sunny\"]\nplayer_play_all_data[GameWeather %in% todos_Rain, GameWeather := \"Rain\"]\nplayer_play_all_data[GameWeather %in% todos_Snow, GameWeather := \"Snow\"]\nplayer_play_all_data[GameWeather %in% c(todos_Cloudy, \"Hazy\",\"Hazy, hot and humid\", \"Partly CLoudy\",\"Mostly CLoudy\",\"Mostly Coudy\",\"Coudy\" ), GameWeather := \"Cloudy\"]\nplayer_play_all_data[!GameWeather %in% c(\"Sunny\", \"Rain\", \"Snow\", \"Cloudy\"), GameWeather := \"\"]\n\n#unique(player_play_all_data$GameWeather)\n\n#OUDOOR WEATHER EITHER FORECASTS OR REDUNDANT INFO\nplayer_play_all_data[, OutdoorWeather := NULL]\n\n#ENOUGH GRANULARITY ALREADY WITH WEEK + SEASON TYPE, NO NEED OF DATE\nplayer_play_all_data[, Game_Date := NULL]\n\n#ITS ALL PUNTS\nplayer_play_all_data[, Play_Type := NULL]\n\ngc(verbose = F)\n\n#GAME CLOCK TO SECONDS(LUBRIDATE)\nplayer_play_all_data[, Game_Clock := period_to_seconds(ms(Game_Clock))]\n\n#hist(player_play_all_data$Game_Clock)\n\n#FLAGS YARDLINE_IS_HOME Y POSS_TEAM_IS_HOME\nplayer_play_all_data <- tidyr::separate(data = player_play_all_data, col = YardLine, into = c(\"YARDLINE_IS_HOME\", \"YARDS\"), sep = \" \")\nplayer_play_all_data[, YARDLINE_IS_HOME := (YARDLINE_IS_HOME == HomeTeamCode)]\nplayer_play_all_data[, Poss_Team := (Poss_Team == HomeTeamCode)]\nsetnames(player_play_all_data, \"Poss_Team\", \"POSSTEAM_IS_HOME\")\n\n#player_play_all_data[, mean(POSSTEAM_IS_HOME==YARDLINE_IS_HOME, na.rm = T)]\n#[1] 0.8435941 KEEP BOTH\n\n#NO NEED OF  HOME & VISIT CODES:\nplayer_play_all_data[, c(\"HomeTeamCode\", \"VisitTeamCode\") := NULL]\n\n#PLAY FORMATIONS:\nplay_formations <- player_play_all_data[order(Role)][,paste(Role, collapse=\"_\"),by=c(\"GameKey\", \"PlayID\")]\n#length(unique(play_formations$V1)) \n#[1] 722 UNIQUE (COMBINED OFFENSE AND DEFENSE) FORMATIONS \n#sort(table(play_formations$V1), decreasing = T)[1:15]\n\nsetnames(play_formations, \"V1\", \"FORMATION\")\n#head(play_formations); length(unique(play_formations$FORMATION))\n\nplayer_play_all_data <- play_formations[player_play_all_data, on = c(\"GameKey\", \"PlayID\")]\n\n\n#SPLIT SCORES HOME-VISITING COLUMNAS, + Additional FEATURE = DIFFERENCE\nplayer_play_all_data <- tidyr::separate(data = player_play_all_data, col = Score_Home_Visiting, into = c(\"SCORE_HOME\", \"SCORE_VISITING\"), sep = \" - \")\nplayer_play_all_data[, `:=`(SCORE_HOME = as.integer(SCORE_HOME),\n                            SCORE_VISITING = as.integer(SCORE_VISITING))]\ninvisible(gc())\n\nplayer_play_all_data[, \"DIFFSCORE_HV\" := (SCORE_HOME - SCORE_VISITING)]\n\n#REORDERING\nsetcolorder(player_play_all_data, c(\"GameKey\",\"PlayID\", \"GSISID\",\"id_player_play_game\", \"SUFFERS_CONCUSSION\", \"CAUSES_CONCUSSION\"))\n\n# NOT HIGH CARDINALITY CATEGORICALS, ONE MODERATE CARDINALITY (FORMATIONS)\n# FACTORS ENCODING ALL CATEGORICALS,  RANK FREQUENCY ENCODING FORMATIONS\ncharcols  <-  names(player_play_all_data)[sapply(player_play_all_data, is.character)]\n#charcols\n#  [1] \"id_player_play_game\" \"FORMATION\"           \"Game_Day\"            \"Game_Site\"           \"Start_Time\"          \"Home_Team\"           \"Visit_Team\"         \n#  [8] \"Stadium\"             \"StadiumType\"         \"Turf\"                \"GameWeather\"         \"Season_Type\"         \"YARDS\"               \"Position\"           \n# [15] \"Role\"\n#EXCLUDE: \"id_player_play_game\"\n#TO INTEGER: \"YARDS\"\n#FACT IN FREQ: \"FORMATION\"\n#PSEUDO-NUMERIC: \"Start_Time\"\n#USUAL FACTORS(NATURAL LEVEL ORDER): \"Game_Day\"\nplayer_play_all_data[, c(\"YARDS\") := as.integer(YARDS)]\nplayer_play_all_data[, c(\"FORMATION\") := forcats::fct_infreq(FORMATION)]\nplayer_play_all_data[, c(\"FORMATION\") := forcats::fct_infreq(FORMATION)]\nplayer_play_all_data[, c(\"Start_Time\") := as.integer(gsub(\":\", \"\", Start_Time))]\n#CHARCOLS LEFT:\ncharcols  <-  names(player_play_all_data)[sapply(player_play_all_data, is.character)]\n#charcols\n# [1] \"id_player_play_game\" \"Game_Day\"            \"Game_Site\"           \"Home_Team\"           \"Visit_Team\"          \"Stadium\"             \"StadiumType\"        \n#  [8] \"Turf\"                \"GameWeather\"         \"Season_Type\"         \"Position\"            \"Role\"        \n#TO FACTORS EXCLUDING id_player_play_game:\nplayer_play_all_data[, (charcols)[-1] := lapply(.SD, function(x) as.factor(x)), .SDcols = charcols[-1]]\n#LOGICAL AS  NUMERIC:\nlogicols  <-  names(player_play_all_data)[sapply(player_play_all_data, is.logical)] #OJO QUE PARECE QUE HACE FALTA PARENTESIS (!!!\n#logicols #[1] \"YARDLINE_IS_HOME\" \"POSSTEAM_IS_HOME\"\nplayer_play_all_data[, (logicols) := lapply(.SD, function(x) as.integer(x)), .SDcols = logicols] #OJO QUE PARECE QUE HACE FALTA PARENTESIS!!!\n\n#str(player_play_all_data)\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"c89bd26195f6faad779168a5ce9673fc48e5f733"},"cell_type":"markdown","source":"Once non-spatial data is ready,  we can have a look:"},{"metadata":{"trusted":true,"_uuid":"9effda2ecd411d007d5903515a28c26cb8d5cb96","_kg_hide-input":true,"scrolled":true},"cell_type":"code","source":"str(player_play_all_data)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"e8e0dcb5720826e05be2b706eccbdd3104207677"},"cell_type":"markdown","source":"From here it gets more interesting.\n\nWe have defined 146.573 \"individual risk situations\" this is, plays played by each player. \n\nTime to include spatial info of each of this individual event from NGS data (Next Gen Stats).\n\nHow to do it? In general, there are unlimited options. NGS data has incredible detail. In this case though,  flexibility is not an option. Overfitting risk doesnt mix well with flexibility. We need to somehow characterize trajectories keeping as much individual information as possible and discarding most of the noise. We need  **the  \"fingerprint\" of each trajectory**. \n\nFor this task we use some very handy tools designed for scientific researching  movement patterns of birds, insects, and all kind of wildlife. If good enough to cluster extremely fast and complex bird movements it will probably do the job for human trajectories.\n\nThe features we will extract to **characterize each trajectory**:\n\n  - mean, max and standard deviation of speed\n  - mean, max and standard deviation of acceleration \n  - min acceleration (biggest deceleration) \n  - straightness measure  \n  - sinuosity measure\n  - maximum expected displacement\n  - mean, max and standard deviation  of directional change\n  - length of trajectory\n  - distance covered by trajectory\n  - total time of trajectory movement\n  - module of mean velocity vector\n  - module of mean vector of turning angles\n  - expected square displacement of a correlated random walk"},{"metadata":{"trusted":true,"_uuid":"b6b4a63bbe134555fad859b2dc5795e138ead094","_kg_hide-input":true,"_kg_hide-output":true},"cell_type":"code","source":"#LOAD AND BIND ALL NGS FILES:\n\n#1)MERGE AND PROCESS ALL NGS DATA:\nfread_folder(directory=\"../input/NFL-Punt-Analytics-Competition/\")\nprint(ls())\n\nnames_NGS <- ls()[grep(\"NGS\", ls())]\n#names_NGS\n\n#RBNDLIST ALL + ORDERING\ngc()\nNGS_all_data <- rbindlist(lapply(names_NGS[-11], get), use.names = T, fill = T )\n\nNGS_all_data <- NGS_all_data[order(Season_Year, GameKey, PlayID)]\n\n\nrm(list = names_NGS)\ngc()\n\n\n#TIME TO NUMERIC\nlibrary(fasttime)\n\nlength(unique(NGS_all_data$Time)) #[1] 2220871, MENOR QUE 66 MILLONES, LO CALCULO AGRUPANDO CON DATA.TABLE\n\nsystem.time(\nNGS_all_data[, time_numeric := as.numeric(fastPOSIXct(Time[1])), by = Time]\n)\n\n#DEFINE FUNCTION TO CHARACTERIZE TRAJECTORIES:\n\ncharacteriseTrajectory <- function(trj, step_length_resampling) {\n\n  resampled <- try(TrajRediscretize(trj, step_length_resampling)) #SHORT TRAJECTORIES GIVE ERROR MESSAGE WHEN RESAMPLED, FUNCTION OF STEP SIZE.\n\n  # Measures of speed and acceleration:\n  derivs <- TrajDerivatives(trj)\n\n  mean_speed <- mean(derivs$speed)\n  max_speed <- max(derivs$speed)\n  #min(derivs$speed); SIN INTERES, SIEMPRE 0\n  sd_speed <- sd(derivs$speed)\n  mean_acc <- mean(derivs$acceleration)\n  max_acc <- max(derivs$acceleration)\n  min_acc <- min(derivs$acceleration)\n  sd_acc <- sd(derivs$acceleration)\n\n\n  # Measures of straightness\n  straightness <- TrajStraightness(trj)\n  sinuosity <- try(TrajSinuosity2(resampled))\n  #MAX EXPECTED DISPLACEMENT, DISTANCE UNITS:\n  TrajEmax_b <- TrajEmax(trj, eMaxB = TRUE)\n\n  #DIRECTIONAL CHANGE:\n  dc <- TrajDirectionalChange(trj)\n\n  mdc <- mean(dc)\n  sddc <- sd(dc)\n  maxdc <- max(dc)\n\n  # Periodicity (NO)\n\n  #OTHERS:\n  trlength <- TrajLength(trj)\n  trdist <- TrajDistance(trj)\n  trdur <- TrajDuration(trj)\n  mod_meanv <- Mod(TrajMeanVelocity(trj)) # VECTOR (COMPLEX NUMBER), CALCULATE MODULE\n  mod_mean_ta <- Mod(TrajMeanVectorOfTurningAngles(trj)) # VECTOR (COMPLEX NUMBER), CALCULATE MODULE\n  expsqdisp <- TrajExpectedSquareDisplacement(trj)\n\n   # Return a list with all of the statistics for this trajectory\n\n    list(mean_speed = mean_speed,\n         max_speed =max_speed,\n         sd_speed = sd_speed,\n         mean_acc = mean_acc,\n         max_acc = max_acc,\n         min_acc = min_acc,\n         sd_acc = sd_acc,\n         straightness = straightness,\n         sinuosity = sinuosity,\n         TrajEmax_b = TrajEmax_b,\n         mdc = mdc,\n         sddc = sddc,\n         maxdc = maxdc,\n         trlength = trlength,\n         trdist = trdist,\n         trdur = trdur,\n         mod_meanv = mod_meanv,\n         mod_mean_ta = mod_mean_ta,\n         expsqdisp = expsqdisp)\n\n}\n\n\n\n\nNGS_all_data[, id_player_play_game := paste(GSISID, PlayID, GameKey, sep = \"_\")]\n\n\n#GET RID OF UNNECESSARY COLUMNS\n\nNGS_all_data <- NGS_all_data[, .(id_player_play_game, x, y, time_numeric)]\ngc()\n\n\n#PLAYER PLAY GAMES IDS TO ITERATE:\n\nid_player_play_game <- unique(NGS_all_data$id_player_play_game); length(id_player_play_game)\n\n\n\n########################################################################################################################################################\n########################################################################################################################################################\n# UNCOMMENT TO COMPUTE TRAJECTORY CHARACTERIZATION:\n########################################################################################################################################################\n# ############################### IF SINGLE CORE CPU, OR RAM CONSTRAINTS,SEQUENTIAL CALCULATION (1 THREAD) #############################################\n# system.time(\n#\n# trajs_feats <- lapply(1:length(id_player_play_game), function(i){ #\n#   #p <- \"27835_2643_3\";plot(trj)\n#\n#   if(i %% 1000  == 0) {\n#     cat(i, \"|\") \n#     #GUARDADO CADA 100000 OBSERVACIONES:\n#     #save(lista_provisional, file = \"../tmp/prueba_lista_trajs_feats.Rdata\")\n#   }\n#\n#   p <- id_player_play_game[i]\n#\n#\n#   player_play_coords <-  NGS_all_data[id_player_play_game == p][order(time_numeric), .(x, y, time_numeric)]\n#\n#   trj <- TrajFromCoords(player_play_coords, timeCol = \"time_numeric\", spatialUnits = \"time_numeric\", timeUnits = \"s\")\n#\n#   try(characteriseTrajectory(trj, 0.1)) #step length for resam = 0.1\n#\n# })\n#\n# )\n#\n# # if non parallelized 3428.190 secs, quite a long runtime\n\n\n# TO DATA TABLE ADDING ID DE GAME-PLAY-PLAYER:\n\n\n# All_trajs <- rbindlist(trajs_feats, use.names = T, fill = T)\n# All_trajs$id_player_play_game <- id_player_play_game\n# gc()\n\n\n#######################################################################################################################################\n#  COMMENT THE FOLLOWING IF SKIPED PREVIOUS COMPUTATION:\n\n#######################################################################################################################################\n\nAll_trajs <- read_fst(\"../input/characterized-nfl-punt-trajectories/All_trajs.fst\", as.data.table = TRUE)\n#head(All_trajs)\n","execution_count":null,"outputs":[]},{"metadata":{"trusted":true,"_uuid":"95939b47e53bf53f134ef85f0c8e4c27b96654d1","_kg_hide-input":true,"_kg_hide-output":true},"cell_type":"code","source":"#LET'S MERGE THIS TRAJECTORIES DATA TABLE WITH PREVIOUS ONE:\nALLTOGETHER_play_data_plus_Traj <- All_trajs[player_play_all_data, on = \"id_player_play_game\"]\n\nALLTOGETHER_play_data_plus_Traj[, sinuosity := as.numeric(sinuosity)]\n\n","execution_count":null,"outputs":[]},{"metadata":{"trusted":true,"_uuid":"070365ea9137338fc020663f59d91f203e776cdd"},"cell_type":"markdown","source":"### 3.\n### Information Value with cross validated penalty: Who suffers a concussion? Who causes a concussion?"},{"metadata":{"_uuid":"b9b4fa277f89dea0cadebe5e80239bb068f591dd"},"cell_type":"markdown","source":"We are almost ready. As overfitting is a huge risk we will **cross validate** our screening iterating 100 times over 2/3 of available data and validating on 1/3. After randomly repeating this sampling for 100 times we can reasonably trust the -penalized- Information Value (IV) screening.\n\nIV  only assesses how \"real\" a pattern is but doesn't qualify the relationship. To qualify predictor effect  Weight of Evidence on total dataset can be used. \n\nIt is usually considered that a value for IV smaller than 0.1 is too weak for a predictor to be useful and in this context values smaller than that are probably of doubtful actionability. But let's not get ahead of ourselves and find out what we have regarding explanation of our two targets:\n\n* IV of predictors related to \"SUFFERS_CONCUSSION\":\n"},{"metadata":{"_kg_hide-input":true,"_kg_hide-output":true,"trusted":true,"_uuid":"fcb38d78bafab9dc56e0a2468c236ab2f549e2f8"},"cell_type":"code","source":"set.seed(1)\nn_iters <- repeatedcv_niters\n\nmean_IV <- vector(mode = \"list\", length = n_iters)\ninvisible(lapply(c(1:n_iters), function(x) {\n\nif(x %% 10  == 0) {\n    cat(x, \"|\") \n  }\n \n  \npartidos_valset <- ALLTOGETHER_play_data_plus_Traj[, sample(unique(GameKey), 220)]\n \nIV <- create_infotables(data =ALLTOGETHER_play_data_plus_Traj[!GameKey %in% partidos_valset, -c(\"GameKey\",\"id_player_play_game\", \"CAUSES_CONCUSSION\"), with = F],  \n                        valid = ALLTOGETHER_play_data_plus_Traj[GameKey %in% partidos_valset, -c(\"GameKey\",\"id_player_play_game\", \"CAUSES_CONCUSSION\"), with = F], \n                        y = \"SUFFERS_CONCUSSION\", bins = 10, \n  trt = NULL, ncore = 4, parallel = TRUE)    \n\n#head(IV$Summary, 20)\n \nmean_IV[[x]] <<- data.table(IV$Summary)[order(Variable)]\n\n})\n)\n\n\nlista_de_IVs <- lapply(mean_IV, \"[[\", 4) \n\navg_adjusted_IV <- Reduce(\"+\", lista_de_IVs) / length(lista_de_IVs)\n\nfinal_suffers <- data.table(cbind(mean_IV[[1]][[1]], avg_adjusted_IV))\nsetnames(final_suffers, \"V1\", \"Feature\")\n","execution_count":null,"outputs":[]},{"metadata":{"_kg_hide-input":true,"trusted":true,"_uuid":"a712cb45dd98ebdd65898b5deec7dd9e24d4885a"},"cell_type":"code","source":"(IV_suffers_conc <- final_suffers[avg_adjusted_IV > 0.05][order(-avg_adjusted_IV)])","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"ddb5fe55f6738c65bd2b838f7f7a5ec775a61571"},"cell_type":"markdown","source":"Results could have been worse.\n\n**There seems to be at least one clearly predictive feature: FORMATION** (up to this moment included as the combined offense-defense formation of each punt play)\n\nNot surprisingly there is a group of quite **weaker predictors related with trajectory physical measures**. As we are screening current play for patterns it makes sense that a concussive trajectory includes more deceleration, or mean directional change than a safer one. We will later consider the usability of those weaker predictors.\n\n\nTime to answer our second question:\n* Predictors related to \"CAUSES_CONCUSSION\":"},{"metadata":{"_kg_hide-input":true,"_kg_hide-output":true,"trusted":true,"_uuid":"57a6c222fc7ae0e0618e1745b436eb22dc3a28f0"},"cell_type":"code","source":"set.seed(1)\n\nn_iters <- repeatedcv_niters\n\nmean_IV <- vector(mode = \"list\", length = n_iters)  \ninvisible(lapply(c(1:n_iters), function(x) {\n\n  \n   if(x %% 10  == 0) {\n    cat(x, \"|\")\n  }\n  \npartidos_valset <- ALLTOGETHER_play_data_plus_Traj[, sample(unique(GameKey), 220)]\n \nIV <- create_infotables(data =ALLTOGETHER_play_data_plus_Traj[!GameKey %in% partidos_valset, -c(\"GameKey\",\"id_player_play_game\", \"SUFFERS_CONCUSSION\"), with = F],  \n                        valid = ALLTOGETHER_play_data_plus_Traj[GameKey %in% partidos_valset, -c(\"GameKey\",\"id_player_play_game\", \"SUFFERS_CONCUSSION\"), with = F], \n                        y = \"CAUSES_CONCUSSION\", bins = 10, \n  trt = NULL, ncore = 4, parallel = TRUE)        \n\n\n#head(IV$Summary, 20)\n\nmean_IV[[x]] <<- data.table(IV$Summary)[order(Variable)]\n\n})\n)\n\n\nlista_de_IVs <- lapply(mean_IV, \"[[\", 4)\n\navg_adjusted_IV <- Reduce(\"+\", lista_de_IVs) / length(lista_de_IVs)\n\nfinal_causes <- data.table(cbind(mean_IV[[1]][[1]], avg_adjusted_IV))\n#final[order(-avg_adjusted_IV)]\nsetnames(final_causes, \"V1\", \"Feature\")","execution_count":null,"outputs":[]},{"metadata":{"_kg_hide-input":true,"trusted":true,"_uuid":"21855927830aa02be4a89cd37884cb7f26e83964"},"cell_type":"code","source":"(IV_causes_conc <- final_causes[avg_adjusted_IV > 0.05][order(-avg_adjusted_IV)])","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"f69d62dbf6486ba24795094fb791bc47396ad0cf"},"cell_type":"markdown","source":"Interestingly, we get different results.\n\nFORMATION is similarly predictive of causing a concussion, as it is a condition of the play for both players involved. Not exact IV value as before as we are randomly sampling 100 times a small variability is expected. But this time trajectory predictors of partner dont predict the accident. Apart of FORMATION  only other moderate predictor is Role of the partner.\n\n\nWe have quantified predictors importance but still no qualitative insights, let's now recalculate and plot for all dataset and visualize **Weight of evidence** of meaningful predictors (IV threshold >= 0.1, to get a sense of general proportions: \n\n  - Let's plot first *predictors related to suffering a concussion:*"},{"metadata":{"_kg_hide-input":true,"trusted":true,"_uuid":"49f9cf89fea64d06ee8a86876b5f8c528c11c35c"},"cell_type":"code","source":"filtered_predictors_suffersconc <- final_suffers[order(-avg_adjusted_IV)][ as.numeric(avg_adjusted_IV) >= 0.1, Feature]\n\n#Once assesed real importance we can estimate global WOE recalculating model for complete dataset:\n\nset.seed(1)\nIV <- create_infotables(data =ALLTOGETHER_play_data_plus_Traj[#!GameKey %in% partidos_valset\n  , -c(\"GameKey\",\"id_player_play_game\", \"CAUSES_CONCUSSION\"), with = F], \n                        #valid = ALLTOGETHER_play_data_plus_Traj[GameKey %in% partidos_valset, -c(\"GameKey\",\"id_player_play_game\", \"CAUSES_CONCUSSION\"), with = F], \n                        y = \"SUFFERS_CONCUSSION\", bins = 10, \n  trt = NULL, ncore = 4, parallel = TRUE)        \n\n\nfiltered_IV_summary <- data.table(IV$Summary)[Variable %in%filtered_predictors_suffersconc]\n\n#Lets get a general idea of scale of WOE related to suffering concussion\nMultiPlot(IV, filtered_IV_summary$Variable, same_scales = T)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"74fe5dfaac283a9d272990f51770d2e502094005"},"cell_type":"markdown","source":"At first sight, the most qualitatively interesting is, again, FORMATIONS with some very big WOE in some cases.\n\n  - And now we have a look at WOE of *predictors related to causing a concussion:*, only Role:"},{"metadata":{"_kg_hide-input":true,"_kg_hide-output":true,"trusted":true,"_uuid":"834e238d2b64c26252f19f5cdd417616ee5c9357"},"cell_type":"code","source":"filtered_predictors_causesconc <- final_causes[order(-avg_adjusted_IV)][ as.numeric(avg_adjusted_IV) >= 0.1, Feature]\n\n\nIV <- create_infotables(data =ALLTOGETHER_play_data_plus_Traj[#!GameKey %in% partidos_valset\n  , -c(\"GameKey\",\"id_player_play_game\", \"SUFFERS_CONCUSSION\"), with = F], \n                        #valid = ALLTOGETHER_play_data_plus_Traj[GameKey %in% partidos_valset, -c(\"GameKey\",\"id_player_play_game\", \"CAUSES_CONCUSSION\"), with = F], \n                        y = \"CAUSES_CONCUSSION\", bins = 10, \n  trt = NULL, ncore = 4, parallel = TRUE)        \n\n#head(IV$Summary, 20)\n#IV$Summary\n#data.table(IV$Tables$Role)[order(-WOE), -c(\"IV\"), with = F]","execution_count":null,"outputs":[]},{"metadata":{"_kg_hide-input":true,"trusted":true,"_uuid":"c6e07e6fc82e90104d9e818254af65f8e9ba9f9d"},"cell_type":"code","source":" SinglePlot(information_object = IV, variable = \"Role\", show_values = TRUE) +\n  coord_flip()+ #DA ERROR, ALGUNAS VARIABLES NO SE PLOTEAN CON UN MENSAJE DE FACTOR LEVEL DUPLICATED\n  theme(text = element_text(size=10))\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"ad7f7f0a698b28591119b38eb5bc1e467471a0fc"},"cell_type":"markdown","source":"There are some Roles with bigger WOE value related to causing concussions but let's keep in mind that there is not a strong IV in the background of that predictor, or any other predictor with the exception of FORMATIONS.\n\n### 4.\n### Preliminary insights\n\nLet's recap what we know up to this moment:\n\n  \n- <span style=\"color:darkred; font-size:20px\">There seems to be at least some degree of predictability of concussive plays.</span>\n\n- <span style=\"color:darkred; font-size:20px\">It is roughly equally difficult to predict who will suffer a concussion than who will cause it. This implies a \"fair play\" related to injuries (no asymmetry).</span>\n\n- <span style=\"color:darkred; font-size:20px\">Trajectory of concussed player is weakly distinguishable by its physical properties.</span>\n\n- <span style=\"color:darkred; font-size:20px\">Trajectory of partner involved in concussion is not distinguishable by its physical properties.</span>\n\n- <span style=\"color:darkred; font-size:20px\"><u>Punt initial formations matter the most.</u></span>\n\n\n### 5.\n### Focusing on the most important predictor: Initial formations\n\nIt's necessary to understand better what's going on with formations. \n\nFirst question now is: **Is it offense-defense combination what matters or only  one of the two?**\n\nLet's split FORMATIONS feature and repeat penalized IV calculation:\n"},{"metadata":{"_kg_hide-input":true,"_kg_hide-output":true,"trusted":true,"_uuid":"ad59434d28cb3d003c30944a980e78f43ee09915"},"cell_type":"code","source":"ALLTOGETHER_play_data_plus_Traj[, `:=`(punting_formation = sapply(FORMATION, function(x) paste(intersect(unlist(strsplit(as.character(x) , \"_\" )),  c('GL','GR','PLW','PLT','PLG','PLS','PRG','PRT','PRW','PC','PPR','P', 'PPL', 'GLi','GLo','GRi','GRo','PPLi','PPLo')), collapse = \" \")),\n                            preturn_formation = sapply(FORMATION, function(x) paste(setdiff(unlist(strsplit(as.character(x) , \"_\" )),  c('GL','GR','PLW','PLT','PLG','PLS','PRG','PRT','PRW','PC','PPR','P', 'PPL','GLi','GLo','GRi','GRo', 'PPLi','PPLo')), collapse = \" \"))\n )]\n","execution_count":null,"outputs":[]},{"metadata":{"_kg_hide-input":true,"_kg_hide-output":true,"trusted":true,"_uuid":"41ed371c2b0a3ddfa9e6169b4b0a896597dd1f74"},"cell_type":"code","source":"set.seed(1)\nn_iters <- repeatedcv_niters\n\nmean_IV <- vector(mode = \"list\", length = n_iters)\ninvisible(lapply(c(1:n_iters), function(x) {\n\nif(x %% 10  == 0) {\n    cat(x, \"|\") \n  }\n \n  \npartidos_valset <- ALLTOGETHER_play_data_plus_Traj[, sample(unique(GameKey), 220)]\n \nIV <- create_infotables(data =ALLTOGETHER_play_data_plus_Traj[!GameKey %in% partidos_valset, -c(\"GameKey\",\"id_player_play_game\", \"CAUSES_CONCUSSION\",  \"FORMATION\"), with = F], \n                        valid = ALLTOGETHER_play_data_plus_Traj[GameKey %in% partidos_valset, -c(\"GameKey\",\"id_player_play_game\", \"CAUSES_CONCUSSION\", \"FORMATION\"), with = F], \n                        y = \"SUFFERS_CONCUSSION\", bins = 10, \n  trt = NULL, ncore = 4, parallel = TRUE)        \n\n#head(IV$Summary, 20)\n \nmean_IV[[x]] <<- data.table(IV$Summary)[order(Variable)]\n\n})\n)\n\n\nlista_de_IVs <- lapply(mean_IV, \"[[\", 4) \n\navg_adjusted_IV <- Reduce(\"+\", lista_de_IVs) / length(lista_de_IVs)\n\nfinal_suffers <- data.table(cbind(mean_IV[[1]][[1]], avg_adjusted_IV))\n#final[order(-avg_adjusted_IV)]\nsetnames(final_suffers, \"V1\", \"Feature\")","execution_count":null,"outputs":[]},{"metadata":{"_kg_hide-input":true,"trusted":true,"_uuid":"cf842bfe9ebb8539af4191d09fdc0814aaff392f"},"cell_type":"code","source":"(IV_suffers_conc <- final_suffers[avg_adjusted_IV > 0.05][order(-avg_adjusted_IV)]) ","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"e9e183bbf07a49b8abaef9f690c8002abe194081"},"cell_type":"markdown","source":"It is clear that  **It is only punt return formation the one that matters**. \n\nTo qualify this we recalculate global WOE and display punt return formations that carry a bigger or smaller concussion risk as reflected by WOE:"},{"metadata":{"_kg_hide-input":true,"trusted":true,"_uuid":"8ae6001b21da504deb4f74f486dcda6fd7bfb511"},"cell_type":"code","source":"set.seed(1)\nIV <- create_infotables(data =ALLTOGETHER_play_data_plus_Traj[#!GameKey %in% partidos_valset\n  , -c(\"GameKey\",\"id_player_play_game\", \"CAUSES_CONCUSSION\"), with = F], \n                        #valid = ALLTOGETHER_play_data_plus_Traj[GameKey %in% partidos_valset, -c(\"GameKey\",\"id_player_play_game\", \"CAUSES_CONCUSSION\"), with = F], \n                        y = \"SUFFERS_CONCUSSION\", bins = 10, \n  trt = NULL, ncore = 4, parallel = TRUE)        \n\n#head(IV$Summary, 20)\n\n#IV$Summary\n\n\nWOE_formations_preturn_suffersconc <- data.table(IV$Tables$preturn_formation)[order(-WOE)]\nWOE_formations_preturn_suffersconc[abs(WOE)>0, -c(\"IV\"), with = F][N > 22]","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"e6d718bc73e226491de736554af3b207bd6b6efb"},"cell_type":"markdown","source":"Highest risk formations are more varied but it is quite easy to grasp something about lowest risk formation structure :"},{"metadata":{"_kg_hide-input":true,"trusted":true,"_uuid":"d521a8bfe91d540d04882b0f8e17a124df4cae09"},"cell_type":"code","source":"WOE_formations_preturn_suffersconc[WOE==min(WOE), -c(\"IV\"), with = F]","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"cd879de7a2f1ee7208f2266fc3d32a57f9bfbddd"},"cell_type":"markdown","source":"That's the lowest risk formation, a symmetric transversal first line of defense. Used in a good number of plays (9%) seems to bring less concussion risk.\n\n### 6.\n### Underlying patterns of riskier punt return formations\n\nGeometrically this formation expands defense symmetrically from the center, a simple wall transversal to the main field axis. \n\nThere are at least two aspects to explore about this, symmetry and field transversal density, or \"wall likeness\" if you like, of that first line of defense.\n\nIt is time for visualization:"},{"metadata":{"_kg_hide-input":true,"_kg_hide-output":true,"trusted":true,"_uuid":"4c040f1e356a0a37d906bdd040ae28bc5d384f8e"},"cell_type":"code","source":"player_play_coords_start <-  NGS_all_data[order(time_numeric), .(x[1], y[1], time_numeric[1]), by = id_player_play_game]\n\nALLTOGETHER_play_data_plus_Traj <- player_play_coords_start[, .(id_player_play_game, V1, V2)][ALLTOGETHER_play_data_plus_Traj, on = \"id_player_play_game\"]\nsetnames(ALLTOGETHER_play_data_plus_Traj, c(\"V1\", \"V2\"), c(\"start_x\", \"start_y\"))\n\n\nrisky_formations <- WOE_formations_preturn_suffersconc[WOE>=0.94, preturn_formation]\n\nsafer_formations <- c(\"PDL1 PDL2 PDL3 PDL4 PDR1 PDR2 PDR3 PDR4 PR VL VR\")\n\n#FEATURE:FLAG IS_CONCUSSIVE_PLAY\nALLTOGETHER_play_data_plus_Traj[, IS_CONCUSSIVE_PLAY := max(SUFFERS_CONCUSSION + CAUSES_CONCUSSION), by = .(GameKey, PlayID)]\n\n#FEATURE is_prteam_player\nALLTOGETHER_play_data_plus_Traj[, is_prteam_player := grepl(Role, preturn_formation), by = id_player_play_game]","execution_count":null,"outputs":[]},{"metadata":{"_kg_hide-input":true,"trusted":true,"_uuid":"9b15726229f2ac0e4f298f2521b648b2684537e6"},"cell_type":"code","source":"n_riskier_plays_plotted <-ALLTOGETHER_play_data_plus_Traj[preturn_formation %in% risky_formations, length(unique(paste0(GameKey, PlayID), \"\\n\"))]\n#[1] 552\nn_safer_plays_plotted <- ALLTOGETHER_play_data_plus_Traj[preturn_formation %in% safer_formations, length(unique(paste0(GameKey, PlayID), \"\\n\"))]\n#[1] 599\n\n\n\nriskier_avg_plot <- ALLTOGETHER_play_data_plus_Traj[(is_prteam_player == 1) & preturn_formation %in% risky_formations,\n                                  {plot(start_x, start_y, pch = 20, col = rgb(red = 0, green = 0, blue = 0.25, alpha = 0.25), cex=1.25, main = \"average plays with riskier formations\");}]\n\n\n\n\nsafer_avg_plot <- ALLTOGETHER_play_data_plus_Traj[(is_prteam_player == 1) & preturn_formation %in% safer_formations, {plot(start_x, start_y, pch = 20, col = rgb(red = 0, green = 0, blue = 0.25, alpha = 0.25), cex=1.25, main = \"average plays with safer formations\");}]   \n\n\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"1a254723d8ec92bd06df01b0fcfe08924e2be18a"},"cell_type":"markdown","source":"Those two plots look definitely not the same. Are we seeing a spatial pattern related to injury risk?\n\n**Riskier formations show a less dense longitudinal corridors and are less clustered around the center of the field**. It looks plausible that on average spatial patterns of riskier formations are made of bigger gaps and allow faster longitudinal speeds.\n\nThe structure of this mean plots shows absolute nature. To inspect for relative, normalized nature we have to  align all punts referenced to punt returner position and flip half of them to have them all at the same side of the field:"},{"metadata":{"_kg_hide-input":true,"_kg_hide-output":true,"trusted":true,"_uuid":"0d34c779805d717c6933444746c3095aa1653b8c"},"cell_type":"code","source":"#ALLTOGETHER_play_data_plus_Traj[Role == \"PR\", .(mean(start_x, na.rm = T), mean(start_y, na.rm = T))] \n# 59.73826\t26.82029  \n# WE COULD CENTER AT 60 AND 27 BUT PROBABLY VISUALLY MORE CLEAR TO CENTER A CERO FOR BOTH X AND Y:\n\nALLTOGETHER_play_data_plus_Traj[, `:=`(reference_start_x =  start_x[which(Role == \"PR\")],\n                                       reference_start_y =  start_y[which(Role == \"PR\")]\n                                       ), by = .(GameKey, PlayID)][, `:=`(aligned_start_x = start_x - (reference_start_x) , #- 60) ,\n                                                                          aligned_start_y = start_y - (reference_start_y) #- 27)\n                                                                          ), by = .(GameKey, PlayID)]\n\n#SAME ORIENTATION:\n#(IF CENTERED AT 60, 27)\n#ALLTOGETHER_play_data_plus_Traj[aligned_start_x > 60, `:=`(aligned_start_x = 60 - (aligned_start_x - 60)), by = .(GameKey, PlayID)]\n#CENTERED AT 0,0:\nALLTOGETHER_play_data_plus_Traj[aligned_start_x > 0, `:=`(aligned_start_x = 0 - (aligned_start_x - 0)), by = .(GameKey, PlayID)]\n","execution_count":null,"outputs":[]},{"metadata":{"_kg_hide-input":true,"trusted":true,"_uuid":"9172b1463c3064132853061650d3848e3dd73e79"},"cell_type":"code","source":"Aligned_riskier_avg_formations <- ALLTOGETHER_play_data_plus_Traj[(is_prteam_player == 1) & preturn_formation %in% risky_formations, {plot(aligned_start_x, aligned_start_y, pch = 20, col = rgb(red = 0, green = 0, blue = 0.25, alpha = 0.15), cex=1.25, main = \"Aligned riskier average formations\");}]\n\n\n\nAligned_safer_avg_formations <- ALLTOGETHER_play_data_plus_Traj[(is_prteam_player == 1) & preturn_formation %in% safer_formations, {plot(aligned_start_x, aligned_start_y, pch = 20, col = rgb(red = 0, green = 0, blue = 0.25, alpha = 0.15), cex=1.25, main = \"Aligned safer average formations\");}]\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"8d03eb27c928abff5528c21068b7df3e5ceab0bb"},"cell_type":"markdown","source":"This aligned plots show  mean bigger distance between defense players and punt returner in riskier plays. Again, higher speeds could be related to this.\n\nWith the insights gained from the plots let's attempt to make this more concrete. We create now a set of different features related to what we see in the plots aimed to describe density and symmetry... and screen their IV. (For details of all screened descriptors uncomment code below)\n\nOf all descriptors, which ones have IV > 0 ?\n"},{"metadata":{"_kg_hide-input":true,"_kg_hide-output":true,"trusted":true,"_uuid":"2e67fbcd5f8095e339fa5367c764489e89492d5b"},"cell_type":"code","source":"#FEATURE GLOBAL ASYMMETRY PROXY:\n\nALLTOGETHER_play_data_plus_Traj[, asymmetry_preturn := sapply(preturn_formation, function(x){unlist(\nxor(grepl(\"PDL1\", x), grepl(\"PDR1\", x)) +\nxor(grepl(\"PDL2\", x), grepl(\"PDR2\", x)) +\nxor(grepl(\"PDL3\", x), grepl(\"PDR3\", x)) +\nxor(grepl(\"PDL4\", x), grepl(\"PDR4\", x)) +\nxor(grepl(\"PDL5\", x), grepl(\"PDR5\", x)) +\nxor(grepl(\"PDL6\", x), grepl(\"PDR6\", x)) +\nxor(grepl(\"VLi\", x), grepl(\"VRi\", x))+\nxor(grepl(\"VLo\", x), grepl(\"VRo\", x))+\nxor(grepl(\"VL\", x), grepl(\"VR\", x))+\nxor(grepl(\"PLL\", x), grepl(\"PLR\", x))+\nxor(grepl(\"PLL1\", x), grepl(\"PLR1\", x)) +\nxor(grepl(\"PLL2\", x), grepl(\"PLR2\", x)) +\nxor(grepl(\"PLL3\", x), grepl(\"PLR3\", x)) \n)\n}\n)]\n\n\n# Average x distance of PR to average (starting) rest of positions x distance:\nALLTOGETHER_play_data_plus_Traj[is_prteam_player==1,\n                                pr_team_gravity_center_x := mean(start_x),\n                                by = .(GameKey, PlayID)][, abs_xdist_preturn_vs_average_rest := abs(pr_team_gravity_center_x - reference_start_x),by = .(GameKey, PlayID)] \n\n\n\n\n\n#N PLAYERS FIRST LINE:\nALLTOGETHER_play_data_plus_Traj[, nplayers_firstline := sapply(preturn_formation, function(x){unlist(\ngrepl(\"PDL1\", x) + grepl(\"PDR1\", x) +\ngrepl(\"PDL2\", x) + grepl(\"PDR2\", x) +\ngrepl(\"PDL3\", x) + grepl(\"PDR3\", x) +\ngrepl(\"PDL4\", x) + grepl(\"PDR4\", x) +\ngrepl(\"PDL5\", x) + grepl(\"PDR5\", x) +\ngrepl(\"PDL6\", x) + grepl(\"PDR6\", x) +\ngrepl(\"VLi\", x) + grepl(\"VRi\", x)+\ngrepl(\"VLo\", x) + grepl(\"VRo\", x)+\ngrepl(\"VL \", x) + grepl(\"VR \", x)\n)\n}\n)]\n\n\n\n\n#N PLAYERS CENTRAL BOX FIRST LINE:\n\nALLTOGETHER_play_data_plus_Traj[, nplayers_cbox_firstline := sapply(preturn_formation, function(x){unlist(\ngrepl(\"PDL1\", x) + grepl(\"PDR1\", x) +\ngrepl(\"PDL2\", x) + grepl(\"PDR2\", x) +\ngrepl(\"PDL3\", x) + grepl(\"PDR3\", x) +\ngrepl(\"PDL4\", x) + grepl(\"PDR4\", x) +\ngrepl(\"PDL5\", x) + grepl(\"PDR5\", x) +\ngrepl(\"PDL6\", x) + grepl(\"PDR6\", x) \n)\n}\n)]\n\n\n\n#N PLAYERS VR & VL:\nALLTOGETHER_play_data_plus_Traj[, nplayers_v := sapply(preturn_formation, function(x){unlist(\ngrepl(\"VLi\", x) + grepl(\"VRi\", x)+\ngrepl(\"VLo\", x) + grepl(\"VRo\", x)+\ngrepl(\"VL \", x) + grepl(\"VR \", x)\n)\n}\n)]\n\n\n#N PLAYERS VR & VL:\n\nALLTOGETHER_play_data_plus_Traj[, withPLM := sapply(preturn_formation, function(x){unlist(\ngrepl(\"PLM\", x) \n)\n}\n)]\n\n\nALLTOGETHER_play_data_plus_Traj[, withPFB := sapply(preturn_formation, function(x){unlist(\ngrepl(\"PFB\", x) \n)\n}\n)]\n\n\nALLTOGETHER_play_data_plus_Traj[, with_PLM_PFB := sapply(preturn_formation, function(x){unlist(\ngrepl(\"PLM\", x)  + grepl(\"PFB\", x) \n)\n}\n)]\n\n\n#TRANSVERSAL EXTENSION\nALLTOGETHER_play_data_plus_Traj[is_prteam_player==1,\n                                pr_team_y_extension := max(start_y)-min(start_y),\n                                by = .(GameKey, PlayID)]\n\n\n#FEATURE -ONLY 1ST LINE CENTRAL BOX ASYMMETRY PROXY:\n\nALLTOGETHER_play_data_plus_Traj[, asymmetry_line1central_1_4_preturn := sapply(preturn_formation, function(x){unlist(\nxor(grepl(\"PDL1\", x), grepl(\"PDR1\", x)) +\nxor(grepl(\"PDL2\", x), grepl(\"PDR2\", x)) +\nxor(grepl(\"PDL3\", x), grepl(\"PDR3\", x)) +\nxor(grepl(\"PDL4\", x), grepl(\"PDR4\", x))  \n)\n}\n)]\n\n\nALLTOGETHER_play_data_plus_Traj[, asymmetry_line1central_1_2_preturn := sapply(preturn_formation, function(x){unlist(\nxor(grepl(\"PDL1\", x), grepl(\"PDR1\", x)) +\nxor(grepl(\"PDL2\", x), grepl(\"PDR2\", x))\n)\n}\n)]\n\nALLTOGETHER_play_data_plus_Traj[, asymmetry_2lines_l1_1_3_preturn := sapply(preturn_formation, function(x){unlist(\nxor(grepl(\"PDL1\", x), grepl(\"PDR1\", x)) +\nxor(grepl(\"PDL2\", x), grepl(\"PDR2\", x)) +\nxor(grepl(\"PDL3\", x), grepl(\"PDR3\", x)) +\nxor(grepl(\"PLL\", x), grepl(\"PLR\", x))  \n)\n}\n)]\n\n\n#NUMBER OF PLAYERS IN CENTRAL BOX, INCLUDING 2 LINEs, upt to 3th LINE1 DEFENSE EACH SIDE:\n\nALLTOGETHER_play_data_plus_Traj[, n_players_central_box_2lines_l1_1_3 := sapply(preturn_formation, function(x){unlist(\ngrepl(\"PDL1\", x) + grepl(\"PDR1\", x) +\ngrepl(\"PDL2\", x) + grepl(\"PDR2\", x) +\ngrepl(\"PDL3\", x) +  grepl(\"PDR3\", x) +\ngrepl(\"PLL\", x) + grepl(\"PLR\", x)\n)\n}\n)]\n\n#NUMBER OF PLAYERS IN CENTRAL BOX, INCLUDING 2 LINEs, upt to 4th LINE1 DEFENSE EACH SIDE:\n\nALLTOGETHER_play_data_plus_Traj[, n_players_central_box_2lines_l1_1_4 := sapply(preturn_formation, function(x){unlist(\ngrepl(\"PDL1\", x) + grepl(\"PDR1\", x) +\ngrepl(\"PDL2\", x) + grepl(\"PDR2\", x) +\ngrepl(\"PDL3\", x) +  grepl(\"PDR3\", x) +\ngrepl(\"PDL4\", x) +  grepl(\"PDR4\", x) +\ngrepl(\"PLL\", x) + grepl(\"PLR\", x)\n)\n}\n)]\n\n\nnew_formation_feats <- c(\"asymmetry_preturn\", \"abs_xdist_preturn_vs_average_rest\", \"nplayers_firstline\", \"nplayers_cbox_firstline\", \"nplayers_v\", \"withPLM\", \"withPFB\", \"with_PLM_PFB\", \"pr_team_y_extension\", \"asymmetry_line1central_1_4_preturn\", \"asymmetry_line1central_1_2_preturn\", \"asymmetry_2lines_l1_1_3_preturn\", \"n_players_central_box_2lines_l1_1_3\", \"n_players_central_box_2lines_l1_1_4\")\n\n","execution_count":null,"outputs":[]},{"metadata":{"_kg_hide-input":true,"_kg_hide-output":true,"trusted":true,"_uuid":"ba9e3b5311aea4f2266a7c0463ce46c07fd316e1"},"cell_type":"code","source":"gc()","execution_count":null,"outputs":[]},{"metadata":{"_kg_hide-input":true,"_kg_hide-output":true,"trusted":true,"_uuid":"434740c62043fae760ba7b7fd2832f8a2a771f93"},"cell_type":"code","source":"set.seed(1)\nn_iters <- repeatedcv_niters\n\nmean_IV <- vector(mode = \"list\", length = n_iters)\ninvisible(lapply(c(1:n_iters), function(x) {\n\nif(x %% 10  == 0) {\n    cat(x, \"|\") \n  }\n \n  \npartidos_valset <- ALLTOGETHER_play_data_plus_Traj[, sample(unique(GameKey), 220)]\n \nIV <- create_infotables(data =ALLTOGETHER_play_data_plus_Traj[!GameKey %in% partidos_valset, c(\"SUFFERS_CONCUSSION\", new_formation_feats), with = F], \n                        valid = ALLTOGETHER_play_data_plus_Traj[GameKey %in% partidos_valset, c(\"SUFFERS_CONCUSSION\",new_formation_feats), with = F], \n                        y = \"SUFFERS_CONCUSSION\", bins = 10, \n  trt = NULL, ncore = 4, parallel = TRUE)        \n\n#head(IV$Summary, 20)\n \nmean_IV[[x]] <<- data.table(IV$Summary)[order(Variable)]\n\n})\n)\n\n\n\nlista_de_IVs <- lapply(mean_IV, \"[[\", 4) \n\navg_adjusted_IV <- Reduce(\"+\", lista_de_IVs) / length(lista_de_IVs)\n\nfinal_suffers <- data.table(cbind(mean_IV[[1]][[1]], avg_adjusted_IV))\n#final[order(-avg_adjusted_IV)]","execution_count":null,"outputs":[]},{"metadata":{"_kg_hide-input":true,"trusted":true,"_uuid":"3e60584bfbacda9209d524e368ab9423c2c9460f"},"cell_type":"code","source":"(IV_suffers_conc <- final_suffers[avg_adjusted_IV >0][order(-as.numeric(avg_adjusted_IV))])","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"1085207dea0fed14742ca40325af11c397edfca8"},"cell_type":"markdown","source":"Looks like to characterize starting point patterns is already asking too much to this dataset.\n\nOnly one feature seems to be -weakly- predictive of target. IV value is low but at this stage of the analysis we can not afford being too picky as we have already squeezed almost all drops of information available in the data.\n\nThe descriptor of interest is **asymmetry_2lines_l1_1_3_preturn**. This feature measures  unbalance in  central \"defense box\" considering two first lines (including up to 3th player at each side in first line.)\n\nLet's have a look at WOE for complete dataset:"},{"metadata":{"_kg_hide-input":true,"_kg_hide-output":true,"trusted":true,"_uuid":"a376720c77da5d8ec2b1ede08dc2128dfdb47e51"},"cell_type":"code","source":"set.seed(1)\nIV <- create_infotables(data =ALLTOGETHER_play_data_plus_Traj[#!GameKey %in% partidos_valset\n  , c(\"SUFFERS_CONCUSSION\", \"asymmetry_2lines_l1_1_3_preturn\"), with = F], \n                        #valid = ALLTOGETHER_play_data_plus_Traj[GameKey %in% partidos_valset, -c(\"GameKey\",\"id_player_play_game\", \"CAUSES_CONCUSSION\"), with = F],\n                        y = \"SUFFERS_CONCUSSION\", bins = 10, \n  trt = NULL, ncore = 4, parallel = TRUE)        \n","execution_count":null,"outputs":[]},{"metadata":{"_kg_hide-input":true,"trusted":true,"_uuid":"978cc5228647ffcc0156a03cb692b6289e281fc4"},"cell_type":"code","source":" SinglePlot(information_object = IV, variable = \"asymmetry_2lines_l1_1_3_preturn\", show_values = TRUE) +\n  coord_flip()+ \n  theme(text = element_text(size=10))","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"a07c4a614be754e6d61eaa25ee3d2d2a38493b54"},"cell_type":"markdown","source":"Time to translate in this WOE to more commonly used numbers:\n\nWhen central box asymmetry as defined above is 2 or bigger WOE of 0.76, i.e. concussion weight is e^0.76 times bigger, that is an factor of incidence 2.13 bigger. \n\nOr in a more clear and usual format:"},{"metadata":{"_kg_hide-input":true,"trusted":true,"_uuid":"8258d1f2def35882f860afaed2b59a8cbbd622a1"},"cell_type":"code","source":"(\nALLTOGETHER_play_data_plus_Traj[, .(round(.N/22), round(sum(IS_CONCUSSIVE_PLAY)/22)), by = asymmetry_2lines_l1_1_3_preturn][, .( asymmetry_2lines_l1_1_3_preturn, V1, V2, `% OF PLAYS` = round(100*V1/sum(V1), 2) , `% OF CONCUSSIONS` = round(100*V2/sum(V2), 2), `CONC PER 1000 PLAYS` = round(1000*V2/V1, 2))][order(asymmetry_2lines_l1_1_3_preturn)] %>% setnames(c(\"asymmetry_2lines_l1_1_3_preturn\",\"V1\",\"V2\"), c(\"asymmetry\", \"N_PLAYS\", \"N_CONCUSSIONS\"))\n)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"45f196536fe8e31b3acf56021ec65c0f765a89da"},"cell_type":"markdown","source":"In summary,\n\n> <span style=\"color:darkred; font-size:22px\"> Almost 3 times less concussions incidence in the symmetrical / near symmetrical two lines box case.  </span>\n\n \nAnd this, to some extent, backed by a positive Information Value. \n\nUncertain as it is, <u>the pattern has survived the screening process and it is a good enough candidate to monitor.</u>\n\n### 7.\n### **Conclusions:  next steps and recommendation:**\n\nA rule change is something serious. This study is based on 37 cases what makes advisable some good practices before any change is introduced:\n\n- <span style=\"color:darkred; font-size:18px\">First and  very important step: <u> share with coaches the main insight of this study:</u> \"There seems to be a relationship between punt return initial formation and concussions\". All coaches should be informed so that they can consider additionally to tactics the increased risk derived of some formations. Explain suspected safer aspects, this is, \"symmetric central box and general formation density and orientation to block longitudinal advances could reduce concussive plays\". Use of compact symmetrical central boxes can be recommended.</span>\n\n- <span style=\"color:darkred; font-size:18px\">Second, <u>monitor pattern during next season.</u> Does the pattern hold? Encourage contribution by coaches and experts on why it holds, or how it happens to avoid concussive plays. Debate also what degree of limitations would be acceptable related to initial formations central symmetry.</span>\n\n- <span style=\"color:darkred; font-size:18px\">Third, once pattern has been confirmed after test time modify rules limiting asymmetry in central defense box in best viable way considering debated possibilities.</span>\n\n- <span style=\"color:darkred; font-size:18px\">Forth, monitor effects of the change.</span> \n\n\n"},{"metadata":{"_uuid":"9cbd82ba8f38b71494c3aa760ae7a5389c3b0948"},"cell_type":"markdown","source":"### Apendix1:\n### Can we predict a future concussion? A possible line of research\n\nOf all the approaches that didn't work during previous analysis I mention here only one,  aimed to discover a \"too good to be true\"  pattern:\n\nThe reason I mention the approach here is because first, it would be extremely useful if it succeeded and second, the  main reason the approach couldn't work in this case was lack of complete NGS data of all games and plays as we were limited to punt plays. \n\nIt all relates to the question: Is causing/suffering a concussion related to not being at 100% performance like being tired, lack of attention...? If it is the case then NGS data should give the possibility to detect some changing patterns in individual trajectories **in real time during a game, before concussive play actually occurs** . \n\nIt was not possible to test individual sequences in time as this dataset consisted only of Punt plays separated one from each other. Because of the appeal of \"real time\" prediction I tested anyway but **found no predictive power of any grouping of previous Punt play individual trajectories of future concussive plays.**\n\nBecause of such patterns not being discarded yet I advice to explore this possible use of NGS complete data in future research, until the possibility can be discarded or confirmed.\n"},{"metadata":{"_uuid":"3cd1545e12b4077b96c01104f0abbd532f3d747c"},"cell_type":"markdown","source":"### Apendix2:\n### Used R Packages citation\n<span style=\"color:darkgray; font-size:14px\">Matt Dowle and Arun Srinivasan (2018). data.table: Extension of `data.frame`. https://CRAN.R-project.org/package=data.table<br> Dror Bogin (2018). easycsv: Load Multiple 'csv' and 'txt' Tables. https://CRAN.R-project.org/package=easycsv<br> Mark Klik (2018). fst: Lightning Fast Serialization of Data Frames for R. https://CRAN.R-project.org/package=fst<br> H. Wickham. ggplot2: Elegant Graphics for Data Analysis. Springer-Verlag New York, 2016.https://cran.r-project.org/web/packages/ggplot2<br> Larsen Kim (2016). Information: Data Exploration with Information Theory (Weight-of-Evidence and Information Value). https://CRAN.R-project.org/package=Information<br> McLean, D. J., & SkowronVolponi, M. A. (2018). trajr: An R package for characterisation of animal trajectories. Ethology, 124(6), 440-448. https://doi.org/10.1111/eth.12739<br> Garrett Grolemund, Hadley Wickham (2011). Dates and Times Made Easy with lubridate. Journal of Statistical Software, 40(3), 1-25. URL http://www.jstatsoft.org/v40/i03/.<br> Stefan Milton Bache and Hadley Wickham (2014). magrittr: A Forward-Pipe Operator for R. https://CRAN.R-project.org/package=magrittr</span>\n"},{"metadata":{"trusted":true,"_uuid":"f21f2b89b8afca9ca35d6653b81c0def97ca425b"},"cell_type":"code","source":"","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}