Visualizing NBA Seasons Part 4: Shootings

Seasons 1950-2017

Part 4: Shootings (3-Points)

Introduction & Preparation

Part 1: Players

Part 2: Points

Part 3: Shootings (FG and FT)

Part 5: Skills

Part 6: Roles

---

Setup Stage

Loading necessary packages.

library(dplyr)
library(tidyr)
library(ggplot2)
library(RColorBrewer)
library(plotly)
library(ggridges)
library(kableExtra)
library(wordcloud2)
library(forcats)

Create additional functions

# Mode average
getmode <- function(v) {
   uniqv <- unique(v)
   uniqv[which.max(tabulate(match(v, uniqv)))]
}

Load the dataset

Dataset taken from: https://www.kaggle.com/drgilermo/nba-players-stats/version/2

If you need to see the glossary and the data tidying process, please visit first part here.

Loading datasets…

NBA <- read.csv("NBA_TidySet.csv")
NBA_Scaled <- read.csv("NBA_Scaled_TidySet.csv")
NBA$Pos <- factor(NBA$Pos, levels = c("C", "PF", "SF", "SG", "PG"))
PosColorCode <- c("C"="#FF0000", "PF"="#FFA500", "SF"="#DDDD00" ,"SG"="#0000FF", "PG"="#32CD32")

Displaying main table

NBA

---

SHOOTING

In this session we explore shooting statistics of the NBA players. As discussed in the previous session, there are 3 basic shooting category in basketball: Field Goals (FG), Three-Points Field Goal (3P), and Free-Throw (FT). Last session we already see the exploratory analysis of FG and FT, now it’s time too see 3-Points stats with additional mixed shooting stats.

Again, I use basic RGB as color-code for shooting type: red for FT, green for 3P and blue for FG.

NOTE: While I don’t have time or an inspiration about the narrative, Lorem ipsum texts will be in display.

Three-Points

Since three-points is my favorite category in a basketball statistics, I wil selfishly dig deeper than any other shooting category. So here we go.

Annual 3-Points % League Leaders

No qui autem reque. Ea tantas vocent dolores vim, an vivendum deserunt sensibus vix. Ea mel zril aliquam appellantur, utinam omnesque liberavisse per ea. Consul ridens voluptatum ea per, laoreet nominati salutandi ne his. Assum graecis voluptatibus id sit, cum id constituto adipiscing.

Top3Pts. <- NBA %>%
    filter(Year >= 1980 & X3P. > 0) %>%
    group_by(Year, Player) %>%
    summarise(Pos = getmode(Pos),
              Team = getmode(Tm),
              Games = sum(G),
              MPG = round(sum(MP)/Games, 1),
              PPG = round(sum(PTS)/Games, 1),
              x3Pm = sum(X3P),
              x3Pa = sum(X3PA),
              x3Pt. = round(x3Pm/x3Pa, 3)) %>%
    filter(ifelse(Year %in% 1980:1990, x3Pm >= 25,
                  ifelse(Year %in% 1991:1994, x3Pm >= 50,
                    ifelse(Year %in% c(1998, 2000, 2004:2008, 2010), x3Pm >= 55,
                      ifelse(Year %in% 1999, x3Pm >= 34,
                        ifelse(Year %in% 2012, x3Pm >= 44,
                          x3Pm >= 82)))))) %>%
    group_by(Year) %>%
    summarise(Player = Player[which.max(x3Pt.)],
              Team = Team[which.max(x3Pt.)],
              Pos = Pos[which.max(x3Pt.)],
              Games = Games[which.max(x3Pt.)],
              MPG = MPG[which.max(x3Pt.)],
              PPG = PPG[which.max(x3Pt.)],
              x3Pm = x3Pm[which.max(x3Pt.)],
              x3Pa = x3Pa[which.max(x3Pt.)],
              x3Pt. = max(x3Pt., na.rm = T)) %>%
    arrange(desc(Year))
Top3Pts. %>%
    mutate(Pos = cell_spec(Pos, color = "white", align = "c", 
                    background = factor(Pos, c("C", "PF", "SF", "SG", "PG"), 
                                        PosColorCode))) %>%
    kable(escape = FALSE, caption = "Annual 3-Points % League Leaders") %>%
    kable_styling("striped", full_width = T) %>%
    column_spec(1, bold = T, color = "yellow", background = "#FF0000") %>%
    column_spec(2, bold = T) %>%
    column_spec(10, bold = T, color = "white", background = "#777777") %>%
    scroll_box(width = "100%", height = "300px")

Annual 3-Points % League Leaders

