{"cells":[{"metadata":{},"cell_type":"markdown","source":"This is a brief introductory notebook on getting **track data summary metrics**."},{"metadata":{"trusted":true},"cell_type":"code","source":"library('data.table')\nPlayerTrackData<-fread('../input/nfl-playing-surface-analytics/PlayerTrackData.csv')","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Add compound measures."},{"metadata":{"trusted":true},"cell_type":"code","source":"PlayerTrackData$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":{},"cell_type":"markdown","source":"Speed and acceleration metrics for each play.\n\nI am choosing **mean speed** and **acceleration percentiles 0.05 and 0.95** as a first quick analysis. I want to see if dynamic plays increase the risk of injury."},{"metadata":{"trusted":true},"cell_type":"code","source":"getPlayMetrics<-function(PlayerTrackData){\n  \n  s_metrics<-by(PlayerTrackData$s,\n                PlayerTrackData$PlayKey,\n                function(x) list(mean(x,na.rm=T)))\n  \n  s_metrics<-setNames(data.frame(names(s_metrics),\n                                 matrix(unlist(s_metrics),\n                                        ncol=1,\n                                        byrow=T)),\n                      c('PlayKey','s_mean'))\n    \n  \n  a_metrics<-by(PlayerTrackData$a,\n                PlayerTrackData$PlayKey,\n                function(x) list(quantile(x,probs = c(0.05),na.rm=T),\n                                 quantile(x,probs = c(0.95),na.rm=T)))\n  \n  a_metrics<-setNames(data.frame(names(a_metrics),\n                                   matrix(unlist(a_metrics),\n                                          ncol=2,\n                                          byrow=T)),\n                        c('PlayKey','a_pct5','a_pct95'))\n  \n  PlayMetrics<-merge(s_metrics, a_metrics)\n  \n  return(PlayMetrics)\n}\n                \nPlayMetrics<-getPlayMetrics(PlayerTrackData)","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"Let's see a couple of examples:\n* The one with the highest gap between pct95 and pct5 whilst having a mean speed below 0.5. We should see a lot of accelerating and decelerating with this one.\n* One with a high pct95 and high mean speed. We should se a long (or multiple) runs.\n* One with a high pct95 and low mean speed. This would indicate one or more moments of high speed with other resting periods."},{"metadata":{"trusted":true},"cell_type":"code","source":"plays<-c()\np<-PlayMetrics[with(PlayMetrics, order(-abs(a_pct95-a_pct5))), ]\nplays[1]<-as.character(p$PlayKey[which(abs(p$s_mean)<0.5)][1])\nplays[2]<-as.character(PlayMetrics$PlayKey[which(PlayMetrics$a_pct95>4 & PlayMetrics$s_mean > 6)[1]])\nplays[3]<-as.character(PlayMetrics$PlayKey[which(PlayMetrics$a_pct95>4 & PlayMetrics$s_mean < 1)[1]])","execution_count":null,"outputs":[]},{"metadata":{"trusted":true},"cell_type":"code","source":"layout(matrix(c(1, 2, 3,\n                4, 5, 6), nrow=2, byrow=F))\n\nfor(play in plays){\n  \n  ymax_s<-with(PlayerTrackData,max(s[which(PlayKey==play)],na.rm=T))\n  ymax_a<-with(PlayerTrackData,max(a[which(PlayKey==play)],na.rm=T))\n  ymin_a<-with(PlayerTrackData,min(a[which(PlayKey==play)],na.rm=T))\n  \n  with(PlayerTrackData[which(PlayerTrackData$PlayKey==play),], plot(s~time, pch='.', xlab='time (s)', ylab='speed y/s', ylim=c(-1,ymax_s+2), col='blue'))\n  with(PlayerTrackData[which(PlayerTrackData$PlayKey==play),], lines(s~time, ylim=c(-1,ymax_s+2), col='blue'))  \n  with(PlayerTrackData[which(PlayerTrackData$PlayKey==play),], plot(a~time, pch='.', xlab='time (s)', ylab='acceleration y/(s^2)', ylim=c(ymin_a-2,ymax_a+2), col='red'))\n  with(PlayerTrackData[which(PlayerTrackData$PlayKey==play),], lines(a~time, ylim=c(ymin_a-2,ymax_a+2), col='red'))\n}","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"I believe getting summary metrics like the ones described are the way to go. In the next days I will be thinking about more representative velocity and acceleration metrics as well as the ones regarding direction, orientation, play time, events, etc.\n\nNow I'm gonna add injury information: **bodypart**, **severity** and **field type**."},{"metadata":{"trusted":true},"cell_type":"code","source":"InjuryRecord<-fread('../input/nfl-playing-surface-analytics/InjuryRecord.csv', drop=c('PlayerKey','Surface'))\nPlayList<-fread('../input/nfl-playing-surface-analytics/PlayList.csv', select=c('PlayKey','GameID','FieldType'))\n\nInjuryRecord$Severity<-apply(InjuryRecord[,c('DM_M1','DM_M7','DM_M28','DM_M42')], 1, sum)\n\nPlayMetrics<-merge(PlayMetrics,InjuryRecord[,c('PlayKey','BodyPart','Severity')],all.x = T)\nPlayMetrics$Severity[which(is.na(PlayMetrics$Severity))]<-0\n\nPlayMetrics<-merge(PlayMetrics,PlayList)\nPlayMetrics$Severity[which(PlayMetrics$GameID %in% InjuryRecord$GameID[which(InjuryRecord$PlayKey=='')])]<-NA\n\n\nPlayMetrics$Severity<-factor(PlayMetrics$Severity,\n                             ordered = TRUE,\n                             levels = 0:4,\n                             labels = c('No injury','Less than a week',\n                                        \"1 to 4 weeks\", \"4 to 6 weeks\",\n                                        \"More than 6 weeks\"))\n\n\nrm(InjuryRecord, PlayList)\nPlayMetrics<-PlayMetrics[order(PlayMetrics$Severity,decreasing=T),-which(colnames(PlayMetrics)=='GameID')]\n\nPlayMetrics[c(1,12,15,17,20,50,52,60,70,98,100,102,105,120,160),]","execution_count":null,"outputs":[]},{"metadata":{},"cell_type":"markdown","source":"And this already looks like a table we could use to find some **syntethic vs natural risky movements**.\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}