Project 1: Wrangling, Exploration, Visualization

Data Wrangling, Exploration, Visualization

Name: Viren Velacheri, EID: vv6898

Introduction

Paragraph or two introducing your datasets and variables, why they are interesting to you, etc.

I am a big sports lover and one of my favorite sports is basketball. I played competitively through middle school and was a part of the school team and still play it today as a side hobby. In basketball, there are various metrics/stats used to evaluate players and teams.

The 1st dataset and 2nd dataset come from the websites https://www.nbastuffer.com/2020-2021-nba-player-stats/ and https://www.basketball-reference.com/leagues/NBA_2021_advanced.html respectively. The 1st dataset contains common stats related to all the eligible players such as shooting percentages, rebounds, minutes played per game, etc. It also contains a couple of advanced metrics such as true shooting percentage which takes into account some of the basic stats like free throw shooting and three point percentage as an attempt to more accurately portray how good a player is compared to their fellow peers.The 2nd dataset contains some common variables such as the players and number of games played, but instead of some of the basic statistics that make up the majority of the 1st set, this dataset contains more advanced metrics such as win shares, box plus/minus, etc. I found these datasets through the usual google search and the reason these specific datasets stood out to me, as implied above, is because of the different metrics of data they contained. I am a basketball lover and look forward to exploring these datasets! I expect there to be some obvious associations between some of the metrics such as points scored and PER, but my goal is to more look at by position and see potentially if these advanced metrics tend to favor certain positions over others.

library(tidyverse)
library(stringi)
# read your datasets in here, e.g., with read_csv()
dataset_1 <- read_csv("polished_1st_dataset.csv")
dataset_2 <- read_csv("polished_2nd_dataset.csv")

# Due to difference in first dataset not using accent marks
# and other dataset using accent marks for name, I used this
# function to keep them all the same.  That way there are no
# discrepancies in that regard
dataset_1$Player <- stri_trans_general(str = dataset_1$Player, 
    id = "Latin-ASCII")
dataset_2$Player <- stri_trans_general(str = dataset_2$Player, 
    id = "Latin-ASCII")

Tidying: Reshaping

If your datasets are tidy already, demonstrate that you can reshape data with pivot wider/longer here (e.g., untidy and then retidy). Alternatively, it may be easier to wait until the wrangling section so you can reshape your summary statistics. Note here if you are going to do this.

My datasets are already tidy enough, but I do the reshaping with pivot_wider() in the wrangling section when I am doing the group_by stuff and calling the summarize functions

# your tidying code (if applicable; can also wait until
# wrangling section)

Joining/Merging

# your joining code Merged datasets together
merged_dataset <- full_join(dataset_1, dataset_2, by = "Player")

dataset1_rows <- nrow(dataset_1)
dataset1_rows  # 626 rows/observations in first dataset

## [1] 626

dataset2_rows <- nrow(dataset_2)
dataset2_rows  # 705 rows/observations in second dataset

## [1] 705

# Number of unique ids/players in respective datasets
dataset1_uniqueIds <- dataset_1 %>% summarize_all(n_distinct) %>% 
    select(Player)
dataset1_uniqueIds

## # A tibble: 1 x 1
##   Player
##    <int>
## 1    540

dataset2_uniqueIds <- dataset_2 %>% summarize_all(n_distinct) %>% 
    select(Player)
dataset2_uniqueIds

## # A tibble: 1 x 1
##   Player
##    <int>
## 1    540

# Number of players in first dataset but not other and vice
# versa It is 17 each
setdiff(dataset_1$Player, dataset_2$Player)

##  [1] "Marcus Morris Sr."    "Lonnie Walker IV"     "Otto Porter Jr."     
##  [4] "Danuel House Jr."     "JJ Redick"            "James Ennis III"     
##  [7] "Robert Williams III"  "Juancho Hernangomez"  "Xavier Tillman"      
## [10] "Frank Mason"          "Charlie Brown Jr."    "Kevin Knox II"       
## [13] "Harry Giles III"      "Wes Iwundu"           "Marcos Louzada Silva"
## [16] "Robert Woodard II"    "Brian Bowen II"

setdiff(dataset_2$Player, dataset_1$Player)

##  [1] "Brian Bowen"        "Charlie Brown"      "James Ennis"       
##  [4] "Harry Giles"        "Juan Hernangomez"   "Danuel House"      
##  [7] "Wesley Iwundu"      "Kevin Knox"         "Didi Louzada"      
## [10] "Frank Mason III"    "Marcus Morris"      "Otto Porter"       
## [13] "J.J. Redick"        "Xavier Tillman Sr." "Lonnie Walker"     
## [16] "Robert Williams"    "Robert Woodard"

# Number of rows in merged dataset is 988
merged_dataset_nrow <- nrow(merged_dataset)
merged_dataset_nrow

## [1] 988

# These are some of the variables the datasets had in common
# that I decided to remove
cols_removed_dataset <- merged_dataset %>% select(-"USG%.x") %>% 
    select(-"Games Played.x") %>% select(-"TO%.x") %>% select(-"TS%.x") %>% 
    select(-"TRB%.x") %>% select(-"AST%.x")

