abresler/plot_player_shot_chart.r

## 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
  }
}
	#' 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
	}
	}