Year	Player	Team	Pos	Games	MPG	PPG	x3Pm	x3Pa	x3Pt.
2017	Kyle Korver	ATL	SG	67	26.2	10.1	162	359	0.451
2016	J.J. Redick	LAC	SG	75	28.0	16.3	200	421	0.475
2015	Kyle Korver	ATL	SG	75	32.2	12.1	221	449	0.492
2014	Kyle Korver	ATL	SG	71	33.9	12.0	185	392	0.472
2013	Jose Calderon	TOR	PG	73	29.6	11.3	130	282	0.461
2012	Steve Novak	NYK	PF	54	18.9	8.8	133	282	0.472
2011	Matt Bonner	SAS	PF	66	21.7	7.3	105	230	0.457
2010	Kyle Korver	UTA	SG	52	18.3	7.2	59	110	0.536
2009	Anthony Morrow	GSW	SG	67	22.6	10.1	86	184	0.467
2008	Jason Kapono	TOR	SF	81	18.9	7.2	57	118	0.483
2007	Jason Kapono	MIA	SF	67	26.4	10.9	108	210	0.514
2006	Richard Hamilton	DET	SG	80	35.3	20.1	55	120	0.458
2005	Fred Hoiberg	MIN	SG	76	16.7	5.8	70	145	0.483
2004	Anthony Peeler	SAC	SG	75	18.5	5.7	68	141	0.482
2003	Bruce Bowen	SAS	SF	82	31.3	7.1	101	229	0.441
2002	Steve Smith	SAS	SG	77	28.7	11.6	116	246	0.472
2001	Brent Barry	SEA	SG	67	26.5	8.8	109	229	0.476
2000	Hubert Davis	DAL	PG	79	23.0	7.4	82	167	0.491
1999	Dell Curry	MIL	SG	42	20.6	10.1	69	145	0.476
1998	Dale Ellis	SEA	SF	79	24.5	11.8	127	274	0.464
1997	Glen Rice	CHH	SF	79	42.6	26.8	207	440	0.470
1996	Tim Legler	WSB	SG	77	23.1	9.4	128	245	0.522
1995	Steve Kerr	CHI	PG	82	22.4	8.2	89	170	0.524
1994	Tracy Murray	POR	SF	66	12.4	6.6	50	109	0.459
1993	B.J. Armstrong	CHI	PG	82	30.4	12.3	63	139	0.453
1992	Dana Barros	SEA	PG	75	17.7	8.3	83	186	0.446
1991	Jim Les	SAC	PG	55	25.4	7.2	71	154	0.461
1990	Steve Kerr	CLE	PG	78	21.3	6.7	73	144	0.507
1989	Jon Sundvold	MIA	SG	68	19.7	10.4	48	92	0.522
1988	Craig Hodges	MIL	SG	66	21.9	9.5	86	175	0.491
1987	Kiki Vandeweghe	POR	SF	79	38.3	26.9	39	81	0.481
1986	Craig Hodges	MIL	SG	66	26.3	10.8	73	162	0.451
1985	Byron Scott	LAL	SG	81	28.5	16.0	26	60	0.433
1984	Darrell Griffith	UTA	SG	82	32.3	20.0	91	252	0.361
1983	Mike Dunleavy	SAS	PG	79	20.5	7.8	67	194	0.345
1982	Campy Russell	NYK	SF	77	30.6	13.9	25	57	0.439
1981	Brian Taylor	SDC	PG	80	28.9	10.1	44	115	0.383
1980	Fred Brown	SEA	SG	80	21.3	12.0	39	88	0.443

To qualify for league leaders, a player must meet the Rate Statistic Requirements

Vix doming conceptam percipitur cu, qui essent vidisse nusquam et! Vivendo voluptaria scribentur sit ut. Vis modus ceteros contentiones at, id regione moderatius sea? Te vim natum hendrerit.

mean3PT.Year <- NBA %>%
    group_by(Year) %>%
    filter(Year >= 1980 & X3P. > 0) %>%
    summarise(x3PT. = sum(X3P, na.rm = T)/sum(X3PA, na.rm = T))
T3p. <- Top3Pts. %>%
    ggplot() +
    geom_bar(aes(Year, x3Pt., fill = Pos, text = paste("Player:", Player)), stat = "identity") +
    geom_line(data=mean3PT.Year, aes(Year, x3PT., linetype = "Average line"), color = "black") +
    ggtitle("Annual 3-point Shooting Leaders") +
    geom_hline(yintercept = mean(Top3Pts.$x3Pt.), col = "blue", alpha = 0.5) +
    scale_x_continuous(breaks = seq(1950, 2017, 10)) +
    scale_fill_manual("Pos", values = PosColorCode) +
    theme(legend.position="none")
pT3p. <- ggplotly(T3p.)
#api_create(pT3p., filename = "Annual3P% Leaders")

• Average top 3P% is 0.467.
• Highest top 3P% is 0.536, in season 2010.
• Lowest top 3P% is 0.345, in season 1983.
• The SG dominated the league by 50%, followed by PG with 23.7%, then SF
  added with 21.1%, and finally PF completed the leaderboard with only 5.3%. No center ever be in 3P% leaderboard, this because 3-Points is requires more long-range shooting skills which not the role for centers.

All-Time 3 Points Field Goals % Leaders

Sed turpis est, pretium nec elit lacinia, accumsan tristique enim. Curabitur consectetur risus sit amet mauris vestibulum rhoncus. Nam non finibus augue, nec rhoncus nulla. Nam in molestie ipsum. Praesent pharetra fermentum orci, et faucibus odio porta non. Duis finibus mattis elementum. Mauris posuere dolor nec aliquam mattis. Etiam elementum erat ex, at dapibus lacus convallis aliquam. Nam eget magna lacus.

AllTime3P. <- NBA %>%
    filter(X3P. > 0) %>%
    group_by(Player) %>%
    summarise(Pos = getmode(Pos),
              Team = getmode(Tm),
              ActiveYears = paste(getmode(YearStart), "-", getmode(YearEnd)),
              Games = sum(G),
              MPG = round(sum(MP) / Games, 1),
              PPG = round(sum(PTS) / Games, 1),
              x3Pm = sum(X3P),
              x3Pa = sum(X3PA),
              x3P. = round(x3Pm/x3Pa, 3)) %>%
    filter(x3Pm >= 250) %>%
    arrange(desc(x3P.), desc(x3Pm)) %>%
    mutate(Rank = min_rank(desc(x3P.))) %>%
    select(Rank, everything())
AllTime3P. %>%
    head(n=10) %>%
    mutate(Pos = cell_spec(Pos, color = "white", align = "c", 
                    background = factor(Pos, c("C", "PF", "SF", "SG", "PG"), 
                                        PosColorCode))) %>%
    kable(escape = FALSE, caption = "All-Time 3 Points Field Goals % Leaders") %>%
    kable_styling("striped", full_width = T) %>%
    column_spec(1, bold = T, color = "yellow", background = "#FF0000") %>%
    column_spec(2, bold = T) %>%
    column_spec(11, bold = T, color = "white", background = "#777777") %>%
    scroll_box(width = "100%", height = "300px")

All-Time 3 Points Field Goals % Leaders