# After columns removed, renamed some of the existing columns
# to better names
renamed_dataset <- cols_removed_dataset %>% rename(TS = "TS%.y") %>% 
    rename(TRB = "TRB%.y") %>% rename(AST = "AST%.y") %>% rename(TO = "TO%.y") %>% 
    rename(USG = "USG%.y") %>% rename(Games_Played = "Games Played.y") %>% 
    rename(EFG = "eFG%")

# Number of rows dropped when join happened is 343.
num_rows_dropped <- nrow(dataset_1) + nrow(dataset_2) - nrow(renamed_dataset)
# I then decided to remove any rows that still had NAs so
# this dropped an additional 94 rows
renamed_dataset <- renamed_dataset %>% na.omit
renamed_dataset_nrow <- nrow(renamed_dataset)
renamed_dataset_nrow

## [1] 894

# your joining code

Discussions of joining here. Feel encouraged to break up into more than once code chunk and discuss each in turn.

I did a full join by the common variable in both datasets, Player, as all these other surrounding metrics and statistics in the datasets related to the individual players and I wanted to retain all of the original data in both sets and not lose/drop anything as the more data the better.

In the first dataset, there are 626 total observations/rows, while in the second one there are 705 observations/rows. They each have 540 unique IDs.

In the first dataset, these 17 unique Ids/Players do not exist in the second dataset: “Marcus Morris Sr.” “Lonnie Walker IV” “Otto Porter Jr.” “Danuel House Jr.” “JJ Redick” “James Ennis III” “Robert Williams III” “Juancho Hernangomez” “Xavier Tillman” “Frank Mason” “Charlie Brown Jr.” “Kevin Knox II” “Harry Giles III” “Wes Iwundu” “Marcos Louzada Silva” “Robert Woodard II” “Brian Bowen II”

In the second dataset, these 17 unique Ids/Players do not exist in the first dataset: “Brian Bowen” “Charlie Brown” “James Ennis” “Harry Giles” “Juan Hernangomez” “Danuel House” “Wesley Iwundu” “Kevin Knox” “Didi Louzada” “Frank Mason III” “Marcus Morris” “Otto Porter” “J.J. Redick” “Xavier Tillman Sr.” “Lonnie Walker” “Robert Williams” “Robert Woodard”

It appears that this is due to specifications in the names of the players. For example, Robert Williams is mentioned in both datasets, but in the first one it was more specific as it says “Robert Williams III” instead of just “Robert Williams”. This can be manually edited as it appears that this is the case for only these 17 or so names.

In the merged dataset, there are 988 rows and 343 rows/observations were dropped. I decided to also drop any rows that had any NA values, so the merged dataset was reduced to 894 rows and/or 94 additional rows were dropped. Potential problems could be that due to this, there is less data to analyze and results might be less comprehensive. In this case though, I don’t believe this should be much of a problem as there are still 894 rows/observations worth of data to look at which should be plenty.

Wrangling

# your wrangling code

# summary statistics for numeric variables (mean, sd, var, n,
# quantile, min, max, n_distinct, cor, etc)

# Overall statistics for some of the numeric variables of
# interest
knitr::kable(renamed_dataset %>% summarize(Mean = mean(VORP, 
    na.rm = TRUE), Standard_Deviation = sd(VORP, na.rm = TRUE), 
    Variance = var(VORP, na.rm = TRUE), `25%_Quantile` = quantile(VORP, 
        0.25, na.rm = TRUE), `50%_Quantile` = quantile(VORP, 
        0.5, na.rm = TRUE), `75%_Quantile` = quantile(VORP, 0.75, 
        na.rm = TRUE), Minimum = min(VORP, na.rm = TRUE), Maximum = max(VORP, 
        na.rm = TRUE), Num_Distinct = n_distinct(VORP, na.rm = TRUE)) %>% 
    na.omit, caption = "Value Over Replacement Player Stats")

Value Over Replacement Player Stats
Mean	Standard_Deviation	Variance	25%_Quantile	50%_Quantile	75%_Quantile	Minimum	Maximum	Num_Distinct
0.3081655	0.9153356	0.8378392	-0.1	0	0.4	-1.6	8.6	57

knitr::kable(renamed_dataset %>% summarize(Mean = mean(VI, na.rm = TRUE), 
    Standard_Deviation = sd(VI, na.rm = TRUE), Variance = var(VI, 
        na.rm = TRUE), `25%_Quantile` = quantile(VI, 0.25, na.rm = TRUE), 
    `50%_Quantile` = quantile(VI, 0.5, na.rm = TRUE), `75%_Quantile` = quantile(VI, 
        0.75, na.rm = TRUE), Minimum = min(VI, na.rm = TRUE), 
    Maximum = max(VI, na.rm = TRUE), Num_Distinct = n_distinct(VI, 
        na.rm = TRUE)) %>% na.omit, caption = "Versatility Index Stats")

Versatility Index Stats
Mean	Standard_Deviation	Variance	25%_Quantile	50%_Quantile	75%_Quantile	Minimum	Maximum	Num_Distinct
7.027741	2.198246	4.832287	5.7	6.9	8.2	0	15.8	94

