{"cells":[{"metadata":{"_uuid":"4f33adbe78690350825656a7d3222511fd5b92ec","_execution_state":"idle","trusted":true},"cell_type":"code","source":"## Importing packages\n\n# This R environment comes with all of CRAN and many other helpful packages preinstalled.\n# You can see which packages are installed by checking out the kaggle/rstats docker image: \n# https://github.com/kaggle/docker-rstats\n\nlibrary(tidyverse)\nlibrary(gridExtra)\nlist.files(path = \"../input\")\n\n# Load All NGS Data & video data\n###########################################################################################\nNGS_Data_1 <- read_csv(\"../input/NGS-2016-pre.csv\")\nNGS_Data_2 <- read_csv(\"../input/NGS-2016-reg-wk1-6.csv\")\nNGS_Data_3 <- read_csv(\"../input/NGS-2016-reg-wk7-12.csv\")\nNGS_Data_4 <- read_csv(\"../input/NGS-2016-reg-wk13-17.csv\")\nNGS_Data_5 <- read_csv(\"../input/NGS-2017-pre.csv\")\nNGS_Data_6 <- read_csv(\"../input/NGS-2017-reg-wk1-6.csv\")\nNGS_Data_7 <- read_csv(\"../input/NGS-2017-reg-wk7-12.csv\")\nNGS_Data_8 <- read_csv(\"../input/NGS-2017-reg-wk13-17.csv\")\nvideo_review <- read_csv(\"../input/video_review.csv\")   \nvideo_injury <- read_csv(\"../input/video_footage-injury.csv\")\nvideo_control <- read_csv(\"../input/video_footage-control.csv\")\n###########################################################################################\n\n\n\n\n# USER FUNCTION TO CREATE ONE FILE OF ALL NGS_TABLES FOR KNOWN INJURIES\n###########################################################################################\nNFL_Filter <- function(S,Data){\n  DataFiltered <- Data %>%\n    filter(Season_Year %in% S$Season_Year,\n           GameKey %in% S$GameKey,\n           PlayID %in% S$PlayID,\n           GSISID %in% S$GSISID)\n  \n  DataTemp <- Data %>%\n    filter(Season_Year %in% S$Season_Year,\n           GameKey %in% S$GameKey,\n           PlayID %in% S$PlayID,\n           GSISID %in% S$Primary_Partner_GSISID)\n  \n  return(rbind(DataFiltered, DataTemp))\n}\n###########################################################################################\n\n\n\n\n# USER FUNCTION TO MERGE GSN DATA FOR PLAYR 1 (P1) AND PLAYER 2 (P2)\n# MATCH ON GAME, PLAY, PLAYERS (P1 & P2) AND TIME\n###########################################################################################\nNFL_combine <- function(data,lr){\n  # DATAT FOR PLAYER 1\n  P1 <- data %>%     \n    filter(Season_Year == lr$Season_Year[1]\n           , GameKey == lr$GameKey[1]\n           , PlayID == lr$PlayID[1]\n           , GSISID == lr$GSISID[1]) %>%\n    arrange(GSISID,GameKey,PlayID,Time)\n  \n  # DATAT FOR PLAYER 2\n  P2 <- data %>% \n    filter(Season_Year == lr$Season_Year[1]\n           , GameKey == lr$GameKey[1]\n           , PlayID == lr$PlayID[1]\n           , GSISID == lr$GSISID2[1]) %>%\n    arrange(GSISID,GameKey,PlayID,Time)\n  \n  # JOIN THE TWO DATA SENTS\n  Out <- inner_join(P1, P2, by = c(\"Season_Year\",\"GameKey\",\"PlayID\",\"Time\"))\n  \n  # CALCULATE & ADD VARIABLE DISTANCE BETWEEN PLAYERS\n  Out <- Out %>%  \n    mutate(d = sqrt((x.x-x.y)^2 + (y.x-y.y)^2))\n  \n  return(Out)\n}\n###########################################################################################\n\n\n\n\n# USER FUNCTION TO CREATE SUMMARY TABLES\n###########################################################################################\nNFL_table <- function(data, desc){\nn <- nrow(desc)                # NUMBER OF ROWS TO ITTERATE\npb <- txtProgressBar(min = 0, max = n, style = 3)\ntbl_out <- data_frame(GSISID1 = rep(0,n)\n                         , GSISID2 = rep(0,n)\n                         , d_start = rep(0,n)\n                         , d_min = rep(0,n)\n                         , time_c = rep(0,n)\n                         , vel_p1 = rep(0,n)\n                         , vel_p2 = rep(0,n)\n                         , angle = rep(0,n))\n  \nfor (itt in 1:n) {\n    tbl_data <- data %>%\n      filter(Season_Year == desc$Season_Year[itt]\n             , GameKey == desc$GameKey[itt]\n             , PlayID == desc$PlayID[itt]\n             , GSISID.x == desc$GSISID[itt]\n             , GSISID.y == desc$GSISID2[itt]) %>%\n      select(Time, GSISID.x, x.x, y.x, dis.x, o.x, dir.x\n             , GSISID.y, x.y, y.y, dis.y, o.y, dir.y,d)\n    \n      # ADD LAG OF 1 TIME UNIT VARIABLES\n    tbl_data <- tbl_data %>%\n      mutate( dp = lag(d, n = 1)\n              , x1p = lag(x.x, n = 1)\n              , y1p = lag(y.x, n = 1)\n              , x2p = lag(x.y, n = 1)\n              , y2p = lag(y.y, n = 1)\n              , tp = lag(Time, n = 1)\n              , op = lag(o.x, n = 1)\n              , dirp = lag(dir.x, n = 1))\n    \n    smd <- sum(which(tbl_data$d < 1))\n    \n    if (smd > 0) {\n      min_d <- min(which(tbl_data$d < 1))\n      temp <- tbl_data %>%\n        filter(d == d[min_d])\n    } else {\n      temp <- tbl_data %>%\n        filter(d== min(d))\n    }\n    \n    tbl_out$GSISID1[itt] <- desc$GSISID[itt]\n    tbl_out$GSISID2[itt] <- desc$GSISID2[itt]\n    if (nrow(temp) > 0) {\n    tbl_out$d_start[itt] <- round(tbl_data$d[1],1)\n    tbl_out$d_min[itt]  <- round(temp$d[1],1)\n    tbl_out$time_c[itt] <- round(as.numeric(temp$Time[1] - tbl_data$Time[1])/10,1)\n    td <- round(as.numeric(temp$Time[1] - temp$tp[1]),1)\n    tbl_out$vel_p1[itt] <- round(sqrt((temp$x.x[1] - temp$x1p[1])^2 + (temp$y.x[1] - temp$y1p[1])^2) / td, 1)\n    tbl_out$vel_p2[itt] <- round(sqrt((temp$x.y[1] - temp$x2p[1])^2 + (temp$y.y[1] - temp$y2p[1])^2) / td, 1)\n    tbl_out$angle[itt] <- round(abs(temp$dir.x[1] - temp$dir.y[1]),0)  \n    }\n    Sys.sleep(0.1)\n    setTxtProgressBar(pb,itt)\n}  \nclose(pb)\nreturn(tbl_out)\n}\n###########################################################################################\n\n\n\n\n\n# USER FUNCTION TO PLOT POSITION ON FIELD, LOCATE POINT OF CONTACT WITH SQUARE BLUE BOX ...\n# AND TEMPRAL GRAPH OF DISTANCE BETWEEN PLAYERS\n# PROVIDE SUMMARY STATISTICS FOR SPEED OF BOTH PLAYERS AND ANGLE OF CONTACT\n###########################################################################################\nNFL_plot <- function(data, desc){\n  \n  n <- nrow(desc)                # NUMBER OF ROWS TO ITTERATE\n  md <- round(max(data$d),0)     # FIND MAX DISTANCE TO MAKE ALL GRAPHS ON SAME SCALE\n  pb <- txtProgressBar(min = 0, max = n, style = 3)\n  \n  for (itt in 1:n) {\n\n    # ASSINING FILTERED DATA THAT MATCHES PLAYER 1 & PLAYER 2\n    plot_data <- data %>%\n      filter(Season_Year == desc$Season_Year[itt]\n             , GameKey == desc$GameKey[itt]\n             , PlayID == desc$PlayID[itt]\n             , GSISID.x == desc$GSISID[itt]\n             , GSISID.y == desc$GSISID2[itt]) %>%\n      select(Time, GSISID.x, x.x, y.x, dis.x, o.x, dir.x\n             , GSISID.y, x.y, y.y, dis.y, o.y, dir.y, d)\n    \n    # ADD LAG OF 1 TIME UNIT VARIABLES\n    plot_data <- plot_data %>%\n      mutate( dp = lag(d, n = 1)\n             , x1p = lag(x.x, n = 1)\n             , y1p = lag(y.x, n = 1)\n             , x2p = lag(x.y, n = 1)\n             , y2p = lag(y.y, n = 1)\n             , tp = lag(Time, n = 1)\n             , op = lag(o.x, n = 1)\n             , dirp = lag(dir.x, n = 1))\n    \n    # IF PLAYERS ARE NOT IN CONTACT ZONE (I.E. < 1 YARD), FIX PRINTING VARIABLES\n    # VARIABLES INCLUDE SPEED OF BOTH PLAYERS, ANGLE OF CONTACT & LOCATION OF CONTACT\n    # YES IN CONTACT ZONE\n    if (sum(which(plot_data$d < 1)) > 0) { \n      \n      # FIRST POINT IN CONTACT ZONE\n      min_d <- min(which(plot_data$d < 1)) \n      \n      # FILTER ALL DATA TO JUST FIRST POINT IN CONTACT ZONE\n      temp <- plot_data[min_d,]\n      \n      # CALUCLUATE SUMMARY VARIABLES\n      # TIME BETWEEN FIST POINT IN CONTACT ZONE AND LAGGED DATA POINT\n      td <- temp$Time - temp$tp\n      \n      # VELOCITY PLAYER 1\n      v1 <- round(sqrt((temp$x.x - temp$x1p)^2 + (temp$y.x - temp$y1p)^2) / as.numeric(td), 1)\n      \n      # VELOCITY PLAYER 2\n      v2 <- round(sqrt((temp$x.y - temp$x2p)^2 + (temp$y.y - temp$y2p)^2) / as.numeric(td), 1)\n      \n      # ANGLE OF CONTACT\n      a <- round(abs(temp$dir.x - temp$dir.y),0)\n    } # END YES TO CONTACTO ZONE\n    \n    # NO IN CONTACT ZONE\n    if(sum(which(plot_data$d < 1)) == 0){\n      v1 <- \"NA\"\n      v2 <- \"NA\"\n      a <- \"NA\"\n      temp <- plot_data %>%\n        filter(d == min(d))\n    }\n    \n    T <- seq(0,(nrow(plot_data)-1)) / 10\n    dt <- difftime(as.POSIXlt(plot_data$Time[nrow(plot_data)],'%Y-%m-%d %H:%M%OS1')\n                         , as.POSIXlt(plot_data$Time[1], '%Y-%m-%d %H:%M%OS1')\n                         , units = 'secs')\n    dt <- round(as.numeric(dt),1)\n    \n    # EXCLUDE PLAYERS WHO DID NOT MAKE CONTACT WITH OTHER PLAYERS\n    # FUTURE WORK, REMOVE CONSTRAINT AND SEE MOVEMENT OF PLAYER CONCUSSED BY GROUND\n    if (nrow(plot_data) > 0) {\n      \n      # MAIN PLOT OF FIELD POSITION\n      p1 <- ggplot(plot_data, aes(x=x.x, y=y.x, shape = as.factor(GSISID.x))) + \n        geom_point(color = 'red') + \n        labs (x = 'x direction', y = 'y direction') +\n        coord_cartesian(xlim = c(0,120), ylim = c(0,55)) +\n        geom_point(aes(x=x.y, y=y.y, shape = as.factor(GSISID.y))) +\n        theme(legend.position = 'top', legend.title = element_blank()) +\n        annotate(geom = 'text', x=plot_data$x.x[1], y=plot_data$y.x[1], label = 'P1 Start') +\n        annotate(geom = 'text', x=plot_data$x.y[1], y=plot_data$y.y[1], label = 'P2 Start') +\n        geom_rect(aes(xmin = temp$x.x - 2.5, xmax = temp$x.x + 2.5,\n                      ymin = temp$y.x - 2.5, ymax = temp$y.x + 2.5)\n                  ,color = \"blue\", alpha = 0) +\n        geom_rect(aes(xmin = 0, xmax = 10,\n                      ymin = 0, ymax = 55),\n                   color = \"palegreen1\", alpha = 0) +\n        geom_rect(aes(xmin = 110, xmax = 120,\n                      ymin = 0, ymax = 55),\n                  color = \"palegreen1\", alpha = 0) +\n        geom_rect(aes(xmin = 0, xmax = 120,\n                      ymin = 0, ymax = 55),\n                  color = \"black\", alpha = 0) +\n        ggtitle(desc$desc[itt]\n                , subtitle = paste0(\"Player 1: \", v1, \" yards/sec  |  Player 2: \"\n                                    , v2, \" yards/sec |\", \" Angle of contact: \", a\n                                    , sep = \"\"))\n\n      # SECONDARY PLOT OF DISTANCE BETWEEN PLAYERS\n      p2 <- ggplot(plot_data, aes(x=T, y=d)) + \n        geom_line() +\n        ylim(0,md) +\n        theme(legend.position = \"none\") +\n        ggtitle(\"Distance Between Players Over Time\") +\n        geom_hline(aes(yintercept = 1, color = 'red')) + \n        labs(x = paste(\"Play Duration \", dt, \" Seconds\", sep = \"\")\n             , y = \"Yards Between Players\") \n      \n      grid.arrange(p1,p2,nrow=2)\n      rm(p1,p2)\n    }\n\n    Sys.sleep(0.1)                  # PAUSE FOR PROGRESS BAR TO UPDATE\n    setTxtProgressBar(pb,itt)       # UPDATE PROGRESS BAR\n    \n  }         # END ITT\n  close(pb) # CLOSE PROGRESS BAR\n}  \n###########################################################################################\n\n\n\n\n# Make NGS Data Frame For Known Injured Players In GameKey x & PlayID y\n###########################################################################################\nNGS_Data <- NFL_Filter(video_review, NGS_Data_1)\nNGS_Data <- rbind(NGS_Data,NFL_Filter(video_review, NGS_Data_2))\nNGS_Data <- rbind(NGS_Data,NFL_Filter(video_review, NGS_Data_3))\nNGS_Data <- rbind(NGS_Data,NFL_Filter(video_review, NGS_Data_4))\nNGS_Data <- rbind(NGS_Data,NFL_Filter(video_review, NGS_Data_5))\nNGS_Data <- rbind(NGS_Data,NFL_Filter(video_review, NGS_Data_6))\nNGS_Data <- rbind(NGS_Data,NFL_Filter(video_review, NGS_Data_7))\nNGS_Data <- rbind(NGS_Data,NFL_Filter(video_review, NGS_Data_8))\nNGS_Data <- NGS_Data %>%\n  arrange(GSISID,Season_Year,GameKey,PlayID, Time)\n###########################################################################################\n\n\n\n\n# Gather All GSN data for KNOWN concussions \n###############################################################################################\nvr <- video_review %>%\n  filter(GameKey %in% NGS_Data$GameKey) %>%\n  select(Season_Year, GameKey, PlayID, GSISID, GSISID2 = Primary_Partner_GSISID) %>%\n  mutate(GSISID2 = parse_integer(GSISID2)) %>%\n  filter(!is.na(GSISID2))\n\nn = nrow(vr)  \npb <- txtProgressBar(min = 0, max = n, style = 3)\nk = 1\nfor (i in 1:length(vr$GSISID)) {\n  #Custom Function\n  injured_true <- NFL_combine(NGS_Data,vr[i,])\n  ifelse(k == 1\n         , injured_play_data <- injured_true\n         , injured_play_data <- rbind(injured_play_data, injured_true))\n  k = k + 1\n  Sys.sleep(0.1)\n  setTxtProgressBar(pb,i)\n}\nclose(pb)\nrm(vr,k,injured_true,n,pb,i)\n###############################################################################################\n\n\n\n\n# Make a table describing player interactions -- to be used for plotting \n###############################################################################################\nir_play_desc <- video_review %>%\n  mutate(desc = paste0(\"Player \", GSISID,\" concussed, \", Player_Activity_Derived\n                       , \" \", Primary_Impact_Type, \", Player2 \"\n                       , Primary_Partner_Activity_Derived, sep = \" \")) %>%\n  select(Season_Year, GameKey, PlayID, GSISID, GSISID2 = Primary_Partner_GSISID, desc)\n###############################################################################################\n\n\n\n\n# Make a table summarizing KNOWN injuries\n###############################################################################################\ntbl_ir_summary <- NFL_table(injured_play_data, ir_play_desc)\nprint(tbl_ir_summary)\n\n\n\n\n# Make Plots of Player Interactions\n###############################################################################################\nNFL_plot(injured_play_data, ir_play_desc)\n\n\n\n# How many injuries occur with impact type\nvideo_review %>%\n    group_by(Primary_Impact_Type) %>%\n    summarise(n = n())\n\n# How many injuries occur with impact type, broken out by partner activity\nvideo_review %>%\n    group_by(Primary_Impact_Type, Primary_Partner_Activity_Derived) %>%\n    summarise(n = n())\n\n\n\nprint(tbl_ir_summary)\nnames(tbl_ir_summary)\nnames(video_review)\nnames(tbl_ir_summary)[1] <- 'GSISID'\nnames(video_review)[8] <- 'GSISID2'\nanalysis_data <- left_join(video_review, tbl_ir_summary, by = c(\"GSISID\",'GSISID2'))\n\nanalysis_data <- analysis_data %>%\n    mutate(vel_1t = case_when(\n        between(vel_p1,0,3) ~ '0-3',\n        between(vel_p1,3,6) ~ '3-6',\n        between(vel_p1,6,500) ~ '6+',\n        TRUE ~ 'else'\n    ))\n\nanalysis_data <- analysis_data %>%\n    mutate(vel_2t = case_when(\n        between(vel_p2,0,3) ~ '0-3',\n        between(vel_p2,3,6) ~ '3-6',\n        between(vel_p2,6,500) ~ '6+',\n        TRUE ~ 'else'\n    ))\n\nanalysis_data %>%\n    group_by(Primary_Impact_Type,vel_1t, vel_2t) %>%\n    summarise(n = n())\n\nanalysis_data %>%\n    group_by(Primary_Impact_Type,Player_Activity_Derived,vel_1t, vel_2t) %>%\n    summarise(n = n())\n\nanalysis_data <- analysis_data %>%\n    mutate(vel_dif = vel_p1 - vel_p2)\n\nanalysis_data <- analysis_data %>%\n    mutate(vel_dif_t = case_when(\n        between(vel_dif,-1,1) ~ 'same',\n        between(vel_dif,-3,-1) ~ 'p2_faster',\n        between(vel_dif,1,3) ~ 'p1_faster',\n        between(vel_dif,-50,-3) ~ 'p2_muchfaster',\n        between(vel_dif,3,50) ~ 'p1_muchfaster',\n        TRUE ~ 'else'\n    ))\n\nanalysis_data %>%\n    filter(Primary_Impact_Type == \"Helmet-to-body\") %>%\n    group_by(Player_Activity_Derived,vel_dif_t) %>%\n    summarise(n = n())\n\nanalysis_data %>%\n    filter(Primary_Impact_Type == \"Helmet-to-helmet\") %>%\n    group_by(Player_Activity_Derived,vel_dif_t) %>%\n    summarise(n = n())\n\nanalysis_data <- analysis_data %>%\n    mutate(at = case_when(\n        between(angle,0,60) ~ 'headon',\n        between(angle,300,360) ~ 'headon',\n        between(angle,120,240) ~ 'behind',\n        between(angle,60,120) ~ 'side',\n        between(angle,240,300) ~ 'side',\n        TRUE ~ 'else'\n    ))\n\nanalysis_data %>%\n    group_by(Player_Activity_Derived, Primary_Impact_Type ,at) %>%\n    summarise(n = n())\n\nanalysis_data %>%\n    group_by(Player_Activity_Derived, vel_dif_t ,at) %>%\n    summarise(n = n())","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}