Rank	Player	Pos	Team	ActiveYears	Games	MPG	PPG	x3Pm	x3Pa	x3P.
1	Steve Kerr	PG	CHI	1989 - 2003	905	17.9	6.0	726	1597	0.455
2	Hubert Davis	SG	NYK	1993 - 2004	668	22.6	8.4	728	1650	0.441
3	Stephen Curry	PG	GSW	2010 - 2018	574	34.7	22.8	1917	4379	0.438
4	Drazen Petrovic	SG	NJN	1990 - 1993	290	26.4	15.4	255	583	0.437
5	Tim Legler	SG	DAL	1990 - 2000	288	17.7	7.4	260	596	0.436
6	Jason Kapono	SF	MIA	2004 - 2012	509	17.8	6.7	457	1054	0.434
7	Kyle Korver	SG	PHI	2004 - 2018	1031	26.5	10.0	2049	4754	0.431
8	Steve Novak	SF	HOU	2007 - 2017	467	12.1	4.7	575	1337	0.430
9	Steve Nash	PG	PHO	1997 - 2014	1217	31.3	14.3	1685	3939	0.428
10	B.J. Armstrong	PG	CHI	1990 - 2000	743	23.9	9.8	436	1025	0.425

Let’s go to the plot.

LabelFix <- AllTime3P. %>%
    head(10) %>%
    mutate(Player = fct_reorder(Player, desc(x3P.), fun=mean),
           x3Pa = x3Pa-x3Pm,
           x3P. = paste(x3P. * 100, "%")) %>%
    head(n=10) %>%
    gather(Parameter, Count, x3Pm:x3Pa, -c(Player, x3P.)) %>%
    filter(Parameter == "x3Pa")
    
AllTime3P. %>%
    head(10) %>%
    mutate(Player = fct_reorder(Player, desc(x3P.), fun=mean),
           x3Pa = x3Pa-x3Pm) %>%
    gather(Parameter, Count, x3Pm:x3Pa, -c(Player, x3P.)) %>%
    ggplot(aes(Player, Count, fill = Parameter)) + 
    geom_bar(stat = 'identity', position = 'stack') +
    geom_label(aes(label = x3P.,
                   y = 5000),
               data = LabelFix,
               stat = 'identity',
               position = "stack",
               fill = "#FF4000",
               color = "#00FFFF",
               size = 4.5) +
    ggtitle("All-Time 3 Points Percentage Leaders") +
    theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
    xlab("") +
    scale_fill_manual(labels=c("3Pts-missed  ", "3Pts-made"), values=c("#66B266", "#008000")) +
    theme(legend.title=element_blank()) +
    theme(legend.position="bottom")

And again, here comes my favorite boxes, the result of combining HTML, CSS and R code.

Top3P.Pos <- AllTime3P. %>%
    group_by(Pos) %>%
    summarise(Player = Player[which.max(x3P.)],
              Team = Team[which.max(x3P.)],
              ActiveYears = ActiveYears[which.max(x3P.)],
              Games = Games[which.max(x3P.)],
              MPG = MPG[which.max(x3P.)],
              PPG = PPG[which.max(x3P.)],
              x3Pm = x3Pm[which.max(x3P.)],
              x3Pa = x3Pa[which.max(x3P.)],
              x3P. = x3P.[which.max(x3P.)])

Best 3-Points % by Position

C

Mehmet Okur

0.375

• FG: 596 / 1590
• PPG: 13.5
• Years: 2003 - 2012

PF

Matt Bonner

0.414

• FG: 797 / 1923
• PPG: 5.8
• Years: 2005 - 2016

SF

Jason Kapono

0.434

• FG: 457 / 1054
• PPG: 6.7
• Years: 2004 - 2012

SG

Hubert Davis

0.441

• FG: 728 / 1650
• PPG: 8.4
• Years: 1993 - 2004

PG

Steve Kerr

0.455

• FG: 726 / 1597
• PPG: 6
• Years: 1989 - 2003

3-Points per 36 Minutes

Lorem ipsum dolor sit amet, consectetur adipiscing elit. Nunc nec pulvinar eros. Proin elementum nunc eget fringilla eleifend. Nulla facilisi. Vestibulum vitae lacus et felis facilisis pharetra. In id diam lacus. Fusce et pulvinar urna, ac gravida ipsum. Interdum et malesuada fames ac ante ipsum primis in faucibus. Vivamus tristique viverra suscipit. Suspendisse eleifend mollis euismod. Aliquam sed turpis ipsum. Donec et libero sit amet mi ultricies porta.

AllTime3Pma <- NBA %>%
    group_by(Player) %>%
    filter(sum(G) >= 400) %>%
    summarise(Pos = getmode(Position),
              Team = getmode(Tm),
              ActiveYears = paste(getmode(YearStart), "-", getmode(YearEnd)),
              Games = sum(G),
              Minutes = sum(MP),
              MPG = round(Minutes /sum(G), 1),
              PPG = round(sum(PTS)/sum(G), 1),
              x3Pm_36 = round((sum(X3P) / Minutes) * 36, 1),
              x3Pm_G = round(sum(X3P) / Games, 1),
              x3Pa_36 = round((sum(X3PA) / Minutes) * 36, 1),
              x3Pa_G = round(sum(X3PA) / Games, 1),
              x3P. = round(sum(X3P)/sum(X3PA), 3)) %>%
    select(-"Minutes")
AllTime3Pma %>%
    arrange(desc(x3Pm_36), desc(x3P.)) %>%
    head(n=10) %>%
    mutate(Rank = min_rank(desc(x3Pm_36))) %>%
    select(Rank, everything()) %>%
    kable(escape = FALSE, align = "c", caption = "3-Points Made per 36 Minutes") %>%
    kable_styling("striped", full_width = T, font_size = 11) %>%
    column_spec(1, bold = T, color = "yellow", background = "#FF0000") %>%
    column_spec(c(2, 13), bold = T) %>%
    column_spec(9, bold = T, color = "white", background = "#777777") %>%
    scroll_box(width = "100%", height = "300px")