knitr::kable(renamed_dataset %>% summarize(Mean = mean(PER, na.rm = TRUE), 
    Standard_Deviation = sd(PER, na.rm = TRUE), Variance = var(PER, 
        na.rm = TRUE), `25%_Quantile` = quantile(PER, 0.25, na.rm = TRUE), 
    `50%_Quantile` = quantile(PER, 0.5, na.rm = TRUE), `75%_Quantile` = quantile(PER, 
        0.75, na.rm = TRUE), Minimum = min(PER, na.rm = TRUE), 
    Maximum = max(PER, na.rm = TRUE), Num_Distinct = n_distinct(PER, 
        na.rm = TRUE)) %>% na.omit, caption = "Player Efficiency Rating Stats")

Player Efficiency Rating Stats
Mean	Standard_Deviation	Variance	25%_Quantile	50%_Quantile	75%_Quantile	Minimum	Maximum	Num_Distinct
12.96007	5.677235	32.231	9.725	12.75	16.3	-40.6	31.3	213

knitr::kable(renamed_dataset %>% summarize(Mean = mean(TS, na.rm = TRUE), 
    Standard_Deviation = sd(TS, na.rm = TRUE), Variance = var(TS, 
        na.rm = TRUE), `25%_Quantile` = quantile(TS, 0.25, na.rm = TRUE), 
    `50%_Quantile` = quantile(TS, 0.5, na.rm = TRUE), `75%_Quantile` = quantile(TS, 
        0.75, na.rm = TRUE), Minimum = min(TS, na.rm = TRUE), 
    Maximum = max(TS, na.rm = TRUE), Num_Distinct = n_distinct(TS, 
        na.rm = TRUE)) %>% na.omit, caption = "True Shooting Percentage Stats")

True Shooting Percentage Stats
Mean	Standard_Deviation	Variance	25%_Quantile	50%_Quantile	75%_Quantile	Minimum	Maximum	Num_Distinct
0.5461443	0.0951927	0.0090616	0.50925	0.549	0.597	0	1.078	264

knitr::kable(renamed_dataset %>% summarize(Mean = mean(EFG, na.rm = TRUE), 
    Standard_Deviation = sd(EFG, na.rm = TRUE), Variance = var(EFG, 
        na.rm = TRUE), `25%_Quantile` = quantile(EFG, 0.25, na.rm = TRUE), 
    `50%_Quantile` = quantile(EFG, 0.5, na.rm = TRUE), `75%_Quantile` = quantile(EFG, 
        0.75, na.rm = TRUE), Minimum = min(EFG, na.rm = TRUE), 
    Maximum = max(EFG, na.rm = TRUE), Num_Distinct = n_distinct(EFG, 
        na.rm = TRUE)) %>% na.omit, caption = "Effective Field Goal Percentage Stats")

Effective Field Goal Percentage Stats
Mean	Standard_Deviation	Variance	25%_Quantile	50%_Quantile	75%_Quantile	Minimum	Maximum	Num_Distinct
0.5134553	0.1089446	0.0118689	0.476	0.519	0.565	0	1	241

knitr::kable(renamed_dataset %>% summarize(Mean = mean(BPM, na.rm = TRUE), 
    Standard_Deviation = sd(BPM, na.rm = TRUE), Variance = var(BPM, 
        na.rm = TRUE), `25%_Quantile` = quantile(BPM, 0.25, na.rm = TRUE), 
    `50%_Quantile` = quantile(BPM, 0.5, na.rm = TRUE), `75%_Quantile` = quantile(BPM, 
        0.75, na.rm = TRUE), Minimum = min(BPM, na.rm = TRUE), 
    Maximum = max(BPM, na.rm = TRUE), Num_Distinct = n_distinct(BPM, 
        na.rm = TRUE)) %>% na.omit, caption = "BPM Summary Stats")

BPM Summary Stats
Mean	Standard_Deviation	Variance	25%_Quantile	50%_Quantile	75%_Quantile	Minimum	Maximum	Num_Distinct
-1.881544	3.921949	15.38169	-3.8	-1.55	0.4	-47.1	11.7	156

knitr::kable(renamed_dataset %>% summarize(Mean = mean(WS, na.rm = TRUE), 
    Standard_Deviation = sd(WS, na.rm = TRUE), Variance = var(WS, 
        na.rm = TRUE), `25%_Quantile` = quantile(WS, 0.25, na.rm = TRUE), 
    `50%_Quantile` = quantile(WS, 0.5, na.rm = TRUE), `75%_Quantile` = quantile(WS, 
        0.75, na.rm = TRUE), Minimum = min(WS, na.rm = TRUE), 
    Maximum = max(WS, na.rm = TRUE), Num_Distinct = n_distinct(WS, 
        na.rm = TRUE)) %>% na.omit, caption = "Win Share Summary Stats")

Win Share Summary Stats
Mean	Standard_Deviation	Variance	25%_Quantile	50%_Quantile	75%_Quantile	Minimum	Maximum	Num_Distinct
1.586242	2.004212	4.016865	0.2	0.8	2.3	-1.9	15.6	97

# Statistics calculated after grouping and other functions

