BDC_2022_inR.Rmd

---
title: "BDC_2022 - Single Frame Pass Analysis"
output: pdf_document
---

```{r}
# Load (and install if necessary) libraries and set constants

load.libraries = c("rjson", "jsonlite", "tidyverse", "gganimate", "ggpmisc", "ggnewscale", "viridis", "tictoc", "scales", "ggforce", "cowplot", "here")
install.lib = load.libraries[!load.libraries %in% installed.packages()]
for (libs in install.lib) {install.packages(libs, dependencies = TRUE)}
sapply(load.libraries, require, character = TRUE)

#time_step = seq(0.01,10,0.01) #extra fine scale
time_step = seq(0.05,10,0.05) #regular scale
#theta_scale = 0.01 #extra fine scale
theta_scale = 0.05 #regular scale
#speed_puck = 90 #ft/s
speed_puck = 55 #ft/s
#speed_puck = 40 #ft/s

source(here("code","hockey_pipeline.R"))

json_file <-here("data","BDC_2022_passOnly.json")
dat <- fromJSON(json_file)

# Set up the event data to be in a data frame. 
json_events <- lapply(dat[1:28], function(x) {
  x[sapply(x, is.null)] <- NA
  unlist(x)
})
current_event <- as.data.frame(do.call("cbind", json_events))

# Simplify team and opponent team names
current_event$team_name[current_event$team_name=="Olympic (Women) - Canada"]="Canada"
current_event$team_name[current_event$team_name=="Olympic (Women) - United States"]="USA"
current_event$team_name[current_event$team_name=="Olympic (Women) - Finland"]="Finland"
current_event$team_name[current_event$team_name=="Olympic (Women) - Olympic Athletes from Russia"]="ROC"
current_event$team_name[current_event$team_name=="Olympic (Women) - Switzerland"]="Switzerland"

current_event$opp_team_name[current_event$opp_team_name=="Olympic (Women) - Canada"]="Canada"
current_event$opp_team_name[current_event$opp_team_name=="Olympic (Women) - United States"]="USA"
current_event$opp_team_name[current_event$opp_team_name=="Olympic (Women) - Finland"]="Finland"
current_event$opp_team_name[current_event$opp_team_name=="Olympic (Women) - Olympic Athletes from Russia"]="ROC"
current_event$opp_team_name[current_event$opp_team_name=="Olympic (Women) - Switzerland"]="Switzerland"

current_event$x_coord = current_event$x_coord %>% as.double()
current_event$y_coord = current_event$y_coord %>% as.double()
current_event$x_coord_2 = current_event$x_coord_2 %>% as.double()
current_event$y_coord_2 = current_event$y_coord_2 %>% as.double()

#Identify defensive passes to omit
defensive_plays <- current_event$x_coord<100

#correct for flipping the ice
current_event$y_coord = 85-current_event$y_coord
current_event$y_coord_2 = 85-current_event$y_coord_2

# get pass speed and angle
vel_ang = calc_vmag_ang(current_event)
current_event$vel_init = vel_ang[,1]
current_event$ang_init = vel_ang[,2]
```

```{r}
t_track=405 # Pass index to analyse

#load track
speed_puck = current_event$vel_init[t_track]
line1 <- paste('dat$tracks$\'',(t_track-1),'\'',sep='')
line2 <- eval(parse(text=line1))
if(length(line2$frame_id)!=0){
  json_tracks <- lapply(line2, function(x) {
    x[sapply(x, is.null)] <- NA
    unlist(x)
  })
  current_track <- as.data.frame(do.call("cbind", json_tracks))
}
# fix variable types
current_track$frame_id = current_track$frame_id %>% as.integer()
current_track$period = current_track$period %>% as.integer()
current_track$track_id = current_track$track_id %>% as.integer()
current_track$jersey_number = current_track$jersey_number %>% as.integer()
current_track$x_ft = current_track$x_ft %>% as.double()
current_track$y_ft = current_track$y_ft %>% as.double()
current_track$vel_x = current_track$vel_x %>% as.double()
current_track$vel_y = current_track$vel_y %>% as.double()

current_track$vel_x[which(current_track$vel_x==0)]=0.05
current_track$vel_y[which(current_track$vel_y==0)]=0.05
current_track$goalie = ifelse(current_track$goalie =='TRUE',T,F)


# Flip track if necessary
if(mean(current_track[current_track$team_name==current_event$team_name[t_track],'x_ft'])<100){
  current_track$x_ft = 200 - current_track$x_ft
  current_track$vel_x = -current_track$vel_x
  current_track$y_ft = 85 - current_track$y_ft
  current_track$vel_y = -current_track$vel_y
}

# Fill in passer and passee if they are missing
current_track <- fill_missing_players(current_event[t_track,],current_track)

# Identify offensive team and find the puck
event_info <- current_event[t_track,] %>% select(team_name,Player_1_num,Player_2_num)
off <- event_info$team_name
puck = current_track[current_track$jersey_number==event_info$Player_1_num,] %>% select(team_name,x_ft,y_ft)
puck = puck[puck$team_name==off,]

# Count players on each side (to ensure reasonable minimum amount on each team)
n_players <- table(current_track$team_name)
n_off <- sum(n_players[names(n_players)==off])
n_def <- sum(n_players[names(n_players)!=off])
```