3-Points Made per 36 Minutes

Rank	Player	Pos	Team	ActiveYears	Games	MPG	PPG	x3Pm_36	x3Pm_G	x3Pa_36	x3Pa_G	x3P.
1	Steve Novak	SF	HOU	2007 - 2017	467	12.1	4.7	3.7	1.2	8.5	2.9	0.430
2	Stephen Curry	PG	GSW	2010 - 2018	574	34.7	22.8	3.5	3.3	7.9	7.6	0.438
3	Klay Thompson	SG	GSW	2012 - 2018	464	32.7	19.1	3.1	2.9	7.5	6.8	0.419
4	Ryan Anderson	PF	ORL	2009 - 2018	556	26.5	13.2	2.9	2.1	7.6	5.6	0.381
5	Patty Mills	PG	SAS	2010 - 2018	441	17.0	7.9	2.8	1.3	7.2	3.4	0.395
6	Kyle Korver	SG	PHI	2004 - 2018	1031	26.5	10.0	2.7	2.0	6.3	4.6	0.431
6	J.J. Redick	SG	ORL	2007 - 2018	690	24.9	11.9	2.7	1.8	6.4	4.4	0.415
6	J.R. Smith	SG	DEN	2005 - 2018	880	27.0	12.9	2.7	2.0	7.2	5.4	0.374
9	Danny Green	SG	SAS	2010 - 2018	470	25.0	8.8	2.6	1.8	6.5	4.5	0.400
10	James Jones	SF	MIA	2004 - 2017	709	15.7	5.2	2.5	1.1	6.3	2.7	0.401

AllTime3Pma %>%
    arrange(desc(x3Pa_36), desc(x3P.)) %>%
    head(n=10) %>%
    mutate(Rank = min_rank(desc(x3Pa_36))) %>%
    select(Rank, everything()) %>%
    kable(escape = FALSE, align = "c", caption = "3-Points Attempts per 36 Minutes") %>%
    kable_styling("striped", full_width = T, font_size = 11) %>%
    column_spec(1, bold = T, color = "yellow", background = "#FF0000") %>%
    column_spec(c(2, 13), bold = T) %>%
    column_spec(11, bold = T, color = "white", background = "#777777") %>%
    scroll_box(width = "100%", height = "300px")

3-Points Attempts per 36 Minutes

Rank	Player	Pos	Team	ActiveYears	Games	MPG	PPG	x3Pm_36	x3Pm_G	x3Pa_36	x3Pa_G	x3P.
1	Steve Novak	SF	HOU	2007 - 2017	467	12.1	4.7	3.7	1.2	8.5	2.9	0.430
2	Stephen Curry	PG	GSW	2010 - 2018	574	34.7	22.8	3.5	3.3	7.9	7.6	0.438
3	Ryan Anderson	PF	ORL	2009 - 2018	556	26.5	13.2	2.9	2.1	7.6	5.6	0.381
4	Klay Thompson	SG	GSW	2012 - 2018	464	32.7	19.1	3.1	2.9	7.5	6.8	0.419
5	Patty Mills	PG	SAS	2010 - 2018	441	17.0	7.9	2.8	1.3	7.2	3.4	0.395
5	J.R. Smith	SG	DEN	2005 - 2018	880	27.0	12.9	2.7	2.0	7.2	5.4	0.374
7	C.J. Miles	SG	UTA	2006 - 2018	715	20.9	9.8	2.4	1.4	6.7	3.9	0.361
8	James Harden	SG	HOU	2010 - 2018	615	33.6	22.1	2.4	2.2	6.6	6.2	0.364
9	Danny Green	SG	SAS	2010 - 2018	470	25.0	8.8	2.6	1.8	6.5	4.5	0.400
9	Damon Jones	PG	CLE	1999 - 2009	657	20.5	6.6	2.5	1.4	6.5	3.7	0.390

AllTime3Pma %>%
    arrange(desc(x3Pm_36), desc(x3P.)) %>%
    mutate(Player = reorder(Player, desc(x3Pm_36), FUN=mean)) %>%
    head(n=10) %>%
    ggplot(aes(group = 1)) +
    geom_segment(aes(x=Player, xend=Player, y=x3Pm_36, yend=x3Pa_36), color="black") +
    geom_point(aes(Player, x3Pm_36, color="#FF5800"), size=5) +
    geom_point(aes(Player, x3Pa_36, color="#FF5800"), size=2.5) +
    geom_point(aes(Player, x3Pm_G, color="#009dff"), size=5, shape=18) +
    theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
    ggtitle("3-Pts Made per 36 Minutes vs. 3-Pts Made per Game") +
    xlab("") +
    ylab("3-Pts Made") +
    scale_color_manual(name="", values=c("#009dff", "#FF5800"),
                       labels=c("3-Pts a/m per Game", "3-Pts a/m per 36 minutes"),
                       guide = guide_legend(reverse=TRUE)) +
    theme(legend.position='none')

BIG 3-Pointers Names

The Three-Pointers will be sorted according to the following arbritary criteria :

• Annual league leader in 3-Points percentage category earn 1 point.
• Top 10 all-time leaders in 3-Points percentage category earn 2 points.
• Top 10 all-time leaders in 3-Points made category with 3P% more than 38% earn 1 point.
• Top 10 all-time leaders in 3-Points made per 36 minutes category with 3P% more than 38% earn 1 point.
• Annual Three-Points Contest winner earn 1 point.

Calculate the points and we have the rank!

Note that we have special category here that cannot be apply anywhere els, “Three-Points Contest winner”. It’s annual contest held during NBA All-Star Weekend. I had to add the winners data manually.

Let the calculation begin.

# Filter total 3-Points made with 3P% > .380
AllTime3Pm <- NBA %>%
    group_by(Player) %>%
    summarise(x3Pm = sum(X3P),
              x3Pa = sum(X3PA),
              x3P. = x3Pm / x3Pa) %>%
    filter(x3P. > 0.38) %>%
    arrange(desc(x3Pm)) %>% head(10)