knitr::kable(renamed_dataset %>% group_by(Pos) %>% pivot_wider() %>% 
    summarize(Mean = mean(VORP, na.rm = TRUE), Standard_Deviation = sd(VORP, 
        na.rm = TRUE), Variance = var(VORP, na.rm = TRUE), `25%_Quantile` = quantile(VORP, 
        0.25, na.rm = TRUE), `50%_Quantile` = quantile(VORP, 
        0.5, na.rm = TRUE), `75%_Quantile` = quantile(VORP, 0.75, 
        na.rm = TRUE), Minimum = min(VORP, na.rm = TRUE), Maximum = max(VORP, 
        na.rm = TRUE), Num_Distinct = n_distinct(VORP, na.rm = TRUE)) %>% 
    na.omit %>% filter(Mean >= 0) %>% arrange(desc(Mean)), caption = "Top VORP Positions")

Top VORP Positions
Pos	Mean	Standard_Deviation	Variance	25%_Quantile	50%_Quantile	75%_Quantile	Minimum	Maximum	Num_Distinct
PG-SG	3.5000000	0.0000000	0.0000000	3.50	3.50	3.500	3.5	3.5	1
C-PF	0.9000000	0.8082904	0.6533333	0.20	0.90	1.600	0.2	1.6	2
PF-C	0.9000000	0.0000000	0.0000000	0.90	0.90	0.900	0.9	0.9	1
SG-SF	0.5500000	0.7505553	0.5633333	-0.10	0.55	1.200	-0.1	1.2	2
SG-PG	0.5000000	0.9674709	0.9360000	-0.25	0.20	1.325	-0.4	1.7	3
C	0.4826531	0.9840810	0.9684155	0.00	0.20	0.600	-0.7	8.6	31
PG	0.4519231	1.1167621	1.2471576	-0.10	0.00	0.600	-1.4	5.5	36
SF-SG	0.3500000	0.7505553	0.5633333	-0.30	0.35	1.000	-0.3	1.0	2
PF	0.2405714	0.8709288	0.7585169	-0.10	0.00	0.300	-1.1	5.5	31
SF	0.2060150	0.8853829	0.7839029	-0.20	0.00	0.300	-1.2	4.2	34
SG	0.1181373	0.6114784	0.3739059	-0.20	0.00	0.300	-1.6	2.9	32

knitr::kable(renamed_dataset %>% group_by(Team, Pos) %>% pivot_wider() %>% 
    summarize(Mean = mean(VI, na.rm = TRUE), Standard_Deviation = sd(VI, 
        na.rm = TRUE), Variance = var(VI, na.rm = TRUE), `25%_Quantile` = quantile(VI, 
        0.25, na.rm = TRUE), `50%_Quantile` = quantile(VI, 0.5, 
        na.rm = TRUE), `75%_Quantile` = quantile(VI, 0.75, na.rm = TRUE), 
        Minimum = min(VI, na.rm = TRUE), Maximum = max(VI, na.rm = TRUE), 
        Num_Distinct = n_distinct(VI, na.rm = TRUE)) %>% na.omit %>% 
    arrange(desc(Mean)) %>% slice(1:2), caption = "Top 2 Versatile Positions by Team")

