{"cells":[{"metadata":{},"cell_type":"markdown","source":"The main objectives of this notebook/series of notebooks are:\n1. Determine which movements increase the risk of suffering a **non-contact lower limb injury**.\n2. Ascertain whether or not such risk **varies across surface**.\n\nPlease debate and comment the correctness of my procedures as we will all learn from them :)\n\nRemember that the jury will evaluate our findings based on how well we address:\n* **Representation of player movement**. Including, but not limited to, speed, directional changes, acceleration/deceleration and distance.\n* **Identification of specific variables that present an elevated risk of injury**. Specific movement patterns, summary metrics of player movement and interaction with other covariables.\n* **Evaluation of differences in player movement between playing surfaces**. For risk injury influential player movement metrics, evaluate difference across surfaces in the non-injured player population. Find covariables that influence player movement in the non-injured population."},{"metadata":{},"cell_type":"markdown","source":"**Essential proposed reads:**\n\n* Incidence of Knee Injuries on Artificial Turf Versus Natural Grass in National Collegiate Athletic Association American Football: 2004-2005 Through 2013-2014 Seasons. https://www.ncbi.nlm.nih.gov/pubmed/30995074\n\n**Conclusion**: Artificial turf is an important risk factor for specific knee ligament injuries in NCAA football. Injury rates for PCL tears were significantly increased during competitions played on artificial turf as compared with natural grass. Lower NCAA divisions (II and III) also showed higher rates of ACL injuries during competitions on artificial turf versus natural grass.\n\n* Higher Rates of Lower Extremity Injury on Synthetic Turf Compared With Natural Turf Among National Football League Athletes: Epidemiologic Confirmation of a Biomechanical Hypothesis. https://www.ncbi.nlm.nih.gov/pubmed/30452873\n\n**Conclusion**:\nThese results support the biomechanical mechanism hypothesized and add confidence to the conclusion that synthetic turf surfaces have a causal impact on lower extremity injury.\n\n**Complementary reads:**\n\n* The effect of playing surface on the incidence of ACL injuries in National Collegiate Athletic Association American Football. https://www.ncbi.nlm.nih.gov/pubmed/22920310\n\n**Conclusion**:\nNCAA football players experience a greater number of ACL injuries when playing on artificial surfaces.\n\n* Risk of Anterior Cruciate Ligament Injury in Athletes on Synthetic Playing Surfaces: A Systematic Review. https://www.ncbi.nlm.nih.gov/pubmed/25164575\n\n**Conclusion**:\nHigh-quality studies support an increased rate of ACL injury on synthetic playing surfaces in football, but there is no apparent increased risk in soccer. Further study is needed to clarify the reason for this apparent discrepancy.\n"},{"metadata":{},"cell_type":"markdown","source":"According to the literature we see these lower limb injuries tend to be **ACL** and **PCL** (Anterior or Posterior Cruciate Ligament) tears, which are located in the knee. Such injuries are usually caused by:\n* Changing direction rapidly (also known as \"cutting\")\n* Landing from a jump awkwardly\n* Coming to a sudden stop when running\n\nTherefore it is paramount to create movement metrics that capture these movements. As our data is quite limited, we will assume all the injuries in our dataset, including the ones that do not affect the knees, are product of the same movement patterns."},{"metadata":{"trusted":true},"cell_type":"code","source":"rm(list=ls())\noptions(repr.plot.width = 15, repr.plot.height = 7) #set plot size\nlibrary('data.table')\nlibrary('ggplot2')\nlibrary('gridExtra')","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"InjuryRecord<-fread('../input/nfl-playing-surface-analytics/InjuryRecord.csv')\nPlayList<-fread('../input/nfl-playing-surface-analytics/PlayList.csv')\nPlayerTrackData<-fread('../input/nfl-playing-surface-analytics/PlayerTrackData.csv', drop=c('x','y'))\n\ncat('Number of known plays causing an injury:', sum(InjuryRecord$PlayKey!=''))\ncat('\\nNumber of plays in PlayerTrackData:', length(unique(PlayerTrackData$PlayKey)))","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"**Data Analysis**\n\nThe biggest problem we face, I think, is that we have few plays with injuries in the data. We have almost 267 thousand plays of which only 77 resulted in an injury, and there are 32 more but the PlayKey for those is unknown.\n\nFor now we will work on computing some **general metrics for each play individually**."},{"metadata":{},"cell_type":"markdown","source":"Adding compound measures:\n* Acceleration\n* Direction change\n* Orientation_vs_direction"},{"metadata":{"trusted":true},"cell_type":"code","source":"#acceleration\nPlayerTrackData$a<-NA\nPlayerTrackData$a[-1]<-with(PlayerTrackData, (s[-1]-s[-length(s)]) / (time[-1]-time[-length(time)]))\nPlayerTrackData$a[which(PlayerTrackData$time==0)]<-NA","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"#direction change\nPlayerTrackData$dir_change<-NA\nPlayerTrackData$dir_change[-1]<-with(PlayerTrackData, dir[-1]-dir[-length(dir)])\nPlayerTrackData<-PlayerTrackData[,dir:=NULL]\n\nPlayerTrackData$dir_change[which(PlayerTrackData$time==0)]<-NA\nPlayerTrackData$dir_change[which(PlayerTrackData$dir_change<(-180))] <- PlayerTrackData$dir_change[which(PlayerTrackData$dir_change<(-180))]+360\nPlayerTrackData$dir_change[which(PlayerTrackData$dir_change>(+180))] <- PlayerTrackData$dir_change[which(PlayerTrackData$dir_change>(+180))]-360","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"#orientation vs direction: negative means facing left, positive means facing right\nPlayerTrackData$o_dir<-PlayerTrackData$o-PlayerTrackData$dir\nPlayerTrackData<-PlayerTrackData[,o:=NULL]\n\nPlayerTrackData$o_dir[which(PlayerTrackData$o_dir<(-180))] <- PlayerTrackData$o_dir[which(PlayerTrackData$o_dir<(-180))]+360\nPlayerTrackData$o_dir[which(PlayerTrackData$o_dir>(+180))] <- PlayerTrackData$o_dir[which(PlayerTrackData$o_dir>(+180))]-360","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"I got rid of the *x*, *y*, *dir* and *o* because I am more interested in seeing how the movement **evolves** and not the exact position a player is in every moment. I have added acceleration and the angle difference between direction and orientation, though I do not think this last one will be of much importance."},{"metadata":{},"cell_type":"markdown","source":"**Raw PlayerTrackData exploration.**\n\nWe will explore the data provided by the tracking system before computing any metrics for each play."},{"metadata":{"trusted":true},"cell_type":"code","source":"PlayerTrackData<-merge(PlayerTrackData,PlayList[,c('PlayKey','FieldType')])","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"set.seed(100)\nplots<-PlayerTrackData[sample(1:nrow(PlayerTrackData), 10^4),]\n\np_speed <-ggplot(plots, aes(s, group = FieldType)) +\ngeom_histogram(aes(y = stat(density), fill=..x..),binwidth = 0.25, na.rm=T) + \nscale_fill_gradient2(low='blue', mid='blue', high='red', name= '') +\nxlab('Speed (y/s)') + ggtitle(\"Speed\") + ylab('Density') + \ntheme(plot.title = element_text(hjust = 0.5), axis.text.x = element_text(angle = 90),legend.position=\"none\") + \nfacet_wrap(~FieldType)\n\np_acc <-ggplot(plots, aes(a, group = FieldType)) +\ngeom_histogram(aes(y = stat(density), fill=..x..),binwidth = 0.5, na.rm=T) + \nscale_fill_gradient2(low='red', mid='blue', high='red', name= '') +\nxlab('Acceleration (y/s^2)') + ggtitle(\"Acceleration\") + ylab('Density') + \ntheme(plot.title = element_text(hjust = 0.5), axis.text.x = element_text(angle = 90),legend.position=\"none\") + \nfacet_wrap(~FieldType)\n\np_dir <-ggplot(plots, aes(dir_change, group = FieldType)) +\ngeom_histogram(aes(y = stat(density), fill=..x..),binwidth = 9, na.rm=T) + \nscale_fill_gradient2(low='red', mid='blue', high='red', name= '') +\nxlab('Direction change (º)') + ggtitle(\"Direction change\") + ylab('Density') + \ntheme(plot.title = element_text(hjust = 0.5), axis.text.x = element_text(angle = 90),legend.position=\"none\") + \nfacet_wrap(~FieldType)\n\ngrid.arrange(p_speed, p_acc, p_dir, nrow = 1)\n\nrm(plots,p_acc,p_dir,p_speed)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"So far nothings stands as strange - nor wrong - in these first histograms. Let's dive a little deeper into the data."},{"metadata":{},"cell_type":"markdown","source":"**Summary metrics for each play.**\n\nWe know that rapid changes in speed and direction should be indicators of a risky movement, and therefore cause of higher risks of injury. To try to get these, **for each play** we should try to retrieve measures of such movements - i.e. number of rapid changes in acceleration, number of rapid changes in direction, mean speed, quantiles of acceleration, interaction of acceleration and direction change, etc. Seeing that not all plays last the same, some variables (count variables) should be standardized by play time (rel_n=n/time_play).\n\nWe will start by getting some basic and easy to understand **general summary metrics for each play** and visualize them:\n* Quantiles 0.05, 0.25, 0.5, 0.75 and 0.95 for speed, acceleration, direction change and orientation_vs_direction.\n* Length of game.\n* Distance travelled.\n\nThese attributes will help us get an overall idea of a play by looking at some numbers. However, **I don't think we will identify movement patterns** by only using these general metrics."},{"metadata":{"trusted":true},"cell_type":"code","source":"getPlayMetrics<-function(PlayerTrackData){\n  \n  s_metrics<-by(PlayerTrackData$s,\n                PlayerTrackData$PlayKey,\n                function(x) list(quantile(x,probs = c(0.05,0.25,0.5,0.75,0.95),na.rm=T)))\n  \n  s_metrics<-setNames(data.frame(names(s_metrics),\n                                 matrix(unlist(s_metrics),\n                                        ncol=5,\n                                        byrow=T)),\n                      c('PlayKey','s_pct5','s_pct25','s_pct50','s_pct75','s_pct95'))\n    \n  \n  a_metrics<-by(PlayerTrackData$a,\n                PlayerTrackData$PlayKey,\n                function(x) list(quantile(x,probs = c(0.05,0.25,0.5,0.75,0.95),na.rm=T)))\n  \n  a_metrics<-setNames(data.frame(names(a_metrics),\n                                   matrix(unlist(a_metrics),\n                                          ncol=5,\n                                          byrow=T)),\n                        c('PlayKey','a_pct5','a_pct25','a_pct50','a_pct75','a_pct95'))\n                \n  dir_metrics<-by(PlayerTrackData$dir_change,\n                PlayerTrackData$PlayKey,\n                function(x) list(quantile(x,probs = c(0.05,0.25,0.5,0.75,0.95),na.rm=T)))\n  \n  dir_metrics<-setNames(data.frame(names(dir_metrics),\n                                   matrix(unlist(dir_metrics),\n                                          ncol=5,\n                                          byrow=T)),\n                        c('PlayKey','dir_c_pct5','dir_c_pct25','dir_c_pct50','dir_c_pct75','dir_c_pct95'))\n                  \n  o_dir_metrics<-by(PlayerTrackData$o_dir,\n                PlayerTrackData$PlayKey,\n                function(x) list(quantile(x,probs = c(0.05,0.25,0.5,0.75,0.95),na.rm=T)))\n  \n  o_dir_metrics<-setNames(data.frame(names(o_dir_metrics),\n                                   matrix(unlist(o_dir_metrics),\n                                          ncol=5,\n                                          byrow=T)),\n                        c('PlayKey','o_dir_pct5','o_dir_pct25','o_dir_pct50','o_dir_pct75','o_dir_pct95'))  \n                \n  t_metrics<-by(PlayerTrackData$time,\n                PlayerTrackData$PlayKey,\n                function(x) max(x,na.rm=T))\n  \n  t_metrics<-setNames(data.frame(names(t_metrics),\n                                   matrix(unlist(t_metrics),\n                                          ncol=1,\n                                          byrow=T)),\n                        c('PlayKey','length'))\n\n  d_metrics<-by(PlayerTrackData$dis,\n                PlayerTrackData$PlayKey,\n                function(x) sum(x,na.rm=T))\n  \n  d_metrics<-setNames(data.frame(names(d_metrics),\n                                   matrix(unlist(d_metrics),\n                                          ncol=1,\n                                          byrow=T)),\n                        c('PlayKey','dis_total'))\n                \n  PlayMetrics<-merge(s_metrics, a_metrics)\n  PlayMetrics<-merge(PlayMetrics, dir_metrics)\n  PlayMetrics<-merge(PlayMetrics, o_dir_metrics)\n  PlayMetrics<-merge(PlayMetrics, t_metrics)              \n  PlayMetrics<-merge(PlayMetrics, d_metrics)\n                \n  return(PlayMetrics)\n}\n                \nPlayMetrics<-getPlayMetrics(PlayerTrackData)\nhead(PlayMetrics)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"ls()\nsaveRDS(PlayerTrackData,'PlayerTrackData.rds')\nsaveRDS(InjuryRecord,'InjuryRecord.rds')\nsaveRDS(PlayList,'PlayList.rds')\nsaveRDS(PlayMetrics,'PlayMetrics.rds')","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"From here we could run some deeper analysis on the type of plays seen on natural vs synthetic turf.\n\nI hope this code/analysis will be useful to somebody. I will now finish this notebook in here as I want to make use of this table in future notebooks without having to re-run it again.\n\nTo be continued."}],"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}