R function to auto generate heat map shot charts, need help completing court drawing then to complete

plot_player_shot_chart.r

#' NBA Player Shot Chart
#'
#' @param player name the player, must be exact
#' @param author, year_end_season: numeric end of season
#'
#' @return
#' @export
#'
#' @examples boggie_bog <-  plot_player_shot_chart(player = "Bojan Bogdanovic",
#year_season_end = 2015, exclude_backcourt = T
#author = "Alex Bresler")
options(warn = -1)
packages <- #need all of these installed including some from github
  c(
    'dplyr',
    'magrittr',
    'RCurl',
    'jsonlite',
    'ggExtra',
    'viridis',
    #devtools::install_github(hrbrmstr/viridis)
    'tidyr',
    'ggthemes',
    'stringr',
    'formattable',
    #devtools::install_github(renkun-ken/formattable)
    "png",
    "grid",
    'gridExtra',
    'rbokeh',
    'jpeg',
    'hexbin',
    'ggplot2',
    'stringr',
    'tidyr'
  )
options(warn = -1)
lapply(packages, library, character.only = T)


plot_player_shot_chart <- function(player,
                                   year_season_end = 2015,
                                   exclude_backcourt = T,
                                   author = "Alex Bresler") {
  player %<>%
    str_to_title()
  year_season_start <-
    year_season_end - 1
  
  id.season <-
    year_season_start %>%
    paste(year_season_end %>% substr(start = 3, stop = 4),
          sep = "-")
  
  players.url <-
    "http://stats.nba.com/stats/commonallplayers?IsOnlyCurrentSeason=0&LeagueID=00&Season=2015-16"
  
  players.data <-
    players.url %>%
    fromJSON(simplifyDataFrame = T)
  
  players <-
    players.data$resultSets$rowSet %>%
    data.frame %>%
    tbl_df
  
  names(players) <-
    players.data$resultSets$headers %>%
    unlist %>%
    tolower
  
  players %<>%
    separate(
      display_last_comma_first,
      sep = '\\,',
      into = c('name.last', 'name.first')
    ) %>%
    rename(id.player = person_id) %>%
    mutate(
      name.first = name.first %>% gsub("[^A-Z a-z]", '', .),
      name.player = ifelse(
        name.first %>% is.na,
        name.last,
        paste(name.first %>% str_trim, name.last %>% str_trim)
      ),
      id.player = id.player %>% as.numeric,
      is.active_player = rosterstatus %>% str_detect("0")
    ) %>%
    select(name.player, everything())
  
  if (players %>% dplyr::filter(name.player == player) %>% .$id.player %>% length == 0) {
    stop.message <-
      "I'm sorry " %>%
      paste0(player,
             ' is not a valid player, try capitalizing or checking spelling')
    stop(stop.message,call. = FALSE)
  } else {
    id.player <-
      players %>%
      dplyr::filter(name.player == player) %>%
      .$id.player
    
    base_url <-
      'http://stats.nba.com/stats/shotchartdetail?CFID=33&CFPARAMS='
    
    stem.2 <-
      '&ContextFilter=&ContextMeasure=FGA&DateFrom=&DateTo=&GameID=&GameSegment=&LastNGames=0&LeagueID=00&Location=&MeasureType=Base&Month=0&OpponentTeamID=0&Outcome=&PaceAdjust=N&PerMode=PerGame&Period=0&PlayerID='
    
    stem.3 <-
      "&PlusMinus=N&Position=&Rank=N&RookieYear=&Season=" %>%
      paste0(
        id.season,
        "&SeasonSegment=&SeasonType=Regular+Season&TeamID=0&VsConference=&VsDivision=&mode=Advanced&showDetails=0&showShots=1&showZones=0"
      )
    
    shot_data_url <-
      base_url %>%
      paste0(id.season, stem.2, id.player, stem.3)
    
    data <-
      shot_data_url %>%
      fromJSON(simplifyDataFrame = T)
    
    data.shots <-
      data$resultSets$rowSet %>%
      .[1] %>%
      data.frame %>%
      tbl_df
    
    names(data.shots) <-
      data$resultSets$headers %>%
      .[1] %>%
      unlist %>%
      str_to_lower()
    
    data.shots %<>%
      mutate_each(funs(as.numeric), matches("loc")) %>%
      mutate_each(funs(as.numeric), matches("remaining")) %>%
      mutate_each(funs(as.numeric), matches("id")) %>%
      mutate_each(funs(as.numeric), matches("distance")) %>%
      mutate(
        period = period %>% as.numeric,
        shot_attempted_flag = "1" %>% grepl(shot_attempted_flag),
        shot_made_flag = "1" %>% grepl(shot_made_flag)
      )
    
    url.player.photo <-
      "http://stats.nba.com/media/players/230x185/" %>%
      paste0(id.player, '.png')
    
    con <-
      url.player.photo %>%
      url(open = 'rb')
    
    rawpng <-
      con %>%
      readBin(what = 'raw', n = 50000)
    
    close(con)
    
    png1 <-
      rawpng %>%
      readPNG
    
    g <-
      png1 %>%
      rasterGrob(
        interpolate = TRUE,
        width = unit(1, "npc"),
        height = unit(1, "npc")
      )
    
    courtImg.URL <-
      "http://lookingforamerica.us/wp-content/uploads/2015/03/Nba-Basketball-Court-Dimensions.jpg"
    
    court <-
      courtImg.URL %>%
      getURLContent %>%
      readJPEG %>%
      rasterGrob(width = unit(1, "npc"), height = unit(1, "npc"))
    
    summary_shots <-
      data.shots %>%
      group_by(shot_made_flag) %>%
      summarise(shots = n())
    
    title <-
      player %>%
      paste0(
        " Shot Chart\n",
        id.season,
        ' Season',
        '\n',
        summary_shots$shots[2],
        ' Shots Made and ',
        summary_shots$shots[1],
        ' Shots Missed, FG% of ',
        summary_shots$shots[2] / data.shots %>% nrow * 100 %>% digits(2),
        '%'
      )
    
    if (exclude_backcourt == T) {
      data.shots %<>%
        dplyr::filter(!shot_zone_basic == 'Backcourt')
    }
    
    accuracy_data <-
      data.shots %>%
      group_by(shot_zone_basic) %>%
      mutate(shot_value = ifelse(shot_made_flag == TRUE, 1, 0)) %>%
      summarise(
        attempts = n(),
        made = sum(shot_value),
        loc_x = loc_x %>% mean,
        loc_y = loc_y  %>% mean,
        accuracy = made / attempts,
        accuracy_label = percent(accuracy)
      )
    
    if ("Left Corner 3" %in% accuracy_data$shot_zone_basic == F) {
      accuracy_data %<>%
        bind_rows(data_frame(
          shot_zone_basic = "Left Corner 3",
          attempts = 0,
          accuracy_label = NA
        ))
    }
    
    if ("Right Corner 3" %in% accuracy_data$shot_zone_basic == F) {
      accuracy_data %<>%
        bind_rows(data_frame(
          shot_zone_basic = "Right Corner 3",
          attempts = 0,
          accuracy_label = NA
        ))
    }
    
    if ("Above the Break 3" %in% accuracy_data$shot_zone_basic == F) {
      accuracy_data %<>%
        bind_rows(
          data_frame(
            shot_zone_basic = "Above the Break 3",
            attempts = 0,
            accuracy_label = NA
          )
        )
    }
    
    if ("Restricted Area" %in% accuracy_data$shot_zone_basic == F) {
      accuracy_data %<>%
        bind_rows(
          data_frame(
            shot_zone_basic = "Restricted Area",
            attempts = 0,
            accuracy_label = NA
          )
        )
    }
    
    if ("Mid-Range" %in% accuracy_data$shot_zone_basic == F) {
      accuracy_data %<>%
        bind_rows(data_frame(
          shot_zone_basic = "Mid-Range",
          attempts = 0,
          accuracy_label = NA
        ))
    }
    
    if ("In The Paint (Non-RA)" %in% accuracy_data$shot_zone_basic == F) {
      accuracy_data %<>%
        bind_rows(
          data_frame(
            shot_zone_basic = "In The Paint (Non-RA)",
            attempts = 0,
            accuracy_label = NA
          )
        )
    }
    
    accuracy_data %<>%
      mutate(accuracy_label = accuracy_label %>% percent())
    
    cols <-
      c("FALSE" = "red",
        "TRUE" = "black")
    
    p <-
      data.shots %>%
      ggplot(aes(loc_x, loc_y)) +
      annotation_custom(court, -250, 250, -50, 420) +
      stat_density2d(
        geom = "tile",
        aes(fill = ..density.. ^ 0.25),
        alpha = .60,
        contour = F
      ) +
      scale_fill_viridis(guide_legend(
        label = T,
        title = "Shot Density\n % FG Attempts",
        override.aes = list(alpha = .25, fill = 'white')
      )) +
      geom_point(
        size = 1,
        aes(colour = shot_made_flag, scatter = 'jitter'),
        alpha = .75
      ) +
      scale_color_manual(
        values = cols,
        name = '',
        labels = c("Shot Missed", "Shot Made")
      ) +
      theme_bw() +
      xlim(-250, 250) +
      ylim(-50, 420) +
      theme(
        panel.background = element_rect("black"),
        panel.grid.major.x = element_blank(),
        panel.grid.major.y = element_blank(),
        panel.grid.minor.y = element_blank(),
        rect = element_blank(),
        legend.key = element_blank(),
        legend.background  = element_rect(fill = "white", colour = "white"),
        legend.position = "blank",
        axis.text = element_blank(),
        axis.ticks.x = element_blank(),
        axis.ticks.y = element_blank(),
        plot.title = element_text(
          size = 12,
          colour = "white",
          face = "bold"
        ),
        plot.margin = unit(c(.15, .75, .15, .75), "cm")
      )  +
      labs(y = NULL, x = NULL) +
      annotation_custom(
        g,
        xmin = 130,
        xmax = 230,
        ymin = 300,
        ymax = 400
      )  +
      ggplot2::annotate(
        "text",
        x = -200,
        y = 325,
        label = paste0("Authored by\n", author),
        colour = "black"
      ) +
      ggplot2::annotate(
        "text",
        x = 0,
        y = 325,
        label = title,
        size = 5,
        colour = "black"
      ) +
      annotate(
        "text",
        x = 0,
        y = 235,
        label = paste(
          "Above the Break 3",
          #center 3
          accuracy_data %>%
            dplyr::filter(shot_zone_basic == "Above the Break 3") %>%
            .$accuracy_label,
          sep = '\n'
        ),
        size = 4.5,
        colour = "white"
      ) +
      annotate(
        "text",
        x = 0,
        y = 90,
        label = paste(
          "In The Paint (Non-RA)",
          #paint
          accuracy_data %>%
            dplyr::filter(shot_zone_basic == "In The Paint (Non-RA)") %>%
            .$accuracy_label,
          sep = '\n'
        ),
        size = 4.5,
        colour = "white"
      ) +
      annotate(
        "text",
        x = -208,
        y = 15,
        angle = 90,
        label = paste(
          "Left Corner 3",
          #left3
          accuracy_data %>%
            dplyr::filter(shot_zone_basic == "Left Corner 3") %>%
            .$accuracy_label,
          sep = '\n'
        ),
        size = 4.5,
        colour = "white"
      ) +
      annotate(
        "text",
        x = 0,
        y = 160,
        label = paste(
          "Mid-Range",
          #mid
          accuracy_data %>%
            dplyr::filter(shot_zone_basic == "Mid-Range") %>%
            .$accuracy_label,
          sep = '\n'
        ),
        size = 4.5,
        colour = "white"
      ) +
      annotate(
        "text",
        x = 0,
        y = -25,
        label = paste(
          "Restricted Area",
          #restricted
          accuracy_data %>%
            dplyr::filter(shot_zone_basic == "Restricted Area") %>%
            .$accuracy_label,
          sep = '\n'
        ),
        size = 4.5,
        colour = "white"
      ) +
      annotate(
        "text",
        x = 208,
        y = 15,
        angle = 90,
        label = paste(
          "Right Corner 3",
          #right3
          accuracy_data %>%
            dplyr::filter(shot_zone_basic == "Right Corner 3") %>%
            .$accuracy_label,
          sep = '\n'
        ),
        size = 4.5,
        colour = "white"
      )
    
    p <-
      ggMarginal(p,
                 type = c("density"),
                 colour = 'black',
                 size = 10)
    p
  }
}