Top 2 Versatile Positions by Team
Team	Pos	Mean	Standard_Deviation	Variance	25%_Quantile	50%_Quantile	75%_Quantile	Minimum	Maximum	Num_Distinct
Atl	PG	7.833333	2.0426698	4.1725000	7.900	7.90	8.100	3.5	11.6	5
Atl	SG	6.725000	1.3696107	1.8758333	6.225	7.15	7.650	4.8	7.8	4
Bos	SF	7.533333	2.7061658	7.3233333	6.050	6.90	8.700	5.2	10.5	3
Bos	PG	7.000000	1.5885003	2.5233333	6.400	6.40	8.150	4.4	9.1	5
Bro	PG	10.180000	2.5820534	6.6670000	8.900	9.50	10.500	7.6	14.4	5
Bro	SG	7.933333	4.5080484	20.3225000	5.200	8.30	11.200	0.0	14.4	7
Cha	PG	8.140000	1.9099738	3.6480000	7.100	7.10	7.900	7.1	11.5	3
Cha	SG	7.900000	0.7071068	0.5000000	7.650	7.90	8.150	7.4	8.4	2
Chi	C	8.925000	2.3339880	5.4475000	7.600	8.85	10.025	5.0	12.2	6
Chi	PG	7.150000	1.3279056	1.7633333	6.675	7.30	7.775	5.4	8.6	4
Cle	C	9.153333	3.0236843	9.1426667	8.000	9.10	11.200	0.0	11.8	7
Cle	PG	7.577778	1.3470132	1.8144444	7.700	7.90	8.600	4.4	8.6	5
Dal	PG	8.325000	4.4138985	19.4825000	5.275	6.95	10.000	4.9	14.5	4
Dal	C	7.575000	1.2284814	1.5091667	6.900	7.85	8.525	6.0	8.6	4
Den	C	8.500000	3.0463092	9.2800000	7.200	7.50	7.500	7.2	15.4	3
Den	SF	6.900000	0.1414214	0.0200000	6.850	6.90	6.950	6.8	7.0	2
Det	PG	8.292308	0.8873758	0.7874359	8.500	8.50	8.500	5.8	9.0	5
Det	C	7.700000	2.4758837	6.1300000	6.300	6.80	8.650	5.8	10.5	3
Gol	PF	8.240000	1.7784825	3.1630000	7.200	7.80	9.700	6.1	10.4	5
Gol	PG	7.257143	2.3222526	5.3928571	6.650	6.80	7.400	4.1	11.8	5
Hou	PG	9.500000	1.5165751	2.3000000	8.600	8.60	9.600	8.6	12.1	3
Hou	C	8.442857	4.2149959	17.7661905	7.300	11.10	11.100	0.0	11.2	5
Ind	SG	8.390000	1.6861857	2.8432222	7.675	9.40	9.400	5.3	9.4	4
Ind	PG	8.366667	2.1939310	4.8133333	7.500	9.10	9.600	5.9	10.1	3
Lac	SF	9.500000	2.6851443	7.2100000	8.700	11.00	11.050	6.4	11.1	3
Lac	C	9.066667	1.3530213	1.8306667	8.125	9.50	10.200	7.1	10.2	4
Lal	PG	10.400000	4.6669048	21.7800000	8.750	10.40	12.050	7.1	13.7	2
Lal	PF	6.625000	2.4716728	6.1091667	5.250	6.15	7.525	4.2	10.0	4
Mem	PG	8.250000	1.4708274	2.1633333	7.775	8.20	8.675	6.5	10.1	3
Mem	C	8.016667	1.8486932	3.4176667	7.825	8.50	8.500	4.7	10.3	4
Mia	C	8.925000	2.0694202	4.2825000	7.400	8.50	10.025	7.1	11.6	4
Mia	PG	7.066667	1.4843629	2.2033333	6.250	6.70	7.700	5.8	8.7	3
Mil	PG	7.257143	1.3125765	1.7228571	6.100	7.60	7.600	6.1	9.7	3
Mil	C	6.900000	2.4041631	5.7800000	6.050	6.90	7.750	5.2	8.6	2
Min	C	8.933333	3.1564748	9.9633333	7.150	7.80	10.150	6.5	12.5	3
Min	PG	8.466667	0.9712535	0.9433333	8.050	8.70	9.000	7.4	9.3	3
Nor	SF	7.975000	1.5521490	2.4091667	7.275	8.10	8.800	6.0	9.7	4
Nor	C	7.566667	1.0263203	1.0533333	7.000	7.30	8.000	6.7	8.7	3
Nyk	PF	7.900000	3.6428011	13.2700000	5.800	6.00	9.050	5.6	12.1	3
Nyk	PG	6.944444	1.5740959	2.4777778	5.600	7.50	8.500	4.6	8.5	5
Okc	SG	7.940000	1.7643696	3.1130000	6.600	8.00	8.900	5.9	10.3	5
Okc	PF	7.620000	0.4024922	0.1620000	7.300	7.60	7.800	7.2	8.2	5
Orl	C	8.035714	2.4101092	5.8086264	6.075	7.30	8.375	6.0	12.1	5
Orl	PF	7.570000	1.9476767	3.7934444	6.575	6.80	9.600	4.7	10.1	6
Phi	C	9.080000	1.7020576	2.8970000	8.200	8.20	8.700	8.2	12.1	3
Phi	PG	7.300000	2.1679483	4.7000000	6.000	6.00	7.500	6.0	11.0	3
Pho	PG	8.933333	2.2722969	5.1633333	7.900	9.30	10.150	6.5	11.0	3
Pho	SG	7.066667	1.7953644	3.2233333	6.050	6.40	7.750	5.7	9.1	3
Por	C	10.300000	2.2627417	5.1200000	9.500	10.30	11.100	8.7	11.9	2
Por	PF	5.900000	1.4628739	2.1400000	5.500	5.70	6.500	3.9	7.9	5
Sac	PG	7.485714	1.3018302	1.6947619	6.300	7.70	8.000	6.3	9.8	5
Sac	C	7.357143	0.4961759	0.2461905	7.000	7.00	7.700	7.0	8.1	4
San	C	8.050000	0.8124038	0.6600000	7.300	7.75	9.000	7.3	9.0	4
San	PF	7.650000	1.9226718	3.6966667	6.525	7.35	8.475	5.7	10.2	4
Tor	PG	8.850000	1.6263456	2.6450000	8.275	8.85	9.425	7.7	10.0	2
Tor	PF	7.775000	2.6247222	6.8891667	5.875	8.05	9.950	4.9	10.1	4
Uta	PG	9.000000	1.4177447	2.0100000	8.450	9.50	9.800	7.4	10.1	3
Uta	C	7.500000	0.9899495	0.9800000	7.150	7.50	7.850	6.8	8.2	2
Was	PG	9.325000	4.4191817	19.5291667	6.550	7.55	10.325	6.4	15.8	4
Was	C	6.757143	2.0364805	4.1472527	6.600	7.40	7.875	0.0	8.0	7