# Filter 3-Points made per 36 minutes with 3P% > .380
AllTime3Pm36 <- AllTime3Pma %>%
    filter(x3P. >= 0.38) %>%
    arrange(desc(x3Pm_36)) %>%
    head(n=10)
# Create Three-Points Contest data frame
Year <- c(1986:1998, 2000:2018)
Player <- c(rep("Larry Bird", 3), "Dale Ellis", rep("Craig Hodges", 3), rep("Mark Price", 2), "Glen Rice", "Tim Legler", "Steve Kerr", rep("Jeff Hornacek", 2), "Ray Allen", rep("Peja Stojakovic", 2), "Voshon Lenard", "Quentin Richardson","Dirk Nowitzki", rep("Jason Kapono", 2), "Daequan Cook", "Paul Pierce", "James Jones", "Kevin Love", "Kyrie Irving", "Marco Belinelli", "Stephen Curry", "Klay Thompson", "Eric Gordon", "Devin Booker")
TPContest <- data.frame(Year, Player)
# Create all three-pointers leaders
Super3Pointers <- data.frame(Player = c(as.character(Top3Pts.$Player),
                               as.character(rep(head(AllTime3P.$Player, 10), 2)),
                               as.character(AllTime3Pm$Player),
                               as.character(AllTime3Pm36$Player),
                               as.character(TPContest$Player))) %>%
    count(Player) %>%
    arrange(desc(n))
# Display the final table:
    
Super3Pointers %>%
    group_by(Player) %>%
    mutate(Pos = getmode(NBA$Position[NBA$Player %in% Player]),
           x3Pm = sum(NBA$X3P[NBA$Player %in% Player], na.rm = T),
           x3Pa = sum(NBA$X3PA[NBA$Player %in% Player], na.rm = T),
           "3P%" = round(x3Pm/x3Pa, 3),
           Tokens = paste(strrep("|", n)),
           TotalTokens = n) %>%
    select(-"n") %>%
    kable(escape = FALSE, caption = "The Most Prominent Three-Pointers") %>%
    kable_styling(bootstrap_options = "striped", full_width = F, position = "center") %>%
    column_spec(1, bold = T) %>%
    column_spec(6, bold = T, color = "gold") %>%
    column_spec(7, bold = T, color = "white", background = "#777777") %>%
    scroll_box(width = "100%", height = "300px")

The Most Prominent Three-Pointers

Player	Pos	x3Pm	x3Pa	3P%	Tokens	TotalTokens
Kyle Korver	SG	2049	4754	0.431	||||||||	8
Jason Kapono	SF	457	1054	0.434	||||||	6
Craig Hodges	SG	563	1408	0.400	|||||	5
Stephen Curry	PG	1917	4379	0.438	|||||	5
Steve Kerr	PG	726	1599	0.454	|||||	5
Steve Novak	SF	575	1337	0.430	||||	4
Tim Legler	SG	260	603	0.431	||||	4
B.J. Armstrong	PG	436	1026	0.425	|||	3
Dale Ellis	SF	1719	4266	0.403	|||	3
Hubert Davis	SG	728	1651	0.441	|||	3
Larry Bird	SF	649	1727	0.376	|||	3
Peja Stojakovic	SF	1760	4392	0.401	|||	3
Dirk Nowitzki	PF	1780	4668	0.381	||	2
Drazen Petrovic	SG	255	583	0.437	||	2
Glen Rice	SF	1565	3920	0.399	||	2
J.J. Redick	SG	1271	3064	0.415	||	2
James Jones	SF	776	1937	0.401	||	2
Jeff Hornacek	SG	828	2055	0.403	||	2
Klay Thompson	SG	1328	3171	0.419	||	2
Mark Price	PG	976	2428	0.402	||	2
Ray Allen	SG	2973	7429	0.400	||	2
Steve Nash	PG	1685	3939	0.428	||	2
Anthony Morrow	SG	807	1937	0.417	|	1
Anthony Peeler	SG	940	2445	0.384	|	1
Brent Barry	SG	1395	3442	0.405	|	1
Brian Taylor	PG	157	417	0.376	|	1
Bruce Bowen	SF	818	2082	0.393	|	1
Byron Scott	SG	775	2093	0.370	|	1
Campy Russell	SF	34	93	0.366	|	1
Chauncey Billups	PG	1830	4725	0.387	|	1
Daequan Cook	SG	442	1232	0.359	|	1
Damon Jones	PG	941	2414	0.390	|	1
Dana Barros	PG	1090	2652	0.411	|	1
Danny Green	SG	849	2123	0.400	|	1
Darrell Griffith	SG	530	1596	0.332	|	1
Dell Curry	SG	1245	3098	0.402	|	1
Devin Booker	SG	246	694	0.354	|	1
Eric Gordon	SG	1023	2690	0.380	|	1
Fred Brown	SG	110	295	0.373	|	1
Fred Hoiberg	SG	373	941	0.396	|	1
Jason Terry	SG	2242	5895	0.380	|	1
Jim Les	PG	196	495	0.396	|	1
Jon Sundvold	PG	226	576	0.392	|	1
Jose Calderon	PG	861	2106	0.409	|	1
Kevin Love	PF	887	2435	0.364	|	1
Kiki Vandeweghe	SF	218	592	0.368	|	1
Kyrie Irving	PG	723	1887	0.383	|	1
Marco Belinelli	SG	853	2262	0.377	|	1
Matt Bonner	PF	797	1923	0.414	|	1
Mike Dunleavy	SF	1446	3879	0.373	|	1
Patty Mills	PG	592	1499	0.395	|	1
Paul Pierce	SF	2143	5816	0.368	|	1
Quentin Richardson	SF	1167	3288	0.355	|	1
Rashard Lewis	SF	1787	4625	0.386	|	1
Reggie Miller	SG	2560	6486	0.395	|	1
Richard Hamilton	SG	530	1530	0.346	|	1
Ryan Anderson	PF	1184	3107	0.381	|	1
Steve Smith	SG	1148	3208	0.358	|	1
Tracy Murray	SF	753	1942	0.388	|	1
Voshon Lenard	SG	936	2437	0.384	|	1