```{r}
# Puck coordinates by the event data 
x_p = current_event[t_track,"x_coord"]
y_p = current_event[t_track,"y_coord"]

# Flip puck coordinates if necessary
if(abs(y_p-puck$y_ft)>30){
  y_p = 85-y_p
}

# Create all triples x,y,t for pass analysis using puck motion model
theta = seq(-pi,pi,by=theta_scale)
passes = data.frame(angle=c(),x=c(),y=c(), t=c())
for(angle in theta){
  passes = rbind(passes,cbind(angle,puck_motion_model2(x_p,y_p,angle)))
}
new_pass <- clean_pass(passes)
new_pass <- filter_inside_boards(new_pass)

calc_pass <- new_pass %>% group_by(angle) %>% top_n(1, t)

new_pass <- rbind(new_pass,c(new_pass$angle[1],x_p,y_p,0))

xyt <- new_pass %>% select(x,y,t)

# Prepare inputs for subsequent calculations
loc_vel <- current_track %>% mutate(team_label = ifelse(team_name == off,1,-1)) %>%
  select(x_ft,y_ft,vel_x,vel_y, team_label, goalie) 
new_pass <- new_pass %>% 
  mutate(all_ctrl = teamwise_ice_ctrl_xyt(loc_vel, xyt), score_prob = apply(xyt,1,score_prob)) %>%
  mutate(pass_value = score_prob * ((all_ctrl+1)/2)^1)
```


```{r}
# Create image of this frame with potential passes
plot_rink(ggplot(current_track)) +
  geom_point(aes(x = x_ft, y = y_ft, fill = team_name), size = 5, shape = 21) +
  geom_text(aes(x = x_ft, y = y_ft, label = jersey_number, colour = team_name), size = 3) +
  geom_point(aes(x = x_p, y = y_p), size = 2, shape = 16, colour='black') +
  geom_segment(aes(x = x_p, y = y_p, xend = puck$x_ft, yend = puck$y_ft),size=1.5, colour='brown')+
  geom_point(data = new_pass, aes(x = x, y = y), size = 1, shape = 4) +
  scale_colour_manual(values = c("Switzerland" = "white", "Finland" = "white")) +
  scale_fill_manual(values = c("Switzerland" = "red", "Finland" = "blue")) +
  labs(fill = "Team") +
  guides(colour = "none")+ 
  geom_segment(aes(x = x_ft, y = y_ft, xend = x_ft+vel_x, yend = y_ft+vel_y), 
                  arrow = arrow(length = unit(0.2, "cm")),size=1, colour='cyan')
plot_rink(ggplot(current_track)) +
  geom_point(aes(x = x_ft, y = y_ft, fill = team_name), size = 5, shape = 21) +
  geom_text(aes(x = x_ft, y = y_ft, label = jersey_number, colour = team_name), size = 3) +
  geom_point(aes(x = x_p, y = y_p), size = 2, shape = 16, colour='black') +
  geom_point(data = calc_pass, aes(x = x, y = y), size = 1, shape = 4) +
  geom_segment(aes(x = x_p, y = y_p, xend = puck$x_ft, yend = puck$y_ft),size=1.5, colour='brown')+
  scale_colour_manual(values = c("Switzerland" = "white", "Finland" = "white")) +
  scale_fill_manual(values = c("Switzerland" = "red", "Finland" = "blue")) +
  labs(fill = "Team") +
  guides(colour = "none")+ 
  geom_segment(aes(x = x_ft, y = y_ft, xend = x_ft+vel_x, yend = y_ft+vel_y),
                  arrow = arrow(length = unit(0.2, "cm")),size=1, colour='cyan')
```