knitr::kable(renamed_dataset %>% group_by(Pos) %>% pivot_wider() %>% 
    summarize(Mean = mean(PER, na.rm = TRUE), Standard_Deviation = sd(PER, 
        na.rm = TRUE), Variance = var(PER, na.rm = TRUE), `25%_Quantile` = quantile(PER, 
        0.25, na.rm = TRUE), `50%_Quantile` = quantile(PER, 0.5, 
        na.rm = TRUE), `75%_Quantile` = quantile(PER, 0.75, na.rm = TRUE), 
        Minimum = min(PER, na.rm = TRUE), Maximum = max(PER, 
            na.rm = TRUE), Num_Distinct = n_distinct(PER, na.rm = TRUE)) %>% 
    na.omit %>% arrange(desc(Mean)) %>% slice(1:5) %>% select(Pos), 
    caption = "Top 5 PER Position Rankings")

Top 5 PER Position Rankings
Pos
PG-SG
PF-C
C
SG-SF
C-PF

knitr::kable(renamed_dataset %>% group_by(Pos) %>% pivot_wider() %>% 
    summarize(Mean = mean(TS, na.rm = TRUE), Standard_Deviation = sd(TS, 
        na.rm = TRUE), Variance = var(TS, na.rm = TRUE), `25%_Quantile` = quantile(TS, 
        0.25, na.rm = TRUE), `50%_Quantile` = quantile(TS, 0.5, 
        na.rm = TRUE), `75%_Quantile` = quantile(TS, 0.75, na.rm = TRUE), 
        Minimum = min(TS, na.rm = TRUE), Maximum = max(TS, na.rm = TRUE), 
        Num_Distinct = n_distinct(TS, na.rm = TRUE)) %>% na.omit %>% 
    arrange(desc(Mean)) %>% slice(1:5) %>% select(Pos), caption = "Top 5 True Shooting Position Rankings")

Top 5 True Shooting Position Rankings
Pos
PF-C
PG-SG
C
SG-SF
SF-SG

knitr::kable(renamed_dataset %>% group_by(Pos) %>% pivot_wider() %>% 
    summarize(Mean = mean(EFG, na.rm = TRUE), Standard_Deviation = sd(EFG, 
        na.rm = TRUE), Variance = var(EFG, na.rm = TRUE), `25%_Quantile` = quantile(EFG, 
        0.25, na.rm = TRUE), `50%_Quantile` = quantile(EFG, 0.5, 
        na.rm = TRUE), `75%_Quantile` = quantile(EFG, 0.75, na.rm = TRUE), 
        Minimum = min(EFG, na.rm = TRUE), Maximum = max(EFG, 
            na.rm = TRUE), Num_Distinct = n_distinct(EFG, na.rm = TRUE)) %>% 
    na.omit %>% arrange(desc(Mean)) %>% slice(1:5) %>% select(Pos), 
    caption = "Top 5 Effective Field Goal Percentage Position Rankings")

Top 5 Effective Field Goal Percentage Position Rankings
Pos
PF-C
C
PG-SG
SF-SG
SG-SF

knitr::kable(renamed_dataset %>% group_by(Pos) %>% pivot_wider() %>% 
    summarize(Mean = mean(BPM, na.rm = TRUE), Standard_Deviation = sd(BPM, 
        na.rm = TRUE), Variance = var(BPM, na.rm = TRUE), `25%_Quantile` = quantile(BPM, 
        0.25, na.rm = TRUE), `50%_Quantile` = quantile(BPM, 0.5, 
        na.rm = TRUE), `75%_Quantile` = quantile(BPM, 0.75, na.rm = TRUE), 
        Minimum = min(BPM, na.rm = TRUE), Maximum = max(BPM, 
            na.rm = TRUE), Num_Distinct = n_distinct(BPM, na.rm = TRUE)) %>% 
    na.omit %>% arrange(desc(Mean)) %>% slice(1:5) %>% select(Pos), 
    caption = "Top 5 BPM Position Rankings")

Top 5 BPM Position Rankings
Pos
PG-SG
PF-C
C-PF
SG-PG
SF-SG

knitr::kable(renamed_dataset %>% group_by(Pos) %>% pivot_wider() %>% 
    summarize(Mean = mean(WS, na.rm = TRUE), Standard_Deviation = sd(WS, 
        na.rm = TRUE), Variance = var(WS, na.rm = TRUE), `25%_Quantile` = quantile(WS, 
        0.25, na.rm = TRUE), `50%_Quantile` = quantile(WS, 0.5, 
        na.rm = TRUE), `75%_Quantile` = quantile(WS, 0.75, na.rm = TRUE), 
        Minimum = min(WS, na.rm = TRUE), Maximum = max(WS, na.rm = TRUE), 
        Num_Distinct = n_distinct(WS, na.rm = TRUE)) %>% na.omit %>% 
    arrange(desc(Mean)) %>% slice(1:5) %>% select(Pos), caption = "Top 5 Win Share Position Rankings")

Top 5 Win Share Position Rankings
Pos
PG-SG
PF-C
SG-SF
C-PF
C

BPM_WS_Metric_Added <- renamed_dataset %>% mutate(BPM_WS_Metric_Avg = (BPM + 
    WS)/2)

