# Data processing and ploting function for the NCAA March Madness Analysis RMD file plotgame <- function(WTeam,LTeam, year){ # Load data for the basic game information (Teams,seeds,year,conferences) # create basic game information grob # data load for the game plot # join the team names # track each teams score via the Event types for the shots made. datGame <- seeds %>% filter(Season == year) %>% left_join(select(teams,TeamID,TeamName), by = c('TeamID')) %>% filter(TeamName == WTeam | TeamName == LTeam) %>% inner_join(conf,by = c('Season','TeamID')) %>% select(Teams = TeamName,Seed = Seed,Conference = ConfAbbrev) g <- tableGrob(datGame,rows = NULL, theme = ttheme_default(7)) g <- gtable_add_grob(g, grobs = rectGrob(gp = gpar(fill = NA, lwd = 2)), t = 2, b = nrow(g), l = 1, r = ncol(g)) g <- gtable_add_grob(g, grobs = rectGrob(gp = gpar(fill = NA, lwd = 2)), t = 1, l = 1, r = ncol(g)) plota <- as.grob(g) subtit <- results %>% filter(Season == year) %>% select(WTeamID,LTeamID,WScore,LScore) %>% left_join(select(teams,TeamID,TeamName), by = c('WTeamID' = 'TeamID')) %>% left_join(select(teams,TeamID,TeamName), by = c('LTeamID' = 'TeamID')) %>% rename("WTeamName" = "TeamName.x","LTeamName" = "TeamName.y" ) %>% filter(WTeamName == WTeam & LTeamName == LTeam ) %>% select(WTeamName,WScore,LTeamName,LScore) %>% mutate(game = paste(year,WTeamName,"=",WScore,LTeamName,"=",LScore,sep = " " )) %>% select(game) subtit <- subtit[1]$game dat <- fileLoad(year) Labels <- data.table(x = c(600, 1800, 2700), y = c(100,100,100), label = c('1st Half', '2nd Half', 'Overtime')) title <- "NCAA March Madness Classic Games" lim <- dat %>% left_join(select(teams,TeamID,TeamName), by = c("WTeamID" = "TeamID")) %>% left_join(select(teams,TeamID,TeamName), by = c("LTeamID" = "TeamID")) %>% rename("WTeamName" = "TeamName.x","LTeamName" = "TeamName.y" ) %>% filter(WTeamName == WTeam & LTeamName == LTeam ) %>% summarise(gameTime = max(ElapsedSeconds)) %>% pull(gameTime) plotb <- dat %>% left_join(select(teams,TeamID,TeamName), by = c("WTeamID" = "TeamID")) %>% left_join(select(teams,TeamID,TeamName), by = c("LTeamID" = "TeamID")) %>% rename("WTeamName" = "TeamName.x","LTeamName" = "TeamName.y" ) %>% filter(WTeamName == WTeam & LTeamName == LTeam ) %>% filter(EventType %in% c('made1', 'made2','made3')) %>% select(WCurrentScore, LCurrentScore, ElapsedSeconds,EventTeamID,EventType,WTeamName,LTeamName) %>% mutate(EventTeamID = as.character(EventTeamID)) %>% ggplot(aes(x = ElapsedSeconds)) + ggtitle(bquote(atop(bold(.(title)),atop(bold(.(subtit[1]))))))+ geom_point(shape = 1, aes(y = WCurrentScore, color= WTeam))+ geom_point(shape = 1,aes(y = LCurrentScore, color= LTeam)) + geom_vline(xintercept = c(1200,2400)) + geom_label(size = 3, data= Labels,aes(x=x,y=y, label = label)) + scale_x_continuous(limits = c(0,lim + 50)) + ylab(label="Score")+ xlab(label="Elapsed Time (seconds)")+ scale_colour_manual("Teams", breaks=c(WTeam,LTeam), values=c("blue","red")) plotc <- as.grob(plotb) grid.newpage() grid.draw(plotc) vp = viewport(x = 0.20,y=0.75,width = 0.2,height = 0.2) pushViewport(vp) grid.draw(plota) upViewport() } ################################################################################################# # Regression analysis ############################################################################################### plotRegressComp <- function(WTeam,LTeam, year) { # Load the play by play data dat <- fileLoad(year) # data for winning team season regression datRegWin <- rbind( dat %>% left_join(select(teams,TeamID,TeamName), by = c("WTeamID" = "TeamID")) %>% rename("WTeamName" = "TeamName") %>% filter(WTeamName == WTeam, EventType %in% c('made1', 'made2','made3'), WTeamID == EventTeamID) %>% select(WTeamID,WCurrentScore,ElapsedSeconds,WTeamName), dat %>% left_join(select(teams,TeamID,TeamName), by = c("LTeamID" = "TeamID")) %>% rename("WTeamName" = "TeamName") %>% filter(WTeamName == WTeam, EventType %in% c('made1', 'made2','made3'), LTeamID == EventTeamID) %>% select(LTeamID,LCurrentScore,ElapsedSeconds,WTeamName) %>% rename(WTeamID = LTeamID, WCurrentScore = LCurrentScore) ) # Points agains switching W and L in current score datRegWinPointsAgainst <- rbind( dat %>% left_join(select(teams,TeamID,TeamName), by = c("WTeamID" = "TeamID")) %>% rename("WTeamName" = "TeamName") %>% filter(WTeamName == WTeam, EventType %in% c('made1', 'made2','made3'), WTeamID == EventTeamID) %>% select(WTeamID,LCurrentScore,ElapsedSeconds,WTeamName), dat %>% left_join(select(teams,TeamID,TeamName), by = c("LTeamID" = "TeamID")) %>% rename("WTeamName" = "TeamName") %>% filter(WTeamName == WTeam, EventType %in% c('made1', 'made2','made3'), LTeamID == EventTeamID) %>% select(LTeamID,WCurrentScore,ElapsedSeconds,WTeamName) %>% rename(WTeamID = LTeamID, LCurrentScore = WCurrentScore) ) datRegLose <- rbind( dat %>% left_join(select(teams,TeamID,TeamName), by = c("LTeamID" = "TeamID")) %>% rename("LTeamName" = "TeamName") %>% filter(LTeamName == LTeam, EventType %in% c('made1', 'made2','made3'), LTeamID == EventTeamID) %>% select(LTeamID,LCurrentScore,ElapsedSeconds,LTeamName), dat %>% left_join(select(teams,TeamID,TeamName), by = c("WTeamID" = "TeamID")) %>% rename("LTeamName" = "TeamName") %>% filter(LTeamName == LTeam, EventType %in% c('made1', 'made2','made3'), WTeamID == EventTeamID) %>% select(WTeamID,WCurrentScore,ElapsedSeconds,LTeamName) %>% rename(LTeamID = WTeamID, LCurrentScore = WCurrentScore) ) # Losing team data for regression datRegLosePointsAgainst <- rbind( dat %>% left_join(select(teams,TeamID,TeamName), by = c("LTeamID" = "TeamID")) %>% rename("LTeamName" = "TeamName") %>% filter(LTeamName == LTeam, EventType %in% c('made1', 'made2','made3'), LTeamID == EventTeamID) %>% select(LTeamID,WCurrentScore,ElapsedSeconds,LTeamName), dat %>% left_join(select(teams,TeamID,TeamName), by = c("WTeamID" = "TeamID")) %>% rename("LTeamName" = "TeamName") %>% filter(LTeamName == LTeam, EventType %in% c('made1', 'made2','made3'), WTeamID == EventTeamID) %>% select(WTeamID,LCurrentScore,ElapsedSeconds,LTeamName) %>% rename(LTeamID = WTeamID, WCurrentScore = LCurrentScore) ) # Model of points for vs game time robust_model_win = MASS::rlm(WCurrentScore ~ 0 + ElapsedSeconds, data = datRegWin, method = "MM", init = "lts") robust_model_Lose = MASS::rlm(LCurrentScore ~ 0 + ElapsedSeconds, data = datRegLose, method = "MM", init = "lts") # Model of points against vs game time robust_model_win_pa = MASS::rlm(LCurrentScore ~ 0 + ElapsedSeconds, data = datRegWinPointsAgainst, method = "MM", init = "lts") robust_model_Lose_pa = MASS::rlm(WCurrentScore ~ 0 + ElapsedSeconds, data = datRegLosePointsAgainst, method = "MM", init = "lts") # Get the game score for the plot title subtit <- results %>% filter(Season == year) %>% select(WTeamID,LTeamID,WScore,LScore) %>% left_join(select(teams,TeamID,TeamName), by = c('WTeamID' = 'TeamID')) %>% left_join(select(teams,TeamID,TeamName), by = c('LTeamID' = 'TeamID')) %>% rename("WTeamName" = "TeamName.x","LTeamName" = "TeamName.y" ) %>% filter(WTeamName == WTeam & LTeamName == LTeam ) %>% select(WTeamName,WScore,LTeamName,LScore) %>% mutate(game = paste(year,WTeamName,"=",WScore,LTeamName,"=",LScore,sep = " " )) %>% select(game) subtit <- subtit[1]$game lim <- dat %>% left_join(select(teams,TeamID,TeamName), by = c("WTeamID" = "TeamID")) %>% left_join(select(teams,TeamID,TeamName), by = c("LTeamID" = "TeamID")) %>% rename("WTeamName" = "TeamName.x","LTeamName" = "TeamName.y" ) %>% filter(WTeamName == WTeam & LTeamName == LTeam ) %>% summarise(gameTime = max(ElapsedSeconds)) %>% pull(gameTime) datGame <- seeds %>% filter(Season == year) %>% left_join(select(teams,TeamID,TeamName), by = c('TeamID')) %>% filter(TeamName == WTeam | TeamName == LTeam) %>% inner_join(conf,by = c('Season','TeamID')) %>% select(Teams = TeamName,Seed = Seed,Conference = ConfAbbrev) %>% mutate(E_pf = c(round(robust_model_win$coefficients[1]*lim,0),round(robust_model_Lose$coefficients[1]*lim,0)), E_pa = c(round(robust_model_win_pa$coefficients[1]*lim,0),round(robust_model_Lose_pa$coefficients[1]*lim,0)) ) g <- tableGrob(datGame,rows = NULL, theme = ttheme_default(7)) g <- gtable_add_grob(g, grobs = rectGrob(gp = gpar(fill = NA, lwd = 2)), t = 2, b = nrow(g), l = 1, r = ncol(g)) g <- gtable_add_grob(g, grobs = rectGrob(gp = gpar(fill = NA, lwd = 2)), t = 1, l = 1, r = ncol(g)) plota <- as.grob(g) title <- "NCAA March Madness Classic Games Regression Analysis" Labels <- data.table(x = c(600, 1800, 2700), y = c(3,3,3), label = c('1st Half', '2nd Half', 'Overtime')) plotb <- dat %>% left_join(select(teams,TeamID,TeamName), by = c("WTeamID" = "TeamID")) %>% left_join(select(teams,TeamID,TeamName), by = c("LTeamID" = "TeamID")) %>% rename("WTeamName" = "TeamName.x","LTeamName" = "TeamName.y" ) %>% filter(WTeamName == WTeam & LTeamName == LTeam ) %>% filter(EventType %in% c('made1', 'made2','made3')) %>% select(WCurrentScore, LCurrentScore, ElapsedSeconds,EventTeamID,EventType,WTeamName,LTeamName) %>% mutate(EventTeamID = as.character(EventTeamID)) %>% ggplot(aes(x = ElapsedSeconds)) + ggtitle(bquote(atop(bold(.(title)),atop(bold(.(subtit[1]))))))+ geom_point(shape = 1, aes(y = WCurrentScore, color= WTeam))+ geom_point(shape = 1,aes(y = LCurrentScore, color= LTeam)) + geom_abline(intercept=0, slope=robust_model_win$coefficients[1], color='Blue', size=1, linetype = 1) + geom_abline(intercept=0, slope=robust_model_Lose$coefficients[1], color='Red', size=1, linetype = 1) + geom_abline(intercept=0, slope=robust_model_win_pa$coefficients[1], color='Blue', size=1, linetype = 2) + geom_abline(intercept=0, slope=robust_model_Lose_pa$coefficients[1], color='Red', size=1, linetype = 2) + geom_vline(xintercept = c(1200,2400)) + geom_text(size = 3, data= Labels,aes(x=x,y=y, label = label)) + scale_x_continuous(limits = c(0,lim + 50)) + ylab(label="Score")+ xlab(label="Elapsed Time (seconds)")+ scale_colour_manual("Teams", breaks=c(WTeam,LTeam), values=c("blue","red")) plotc <- as.grob(plotb) grid.newpage() grid.draw(plotc) vp = viewport(x = 0.25,y=0.80,width = 0.2,height = 0.2) pushViewport(vp) grid.draw(plota) upViewport() } ########################################################################################################## # Shot Charts ########################################################################################################## shotChart <- function(WTeam,LTeam, year,tstart = 0, tend = 2400) { # get the game data # select made and missed 2 and 3 point shots # move all shot the "left side of the court" # rotate the shots to align with the court plot. # summary data statSum <- EventProbCalc(WTeam = WTeam,LTeam = LTeam,year = year, tstart = tstart, tend = tend) datGame <- seeds %>% filter(Season == year) %>% left_join(select(teams,TeamID,TeamName), by = c('TeamID')) %>% filter(TeamName == WTeam | TeamName == LTeam) %>% inner_join(conf,by = c('Season','TeamID')) %>% select(Teams = TeamName,Seed = Seed,Conference = ConfAbbrev) %>% inner_join(statSum, by = c("Teams" = "TeamName")) g <- tableGrob(datGame,rows = NULL, theme = ttheme_default(7)) g <- gtable_add_grob(g, grobs = rectGrob(gp = gpar(fill = NA, lwd = 2)), t = 2, b = nrow(g), l = 1, r = ncol(g)) g <- gtable_add_grob(g, grobs = rectGrob(gp = gpar(fill = NA, lwd = 2)), t = 1, l = 1, r = ncol(g)) plota <- as.grob(g) # laod play by play data dat <- fileLoad(year) gameShotData <- dat %>% left_join(select(teams,TeamID,TeamName), by = c("WTeamID" = "TeamID")) %>% left_join(select(teams,TeamID,TeamName), by = c("LTeamID" = "TeamID")) %>% rename("WTeamName" = "TeamName.x","LTeamName" = "TeamName.y" ) %>% filter(WTeamName == WTeam & LTeamName == LTeam ) %>% filter(EventType %in% c('made2','made3','miss2','miss3' )) %>% mutate(EventType = ifelse(grepl('made',EventType),'Made','Miss')) %>% select(EventTeamID,X,Y,EventType) %>% left_join(select(teams,TeamID,TeamName), by = c("EventTeamID" = "TeamID")) %>% mutate(team_basket = ifelse(X > 50,'right','left')) %>% mutate(X = ifelse(team_basket == 'right', 100 - X, X), Y = ifelse(team_basket == 'right', 100 - Y,Y)) %>% mutate(coord_X = (47/50)*X, coord_Y = (50 - Y)/2) %>% mutate(X = -1 * coord_Y, Y = coord_X - (50/47)*5.3 ) subtit <- results %>% filter(Season == year) %>% select(WTeamID,LTeamID,WScore,LScore) %>% left_join(select(teams,TeamID,TeamName), by = c('WTeamID' = 'TeamID')) %>% left_join(select(teams,TeamID,TeamName), by = c('LTeamID' = 'TeamID')) %>% rename("WTeamName" = "TeamName.x","LTeamName" = "TeamName.y" ) %>% filter(WTeamName == WTeam & LTeamName == LTeam ) %>% select(WTeamName,WScore,LTeamName,LScore) %>% mutate(game = paste(year,WTeamName,"=",WScore,LTeamName,"=",LScore,sep = " " )) %>% select(game) subtit <- subtit[1]$game title <- "NCAA March Madness Classic Games Regression Analysis" # using the utiltiy code court_plot.R and add points. plotb <- college_court + geom_point(data = gameShotData, size = I(3),aes(x=X,y=Y,color = TeamName,shape = EventType)) + ggtitle(bquote(atop(bold(.(title)),atop(bold(.(subtit[1])))))) plotc <- as.grob(plotb) grid.newpage() grid.draw(plotc) vp = viewport(x = 0.40,y=0.80,width = 0.2,height = 0.2) pushViewport(vp) grid.draw(plota) upViewport() } ##################################################################### # poison dist plot for key games point and blocks and turnovers ##################################################################### poisPlotProb <- function(WTeam, LTeam, year, tstart, tend, Block = 0, Steal = 0, Turnover = 0, maxEvent = 15) { # function to calculate the rate of event and plot estimated probs for the event type at various times in the game. # Uses the Poisson distrubution for the estimates # regular season result filtered for the WTeam and LTeam and year of the game results %>% filter(Season == year) %>% filter(Season == year) %>% left_join(select(teams,TeamID,TeamName), by = c("WTeamID" = "TeamID")) %>% left_join(select(teams,TeamID,TeamName), by = c("LTeamID" = "TeamID")) %>% rename("WTeamName" = "TeamName.x","LTeamName" = "TeamName.y" ) %>% filter(WTeamName == WTeam & LTeamName == LTeam) # load the play by play data dat <- fileLoad(year) # build the data set for calculate lambda. lambdaCalc <- rbind( rbind( regresults %>% filter(Season == year) %>% left_join(select(teams,TeamID,TeamName), by = c("WTeamID" = "TeamID")) %>% left_join(select(teams,TeamID,TeamName), by = c("LTeamID" = "TeamID")) %>% rename("WTeamName" = "TeamName.x","LTeamName" = "TeamName.y" ) %>% mutate(gametime = ifelse(NumOT == 0, 2400, 2400 + NumOT * 300)) %>% filter(WTeamName == WTeam) %>% select(WTeamID, WScore,WTO,WStl,WBlk,gametime,WTeamName), regresults %>% filter(Season == year) %>% left_join(select(teams,TeamID,TeamName), by = c("WTeamID" = "TeamID")) %>% left_join(select(teams,TeamID,TeamName), by = c("LTeamID" = "TeamID")) %>% rename("WTeamName" = "TeamName.x","LTeamName" = "TeamName.y" ) %>% mutate(gametime = ifelse(NumOT == 0, 2400, 2400 + NumOT * 300)) %>% filter(LTeamName == WTeam) %>% select(WTeamID = LTeamID, WScore = LScore,WTO = LTO,WStl=LStl,WBlk=LBlk,gametime,WTeamName = LTeamName) ) , rbind( regresults %>% filter(Season == year) %>% left_join(select(teams,TeamID,TeamName), by = c("WTeamID" = "TeamID")) %>% left_join(select(teams,TeamID,TeamName), by = c("LTeamID" = "TeamID")) %>% rename("WTeamName" = "TeamName.x","LTeamName" = "TeamName.y" ) %>% mutate(gametime = ifelse(NumOT == 0, 2400, 2400 + NumOT * 300)) %>% filter(LTeamName == LTeam) %>% select(WTeamID = LTeamID, WScore = LScore,WTO = LTO,WStl = LStl,WBlk = LBlk,gametime,WTeamName = LTeamName), regresults %>% filter(Season == year) %>% left_join(select(teams,TeamID,TeamName), by = c("WTeamID" = "TeamID")) %>% left_join(select(teams,TeamID,TeamName), by = c("LTeamID" = "TeamID")) %>% rename("WTeamName" = "TeamName.x","LTeamName" = "TeamName.y" ) %>% mutate(gametime = ifelse(NumOT == 0, 2400, 2400 + NumOT * 300)) %>% filter(WTeamName == LTeam) %>% select(WTeamID , WScore ,WTO,WStl,WBlk,gametime,WTeamName ) ) ) %>% group_by(WTeamID) %>% summarise(Turnover = sum(WTO)/sum(gametime), Block = sum(WBlk)/sum(gametime), Steal = sum(WStl)/sum(gametime) ) %>% inner_join(select(teams,TeamID,TeamName), by = c("WTeamID" = "TeamID")) %>% select(TeamName,Turnover,Block,Steal) %>% pivot_longer(-TeamName,names_to = "Event_Type", values_to = "rate") %>% mutate(prob_3 = 1- ppois(q = 3,lambda = rate*(tend - tstart)), prob_12 = 1- ppois(q = 12,lambda = rate*(tend - tstart))) events <- data.table(x = c(0:maxEvent)) for(i in 1:nrow(lambdaCalc)){ events[, paste(lambdaCalc$TeamName[i],lambdaCalc$Event_Type[i],sep = "_") := dpois(x=x, lambda = lambdaCalc$rate[i]*(tend - tstart))] } # game score for the plot title subtit <- results %>% filter(Season == year) %>% select(WTeamID,LTeamID,WScore,LScore) %>% left_join(select(teams,TeamID,TeamName), by = c('WTeamID' = 'TeamID')) %>% left_join(select(teams,TeamID,TeamName), by = c('LTeamID' = 'TeamID')) %>% rename("WTeamName" = "TeamName.x","LTeamName" = "TeamName.y" ) %>% filter(WTeamName == WTeam & LTeamName == LTeam ) %>% select(WTeamName,WScore,LTeamName,LScore) %>% mutate(game = paste(year,WTeamName,"=",WScore,LTeamName,"=",LScore,sep = " " )) %>% select(game) subtit <- subtit[1]$game title <- "NCAA March Madness Classic Games Event Probablity" vline.data <- data.table(Event_Type = c("Block","Steal","Turnover") , z =c(Block,Steal,Turnover)) events %>% pivot_longer(-x, names_to = 'id', values_to = 'Probablity') %>% mutate(Event_Type = word(id, -1, sep = fixed('_')), Team_Name = word(id, 1, sep = fixed('_'))) %>% ggplot(aes(x=x,y=Probablity,color=Team_Name)) + geom_point(shape = 1, size = I(3)) + geom_line()+ geom_vline(aes(xintercept = z), vline.data, colour = "red") + ggtitle(bquote(atop(bold(.(title)),atop(bold(.(subtit[1])))))) + ylab(label="Probablity")+ xlab(label="Event Count") + facet_grid(Event_Type ~.) } ############################################################################ # Plot game events / scorce diff / vs. time / look at specific game times ############################################################################ plotgameEventsTime <- function(WTeam,LTeam, year,tstart = 2000, tend = 2401, mindiff = -20, maxdiff = 20){ # Create grob of seed and conferences datGame <- EventProbCalc(WTeam = WTeam,LTeam = LTeam,year = year, tstart = tstart, tend = tend) g <- tableGrob(datGame,rows = NULL, theme = ttheme_default(7)) g <- gtable_add_grob(g, grobs = rectGrob(gp = gpar(fill = NA, lwd = 2)), t = 2, b = nrow(g), l = 1, r = ncol(g)) g <- gtable_add_grob(g, grobs = rectGrob(gp = gpar(fill = NA, lwd = 2)), t = 1, l = 1, r = ncol(g)) plota <- as.grob(g) subtit <- results %>% filter(Season == year) %>% select(WTeamID,LTeamID,WScore,LScore) %>% left_join(select(teams,TeamID,TeamName), by = c('WTeamID' = 'TeamID')) %>% left_join(select(teams,TeamID,TeamName), by = c('LTeamID' = 'TeamID')) %>% rename("WTeamName" = "TeamName.x","LTeamName" = "TeamName.y" ) %>% filter(WTeamName == WTeam & LTeamName == LTeam ) %>% select(WTeamName,WScore,LTeamName,LScore) %>% mutate(game = paste(year,WTeamName,"=",WScore,LTeamName,"=",LScore,sep = " " )) %>% select(game) subtit <- subtit[1]$game dat <- fileLoad(year) datEvents <- dat %>% left_join(select(teams,TeamID,TeamName), by = c("WTeamID" = "TeamID")) %>% left_join(select(teams,TeamID,TeamName), by = c("LTeamID" = "TeamID")) %>% rename("WTeamName" = "TeamName.x","LTeamName" = "TeamName.y" ) %>% filter(WTeamName == WTeam & LTeamName == LTeam ) %>% filter(EventType %in% setdiff(unique(dat$EventType),c('reb','sub', 'timeout','assist', 'miss1','miss2','miss3','made1','made2','made3'))) %>% select(ElapsedSeconds,EventTeamID,EventType) %>% mutate(count = 1, row = row_number()) %>% group_by(EventType) %>% pivot_wider(names_from = EventType, values_from = count, values_fill = list(count = 0)) %>% select(-row) %>% group_by(EventTeamID) %>% mutate(block = cumsum(block), turnover = cumsum(turnover), steal = cumsum(steal)) %>% pivot_longer(cols = c('block','turnover','steal'), names_to = "EventID", values_to = "count") %>% left_join(select(teams,TeamID,TeamName), by = c("EventTeamID" = "TeamID")) %>% ungroup() %>% mutate(EventTeamID = as.character(EventTeamID), count = ifelse(TeamName == LTeam, count*-1,count)) %>% data.table() Labels <- data.table(x = c(tstart,tend), y = c(0,0), label = c('Start Time', 'End Time')) LabelTeam <- data.table(x=c(tstart + 10,tstart + 10),y=c(15,-15), label = c(WTeam,LTeam)) title <- "NCAA March Madness Classic Games Event Comparisions" lim <- dat %>% left_join(select(teams,TeamID,TeamName), by = c("WTeamID" = "TeamID")) %>% left_join(select(teams,TeamID,TeamName), by = c("LTeamID" = "TeamID")) %>% rename("WTeamName" = "TeamName.x","LTeamName" = "TeamName.y" ) %>% filter(WTeamName == WTeam & LTeamName == LTeam ) %>% summarise(gameTime = max(ElapsedSeconds)) %>% pull(gameTime) plotb <- dat %>% left_join(select(teams,TeamID,TeamName), by = c("WTeamID" = "TeamID")) %>% left_join(select(teams,TeamID,TeamName), by = c("LTeamID" = "TeamID")) %>% rename("WTeamName" = "TeamName.x","LTeamName" = "TeamName.y" ) %>% filter(WTeamName == WTeam & LTeamName == LTeam ) %>% filter(EventType %in% c('made1', 'made2','made3')) %>% select(WCurrentScore, LCurrentScore, ElapsedSeconds,EventTeamID,EventType,WTeamName,LTeamName) %>% mutate(EventTeamID = as.character(EventTeamID), WScoreDiff = WCurrentScore - LCurrentScore, LScoreDiff = LCurrentScore - WCurrentScore) %>% ggplot() + ggtitle(bquote(atop(bold(.(title)),atop(bold(.(subtit[1]))))))+ geom_line(size = I(2), color = "blue", aes(x = ElapsedSeconds,y = WScoreDiff))+ geom_line(size = I(2),color = 'red',aes(x = ElapsedSeconds,y = LScoreDiff)) + geom_point(size = I(3),shape = 1, data = datEvents[TeamName == WTeam,], aes(x = ElapsedSeconds,y = count, color= EventID)) + geom_line(data = datEvents[TeamName == WTeam,], aes(x = ElapsedSeconds,y = count, color= EventID)) + geom_point(size = I(3),shape = 1, data = datEvents[TeamName == LTeam,], aes(x = ElapsedSeconds,y = count, color= EventID)) + geom_line(linetype = 2, data = datEvents[TeamName == LTeam,], aes(x = ElapsedSeconds,y = count, color= EventID)) + geom_vline(xintercept = c(tstart,tend)) + geom_label(size = 3, data= Labels,aes(x=x,y=y, label = label)) + geom_label(size = 3, data= LabelTeam,aes(x=x,y=y, label = label)) + scale_x_continuous(limits = c(tstart,tend)) + scale_y_continuous(limits = c(mindiff,maxdiff)) + ylab(label="Score Difference / Event Count")+ xlab(label="Elapsed Time (seconds)") plotc <- as.grob(plotb) grid.newpage() grid.draw(plotc) vp = viewport(x = 0.32,y=0.83,width = 0.10,height = 0.2) pushViewport(vp) grid.draw(plota) upViewport() }