{"cells":[{"metadata":{"_uuid":"667e20963ea7429d8a3ac4221aab7c056a770dec","_execution_state":"idle","trusted":true},"cell_type":"markdown","source":"# This kernel contains all the R code supporting the analysis results of NFL's punt datasets\n"},{"metadata":{"trusted":true,"_uuid":"e5d5369dddf567cec3b1cdad888f37185d1e1010"},"cell_type":"code","source":"library(tidyverse) # metapackage with lots of helpful functions\nlist.files(path = \"../input\")\nlist.files(path = \"../output\")","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"cf9d331943adf9b9a42c5af9549923b02eabdb50"},"cell_type":"markdown","source":"# Load libraries and get raw data"},{"metadata":{"trusted":true,"_uuid":"699cf9310ec3c4e0c4163d63bc512fb804a2113e"},"cell_type":"code","source":"library (ggplot2)\nlibrary (lubridate)\nlibrary (dplyr)\n\n# get raw data =================================\ngames <- read.csv(\"../input/NFL-Punt-Analytics-Competition/game_data.csv\")\nplays <- read.csv(\"../input/NFL-Punt-Analytics-Competition/play_information.csv\")\nppunts <- read.csv(\"../input/NFL-Punt-Analytics-Competition/player_punt_data.csv\")\npproles <- read.csv(\"../input/NFL-Punt-Analytics-Competition/play_player_role_data.csv\")\nvrevs <- read.csv(\"../input/NFL-Punt-Analytics-Competition/video_review.csv\")","execution_count":null,"outputs":[]},{"metadata":{"trusted":true,"_uuid":"d592d0cdf13a8dbe645da48597f6f491c6e94bd6","_kg_hide-output":true,"_kg_hide-input":false},"cell_type":"code","source":"# enrich play data  =======================\n\nplays$StartArea <- trimws(substr(plays$YardLine,1,3))\nplays$StartYard <- as.integer(substr(plays$YardLine,4,10))\n\n# +++++++++++++++++++++++++++++++++++++++++\nwrite.csv(plays, \"plays_rich.csv\")\n# +++++++++++++++++++++++++++++++++++++++++","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"819e8d00ad720b4afafe3b013e50686f52aad12d"},"cell_type":"markdown","source":"# Enrich video data"},{"metadata":{"trusted":true,"_uuid":"7aedc642164b4c7593f33e7549f8192dfe967c98"},"cell_type":"code","source":"# enrich video data  =======================\n\n# add game data ----------------------------\nvrevsg <- merge (vrevs, games, by = c(\"GameKey\",\"Season_Year\"))\n# add play data ----------------------------\nvrevsgp <- merge (vrevsg, plays, by = c(\"GameKey\",\"PlayID\",\"Season_Year\"))\n# add player1 role -------------------------\nvrevsgpr <- merge (vrevsgp, pproles, by = c(\"GameKey\", \"PlayID\", \"GSISID\", \"Season_Year\"))\n# add player2 role -------------------------\nvrevsgpr2 <- merge (vrevsgpr, pproles, \n                    by.x = c(\"GameKey\", \"PlayID\", \"Primary_Partner_GSISID\", \"Season_Year\"), \n                    by.y = c(\"GameKey\", \"PlayID\", \"GSISID\", \"Season_Year\"), \n                    all.x = TRUE)\n\n# remove duplicate variables\nvrevsgpr2$Week.y <- vrevsgpr2$Season_Type.y <- vrevsgpr2$Game_Date.y <- NULL\nvrevsgpr2 <- vrevsgpr2[!(vrevsgpr2$Primary_Partner_GSISID == \"\"),] # omit rows with Player2 unknown\n\n# +++++++++++++++++++++++++++++++++++++++++\nwrite.csv(vrevsgpr2, \"vrevsgpr2.csv\")\n# +++++++++++++++++++++++++++++++++++++++++\n\nrm(vrevsg)\nrm(vrevsgp)\nrm(vrevsgpr)\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"710914652896cbc975a715d7a9a5eb32fa2aa654"},"cell_type":"markdown","source":"# Extract ngs data related to injury plays"},{"metadata":{"trusted":true,"_uuid":"e2cbd86fb01ae473822bbeef6ad95728b9eba280"},"cell_type":"code","source":"if (TRUE) # extract plays involved in injuries from ngs\n{\n  v <- vrevs[1:3]\n  \n  # 2016\n  pre2016 <- read.csv(\"../input/NFL-Punt-Analytics-Competition/NGS-2016-pre.csv\")\n  ngs <- pre2016[pre2016$Season_Year==2999,]\n  pre2016 <- merge (v,pre2016,by = c(\"GameKey\",\"PlayID\",\"Season_Year\"))\n  ngs <- rbind(ngs, pre2016)\n  rm (pre2016)\n  \n  reg2016_1_6 <- read.csv(\"../input/NFL-Punt-Analytics-Competition/NGS-2016-reg-wk1-6.csv\")\n  reg2016_1_6 <- merge (v,reg2016_1_6,by = c(\"GameKey\",\"PlayID\",\"Season_Year\"))\n  ngs <- rbind(ngs, reg2016_1_6)\n  rm (reg2016_1_6)\n  \n  reg2016_7_12 <- read.csv(\"../input/NFL-Punt-Analytics-Competition/NGS-2016-reg-wk7-12.csv\")\n  reg2016_7_12 <- merge (v,reg2016_7_12,by = c(\"GameKey\",\"PlayID\",\"Season_Year\"))\n  ngs <- rbind(ngs, reg2016_7_12)\n  rm (reg2016_7_12)\n  \n  reg2016_13_17 <- read.csv(\"../input/NFL-Punt-Analytics-Competition/NGS-2016-reg-wk13-17.csv\")\n  reg2016_13_17<- merge (v,reg2016_13_17,by = c(\"GameKey\",\"PlayID\",\"Season_Year\"))\n  ngs <- rbind(ngs, reg2016_13_17)\n  rm (reg2016_13_17)\n  \n  # 2017\n  pre2017 <- read.csv(\"../input/NFL-Punt-Analytics-Competition/NGS-2017-pre.csv\")\n  pre2017 <- merge (v,pre2017,by = c(\"GameKey\",\"PlayID\",\"Season_Year\"))\n  ngs <- rbind(ngs, pre2017)\n  rm (pre2017)\n  \n  reg2017_1_6 <- read.csv(\"../input/NFL-Punt-Analytics-Competition/NGS-2017-reg-wk1-6.csv\")\n  reg2017_1_6 <- merge (v,reg2017_1_6,by = c(\"GameKey\",\"PlayID\",\"Season_Year\"))\n  ngs <- rbind(ngs, reg2017_1_6)\n  rm (reg2017_1_6)\n  \n  reg2017_7_12 <- read.csv(\"../input/NFL-Punt-Analytics-Competition/NGS-2017-reg-wk7-12.csv\")\n  reg2017_7_12 <- merge (v,reg2017_7_12,by = c(\"GameKey\",\"PlayID\",\"Season_Year\"))\n  ngs <- rbind(ngs, reg2017_7_12)\n  rm (reg2017_7_12)\n  \n  reg2017_13_17 <- read.csv(\"../input/NFL-Punt-Analytics-Competition/NGS-2017-reg-wk13-17.csv\")\n  reg2017_13_17<- merge (v,reg2017_13_17,by = c(\"GameKey\",\"PlayID\",\"Season_Year\"))\n  ngs <- rbind(ngs, reg2017_13_17)\n  rm (reg2017_13_17)\n  \n  ngs$TimeStr <- hms(substr(as.character(ngs$Time),12,24))\n  ngs$TimeNum <- as.numeric(ngs$TimeStr)\n  \n  # add pproles data ----------------------------\n  ngs <- merge(ngs, pproles, by = c(\"GameKey\", \"PlayID\", \"GSISID\", \"Season_Year\"), all.x = TRUE)\n  ngs <- ngs[order(ngs$GameKey, ngs$PlayID, ngs$TimeNum),] # order by Time !\n  \n  # remove unwanted variables\n  ngs$X.1 <- ngs$X <- NULL\n  \n  # +++++++++++++++++++++++++++++++++++++++++\n  write.csv(ngs, \"ngs_combined.csv\")\n  # +++++++++++++++++++++++++++++++++++++++++\n}\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"42c13c5d22a56d59a3ac0756e2fd6e342bc9f034"},"cell_type":"markdown","source":"# Enrich ngs (injury plays) with game & play data"},{"metadata":{"trusted":true,"_uuid":"22a015d133d6ab87765e0007335ba42d94715002"},"cell_type":"code","source":"# enrich ngs (all injury plays) ===============================================\nif (FALSE)\n    {\n    ngs <- read.csv(\"../input/ngs_combined.csv\")\n    vrevsgpr2 <- read.csv(\"../input/vrevsgpr2.csv\")\n    }\n    \nngs2 <- merge (ngs, vrevsgpr2, by = c(\"GameKey\", \"PlayID\")) # combine vith play data\n# remove unwanted variables\nngs2$X.x <- ngs2$X.y <- NULL\n# rename variable GSISID.x - > GSISID\nnames(ngs2) <- sub(\"GSISID.x\", \"GSISID\", names(ngs2))\nngs2 <- ngs2[!is.na(ngs2$Role),] # remove NA-s\nngs2$TeamColor <- \"\" # add TeamColor variable","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"6c1f48df486bb51df9f401632edba9c74fdc531b"},"cell_type":"markdown","source":"# Calculate players' velocity and acceleration"},{"metadata":{"trusted":true,"_uuid":"4ccccd1d1927701db315e459b7a56a66d6c776cf"},"cell_type":"code","source":"# calculate players' velocity & acceleration - all plays -----------------------------\n\nngs2 <- ngs2[order(ngs2$GameKey, ngs2$PlayID, ngs2$GSISID, ngs2$TimeNum),] # order by player+time\nplayers <- unique(ngs2[,c(1,2,3)]) # select players from all plays\nngxx <- ngs2[ngs2$GameKey == 0,] # clone ngs2 structure\nnr <- nrow (players)\nfor (j in 1:nr) # step through all  players in ngs2\n{\n\n  pGAMEKEY <- players$GameKey[j]\n  pPLAYID <- players$PlayID[j]\n  pGSISID <- players$GSISID[j]\n  \n  ngx <- ngs2[ngs2$GSISID == pGSISID & ngs2$GameKey == pGAMEKEY & ngs2$PlayID == pPLAYID,]\n  ngx <- ngx[order(ngx$TimeNum),] # order by Time !\n  \n  # calculate velocity ------\n  ngx$vel1 <- 0 # add variable 'velocity'\n  ngx$acc1 <- 0 # add variable 'acceleration'\n  ngx$relvel1 <- 0 # add relative velocity\n  \n  for (i in 2:nrow(ngx))\n  {\n    a <- ngx$x[i] - ngx$x[i-1]\n    b <- ngx$y[i] - ngx$y[i-1]\n    c1 <- sqrt (a**2 + b**2)\n    c <- ngx$dis[i]\n    timediff <- ngx$TimeNum[i] - ngx$TimeNum[i-1]\n    if (timediff != 0)\n    {\n      \n      ngx$vel1[i] <- c1 / timediff\n      ngx$acc1[i] <- (ngx$vel1[i] - ngx$vel1[i-1]) / timediff # acceleration\n    }\n  }\n  # calculate relative velocity\n  ngx$relvel1 <- ngx$vel1/max(ngx$vel1)*100 \n  \n  ngxx <- rbind (ngxx,ngx) # cumulate rows\n \n}\n\nngs2 <- ngxx # velocity and acceleration data added\n# +++++++++++++++++++++++++++++++++++++++++\nwrite.csv (ngs2,\"ngs2.csv\") # ngs2 raw data\n# +++++++++++++++++++++++++++++++++++++++++\nrm(ngxx)\nrm(ngx)\nrm(players)\n\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"2cb14e376e057488f290f28637385b45ffc8c379"},"cell_type":"markdown","source":"# Find actual start of plays (snap)\nOutput: **ngs2** - enriched ngs data for all injury plays"},{"metadata":{"trusted":true,"_uuid":"448330aaac12355a3f41b76831873bc9f8d9aca9"},"cell_type":"code","source":"ngs2 <- read.csv(\"ngs2.csv\")\n\nif (TRUE)\n{\n  # find start time of each play\n  starttimes <- ngs2 %>% group_by(GameKey, PlayID) %>% summarize(TimeNum = min(TimeNum))\n  \n  \n  # find actual start time of the plays (by minimum of team's total velocity)\n  xx <- ngs2\n  \n  xx <- merge(xx,starttimes, by=c(\"GameKey\", \"PlayID\")) # add original starttimes\n  xx <- xx[xx$TimeNum.x > xx$TimeNum.y,] # drop original start data\n  \n  xx$TimeNum.y <- NULL\n  names(xx) <- sub(\"TimeNum.x\", \"TimeNum\", names(xx))\n  \n  xxgroup <- xx %>% group_by(GameKey, PlayID, TimeNum) %>% summarize(meanvel1=mean(vel1), minvel1=min(vel1), maxvel1=max(vel1)) # calculate team velocities\n  \n  xx1 <- merge(xx,xxgroup, by=c(\"GameKey\", \"PlayID\", \"TimeNum\")) # add aggregated data\n  \n  \n  xxminvel <- xx1 %>% group_by(GameKey, PlayID) %>% summarize(meanvel2=min(meanvel1)) # min mean velocity by play\n  xx2 <- merge(xx1, xxminvel, by=c(\"GameKey\", \"PlayID\")) # add min mean velocity by play\n  \n  \n  starttimes_act <- xx2 %>% filter(meanvel1 == meanvel2) %>% group_by(GameKey, PlayID) %>% summarize(TimeNum = min(TimeNum))\n  \n  # +++++++++++++++++++++++++++++++++++++++++\n  write.csv(starttimes_act, \"starttimes_act.csv\") # actual starttimes for each play\n  # +++++++++++++++++++++++++++++++++++++++++\n  \n  xx2 <- merge (xx2, starttimes_act, by = c(\"GameKey\", \"PlayID\"))\n\n}\n\n# drop unwanted variables from ngs2 -----------------------\nxx2 <- xx2[, !(colnames(xx2) %in% c(\n                                    \"Time\", \n                                    \"Season_Year.y\",\n                                    \"Game_Date.x\",\n                                    \"Game_Day\",\n                                    \"Game_Site\",\n                                    \"Start_Time\",\n                                    \"Home_Team\",\n                                    \"Visit_Team\",\n                                    \"Stadium\",\n                                    \"GameWeather\",\n                                    \"OutdoorWeather\",\n                                    \"Game_Clock\",\n                                    \"Play_Type\",\n                                    \"Home_Team_Visit_Team\",\n                                    \"Score_Home_Visiting\",\n                                    \"PlayDescription\"))]\n\nnames(xx2) <- sub(\"Season_Year.x\", \"Season_Year\", names(xx2))\nnames(xx2) <- sub(\"Season_Type.x\", \"Season_Type\", names(xx2))\nnames(xx2) <- sub(\"Week.x\", \"Week\", names(xx2))\nnames(xx2) <- sub(\"TimeNum.x\", \"TimeNum\", names(xx2))\nnames(xx2) <- sub(\"TimeNum.y\", \"TimeNum_Start\", names(xx2))\n\nngs2 <- xx2\n\n# +++++++++++++++++++++++++++++++++++++++++\nwrite.csv (ngs2,\"ngs2.csv\") # ngs2 contains all play and route data\n# +++++++++++++++++++++++++++++++++++++++++\n\nrm (xx1)\nrm (xx2)\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"08901da2f580c80bfb7fda8b73d61c5100e748e5"},"cell_type":"markdown","source":"# Create data set for colliding pairs and calculate distances\nOutput: **ngsAB** - PlayerA and PlayerB for each play, with velocities, accelerations and distances between each other during the play"},{"metadata":{"trusted":true,"_uuid":"dc05e414fa571eaf14d3398a99e7d7d2b42f995c"},"cell_type":"code","source":"\n# routes of all affected players ---------------------------------\nngsA <- ngs2[ngs2$GSISID == ngs2$GSISID.y,] # select routes of all PlayerA\nngsB <- ngs2[ngs2$GSISID == ngs2$Primary_Partner_GSISID,]  # select routes of all PlayerA\n\nngsAB <- merge(ngsA, ngsB, by = c(\"GameKey\", \"PlayID\",\"Season_Year\",\"TimeNum\"))\n\n# drop unwanted variables from ngsAB -----------------------\n\nmyvars <- dput(names(ngsAB)) # get variable names\n\nmyvars <- c(\"GameKey\", \n            \"PlayID\", \n            \"Season_Year\", \n            \"TimeNum\", \n            \"GSISID.x\", \n            \"x.x\", \n            \"y.x\", \n            \"dis.x\", \n            \"o.x\", \n            \"dir.x\", \n            \"Event.x\", \n            \"Role.x\", \n            \"Player_Activity_Derived.x\", \n            \"Turnover_Related.x\", \n            \"Primary_Impact_Type.x\", \n            \"Primary_Partner_Activity_Derived.x\", \n            \"Friendly_Fire.x\", \n            \"Season_Type.x\", \n            \"Week.x\", \n            \"HomeTeamCode.x\", \n            \"VisitTeamCode.x\", \n            \"Turf.x\", \n            \"Temperature.x\", \n            \"Quarter.x\", \n            \"StartArea.x\", \n            \"StartYard.x\", \n            \"TeamColor.x\", \n            \"vel1.x\", \n            \"acc1.x\", \n            \"relvel1.x\", \n            \"meanvel1.x\", \n            \"minvel1.x\", \n            \"maxvel1.x\", \n            \"meanvel2.x\", \n            \"TimeNum_Start.x\", \n            \"GSISID.y\", \n            \"x.y\", \n            \"y.y\", \n            \"dis.y\", \n            \"o.y\", \n            \"dir.y\", \n            \"Role.y\", \n            \"vel1.y\", \n            \"acc1.y\", \n            \"relvel1.y\", \n            \"meanvel1.y\", \n            \"minvel1.y\", \n            \"maxvel1.y\", \n            \"meanvel2.y\" \n            \n)\n\nngsABx <- ngsAB[,myvars]\n\nnewnames <- c(\"GameKey\", \n              \"PlayID\", \n              \"Season_Year\", \n              \"TimeNum\", \n              \"GSISID.x\", \n              \"x.x\", \n              \"y.x\", \n              \"dis.x\", \n              \"o.x\", \n              \"dir.x\", \n              \"Event\", \n              \"Role.x\", \n              \"Player_Activity_Derived\", \n              \"Turnover_Related\", \n              \"Primary_Impact_Type\", \n              \"Primary_Partner_Activity_Derived\", \n              \"Friendly_Fire\", \n              \"Season_Type\", \n              \"Week\", \n              \"HomeTeamCode\", \n              \"VisitTeamCode\", \n              \"Turf\", \n              \"Temperature\", \n              \"Quarter\", \n              \"StartArea\", \n              \"StartYard\", \n              \"TeamColor\", \n              \"vel1.x\", \n              \"acc1.x\", \n              \"relvel1.x\", \n              \"meanvel1.x\", \n              \"minvel1.x\", \n              \"maxvel1.x\", \n              \"meanvel2.x\", \n              \"TimeNum_Start\", \n              # PlayerB -----------------------------           \n              \"GSISID.y\", \n              \"x.y\", \n              \"y.y\", \n              \"dis.y\", \n              \"o.y\", \n              \"dir.y\", \n              \"Role.y\", \n              \"vel1.y\", \n              \"acc1.y\", \n              \"relvel1.y\", \n              \"meanvel1.y\", \n              \"minvel1.y\", \n              \"maxvel1.y\", \n              \"meanvel2.y\" \n              \n)\n\n# rename variables\n\ncolnames(ngsABx) <- newnames\nngsAB <- ngsABx # colliding pairs' data\n\n# calculate velocity and acceleration for each pair of colliding players\n\nnr <- nrow(starttimes_act)\n\nngsAB$CollTime <- ngsAB$CollPointX <- ngsAB$CollPointY <- ngsAB$distAB <- 0 # distance betweent the twe players\n\nfor (k in 1:nr)\n{\n  pGAMEKEY <- starttimes_act$GameKey[k]\n  pPLAYID <- starttimes_act$PlayID[k]\n  \n  ngxy <- ngsAB[ngsAB$GameKey == pGAMEKEY & ngsAB$PlayID == pPLAYID,] # & ngsAB$TimeNum >= ngsAB$TimeNum_Start\n  \n  # calculate distance between players\n  ngxy$distAB <- sqrt ((ngxy$x.x - ngxy$x.y)**2 + (ngxy$y.x - ngxy$y.y)**2)\n\n  ngxy$CollTime <- ngxy[ngxy$distAB == min(ngxy$distAB),]$TimeNum # calculate time of collision\n  ngxy$CollPointX <- ngxy[ngxy$TimeNum == ngxy$CollTime,]$x.x-10 # calculate place of collision X\n  ngxy$CollPointY <- ngxy[ngxy$TimeNum == ngxy$CollTime,]$y.x # calculate place of collision Y\n  \n  ngsAB[ngsAB$GameKey == pGAMEKEY & ngsAB$PlayID == pPLAYID, c(\"distAB\",\"CollTime\", \"CollPointX\", \"CollPointY\")] <- ngxy[,c(\"distAB\",\"CollTime\", \"CollPointX\", \"CollPointY\")]\n}\n\n# ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++\nwrite.csv (ngsAB,\"ngsAB.csv\") # ngsAB contains collision pairs' data\n# ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n\nrm(ngsA)\nrm(ngsB)\nrm(ngsABx)\n\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"4e5141266c2ed7fb0650e822107669279b158f98"},"cell_type":"markdown","source":"# Extract initial formations from ngs2\nOutput: **ngs3** - position of all players at the start of the play (at snap); 1 row per player per play"},{"metadata":{"trusted":true,"_uuid":"b7e713aeab741b2601a18e0e4380cdef8b40ae3c"},"cell_type":"code","source":"# get initial formations from ngs2\n\nngsinit <- merge (ngs2, starttimes_act, by = c(\"GameKey\", \"PlayID\", \"TimeNum\"))\nngsinit <- ngsinit[order(ngsinit$GameKey, ngsinit$PlayID, ngsinit$x),] # order players by x, for each play\nngs3 <- ngsinit # backup ngsinit\nrm (ngsinit)\n\n\nngs3$RETURNERx <- ngs3$PUNTERx <- 0 # add variables - Punter & Returner\nngs3[ngs3$Role == \"P\",]$PUNTERx <- ngs3[ngs3$Role == \"P\",]$x\nngs3[ngs3$Role == \"PR\",]$RETURNERx <- ngs3[ngs3$Role == \"PR\",]$x\n\npunters <- ngs3[ngs3$Role == \"P\",c(\"GameKey\",\"PlayID\",\"PUNTERx\")] # get list of punters\nreturners <- ngs3[ngs3$Role == \"PR\",c(\"GameKey\",\"PlayID\",\"RETURNERx\")] # get list of returners\n\nngs3 <- merge(ngs3, punters, by=c(\"GameKey\", \"PlayID\"))\nngs3 <- merge(ngs3, returners, by=c(\"GameKey\", \"PlayID\"))\n\nrm (punters)\nrm (returners)\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"21fc3f0da9e518a1525d8eb9935a8ac6c9757b26"},"cell_type":"markdown","source":"# Determine teams' positions on the field and scrimmage line\nOutput: **ngs3** - initial formations for each play\nWhich theam is on Left/right, so that the play can be drawn correctly"},{"metadata":{"trusted":true,"_uuid":"94075ee8b6a3c6ff957ecf946e967c768f297532"},"cell_type":"code","source":"# determine left/right teams & position of line of scrimmage ---------------------------\n\nngs3$RightTeam <- ngs3$LeftTeam <- \"\" # add variables - LeftTeam & RightTeam\nngs3$SCRIMx <- 0 # add variable - SCRIMx (line of scrimmage)\n\nattach (ngs3)\n\n# 1 - determine Left/Right teams -----------------------\nnr <- nrow (ngs3)\n\nfor (i in 1:nr)\n{\n  \n  if (ngs3$PUNTERx.y[i] < ngs3$RETURNERx.y[i]) # punter on left\n  {\n    ngs3$LeftTeam[i] <- as.character(ngs3$Poss_Team[i])\n    if (ngs3$LeftTeam[i] == as.character(ngs3$HomeTeamCode[i])) # Home team on left\n    {\n      ngs3$RightTeam[i] <- as.character(ngs3$VisitTeamCode[i])\n      \n    } else # Home team on the right\n    {\n      ngs3$RightTeam[i] <- as.character(ngs3$HomeTeamCode[i])\n    }\n    \n  } else # punter on the right\n  {\n    ngs3$RightTeam[i] <- as.character(ngs3$Poss_Team[i])\n    if (ngs3$RightTeam[i] == as.character(ngs3$HomeTeamCode[i])) # Home team on left\n    {\n      ngs3$LeftTeam[i] <- as.character(ngs3$VisitTeamCode[i])\n      \n    } else # Home team on the right\n    {\n      ngs3$LeftTeam[i] <- as.character(ngs3$HomeTeamCode[i])\n    }\n  }\n  \n  \n  # 2 - determine line of scrimmage -------------------\n  if (ngs3$StartArea[i] == ngs3$RightTeam[i])\n  {\n    ngs3$SCRIMx[i] <- 100 - ngs3$StartYard[i]\n  } else\n  {\n    ngs3$SCRIMx[i] <- ngs3$StartYard[i]\n  }\n  \n  # 3 - add color codes for teams\n  ngs3$TeamColor[i] <- ifelse (ngs3$x[i] < ngs3$SCRIMx[i]+10, \"blue\", \"red\") # A +10 miért szükséges?\n  \n}\n\ndetach (ngs3)\n\n# +++++++++++++++++++++++++++++++++++++++++\nwrite.csv (ngs3,\"ngs3.csv\") # ngs3 contains all initial formation data\n# +++++++++++++++++++++++++++++++++++++++++\n\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"06fe352bb709a65c85de8d926c8acb1b74ea1aa4"},"cell_type":"markdown","source":"# Plot diagrams on the basis of data prepared so far\n## PLOT1\n* **Field with initial formations**\n* **Routes of the colliding two players**\n## PLOT2\n* **Distance of players**\n* **Velocity of players (superposed to Distance chart - optionA)**\n* **Acceleration of players (superposed to Distances - optionB)**"},{"metadata":{"trusted":true,"_uuid":"9db5f11ac7132714e0414a27ed20b7bcc894ab5f"},"cell_type":"code","source":"# =============================================\nif (FALSE) # set it TRUE to run PLOTs without running the data preparation\n    {\n    library (ggplot2)\n    library (lubridate)\n    library (dplyr)\n    ngs2 <- read.csv(\"../input/preprocessed/ngs2.csv\") # all ngs data for injury plays\n    ngs3 <- read.csv(\"../input/preprocessed/ngs3.csv\") # initial formations for injury plays\n    ngsAB <- read.csv (\"../input/preprocessed/ngsAB.csv\") \n    starttimes_act <- read.csv(\"../input/preprocessed/starttimes_act.csv\")\n    }\n#=========== PLOT ==================================\n\n# PLOT1\n# plot field with initial formation\n\nnr <- nrow(starttimes_act)\nng4a <- data_frame ()\n\nfor (k in c(1:29, 31:nr))\n# for (k in 1:1) # can be used for testing\n{\n \n  pGAMEKEY <- starttimes_act$GameKey[k]\n  pPLAYID <- starttimes_act$PlayID[k]\n  \n  \n  CollTime <- ngsAB[ngsAB$GameKey==pGAMEKEY & ngsAB$PlayID==pPLAYID,]$CollTime[1]\n  CollPointX <- ngsAB[ngsAB$GameKey==pGAMEKEY & ngsAB$PlayID==pPLAYID,]$CollPointX[1]\n  CollPointY <- ngsAB[ngsAB$GameKey==pGAMEKEY & ngsAB$PlayID==pPLAYID,]$CollPointY[1]\n  \n  # set zoom level\n  if (TRUE) # no zoom\n  {\n    X <- c(-10, 120) # horizontal dimensions\n    Y <- c(-10, 60) # vertical dimensions\n  }\n  \n  if(FALSE) # zoom to CollPoint\n  {\n    X <- c(CollPointX-10, CollPointX+10) # horizontal dimensions - zoomed\n    Y <- c(CollPointY-10, CollPointY+10)\n  }\n  \n  ng4 <- ngs3[ngs3$GameKey == starttimes_act$GameKey[k] & ngs3$PlayID == starttimes_act$PlayID[k],]\n  \n  ng4a <- rbind(ng4a, ng4[,c(\"GameKey\", \"PlayID\", \"Role\", \"Role.x\", \"Role.y\", \"Poss_Team\", \"LeftTeam\", \"RightTeam\", \"SCRIMx\",\"TimeNum_Start\", \"vel1\", \"acc1\")])\n    \n  attach (ng4)\n  {\n    # plot field with initial formation\n    par (bg=\"darkgreen\")\n    pMAIN <- paste (LeftTeam[1], RightTeam[1], paste(\"Q\",Quarter[1],sep=\"\"),GameKey[1],PlayID[1],Poss_Team[1], YardLine[1],k, sep = \" / \")\n    \n \n    plot (\"\", xlim = X, ylim = Y, xlab = \"\", ylab = \"\", main = pMAIN, cex=2)\n    abline(v = c(0, 10, 20, 30, 40, 50, 60, 70, 80, 90, 100, 110), col=\"black\") # yard lines\n    abline(v = 50, col=\"blue\", lwd=3) # center line\n    abline(h = 0, col=\"black\", lwd=2) # bottom sideline \n    abline(h = 53.3, col=\"black\", lwd=2) # top sideline\n    abline(h = 23.3, col=\"black\", lwd=2, lty=2) # hash line 1\n    abline(h = (53.3-23.3), col=\"black\", lwd=2, lty=2) # hash line 1\n    text(c(0,10,20,30,40,50,60,70,80,90,100),-5,c(\"G\",\"10\",\"20\",\"30\",\"40\",\"50\",\"40\",\"30\",\"20\",\"10\",\"G\"), col = \"white\", font=2, cex=1.5) # yard marks\n   \n    abline(v = SCRIMx[1], col=\"red\", lwd=4) # line of scrimmage\n    \n    text (-5,26.5, LeftTeam[1], col = \"black\", cex=2) # team code 1\n    text (115,26.5, RightTeam[1], col = \"black\", cex=2) # team code 2\n    \n    points (x-10, y, xlim = X, ylim = Y, xlab = \"X\", ylab = \"Y\", col = as.character(TeamColor), pch = 16, cex = 2) # plot players\n    \n    text(x-10, y, labels = Role, pos = 4) # add Role labels\n    \n }\n \n  # plot players' routes  --------------------------\n\n  pGSISID <- c(GSISID.y[1], as.numeric(as.character(Primary_Partner_GSISID[1])))\n  teamcolors <- c(\"red\",\"blue\")\n  \n  for (m in 1:2) # run for two players\n  {\n    ngx <- ngs2[ngs2$GSISID == pGSISID[m] & \n                  ngs2$GameKey == pGAMEKEY & \n                  ngs2$PlayID == pPLAYID & \n                  ngs2$TimeNum >= ngs2$TimeNum_Start,] # movement from the actual play start only\n    \n    ngx <- ngx[order(ngx$TimeNum),] # order by Time !\n    \n    attach(ngx)\n    \n      points(x-10,y, col=teamcolors[m], pch=17, cex=vel1/4)\n\n    detach(ngx)\n  }\n  \n  # --------- add all players at CollTime --------------------------------\n \n  points (CollPointX, CollPointY, cex = 3, col = \"yellow\", pch = 16, font = 2) # mark place of collision\n  \n  ngfin <- ngs2[ngs2$GameKey==pGAMEKEY & ngs2$PlayID==pPLAYID & ngs2$TimeNum == CollTime, ]\n  \n  points (ngfin$x-10, ngfin$y, pch = 17, cex = 1.5)\n  # with(ngfin, text(x-10, y, labels = Role, pos = 1)) # labels\n  \n\n  # ---------------------------------------------------------------------------\n \n  \n  detach (ng4)\n    \n#} # end of for (k ....)\n\n#nr <- nrow(starttimes_act)\n\n#for (k in 1:nr)\n#{\n\n  # get play data --------------------------------\n  pGAMEKEY <- starttimes_act$GameKey[k]\n  pPLAYID <- starttimes_act$PlayID[k]\n  \n  CollTime <- ngsAB[ngsAB$GameKey==pGAMEKEY & ngsAB$PlayID==pPLAYID,]$CollTime[1]\n  CollPointX <- ngsAB[ngsAB$GameKey==pGAMEKEY & ngsAB$PlayID==pPLAYID,]$CollPointX[1]\n  CollPointY <- ngsAB[ngsAB$GameKey==pGAMEKEY & ngsAB$PlayID==pPLAYID,]$CollPointY[1]\n \n  ngxy <- ngsAB[ngsAB$GameKey == pGAMEKEY & ngsAB$PlayID == pPLAYID & ngsAB$TimeNum >= ngsAB$TimeNum_Start,]\n  \n  # set zoom level\n  if (TRUE) # no zoom\n  {\n    X <- c(min(ngxy$TimeNum), max(ngxy$TimeNum)) # horizontal dimensions\n    Y <- c(-10, 120) # vertical dimensions\n  }\n  \n  if(FALSE) # zoom to CollPoint\n  {\n    X <- c(CollTime-1, CollTime+1) # horizontal dimensions - zoomed\n    #X <- c(min(ngxy$TimeNum), max(ngxy$TimeNum)) # horizontal dimensions\n    Y <- c(CollPointX-10, CollPointX+1)\n  }\n  \n  # PLOT2 \n  # plot distance and velocity charts\n  \n  # plot distance chart\n  \n  par (bg=\"white\") # reset plot background\n  \n  pMAIN <- with (ngxy, paste (HomeTeamCode[1], VisitTeamCode[1], paste(\"Q\",Quarter[1],sep=\"\"),GameKey[1],PlayID[1],k, sep = \" / \")) # plot title\n  plot(ngxy$TimeNum, xlim = X, ylim = Y, ngxy$distAB, main=pMAIN, ylab = \"Distance [yds]\", xlab = \"Time\")\n  points(ngxy$TimeNum,ngxy$x.x-10, col=\"red\", pch=16)\n  points(ngxy$TimeNum,ngxy$x.y-10, col=\"green\", pch=17)\n  \n  text(min(ngxy$TimeNum),ngxy$x.x[1]-10, ngxy$Role.x, col=\"red\", font=2, pos=2) # labels\n  text(min(ngxy$TimeNum),ngxy$x.y[1]-10, ngxy$Role.y, col=\"blue\", font=2, pos=2) # labels\n  \n  abline (v = ngxy$TimeNum_Start.x, col=\"blue\", lwd=2, lty=2) # strt of play\n  abline (v = ngxy$CollTime, col=\"red\", lwd=2, lty=2) # time of collision\n  text (ngxy$CollTime,-10,ngxy$CollTime,font=2)\n  \n  abline (h = ngxy$CollPointX, col=\"blue\", lwd=2, lty=2) # place of collision\n  text (min(ngxy$TimeNum),ngxy$CollPointX+2,round(ngxy$CollPointX,2), font=2)\n  \n  \n  if (TRUE)\n  {  \n    \n    # superpose velocity chart\n    if (max(ngxy$vel1.x) > max(ngxy$vel1.y)) # scale chart properly\n    {\n      PlayerA <- ngxy$vel1.x\n      PlayerB <- ngxy$vel1.y\n    } else\n    {\n      PlayerA <- ngxy$vel1.y\n      PlayerB <- ngxy$vel1.x\n    }\n    \n    par (new = T)\n    plot(ngxy$TimeNum,PlayerA, xlim = X, ylim = c(0,max (PlayerA, PlayerB)), axes=F, xlab=NA, ylab=NA, col=\"red\", pch=16, type=\"l\", lwd=2) # Player1\n    axis (side=4)\n    mtext(side = 4, line = 0, 'Player velocity')\n    points(ngxy$TimeNum,PlayerB, col=\"green\", pch=17, type=\"l\", lwd=2) # Player2\n    \n    # velocity totals -------------------------------\n    points(ngxy$TimeNum,ifelse (ngxy$vel1.y!=0,abs(ngxy$vel1.x+ngxy$vel1.y),ngxy$vel1.x), type=\"h\", col = \"grey34\")\n    veldiff <- ngxy[ngxy$TimeNum == ngxy$CollTime,]$vel1.x+ngxy[ngxy$TimeNum == ngxy$CollTime,]$vel1.y # velocity difference\n    text (ngxy$CollTime,max(ngxy$vel1.x)*0.9, paste(\"vel_x+vel_y: \", round(veldiff,2), \" yds/s\"), col = \"red\")\n   \n  }\n    \n  if (FALSE) # set to TRUE to display accelerations\n  {  \n    \n    # superpose acceleration chart ---------------------------------------\n    if (max(ngxy$acc1.x) > max(ngxy$acc1.y)) # scale chart properly\n    {\n      PlayerA <- ngxy$acc1.x\n      PlayerB <- ngxy$acc1.y\n    } else\n    {\n      PlayerA <- ngxy$acc1.y\n      PlayerB <- ngxy$acc1.x\n    }\n    \n    par (new = T)\n    plot(ngxy$TimeNum,PlayerA, xlim = X, ylim = c(min (PlayerA, PlayerB),max (PlayerA, PlayerB)), axes=F, xlab=NA, ylab=NA, col=\"red\", pch=16, type=\"l\", lwd=2) # Player1\n    axis (side=4)\n    mtext(side = 4, line = 0, 'Player acceleration')\n    points(ngxy$TimeNum,PlayerB, col=\"green\", pch=17, type=\"l\", lwd=2) # Player2\n    \n    acc <- max (ngxy[ngxy$TimeNum == ngxy$CollTime,]$acc1.x, ngxy[ngxy$TimeNum == ngxy$CollTime,]$acc1.y)\n    text (ngxy$CollTime,max(ngxy$acc1.x)*0.9, round(acc,2), col = \"red\")\n    \n  }\n    \n}\n","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"fc8014845c6978c64e5461692a91365763311300"},"cell_type":"markdown","source":"# PLOT3\n* **Velocity - PlayerA vs. PlayerB** - by colliding pairs\n* **Acceleration - PlayerA vs. PlayerB** - by colliding pairs\n"},{"metadata":{"trusted":true,"_uuid":"08f19f5cf515c012a1f794c743b4c68a52024673"},"cell_type":"code","source":"if (FALSE) # set it TRUE to run PLOTs without running the data preparation\n    {\n    library (ggplot2)\n    library (lubridate)\n    library (dplyr)\n    ngsAB <- read.csv (\"../input/preprocessed/ngsAB.csv\") \n    starttimes_act <- read.csv(\"../input/preprocessed/starttimes_act.csv\")\n    }\n\n\ng <- ngsAB[ngsAB$TimeNum == ngsAB$CollTime,]\n\nattach(g)\nRolePair <- as.factor(paste(Role.x, Role.y, sep=\"/\"))\ng$rvel <- vel1.x/vel1.y\ng$racc <- acc1.x/acc1.y\ndetach(g)\n\n# overview chart\ng1 <- g[,c(\"vel1.x\",\"vel1.y\", \"acc1.x\", \"acc1.y\")]\npairs(g1, col=\"red\", cex=1, pch=16)\n\n# relative velocities\nwith(g, plot(vel1.x, vel1.y, col=GameKey, pch=16, cex=2))\nwith (g, text(vel1.x, vel1.y, labels = RolePair, pos = 1, cex=0.8))\n\n# relative accelerations\nwith(g, plot(acc1.x, acc1.y, col=GameKey, pch=16, cex=2))\nwith (g, text(acc1.x, acc1.y, labels = RolePair, pos = 1, cex=0.8))","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}