knitr::kable(BPM_WS_Metric_Added %>% group_by(Pos) %>% summarize(Mean = mean(BPM_WS_Metric_Avg, 
    na.rm = TRUE), Standard_Deviation = sd(BPM_WS_Metric_Avg, 
    na.rm = TRUE), Variance = var(BPM_WS_Metric_Avg, na.rm = TRUE), 
    `25%_Quantile` = quantile(BPM_WS_Metric_Avg, 0.25, na.rm = TRUE), 
    `50%_Quantile` = quantile(BPM_WS_Metric_Avg, 0.5, na.rm = TRUE), 
    `75%_Quantile` = quantile(BPM_WS_Metric_Avg, 0.75, na.rm = TRUE), 
    Minimum = min(BPM_WS_Metric_Avg, na.rm = TRUE), Maximum = max(BPM_WS_Metric_Avg, 
        na.rm = TRUE), Num_Distinct = n_distinct(BPM_WS_Metric_Avg, 
        na.rm = TRUE)) %>% na.omit %>% arrange(desc(Mean)) %>% 
    slice(1:5) %>% select(Pos), caption = "Top 5 BPM WS Average Position Rankings")

Top 5 BPM WS Average Position Rankings
Pos
PG-SG
PF-C
C-PF
SG-SF
C

BPM_WS_VORP_calculation <- function(BPM, WS, VORP) {
    return(mean((BPM + WS + VORP * 2)/3))
}

knitr::kable(BPM_WS_Metric_Added %>% group_by(Pos) %>% summarize(BPM_WS_VORP = BPM_WS_VORP_calculation(BPM, 
    WS, VORP)) %>% na.omit %>% arrange(desc(BPM_WS_VORP)) %>% 
    slice(1:5), caption = "Top 5 BPM WS Average Position Rankings")

Top 5 BPM WS Average Position Rankings
Pos	BPM_WS_VORP
PG-SG	6.9333333
PF-C	2.6000000
C-PF	1.8500000
SG-SF	1.0500000
C	0.7268707

knitr::kable(renamed_dataset %>% group_by(Player) %>% filter(str_detect(Pos, 
    ".*G")) %>% summarize(Mean = mean(WS, na.rm = TRUE), Standard_Deviation = sd(WS, 
    na.rm = TRUE), Variance = var(WS, na.rm = TRUE), `25%_Quantile` = quantile(WS, 
    0.25, na.rm = TRUE), `50%_Quantile` = quantile(WS, 0.5, na.rm = TRUE), 
    `75%_Quantile` = quantile(WS, 0.75, na.rm = TRUE), Minimum = min(WS, 
        na.rm = TRUE), Maximum = max(WS, na.rm = TRUE), Num_Distinct = n_distinct(WS, 
        na.rm = TRUE)) %>% na.omit %>% arrange(desc(Mean)) %>% 
    slice(1:5), caption = "Top 5 Win Share Guards")

Top 5 Win Share Guards
Player	Mean	Standard_Deviation	Variance	25%_Quantile	50%_Quantile	75%_Quantile	Minimum	Maximum	Num_Distinct
James Harden	4.666667	2.8751812	8.2666667	2.25	6.00	6.750	1.0	7.0	3
Norman Powell	3.950000	0.8660254	0.7500000	3.20	3.95	4.700	3.2	4.7	2
Delon Wright	2.833333	1.3426342	1.8026667	1.70	2.90	3.950	1.3	4.3	3
Derrick Rose	2.100000	1.3236314	1.7520000	1.00	2.80	3.025	0.4	3.1	3
Evan Fournier	1.950000	0.9814955	0.9633333	1.10	1.95	2.800	1.1	2.8	2

# Categorical Variables
knitr::kable(renamed_dataset %>% group_by(Team) %>% summarize(num_players = n()))

Team	num_players
Atl	22
Bos	35
Bro	42
Cha	16
Chi	39
Cle	43
Dal	20
Den	34
Det	37
Gol	22
Hou	59
Ind	22
Lac	28
Lal	24
Mem	19
Mia	33
Mil	36
Min	14
Nor	23
Nyk	24
Okc	31
Orl	51
Phi	32
Pho	21
Por	22
Sac	38
San	20
Tor	36
Uta	17
Was	34

knitr::kable(renamed_dataset %>% group_by(Pos) %>% summarize(num_times = n()))

Pos	num_times
C	196
C-PF	4
PF	175
PF-C	2
PF-SF	4
PG	156
PG-SG	2
SF	133
SF-PF	4
SF-SG	4
SG	204
SG-PG	6
SG-SF	4

na_count <- function(x) {
    na_vector = is.na(x)
    sum(na_vector)
}

knitr::kable(renamed_dataset %>% summarize_all(na_count))

Player	Team	MPG	MIN%	FTA	FT%	2PA	2P%	3PA	3P%	EFG	PPG	RPG	APG	SPG	BPG	TOPG	VI	ORTG	DRTG	Pos	Age	Games_Played	Total Minutes Played	PER	TS	3PAr	FTr	ORB%	DRB%	TRB	AST	STL%	BLK%	TO	USG	OWS	DWS	WS	WS/48	OBPM	DBPM	BPM	VORP
0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0

For tidying, my datasets and merged dataset were already tidy enough, so I just used the pivot_wider() method in the different summarizations that involved the group_by method and the other respective dplr functions. Since my data was already rearranged properly there wasn’t really much change, but that is what proved to my that my dataset was already tidied enough in the wide manner.