Now see their name cloud

Super3Pointers %>% wordcloud2(size=0.5, color='random-light', backgroundColor="black")

All 3-Point Shooters Career Performance

I can’t resist to see how all the three-pointers compares year-by-year, so let’s see their career performance.

NBA %>%
    filter(Player %in% Super3Pointers$Player) %>%
    group_by(Age, Player) %>%
    summarise(x3Pm = sum(X3P),
              x3Pa = sum(X3PA),
              x3P. = x3Pm/x3Pa) %>%
    filter(x3P. < 0.7) %>%
    ggplot(aes(Age, Player, fill=x3P.)) +
    geom_tile(color = "grey50") +
    scale_x_continuous(expand = c(0, 0)) +
    scale_fill_gradientn(colors = brewer.pal(9, "Reds")) +
    theme(panel.grid = element_blank()) +
    scale_y_discrete(limits = rev(levels(Player))) +
    ggtitle("All 3-Point Shooters Career Performance") +
    theme(legend.position="bottom")

3-Point Ratio

Don’t you dare to think that I’m done with the three-points, it’s the most interesting subject of all. So like it or not, I’m gonna see the highest 3-point ratio. It measure how many percent of points come from the behind the 3-points line.

NBA %>%
    filter(Year >= 1980 & X3P > 1) %>%
    group_by(Player) %>%
    summarise(Pos = getmode(Position),
              Team = getmode(Tm),
              Games = sum(G),
              Pts2 = sum(X2P) * 2,
              Pts3 = sum(X3P) * 3,
              PtsFT = sum(FT),
              PTS = sum(PTS),
              PPG = round(PTS / Games, 1),
              Pts2r = round(Pts2 / PTS, 3),
              Pts3r = round(Pts3 / PTS, 3),
              PtsFTr = round(PtsFT / PTS, 3),
              x3Pm = sum(X3P),
              x3Pa = sum(X3PA),
              x3P. = round(x3Pm / x3Pa, 3)) %>%
    filter(x3Pm > 250) %>%
    select(-c(x3Pm, x3Pa, Pts2:PtsFT)) %>%
    arrange(desc(Pts3r)) %>%
    mutate(Player = reorder(Player, Pts3r, FUN=mean)) %>%
    head(10) %>%
    gather(Parameter, Value, Pts2r:PtsFTr) %>%
    ggplot(aes(Player, Value, fill=forcats::fct_rev(Parameter))) +
    geom_bar( stat="identity", position="fill") +
    geom_label(aes(label = paste(Value * 100, "%")),
               stat = 'identity',
               position = position_stack(vjust = 0.5),
               fill = "#FF4000",
               color = "#00FFFF",
               size = 2.5) +
    ggtitle("Highest 3-Points Ratio") +
    coord_flip() +
    xlab("") +
    ylab("Shooting") +
    guides(fill = guide_legend(reverse = TRUE)) +
    theme(legend.position="bottom") +
    theme(legend.title=element_blank())

Still not satisfied enough, I’m going to see same plot but filled with the top dozen best three-pointers in the league, minus the name that already appear in the plot above.

NBA %>%
    filter(Year >= 1980 & Player %in% head(Super3Pointers$Player, 12)) %>%
    group_by(Player) %>%
    summarise(Pos = getmode(Pos),
              Team = getmode(Tm),
              Games = sum(G),
              Pts2 = sum(X2P) * 2,
              Pts3 = sum(X3P) * 3,
              PtsFT = sum(FT),
              PTS = sum(PTS),
              PPG = round(PTS / Games, 1),
              Pts2r = round(Pts2 / PTS, 3),
              Pts3r = round(Pts3 / PTS, 3),
              PtsFTr = round(PtsFT / PTS, 3),
              x3Pm = sum(X3P),
              x3Pa = sum(X3PA),
              x3P. = round(x3Pm / x3Pa, 3)) %>%
    filter(x3Pm > 250, Player != c("Steve Novak", "Kyle Korver")) %>%
    select(-c(x3Pm, x3Pa, Pts2:PtsFT)) %>%
    arrange(desc(Pts3r)) %>%
    mutate(Player = factor(Player, levels = c("Larry Bird", "B.J. Armstrong", "Dale Ellis", "Craig Hodges", "Tim Legler", "Peja Stojakovic", "Hubert Davis", "Steve Kerr", "Jason Kapono", "Stephen Curry"))) %>%
    gather(Parameter, Value, Pts2r:PtsFTr) %>%
    ggplot(aes(Player, Value, fill=forcats::fct_rev(Parameter))) +
    geom_bar( stat="identity", position="fill") +
    geom_label(aes(label = paste(Value * 100, "%")),
               stat = 'identity',
               position = position_stack(vjust = 0.5),
               fill = "#FF4000",
               color = "#00FFFF",
               size = 2.5) +
    ggtitle("Shooting Ratio of the Super3Pointers") +
    coord_flip() +
    xlab("") +
    ylab("Shooting") +
    guides(fill = guide_legend(reverse = TRUE)) +
    theme(legend.position="bottom") +
    theme(legend.title=element_blank())

It’s interesting to see that, despite being a three consecutive three-point contest winner, and those amazing threes we saw in the NBA highlight, Larry Bird actually acquired less than one-tenth of his points from behind the three-point line.

3-Point Rate

While in the 3-point ratio we can see how many percent of points earned from 3-point, in 3-point rate we can see players who loves to take long-range shooting attempts more than shorter distance.