```{r}
# Get Metrics for actual pass 

observed_angle_pass <- calc_pass[which.min(abs(calc_pass$angle-current_event[t_track,"ang_init"])),]
point_val = probs_to_point(x_p,y_p,observed_angle_pass,new_pass,current_track,off,TRUE)
point_val[[1]]
point_val[[2]]
```

```{r}
# Plot arrow for actual pass
# Note that legend here needs to be changed manually because of R interpretation of strings
plot_half_rink(ggplot(current_track)) +
      geom_segment(aes(x = x_ft, y = y_ft, xend = x_ft+vel_x, yend = y_ft+vel_y), 
                   arrow = arrow(length = unit(0.2, "cm")),size=1, colour='cyan') + 
        geom_segment(aes(x = x_p, y = y_p, xend = puck$x_ft, yend = puck$y_ft),size=1.5, colour='brown')+
  geom_point(aes(x = x_ft, y = y_ft, fill = team_name), size = 5, shape = 21) +
      geom_text(aes(x = x_ft, y = y_ft, label = jersey_number, colour = team_name), size = 3) +
      geom_segment(aes(x = x_p, y = y_p, xend = current_event[t_track,"x_coord_2"], yend = current_event[t_track,"y_coord_2"]),colour='dark grey',size = 1,arrow = arrow(length = unit(0.03, "npc")))+
  geom_point(aes(x = x_p, y = y_p), size = 2, shape = 16, colour='black') + 
      scale_colour_manual(values = c("Switzerland" = "white", "Finland" = "white")) +
  scale_fill_manual(values = c("Switzerland" = "red", "Finland" = "blue")) +
      labs(fill = "Team") +
  guides(colour = "none")

```

```{r}
# Get metrics for all potential passes and put in data frame
all_point_val <- apply(calc_pass,1,probs_to_point,x_puck=x_p,y_puck=y_p,all_ang=new_pass,tracks1=current_track,offence=off,want_plot=FALSE)

pass_potential <- bind_rows(all_point_val, .id = "column_label")
pass_potential
```