Your discussion of wrangling section here. Feel encouraged to break up into more than once code chunk and discuss each in turn.

I decided to compute the summary statistics for the numeric variables that involved the advanced metrics such as PER, VORP, VI, EFG, TS, BPM, and WS. From there, did a similar thing with all these variables except I grouped by Position except for Versatility Index (VI) where I grouped by both Position and Player. I then created a new metric that took both BPM and WS, averaged them together, and then use that in getting summary statistics. I also made up this function to use in summary function that takes in BPM, WS, and VORP and uses this formula I came up with: (BPM + WS + VORP * 2)/ 3). Lastly, at the very end, I did summarization of win shares based on grouping by players, but filtered such that only the guards were taken into consideration. As far as findings go, there were some interesting/surprising things that stood out. It turns out that Power forwards or centers have a better true shooting percentage on average than the guards. This surprised me as I thought that due to the 3 point shot, the guards would have the overall edge in True shooting percentage, but that was not the case. As far as the impact metrics such as PER and BPM that attempt to capture a player’s overall impact on the game, it appears that these metrics favored the guards, specifically, the PG-SG position. These metrics in general tended to favor the positions that were hybrids so to speak like PG-SG, PF-C, etc. I had not really thought of it that way before, but it makes sense as the versatility in the player’s game must play factor. Lastly, in terms of win shares amongst guards, it was not at all surprising seeing James Harden at the top, but the guards that followed such as Delon Wright and Norman Powell was very surprising to say the least. I thought Steph would for sure be in the top 5 in terms of win shares considering how good a player he is.

Visualizing

# your plot 1

library(ggplot2)

ggplot(renamed_dataset, aes(x = PER, y = BPM, color = Pos)) + 
    geom_point() + geom_smooth(method = "lm") + ggtitle("PER vs BPM") + 
    theme(plot.title = element_text(hjust = 0.5)) + xlab("PER") + 
    ylab("BPM") + scale_x_continuous(breaks = seq(-40, 35, 10))

Your discussion of plot 1

The plot appears to show that regardless of position, there seems to be a positive relationship/correlation between PER and BPM where the greater the PER, the greater the BPM and vice versa. Beyond that though it seems to show that PER and BPM vary differently for the different positional groupings. Some of the positional groupings, such as centers, seem to have greater PER and BPM values overall compared to the rest of the positional groupings. There are a couple of outliers here and there, but not too much.

# your plot 2

ggplot(renamed_dataset, aes(x = Pos, y = PER)) + geom_bar(stat = "summary", 
    fun = mean) + geom_errorbar(stat = "summary", fun.data = mean_se) + 
    scale_y_continuous(breaks = seq(0, 25, 2.5)) + ggtitle("Mean PER per Position") + 
    theme(plot.title = element_text(hjust = 0.5)) + xlab("Position") + 
    ylab("PER")

Your discussion of plot 2

The plot shows the mean PER for the different positions along with the mean standard error. This plot appears to show that there seems to be a wide disparity/difference between some of the positions in terms of average PER. For instance, PG-SG has the highest at close to 25, while PF-SF has the lowest around 7.5. This plot shows that there are some considerable differences in PER between the different positional groups in basketball.

# your plot 3
library(ggridges)

ggplot(renamed_dataset, aes(x = BPM, color = Pos)) + geom_density(alpha = 0.75) + 
    theme(legend.position = c(0.9, 0.8)) + geom_rug() + scale_x_continuous() + 
    ggtitle("BPM Density Plot") + theme(plot.title = element_text(hjust = 0.5)) + 
    xlab("BPM") + ylab("Density")

Your discussion of plot 3

This plot depicts the density distribution of BPM in relation to the positional groupings. Based on this plot, it seems that concrete differences exist between the different positional groups in basketball. For instance, the C-PF group appears to have BPM that is between 0 and 3, but the PF-SF group appears to be between mostly -2 and -5. This appears to be the case for most of these positional groupings and seems to be indicative that BPM appears to vary by positional group.

Concluding Remarks

Overall, it seems to me, based on the plots as well as my findings from the wrangling section that there are significant differences that exist in a lot of the advanced metrics such as BPM, PER, VORP, etc between each of the different positional groups. This was surprising as I thought prior that these advanced metrics would evaluate evenly all the players regardless of position. However, my results appear to indicate otherwise.

Team	num_players
Atl	22
Bos	35
Bro	42
Cha	16
Chi	39
Cle	43
Dal	20
Den	34
Det	37
Gol	22
Hou	59
Ind	22
Lac	28
Lal	24
Mem	19
Mia	33
Mil	36
Min	14
Nor	23
Nyk	24
Okc	31
Orl	51
Phi	32
Pho	21
Por	22
Sac	38
San	20
Tor	36
Uta	17
Was	34

Team	num_players
Atl	22
Bos	35
Bro	42
Cha	16
Chi	39
Cle	43
Dal	20
Den	34
Det	37
Gol	22
Hou	59
Ind	22
Lac	28
Lal	24
Mem	19
Mia	33
Mil	36
Min	14
Nor	23
Nyk	24
Okc	31
Orl	51
Phi	32
Pho	21
Por	22
Sac	38
San	20
Tor	36
Uta	17
Was	34