x3PrateAVG <- NBA %>%
    summarise(Player = "Average",
              Games = sum(G, na.rm = T),
              FGa = sum(FGA, na.rm = T),
              x3Pa = sum(X3PA, na.rm = T),
              FGapG = round(FGa / Games, 2),
              x3PapG = round(x3Pa / Games, 2),
              x3Pr = round(x3Pa / FGa, 3)) %>%
    select(-c(Games, x3Pa, FGa))
x3Prate <- NBA %>%
    group_by(Player) %>%
    summarise(Pos = getmode(Pos),
              Team = getmode(Tm),
              Games = sum(G),
              PTS = sum(PTS),
              PPG = round(PTS / Games, 1),
              FGa = sum(FGA),
              x3Pa = sum(X3PA),
              x3Pr = round(x3Pa / FGa, 3),
              x3PapG = round(x3Pa / Games, 2),
              FGapG = round(FGa / Games, 2)) %>%
    filter(x3Pa > 250) %>%
    mutate(Rank = min_rank(desc(x3Pr))) %>%
    select(Rank, everything()) %>%
    arrange(Rank) %>%
    head(10) %>%
    bind_rows(x3PrateAVG)
LabelFix <- x3Prate %>%
    mutate(x3PapG = x3PapG,
           x3Pr = paste(x3Pr * 100, "%")) %>%
    gather(Parameter, Count, x3PapG, -c(Player, x3Pr)) %>%
    mutate(Player = factor(Player, levels = unique(Player[order(desc(x3Pr))])))
x3Prate %>%
    gather(Parameter, Count, FGapG:x3PapG, -c(Player, x3Pr)) %>%
    mutate(Player = factor(Player, levels = unique(Player[order(desc(x3Pr))]))) %>%
    ggplot(aes(Player, Count, fill = Parameter, label = x3Pr)) +
    geom_bar(position="dodge", stat="identity") +
    geom_label(aes(label = x3Pr, y = 0.7),
              data = LabelFix,
              stat = 'identity',
              position = "stack",
              fill = "#FFFFFF",
              color = "#000000",
              size = 4) +
    ggtitle("3-Point Rate") +
    theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
    xlab("") +
    ylab("3P/FG per game") +
    scale_fill_manual(name="", values=c("#0000FF", "#008000"),
                       labels=c("FG per Game", "3P per Game")) +
    theme(legend.position="bottom")

NA

Now I’m finally satisfied having seen everything I wanted to see (so far), now we marching forward to see the next category.

---

Mixed

Effective Field Goal Percentage

eFG. (Effective Field Goal Percentage): This statistic adjusts for the fact that a 3-point field goal is worth one more point than a 2-point field goal. For example, suppose Player A goes 4 for 10 with 2 threes, while Player B goes 5 for 10 with 0 threes. Each player would have 10 points from field goals, and thus would have the same effective field goal percentage (50%).

The formula is \(\frac{FG + 0.5 * 3P}{FGA}\)

Creating table:

NBA %>%
    group_by(Player) %>%
    summarise(Pos = getmode(Pos),
              Team = getmode(Tm),
              ActiveYears = paste(getmode(YearStart), "-", getmode(YearEnd)),
              Games = sum(G),
              PTS = sum(PTS),
              x2Pm = sum(X2P),
              x2Pa = sum(X2PA),
              FGm = sum(FG),
              FGa = sum(FGA),
              x3Pm = sum(X3P, na.rm = T),
              x3Pa = sum(X3PA, na.rm = T),
              PPG = round(PTS/Games, 1),
              x2P. = round(x2Pm/x2Pa, 3),
              x3P. = round(x3Pm/x3Pa, 3),
              eFG. = round((FGm + 0.5 * x3Pm) / FGa, 3)) %>%
    filter(Games > 400) %>%
    select(-c(PTS:x3Pa)) %>%
    arrange(desc(eFG.)) %>%
    head(20) %>%
    mutate(Rank = min_rank(desc(eFG.))) %>%
    select(Rank, everything()) %>%
    mutate(Pos = cell_spec(Pos, color = "white", align = "c", 
                    background = factor(Pos, c("C", "PF", "SF", "SG", "PG"), 
                                        PosColorCode))) %>%
    kable(escape = FALSE, caption = "Effective Field Goal Percentage Leaders") %>%
    kable_styling("striped", full_width = T) %>%
    column_spec(1, bold = T, color = "yellow", background = "#FF0000") %>%
    column_spec(2, bold = T) %>%
    column_spec(10, bold = T, color = "white", background = "#777777") %>%
    scroll_box(width = "100%", height = "300px")

Effective Field Goal Percentage Leaders

Rank	Player	Pos	Team	ActiveYears	Games	PPG	x2P.	x3P.	eFG.
1	DeAndre Jordan	C	LAC	2009 - 2018	673	9.1	0.679	0.091	0.677
2	Steve Novak	SF	HOU	2007 - 2017	467	4.7	0.463	0.430	0.605
3	Artis Gilmore	C	CHI	1972 - 1988	909	17.1	0.600	0.077	0.599
4	Andris Biedrins	C	GSW	2005 - 2014	516	6.3	0.595	0.000	0.594
4	Tyson Chandler	C	CHI	2002 - 2018	1033	8.7	0.595	0.000	0.594
6	Amir Johnson	PF	TOR	2006 - 2018	745	7.5	0.590	0.340	0.585
6	Dwight Howard	C	ORL	2005 - 2018	954	17.5	0.588	0.089	0.585
8	Ryan Hollins	C	CHA	2007 - 2016	518	3.7	0.584	0.000	0.584
9	Shaquille O'Neal	C	LAL	1993 - 2011	1207	23.7	0.583	0.045	0.582
10	Mark West	C	PHO	1984 - 2000	1090	5.7	0.581	0.000	0.580
11	Stephen Curry	PG	GSW	2010 - 2018	574	22.8	0.507	0.438	0.575
12	Darryl Dawkins	C	PHI	1976 - 1989	726	12.0	0.573	0.133	0.572
12	Steve Johnson	C	KCK	1982 - 1991	626	11.7	0.573	0.000	0.572
14	James Donaldson	C	DAL	1981 - 1995	957	8.6	0.571	NaN	0.571
14	Kyle Korver	SG	PHI	2004 - 2018	1031	10.0	0.461	0.431	0.571
16	Brent Barry	SG	SEA	1996 - 2009	912	9.3	0.525	0.405	0.570
16	Matt Bonner	PF	SAS	2005 - 2016	792	5.8	0.516	0.414	0.570
18	Bo Outlaw	PF	ORL	1994 - 2008	914	5.4	0.573	0.079	0.568
19	Steve Kerr	PG	CHI	1989 - 2003	910	6.0	0.494	0.454	0.564
20	Ed Davis	PF	TOR	2011 - 2018	481	6.8	0.562	0.000	0.562