```{r}
# Graph all the different metrics
# Note that legend here needs to be changed manually because of R interpretation of strings
p <- ggplot(data = pass_potential,aes(x = x, y = y)) + 
    geom_point(aes(color = all_ctrl),size=1, shape=16) +
    scale_colour_gradient2(na.value="white",low = muted("red"), mid = "white", high = muted("blue"))+
    scale_x_continuous(expand = c(0, 0)) +
    scale_y_continuous(expand = c(0, 0)) +
  new_scale_fill() +
  new_scale_color() +
  geom_segment(data=current_track,aes(x = x_ft, y = y_ft, xend = x_ft+vel_x, yend = y_ft+vel_y), 
  arrow = arrow(length = unit(0.2, "cm")),size=1, colour='cyan')+
  geom_segment(aes(x = x_p, y = y_p, xend = puck$x_ft, yend = puck$y_ft),size=1.5, colour='brown')+
  geom_point(aes(x = x_p, y = y_p), size = 2, shape = 16, colour='black') +
  geom_point(data=current_track,aes(x = x_ft, y = y_ft, fill = team_name), size = 5, shape = 21) +
  geom_text(data=current_track,aes(x = x_ft, y = y_ft, label = jersey_number, colour = team_name), size = 3) +
  scale_colour_manual(values = c("Switzerland" = "white", "Finland" = "white")) +
  scale_fill_manual(values = c("Switzerland" = "red", "Finland" = "blue")) +
  labs(fill = "Team") +
  guides(colour = "none")

p2 <- ggplot(data = pass_potential,aes(x = x, y = y)) + 
    geom_point(aes(color = score_prob),size=1, shape=16) +
    scale_colour_gradient2(na.value="white",low = muted("red"), mid = "white", high = muted("blue"))+
    scale_x_continuous(expand = c(0, 0)) +
    scale_y_continuous(expand = c(0, 0)) +
  new_scale_fill() +
  new_scale_color() +
  geom_segment(data=current_track,aes(x = x_ft, y = y_ft, xend = x_ft+vel_x, yend = y_ft+vel_y), 
  arrow = arrow(length = unit(0.2, "cm")),size=1, colour='cyan')+
  geom_segment(aes(x = x_p, y = y_p, xend = puck$x_ft, yend = puck$y_ft),size=1.5, colour='brown')+
  geom_point(aes(x = x_p, y = y_p), size = 2, shape = 16, colour='black') +
  geom_point(data=current_track,aes(x = x_ft, y = y_ft, fill = team_name), size = 5, shape = 21) +
  geom_text(data=current_track,aes(x = x_ft, y = y_ft, label = jersey_number, colour = team_name), size = 3) +
  scale_colour_manual(values = c("Switzerland" = "white", "Finland" = "white")) +
  scale_fill_manual(values = c("Switzerland" = "red", "Finland" = "blue")) +
  labs(fill = "Team") +
  guides(colour = "none")

p3 <- ggplot(data = pass_potential,aes(x = x, y = y)) + 
    geom_point(aes(color = pass_value),size=1, shape=16) +
    scale_colour_gradient2(na.value="white",low = muted("red"), mid = "white", high = muted("blue"))+
    scale_x_continuous(expand = c(0, 0)) +
    scale_y_continuous(expand = c(0, 0)) +
  new_scale_fill() +
  new_scale_color() +
  geom_segment(data=current_track,aes(x = x_ft, y = y_ft, xend = x_ft+vel_x, yend = y_ft+vel_y), 
  arrow = arrow(length = unit(0.2, "cm")),size=1, colour='cyan')+
  geom_segment(aes(x = x_p, y = y_p, xend = puck$x_ft, yend = puck$y_ft),size=1.5, colour='brown')+
  geom_point(aes(x = x_p, y = y_p), size = 2, shape = 16, colour='black') +
  geom_point(data=current_track,aes(x = x_ft, y = y_ft, fill = team_name), size = 5, shape = 21) +
  geom_text(data=current_track,aes(x = x_ft, y = y_ft, label = jersey_number, colour = team_name), size = 3) +
  scale_colour_manual(values = c("Switzerland" = "white", "Finland" = "white")) +
  scale_fill_manual(values = c("Switzerland" = "red", "Finland" = "blue")) +
  labs(fill = "Team") +
  guides(colour = "none")

p4 <- ggplot(data = pass_potential,aes(x = x, y = y)) + 
    geom_point(aes(color = adj_pass_value),size=1, shape=16) +
    scale_colour_gradient2(na.value="white",low = muted("red"), mid = "white", high = muted("blue"))+
    scale_x_continuous(expand = c(0, 0)) +
    scale_y_continuous(expand = c(0, 0)) +
  new_scale_fill() +
  new_scale_color() +
  geom_segment(data=current_track,aes(x = x_ft, y = y_ft, xend = x_ft+vel_x, yend = y_ft+vel_y), 
  arrow = arrow(length = unit(0.2, "cm")),size=1, colour='cyan')+
  geom_segment(aes(x = x_p, y = y_p, xend = puck$x_ft, yend = puck$y_ft),size=1.5, colour='brown')+
  geom_point(aes(x = x_p, y = y_p), size = 2, shape = 16, colour='black') +
  geom_point(data=current_track,aes(x = x_ft, y = y_ft, fill = team_name), size = 5, shape = 21) +
  geom_text(data=current_track,aes(x = x_ft, y = y_ft, label = jersey_number, colour = team_name), size = 3) +
  scale_colour_manual(values = c("Switzerland" = "white", "Finland" = "white")) +
  scale_fill_manual(values = c("Switzerland" = "red", "Finland" = "blue")) +
  labs(fill = "Team") +
  guides(colour = "none")

p5 <- ggplot(data = pass_potential,aes(x = x, y = y)) + 
    geom_point(aes(color = off_prob),size=1, shape=16) +
    scale_colour_gradient2(na.value="white",low = muted("red"), mid = "white", high = muted("blue"))+
    scale_x_continuous(expand = c(0, 0)) +
    scale_y_continuous(expand = c(0, 0)) +
  new_scale_fill() +
  new_scale_color() +
  geom_segment(data=current_track,aes(x = x_ft, y = y_ft, xend = x_ft+vel_x, yend = y_ft+vel_y), 
  arrow = arrow(length = unit(0.2, "cm")),size=1, colour='cyan')+
  geom_segment(aes(x = x_p, y = y_p, xend = puck$x_ft, yend = puck$y_ft),size=1.5, colour='brown')+
  geom_point(aes(x = x_p, y = y_p), size = 2, shape = 16, colour='black') +
  geom_point(data=current_track,aes(x = x_ft, y = y_ft, fill = team_name), size = 5, shape = 21) +
  geom_text(data=current_track,aes(x = x_ft, y = y_ft, label = jersey_number, colour = team_name), size = 3) +
  scale_colour_manual(values = c("Switzerland" = "white", "Finland" = "white")) +
  scale_fill_manual(values = c("Switzerland" = "red", "Finland" = "blue")) +
  labs(fill = "Team") +
  guides(colour = "none")

p6 <- ggplot(data = pass_potential,aes(x = x, y = y)) + 
    geom_point(aes(color = location_pass_value),size=1, shape=16) +
    scale_colour_gradient2(na.value="white",low = muted("red"), mid = "white", high = muted("blue"))+
    scale_x_continuous(expand = c(0, 0)) +
    scale_y_continuous(expand = c(0, 0)) +
  new_scale_fill() +
  new_scale_color() +
  geom_segment(data=current_track,aes(x = x_ft, y = y_ft, xend = x_ft+vel_x, yend = y_ft+vel_y), 
  arrow = arrow(length = unit(0.2, "cm")),size=1, colour='cyan')+
  geom_segment(aes(x = x_p, y = y_p, xend = puck$x_ft, yend = puck$y_ft),size=1.5, colour='brown')+
  geom_point(aes(x = x_p, y = y_p), size = 2, shape = 16, colour='black') +
  geom_point(data=current_track,aes(x = x_ft, y = y_ft, fill = team_name), size = 5, shape = 21) +
  geom_text(data=current_track,aes(x = x_ft, y = y_ft, label = jersey_number, colour = team_name), size = 3) +
  scale_colour_manual(values = c("Switzerland" = "white", "Finland" = "white")) +
  scale_fill_manual(values = c("Switzerland" = "red", "Finland" = "blue")) +
  labs(fill = "Team") +
  guides(colour = "none")

p7 <- ggplot(data = pass_potential,aes(x = x, y = y)) + 
    geom_point(aes(color = keep_possesion_prob),size=1, shape=16) +
    scale_colour_gradient2(na.value="white",low = muted("red"), mid = "white", high = muted("blue"))+
    scale_x_continuous(expand = c(0, 0)) +
    scale_y_continuous(expand = c(0, 0)) +
  new_scale_fill() +
  new_scale_color() +
  geom_segment(data=current_track,aes(x = x_ft, y = y_ft, xend = x_ft+vel_x, yend = y_ft+vel_y), 
  arrow = arrow(length = unit(0.2, "cm")),size=1, colour='cyan')+
  geom_segment(aes(x = x_p, y = y_p, xend = puck$x_ft, yend = puck$y_ft),size=1.5, colour='brown')+
  geom_point(aes(x = x_p, y = y_p), size = 2, shape = 16, colour='black') +
  geom_point(data=current_track,aes(x = x_ft, y = y_ft, fill = team_name), size = 5, shape = 21) +
  geom_text(data=current_track,aes(x = x_ft, y = y_ft, label = jersey_number, colour = team_name), size = 3) +
  scale_colour_manual(values = c("Switzerland" = "white", "Finland" = "white")) +
  scale_fill_manual(values = c("Switzerland" = "red", "Finland" = "blue")) +
  labs(fill = "Team") +
  guides(colour = "none")

p8 <- ggplot(data = pass_potential,aes(x = x, y = y)) + 
    geom_point(aes(color = expected_pass_value),size=1, shape=16) +
    scale_colour_gradient2(na.value="white",low = muted("red"), mid = "white", high = muted("blue"))+
    scale_x_continuous(expand = c(0, 0)) +
    scale_y_continuous(expand = c(0, 0)) +
  new_scale_fill() +
  new_scale_color() +
  geom_segment(data=current_track,aes(x = x_ft, y = y_ft, xend = x_ft+vel_x, yend = y_ft+vel_y), 
  arrow = arrow(length = unit(0.2, "cm")),size=1, colour='cyan')+
  geom_segment(aes(x = x_p, y = y_p, xend = puck$x_ft, yend = puck$y_ft),size=1.5, colour='brown')+
  geom_point(aes(x = x_p, y = y_p), size = 2, shape = 16, colour='black') +
  geom_point(data=current_track,aes(x = x_ft, y = y_ft, fill = team_name), size = 5, shape = 21) +
  geom_text(data=current_track,aes(x = x_ft, y = y_ft, label = jersey_number, colour = team_name), size = 3) +
  scale_colour_manual(values = c("Switzerland" = "white", "Finland" = "white")) +
  scale_fill_manual(values = c("Switzerland" = "red", "Finland" = "blue")) +
  labs(fill = "Team") +
  guides(colour = "none")

p9 <- ggplot(data = pass_potential,aes(x = x, y = y)) + 
    geom_point(aes(color = max_pass_value),size=1, shape=16) +
    scale_colour_gradient2(na.value="white",low = muted("red"), mid = "white", high = muted("blue"))+
    scale_x_continuous(expand = c(0, 0)) +
    scale_y_continuous(expand = c(0, 0)) +
  new_scale_fill() +
  new_scale_color() +
  geom_segment(data=current_track,aes(x = x_ft, y = y_ft, xend = x_ft+vel_x, yend = y_ft+vel_y), 
  arrow = arrow(length = unit(0.2, "cm")),size=1, colour='cyan')+
  geom_segment(aes(x = x_p, y = y_p, xend = puck$x_ft, yend = puck$y_ft),size=1.5, colour='brown')+
  geom_point(aes(x = x_p, y = y_p), size = 2, shape = 16, colour='black') +
  geom_point(data=current_track,aes(x = x_ft, y = y_ft, fill = team_name), size = 5, shape = 21) +
  geom_text(data=current_track,aes(x = x_ft, y = y_ft, label = jersey_number, colour = team_name), size = 3) +
  scale_colour_manual(values = c("Switzerland" = "white", "Finland" = "white")) +
  scale_fill_manual(values = c("Switzerland" = "red", "Finland" = "blue")) +
  labs(fill = "Team") +
  guides(colour = "none")

p10 <- ggplot(data = pass_potential,aes(x = x, y = y)) + 
    geom_point(aes(color = best_case_pass_value),size=1, shape=16) +
    scale_colour_gradient2(na.value="white",low = muted("red"), mid = "white", high = muted("blue"))+
    scale_x_continuous(expand = c(0, 0)) +
    scale_y_continuous(expand = c(0, 0)) +
  new_scale_fill() +
  new_scale_color() +
  geom_segment(data=current_track,aes(x = x_ft, y = y_ft, xend = x_ft+vel_x, yend = y_ft+vel_y), 
  arrow = arrow(length = unit(0.2, "cm")),size=1, colour='cyan')+
  geom_segment(aes(x = x_p, y = y_p, xend = puck$x_ft, yend = puck$y_ft),size=1.5, colour='brown')+
  geom_point(aes(x = x_p, y = y_p), size = 2, shape = 16, colour='black') +
  geom_point(data=current_track,aes(x = x_ft, y = y_ft, fill = team_name), size = 5, shape = 21) +
  geom_text(data=current_track,aes(x = x_ft, y = y_ft, label = jersey_number, colour = team_name), size = 3) +
  scale_colour_manual(values = c("Switzerland" = "white", "Finland" = "white")) +
  scale_fill_manual(values = c("Switzerland" = "red", "Finland" = "blue")) +
  labs(fill = "Team") +
  guides(colour = "none")

p11 <- ggplot(data = pass_potential,aes(x = x, y = y)) + 
    geom_point(aes(color = successful_pass_prob),size=1, shape=16) +
    scale_colour_gradient2(na.value="white",low = muted("red"), mid = "white", high = muted("blue"))+
    scale_x_continuous(expand = c(0, 0)) +
    scale_y_continuous(expand = c(0, 0)) +
  new_scale_fill() +
  new_scale_color() +
  geom_segment(data=current_track,aes(x = x_ft, y = y_ft, xend = x_ft+vel_x, yend = y_ft+vel_y), 
  arrow = arrow(length = unit(0.2, "cm")),size=1, colour='cyan')+
  geom_segment(aes(x = x_p, y = y_p, xend = puck$x_ft, yend = puck$y_ft),size=1.5, colour='brown')+
  geom_point(aes(x = x_p, y = y_p), size = 2, shape = 16, colour='black') +
  geom_point(data=current_track,aes(x = x_ft, y = y_ft, fill = team_name), size = 5, shape = 21) +
  geom_text(data=current_track,aes(x = x_ft, y = y_ft, label = jersey_number, colour = team_name), size = 3) +
  scale_colour_manual(values = c("Switzerland" = "white", "Finland" = "white")) +
  scale_fill_manual(values = c("Switzerland" = "red", "Finland" = "blue")) +
  labs(fill = "Team") +
  guides(colour = "none")
```

```{r}
#copy into console
require(gridExtra)
grid.arrange(point_val[[2]],plot_half_rink(p), plot_half_rink(p2),plot_half_rink(p3),plot_half_rink(p4),
plot_half_rink(p5),plot_half_rink(p6),plot_half_rink(p7),plot_half_rink(p8),
plot_half_rink(p9),plot_half_rink(p10),plot_half_rink(p11),ncol=4)
```