eFGLeaders <- NBA %>%
    group_by(Player) %>%
    summarise(Games = sum(G),
              x2Px = round(sum(X2P) / sum(FGA), 3),
              x3Px = round((sum(X3P, na.rm = T) * 1.5) / sum(FGA), 3),
              FGax = round((sum(FGA) - (sum(X2P) + (sum(X3P, na.rm = T) * 1.5))) / sum(FGA), 3),
              eFG. = round((sum(X2P) + sum(X3P, na.rm = T) * 1.5) / sum(FGA), 3)) %>%
    filter(Games > 400) %>%
    arrange(desc(eFG.)) %>%
    head(20) %>%
    mutate(Player = factor(Player, levels = unique(Player[order(desc(eFG.))]))) %>%
    gather(Parameter, Value, x2Px:FGax, -c(Games))
LabelFix1 <- eFGLeaders %>%
    spread(Parameter, Value) %>%
    mutate(eFG. = paste(eFG. * 100, "%"))
eFGLeaders %>%
    ggplot(aes(Player, Value, fill = Parameter)) + 
    geom_bar(stat = 'identity') +
    geom_text(aes(label = eFG., y = 0.95), size = 3) +
    ggtitle("Effective Field Goal Percentage") +
    theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
    xlab("") +
    ylab("Percentage") +
    scale_fill_manual(labels=c("Missed  ", "2P  ", "3P"), values=c("#0080FF", "#0000FF", "#008000")) +
    theme(legend.title=element_blank()) +
    theme(legend.position="bottom")

Sharpest Shooters

Still obsessing with shooters, I’d like to find the sharpest shooter(s) in the league. To achieve this, I need to negate dunks, lay-ups, even hooks. I only interested in medium to long range shooters for this purpose. Therefore, I simply dismiss FG and take average of both 3-point % and Free Throw % as a measurement variable.

SharpestShooters <- NBA %>%
    group_by(Player) %>%
    summarise(Pos = getmode(Pos),
              x3Pm = sum(X3P, na.rm = T),
              x3Pa = sum(X3PA, na.rm = T),
              FTm = sum(FT, na.rm = T),
              FTa = sum(FTA, na.rm = T),
              x3P. = round(x3Pm/x3Pa, 3),
              FT. = round(FTm/FTa, 3),
              Shoot. = round((x3P. + FT.)/2, 3)) %>%
    filter(x3Pa > 250 & FTa > 1000 & FT. > 0.85 & x3P. > 0.38) %>%
    arrange(desc(Shoot.)) %>%
    mutate(Rank = min_rank(desc(Shoot.))) %>%
    select(Rank, everything(), -c(x3Pm:FTa)) %>%
    head(20) %>%
    mutate(Player = factor(Player, levels = unique(Player[order(desc(Shoot.))])))
SharpestShooters %>%
    mutate(Pos = cell_spec(Pos, color = "white", align = "c", 
                    background = factor(Pos, c("C", "PF", "SF", "SG", "PG"), 
                                        PosColorCode))) %>%
    kable(escape = FALSE, caption = "Sharpest Shooters") %>%
    kable_styling("striped", full_width = F, position = "float_left") %>%
    column_spec(2, bold = T) %>%
    column_spec(1, bold = T, color = "yellow", background = "#FF0000") %>%
    column_spec(6, bold = T, color = "white", background = "#777777")

Sharpest Shooters

Rank	Player	Pos	x3P.	FT.	Shoot.
1	Stephen Curry	PG	0.438	0.901	0.670
2	Steve Nash	PG	0.428	0.904	0.666
3	Kyle Korver	SG	0.431	0.880	0.656
4	Mark Price	PG	0.402	0.904	0.653
5	J.J. Redick	SG	0.415	0.888	0.652
6	Peja Stojakovic	SF	0.401	0.895	0.648
7	Ray Allen	SG	0.400	0.894	0.647
8	Jose Calderon	PG	0.409	0.875	0.642
8	Reggie Miller	SG	0.395	0.888	0.642
10	Chauncey Billups	PG	0.387	0.894	0.641
11	B.J. Armstrong	PG	0.425	0.856	0.640
11	Jeff Hornacek	SG	0.403	0.877	0.640
13	Klay Thompson	SG	0.419	0.853	0.636
14	Dana Barros	PG	0.411	0.858	0.634
15	Allan Houston	SG	0.402	0.863	0.633
15	Wally Szczerbiak	SF	0.406	0.860	0.633
17	Hersey Hawkins	SG	0.394	0.870	0.632
18	Dirk Nowitzki	PF	0.381	0.879	0.630
19	Ben Gordon	SG	0.401	0.857	0.629
20	Kyrie Irving	PG	0.383	0.873	0.628

SharpestShooters %>%
    ggplot(aes(x3P., FT., size = Shoot., color=Pos, label=Player)) +
    geom_point(shape=18) +
    geom_text(size=3, color="#000000", position = position_nudge(y = -0.002)) +
    scale_color_manual(values = c("#FFA500", "#DDDD00" ,"#0000FF", "#32CD32")) +
    ggtitle("Sharpest Shooters") +
    xlab("3P%") +
    ylab("FT%") +
    theme(legend.position='none')

---

End of Session

---