Import Dataset
library(readxl)
NBA <- read_excel("NBA 2022-23 Salary Data - Independent Project.xlsx")
## New names:
## • `` -> `...1`
Clean Data
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
NBA_clean <- NBA %>%
rename(
FG_pct = `FG%`,
X3P_pct = `3P%`,
X2P_pct = `2P%`,
FT_pct = `FT%`,
TS_pct = `TS%`,
ORB_pct = `ORB%`,
DRB_pct = `DRB%`,
STL_pct = `STL%`,
BLK_pct = `BLK%`
)
Summary Statistics
library(dplyr)
# Define the variables
variables <- c("FG_pct", "X3P_pct", "X2P_pct", "FT_pct", "TS_pct", "ORB_pct", "DRB_pct", "STL_pct", "BLK_pct")
# Create an empty data frame to store the results
results <- data.frame(
variable = character(),
n = integer(),
mean = numeric(),
sd = numeric(),
min = numeric(),
p25 = numeric(),
median = numeric(),
p75 = numeric(),
max = numeric(),
stringsAsFactors = FALSE
)
# Loop through each variable and calculate the statistics
for (var in variables) {
stats <- c(
var,
sum(!is.na(NBA_clean[[var]])),
mean(NBA_clean[[var]], na.rm = TRUE),
sd(NBA_clean[[var]], na.rm = TRUE),
min(NBA_clean[[var]], na.rm = TRUE),
quantile(NBA_clean[[var]], 0.25, na.rm = TRUE),
median(NBA_clean[[var]], na.rm = TRUE),
quantile(NBA_clean[[var]], 0.75, na.rm = TRUE),
max(NBA_clean[[var]], na.rm = TRUE)
)
# Add the statistics to the results data frame
results <- rbind(results, stats)
}
# Rename the columns
colnames(results) <- c("variable", "n", "mean", "sd", "min", "p25", "median", "p75", "max")
# Print the results
print(results)
## variable n mean sd min p25 median p75
## 1 FG_pct 466 0.465008583690987 0.109546749147304 0 0.417 0.455 0.5075
## 2 X3P_pct 454 0.325090308370044 0.131624250278105 0 0.288 0.3445 0.387
## 3 X2P_pct 463 0.533464362850972 0.136046331250516 0 0.487 0.537 0.5945
## 4 FT_pct 444 0.753488738738739 0.148659145812224 0 0.691 0.769 0.844
## 5 TS_pct 466 0.563023605150215 0.100740940416532 0 0.524 0.567 0.61
## 6 ORB_pct 467 5.24346895074946 4.3322544112627 0 2.1 3.8 7.1
## 7 DRB_pct 467 14.8845824411135 6.47809266185433 0 10.7 13.5 18.35
## 8 STL_pct 467 1.52355460385439 1.36886038513293 0 1 1.4 1.7
## 9 BLK_pct 467 1.8321199143469 2.52433571820543 0 0.7 1.2 2.35
## max
## 1 1
## 2 1
## 3 1
## 4 1
## 5 1.064
## 6 28.8
## 7 55.4
## 8 24.2
## 9 44.1
NBA_clean <- NBA %>%
rename(
FG_pct = `FG%`,
X3P_pct = `3P%`,
X2P_pct = `2P%`,
FT_pct = `FT%`,
TS_pct = `TS%`,
ORB_pct = `ORB%`,
DRB_pct = `DRB%`,
STL_pct = `STL%`,
BLK_pct = `BLK%`
)
Visuals
# Load necessary libraries for plotting
library(ggplot2)
# Histogram for FG%
ggplot(NBA_clean, aes(x = FG_pct)) +
geom_histogram(binwidth = 0.05, fill = "skyblue", color = "black", alpha = 0.7) +
labs(title = "Histogram of Field Goal Percentage (FG%)", x = "FG%", y = "Frequency")
## Warning: Removed 1 row containing non-finite outside the scale range
## (`stat_bin()`).
# Histogram for 3P%
ggplot(NBA_clean, aes(x = X3P_pct)) +
geom_histogram(binwidth = 0.05, fill = "lightgreen", color = "black", alpha = 0.7) +
labs(title = "Histogram of Three-Point Percentage (3P%)", x = "3P%", y = "Frequency")
## Warning: Removed 13 rows containing non-finite outside the scale range
## (`stat_bin()`).
# Histogram for TS%
ggplot(NBA_clean, aes(x = TS_pct)) +
geom_histogram(binwidth = 0.05, fill = "lightcoral", color = "black", alpha = 0.7) +
labs(title = "Histogram of True Shooting Percentage (TS%)", x = "TS%", y = "Frequency")
## Warning: Removed 1 row containing non-finite outside the scale range
## (`stat_bin()`).
# Boxplot of TS% by Position
ggplot(NBA_clean, aes(x = Position, y = TS_pct)) +
geom_boxplot(fill = "lightblue", color = "black") +
labs(title = "Boxplot of TS% by Position", x = "Position", y = "True Shooting Percentage")
## Warning: Removed 1 row containing non-finite outside the scale range
## (`stat_boxplot()`).
# Boxplot of FG% by Position
ggplot(NBA_clean, aes(x = Position, y = FG_pct)) +
geom_boxplot(fill = "lightgreen", color = "black") +
labs(title = "Boxplot of FG% by Position", x = "Position", y = "Field Goal Percentage")
## Warning: Removed 1 row containing non-finite outside the scale range
## (`stat_boxplot()`).
# Density Plot of TS%
ggplot(NBA_clean, aes(x = TS_pct)) +
geom_density(fill = "purple", alpha = 0.6) +
labs(title = "Density Plot of TS%", x = "True Shooting Percentage", y = "Density")
## Warning: Removed 1 row containing non-finite outside the scale range
## (`stat_density()`).
Dummy Variable Mutate - Position
NBA_clean <- NBA_clean %>%
mutate(PG_dummy = ifelse(grepl("PG", Position), 1, 0))
# Create dummy variables for Position using model.matrix()
dummy_vars <- model.matrix(~ Position - 1, data = NBA_clean) # -1 removes the intercept column
head(dummy_vars)
## PositionC PositionPF PositionPG PositionPG-SG PositionSF PositionSF-PF
## 1 0 0 1 0 0 0
## 2 0 0 1 0 0 0
## 3 0 0 1 0 0 0
## 4 0 1 0 0 0 0
## 5 0 1 0 0 0 0
## 6 0 0 0 0 0 0
## PositionSF-SG PositionSG PositionSG-PG
## 1 0 0 0
## 2 0 0 0
## 3 0 0 0
## 4 0 0 0
## 5 0 0 0
## 6 0 1 0
# Replace hyphens with underscores to split hybrid positions
NBA_clean$Position <- gsub("-", "_", NBA_clean$Position)
# Convert Position into a factor after replacing hyphens with underscores
model <- lm(Salary ~ factor(Position) * TS_pct, data = NBA_clean)
summary(model)
##
## Call:
## lm(formula = Salary ~ factor(Position) * TS_pct, data = NBA_clean)
##
## Residuals:
## Min 1Q Median 3Q Max
## -16682287 -6084663 -3418626 2295531 37245871
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.609e+06 8.882e+06 -0.294 0.7691
## factor(Position)PF 3.646e+06 1.078e+07 0.338 0.7352
## factor(Position)PG -1.377e+07 1.106e+07 -1.245 0.2139
## factor(Position)PG_SG -7.093e+09 2.981e+09 -2.379 0.0178 *
## factor(Position)SF 4.448e+06 1.007e+07 0.442 0.6590
## factor(Position)SF_PF -3.671e+06 1.041e+07 -0.353 0.7246
## factor(Position)SF_SG -2.409e+08 2.382e+08 -1.011 0.3124
## factor(Position)SG -3.564e+06 1.157e+07 -0.308 0.7581
## factor(Position)SG_PG -6.161e+07 2.079e+08 -0.296 0.7671
## TS_pct 1.603e+07 1.428e+07 1.122 0.2624
## factor(Position)PF:TS_pct -2.287e+06 1.773e+07 -0.129 0.8974
## factor(Position)PG:TS_pct 3.714e+07 1.888e+07 1.968 0.0497 *
## factor(Position)PG_SG:TS_pct 1.162e+10 4.875e+09 2.384 0.0175 *
## factor(Position)SF:TS_pct -4.531e+06 1.660e+07 -0.273 0.7850
## factor(Position)SF_PF:TS_pct NA NA NA NA
## factor(Position)SF_SG:TS_pct 4.331e+08 4.181e+08 1.036 0.3008
## factor(Position)SG:TS_pct 7.429e+06 1.955e+07 0.380 0.7041
## factor(Position)SG_PG:TS_pct 1.301e+08 3.753e+08 0.347 0.7290
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 10340000 on 449 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.1003, Adjusted R-squared: 0.06819
## F-statistic: 3.127 on 16 and 449 DF, p-value: 4.479e-05
Dummy Statistics Table
library(dplyr)
# Summary statistics by position (cross-section)
summary_table <- NBA_clean %>%
group_by(Position) %>%
summarise(
count = n(),
mean_TS_pct = mean(TS_pct, na.rm = TRUE),
sd_TS_pct = sd(TS_pct, na.rm = TRUE),
mean_Salary = mean(Salary, na.rm = TRUE),
sd_Salary = sd(Salary, na.rm = TRUE)
)
# View the summary table
print(summary_table)
## # A tibble: 9 × 6
## Position count mean_TS_pct sd_TS_pct mean_Salary sd_Salary
## <chr> <int> <dbl> <dbl> <dbl> <dbl>
## 1 C 91 0.617 0.0763 7282722. 8983558.
## 2 PF 86 0.571 0.107 8885045. 10897789.
## 3 PG 77 0.526 0.0961 11579573. 13889342.
## 4 PG_SG 2 0.611 0.00212 21458528. 24690088.
## 5 SF 91 0.547 0.129 8132253. 11055604.
## 6 SF_PF 1 0.579 NA 3000000 NA
## 7 SF_SG 2 0.570 0.0247 12239763 11116054.
## 8 SG 115 0.550 0.0729 6681301. 8308597.
## 9 SG_PG 2 0.554 0.0276 16650807 4029367.
Dummy Summary Statistics?
NBA_clean %>%
group_by(PG_dummy) %>%
summarise(across(
c(FG_pct, X3P_pct, X2P_pct, FT_pct, TS_pct, ORB_pct, DRB_pct, STL_pct, BLK_pct),
list(
n = ~sum(!is.na(.)),
mean = ~mean(., na.rm = TRUE),
sd = ~sd(., na.rm = TRUE),
min = ~min(., na.rm = TRUE),
p25 = ~quantile(., 0.25, na.rm = TRUE),
median = ~median(., na.rm = TRUE),
p75 = ~quantile(., 0.75, na.rm = TRUE),
max = ~max(., na.rm = TRUE)
),
.names = "{.col}_{.fn}"
))
## FG% 3P% 2P% FT%
## Min. :0.0000 Min. :0.0000 Min. :0.0000 Min. :0.0000
## 1st Qu.:0.4170 1st Qu.:0.2880 1st Qu.:0.4870 1st Qu.:0.6910
## Median :0.4550 Median :0.3445 Median :0.5370 Median :0.7690
## Mean :0.4650 Mean :0.3251 Mean :0.5335 Mean :0.7535
## 3rd Qu.:0.5075 3rd Qu.:0.3870 3rd Qu.:0.5945 3rd Qu.:0.8440
## Max. :1.0000 Max. :1.0000 Max. :1.0000 Max. :1.0000
## NA's :1 NA's :13 NA's :4 NA's :23
## TS% ORB% DRB% STL%
## Min. :0.000 Min. : 0.000 Min. : 0.00 Min. : 0.000
## 1st Qu.:0.524 1st Qu.: 2.100 1st Qu.:10.70 1st Qu.: 1.000
## Median :0.567 Median : 3.800 Median :13.50 Median : 1.400
## Mean :0.563 Mean : 5.243 Mean :14.88 Mean : 1.524
## 3rd Qu.:0.610 3rd Qu.: 7.100 3rd Qu.:18.35 3rd Qu.: 1.700
## Max. :1.064 Max. :28.800 Max. :55.40 Max. :24.200
## NA's :1
## BLK% Position
## Min. : 0.000 Length:467
## 1st Qu.: 0.700 Class :character
## Median : 1.200 Mode :character
## Mean : 1.832
## 3rd Qu.: 2.350
## Max. :44.100
##
NBA %>%
count(Position) %>%
arrange(desc(n))
Model 1
# Run the regression model
model1 <- lm(log(Salary) ~ FG_pct + X3P_pct + X2P_pct + FT_pct + TS_pct, data = NBA_clean)
# View regression summary
summary(model1)
##
## Call:
## lm(formula = log(Salary) ~ FG_pct + X3P_pct + X2P_pct + FT_pct +
## TS_pct, data = NBA_clean)
##
## Residuals:
## Min 1Q Median 3Q Max
## -7.0569 -0.7697 0.0658 1.0265 2.7434
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 12.58889 0.65061 19.349 < 2e-16 ***
## FG_pct 3.74117 2.15987 1.732 0.08397 .
## X3P_pct 0.54887 0.70586 0.778 0.43725
## X2P_pct -0.91744 0.93726 -0.979 0.32821
## FT_pct 1.60896 0.59654 2.697 0.00727 **
## TS_pct -0.05345 2.50499 -0.021 0.98299
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.428 on 427 degrees of freedom
## (34 observations deleted due to missingness)
## Multiple R-squared: 0.04677, Adjusted R-squared: 0.03561
## F-statistic: 4.191 on 5 and 427 DF, p-value: 0.0009952
Model 2
# Expanded regression model with rebounding and defensive metrics
model2 <- lm(log(Salary) ~ FG_pct + X3P_pct + X2P_pct + FT_pct + TS_pct +
ORB_pct + DRB_pct + STL_pct + BLK_pct,
data = NBA_clean)
# View model 2 summary
summary(model2)
##
## Call:
## lm(formula = log(Salary) ~ FG_pct + X3P_pct + X2P_pct + FT_pct +
## TS_pct + ORB_pct + DRB_pct + STL_pct + BLK_pct, data = NBA_clean)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6.4452 -0.7203 0.1708 0.9214 2.5618
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 12.46866 0.69409 17.964 < 2e-16 ***
## FG_pct 7.24099 2.39354 3.025 0.002636 **
## X3P_pct -0.29452 0.71243 -0.413 0.679522
## X2P_pct -1.46659 0.92770 -1.581 0.114650
## FT_pct 1.47923 0.58458 2.530 0.011755 *
## TS_pct -1.78091 2.51831 -0.707 0.479842
## ORB_pct -0.12683 0.02764 -4.588 5.91e-06 ***
## DRB_pct 0.05211 0.01527 3.412 0.000708 ***
## STL_pct 0.06441 0.09544 0.675 0.500107
## BLK_pct -0.04669 0.05669 -0.824 0.410673
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.387 on 423 degrees of freedom
## (34 observations deleted due to missingness)
## Multiple R-squared: 0.1082, Adjusted R-squared: 0.08927
## F-statistic: 5.705 on 9 and 423 DF, p-value: 1.766e-07
Model 3
# Make sure Position is treated as a categorical variable
NBA_clean$Position <- as.factor(NBA_clean$Position)
# Model 3: Include position and its interaction with performance metrics
model3 <- lm(log(Salary) ~ FG_pct + X3P_pct + X2P_pct + FT_pct + TS_pct +
ORB_pct + DRB_pct + STL_pct + BLK_pct + Position,
data = NBA_clean)
# Example: including interaction between Position and TS_pct
model3_interaction <- lm(log(Salary) ~ FG_pct + X3P_pct + X2P_pct + FT_pct + TS_pct +
ORB_pct + DRB_pct + STL_pct + BLK_pct +
Position * TS_pct,
data = NBA_clean)
summary(model3) # Or summary(model3_interaction) for the version with interaction
##
## Call:
## lm(formula = log(Salary) ~ FG_pct + X3P_pct + X2P_pct + FT_pct +
## TS_pct + ORB_pct + DRB_pct + STL_pct + BLK_pct + Position,
## data = NBA_clean)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6.4781 -0.6820 0.1322 0.9817 2.6163
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 12.67354 0.81692 15.514 < 2e-16 ***
## FG_pct 7.45252 2.43873 3.056 0.00239 **
## X3P_pct -0.24576 0.71279 -0.345 0.73043
## X2P_pct -1.65959 0.95038 -1.746 0.08151 .
## FT_pct 1.55359 0.58672 2.648 0.00841 **
## TS_pct -1.90815 2.53341 -0.753 0.45176
## ORB_pct -0.13123 0.03058 -4.292 2.21e-05 ***
## DRB_pct 0.04829 0.01632 2.958 0.00327 **
## STL_pct 0.07738 0.10048 0.770 0.44170
## BLK_pct -0.06281 0.05968 -1.053 0.29317
## PositionPF -0.02821 0.26120 -0.108 0.91405
## PositionPG -0.03392 0.35222 -0.096 0.92333
## PositionPG_SG 0.80893 1.02505 0.789 0.43047
## PositionSF -0.05907 0.30421 -0.194 0.84613
## PositionSF_PF -0.53190 1.40985 -0.377 0.70616
## PositionSF_SG 0.73417 1.02983 0.713 0.47631
## PositionSG -0.40514 0.31922 -1.269 0.20509
## PositionSG_PG 1.31510 1.02591 1.282 0.20060
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.386 on 415 degrees of freedom
## (34 observations deleted due to missingness)
## Multiple R-squared: 0.1272, Adjusted R-squared: 0.0915
## F-statistic: 3.559 on 17 and 415 DF, p-value: 2.712e-06
summary(model3_interaction)
##
## Call:
## lm(formula = log(Salary) ~ FG_pct + X3P_pct + X2P_pct + FT_pct +
## TS_pct + ORB_pct + DRB_pct + STL_pct + BLK_pct + Position *
## TS_pct, data = NBA_clean)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6.3055 -0.6682 0.0720 0.9388 2.6614
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 14.49125 1.33823 10.829 < 2e-16 ***
## FG_pct 7.67139 2.46371 3.114 0.00198 **
## X3P_pct -0.28380 0.71364 -0.398 0.69108
## X2P_pct -1.91425 0.95904 -1.996 0.04660 *
## FT_pct 1.23117 0.60439 2.037 0.04229 *
## TS_pct -4.32340 3.27025 -1.322 0.18690
## ORB_pct -0.13188 0.03062 -4.307 2.08e-05 ***
## DRB_pct 0.04620 0.01643 2.812 0.00516 **
## STL_pct 0.09230 0.10201 0.905 0.36607
## BLK_pct -0.07171 0.06053 -1.185 0.23683
## PositionPF -0.87197 1.80805 -0.482 0.62987
## PositionPG -5.33226 2.04017 -2.614 0.00929 **
## PositionPG_SG -385.93769 399.30468 -0.967 0.33435
## PositionSF -2.89270 1.81794 -1.591 0.11234
## PositionSF_PF -0.60849 1.40567 -0.433 0.66533
## PositionSF_SG -16.87729 32.04857 -0.527 0.59875
## PositionSG -1.24898 1.69644 -0.736 0.46201
## PositionSG_PG 2.44243 27.81545 0.088 0.93007
## TS_pct:PositionPF 1.27857 3.05250 0.419 0.67554
## TS_pct:PositionPG 9.41064 3.56767 2.638 0.00866 **
## TS_pct:PositionPG_SG 632.45709 652.97318 0.969 0.33333
## TS_pct:PositionSF 4.84007 3.14689 1.538 0.12481
## TS_pct:PositionSF_PF NA NA NA NA
## TS_pct:PositionSF_SG 30.68907 56.21705 0.546 0.58543
## TS_pct:PositionSG 1.22761 2.94226 0.417 0.67673
## TS_pct:PositionSG_PG -2.33604 50.22195 -0.047 0.96292
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.381 on 408 degrees of freedom
## (34 observations deleted due to missingness)
## Multiple R-squared: 0.1477, Adjusted R-squared: 0.09756
## F-statistic: 2.946 on 24 and 408 DF, p-value: 6.323e-06
Models Summary
library(modelsummary)
modelsummary(
list("Model 1" = model1, "Model 2" = model2, "Model 3" = model3),
output = "gt", # Opens a pretty table in the Viewer pane
title = "Regression Results: Determinants of Log Salary",
statistic = c("({std.error})", "{p.value}"), # Show SE and p-values
stars = TRUE, # Adds significance stars
gof_omit = "AIC|BIC|Log.Lik|RMSE|Deviance", # Clean up extra stats
coef_rename = c(
"FG_pct" = "FG%",
"X3P_pct" = "3P%",
"TS_pct" = "TS%",
"ORB_pct" = "ORB%",
"DRB_pct" = "DRB%",
"STL_pct" = "STL%",
"BLK_pct" = "BLK%",
"positionF" = "Position: Forward",
"positionG" = "Position: Guard"
)
)
## Warning: Can't find generic `as.gtable` in package gtable to register S3 method.
## ℹ This message is only shown to developers using devtools.
## ℹ Do you need to update gtable to the latest version?
Regression Results: Determinants of Log Salary
| |
Model 1 |
Model 2 |
Model 3 |
| (Intercept) |
12.589*** |
12.469*** |
12.674*** |
|
(0.651) |
(0.694) |
(0.817) |
|
<0.001 |
<0.001 |
<0.001 |
| FG% |
3.741+ |
7.241** |
7.453** |
|
(2.160) |
(2.394) |
(2.439) |
|
0.084 |
0.003 |
0.002 |
| 3P% |
0.549 |
-0.295 |
-0.246 |
|
(0.706) |
(0.712) |
(0.713) |
|
0.437 |
0.680 |
0.730 |
| X2P_pct |
-0.917 |
-1.467 |
-1.660+ |
|
(0.937) |
(0.928) |
(0.950) |
|
0.328 |
0.115 |
0.082 |
| FT_pct |
1.609** |
1.479* |
1.554** |
|
(0.597) |
(0.585) |
(0.587) |
|
0.007 |
0.012 |
0.008 |
| TS% |
-0.053 |
-1.781 |
-1.908 |
|
(2.505) |
(2.518) |
(2.533) |
|
0.983 |
0.480 |
0.452 |
| ORB% |
|
-0.127*** |
-0.131*** |
|
|
(0.028) |
(0.031) |
|
|
<0.001 |
<0.001 |
| DRB% |
|
0.052*** |
0.048** |
|
|
(0.015) |
(0.016) |
|
|
<0.001 |
0.003 |
| STL% |
|
0.064 |
0.077 |
|
|
(0.095) |
(0.100) |
|
|
0.500 |
0.442 |
| BLK% |
|
-0.047 |
-0.063 |
|
|
(0.057) |
(0.060) |
|
|
0.411 |
0.293 |
| PositionPF |
|
|
-0.028 |
|
|
|
(0.261) |
|
|
|
0.914 |
| PositionPG |
|
|
-0.034 |
|
|
|
(0.352) |
|
|
|
0.923 |
| PositionPG_SG |
|
|
0.809 |
|
|
|
(1.025) |
|
|
|
0.430 |
| PositionSF |
|
|
-0.059 |
|
|
|
(0.304) |
|
|
|
0.846 |
| PositionSF_PF |
|
|
-0.532 |
|
|
|
(1.410) |
|
|
|
0.706 |
| PositionSF_SG |
|
|
0.734 |
|
|
|
(1.030) |
|
|
|
0.476 |
| PositionSG |
|
|
-0.405 |
|
|
|
(0.319) |
|
|
|
0.205 |
| PositionSG_PG |
|
|
1.315 |
|
|
|
(1.026) |
|
|
|
0.201 |
| Num.Obs. |
433 |
433 |
433 |
| R2 |
0.047 |
0.108 |
0.127 |
| R2 Adj. |
0.036 |
0.089 |
0.091 |
| F |
4.191 |
5.705 |
3.559 |
| + p < 0.1, * p < 0.05, ** p < 0.01, *** p < 0.001 |
Outlier Test - Model 1
# Filter to complete cases used in model1
NBA_model1_data <- NBA_clean[complete.cases(NBA_clean[, c("Salary", "FG_pct", "X3P_pct", "X2P_pct", "FT_pct", "TS_pct")]), ]
# Refit the model on this data
model1 <- lm(log(Salary) ~ FG_pct + X3P_pct + X2P_pct + FT_pct + TS_pct, data = NBA_model1_data)
# Calculate studentized residuals
NBA_model1_data$stud_resid <- rstudent(model1)
# Show the top 10 absolute outliers
NBA_model1_data %>%
arrange(desc(abs(stud_resid))) %>%
select(Salary, stud_resid) %>%
head(10)
Comparison - R^2 and Coefficients
NBA_no_outliers <- NBA_model1_data %>% filter(abs(stud_resid) <= 3)
# Re-run model
model1_no_outliers <- lm(log(Salary) ~ FG_pct + X3P_pct + X2P_pct + FT_pct + TS_pct, data = NBA_no_outliers)
summary(model1_no_outliers)
##
## Call:
## lm(formula = log(Salary) ~ FG_pct + X3P_pct + X2P_pct + FT_pct +
## TS_pct, data = NBA_no_outliers)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.3435 -0.8489 0.0601 0.9147 2.7978
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 11.3220 0.5948 19.035 < 2e-16 ***
## FG_pct 2.5174 1.9331 1.302 0.193543
## X3P_pct 0.9245 0.6429 1.438 0.151136
## X2P_pct -1.0784 0.8536 -1.263 0.207207
## FT_pct 1.9028 0.5304 3.587 0.000374 ***
## TS_pct 2.9018 2.2555 1.287 0.198974
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.253 on 419 degrees of freedom
## Multiple R-squared: 0.1144, Adjusted R-squared: 0.1038
## F-statistic: 10.82 on 5 and 419 DF, p-value: 8.337e-10
Robustness Checks
# Run Ramsey RESET test for model specification
library(AER)
## Loading required package: car
## Loading required package: carData
##
## Attaching package: 'car'
## The following object is masked from 'package:dplyr':
##
## recode
## Loading required package: lmtest
## Loading required package: zoo
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
## Loading required package: sandwich
## Loading required package: survival
reset_test_model1 <- resettest(model1)
reset_test_model2 <- resettest(model2)
reset_test_model3 <- resettest(model3)
# Print RESET test results
print(reset_test_model1)
##
## RESET test
##
## data: model1
## RESET = 22.397, df1 = 2, df2 = 425, p-value = 5.652e-10
print(reset_test_model2)
##
## RESET test
##
## data: model2
## RESET = 13.614, df1 = 2, df2 = 421, p-value = 1.866e-06
print(reset_test_model3)
##
## RESET test
##
## data: model3
## RESET = 6.7181, df1 = 2, df2 = 413, p-value = 0.001345
plot(model$fitted.values, model$residuals)
abline(h = 0, col = "red")
Multicoliniearity
library(car)
# For model1
vif(model1)
## FG_pct X3P_pct X2P_pct FT_pct TS_pct
## 6.985771 1.595839 2.058965 1.399115 6.821114
# For model2
vif(model2)
## FG_pct X3P_pct X2P_pct FT_pct TS_pct ORB_pct DRB_pct STL_pct
## 9.084527 1.721436 2.136026 1.422780 7.299971 2.532740 1.727078 1.068789
## BLK_pct
## 1.644400
# For model3
vif(model3)
## GVIF Df GVIF^(1/(2*Df))
## FG_pct 9.453949 1 3.074727
## X3P_pct 1.727398 1 1.314305
## X2P_pct 2.247225 1 1.499075
## FT_pct 1.436700 1 1.198624
## TS_pct 7.405893 1 2.721377
## ORB_pct 3.106087 1 1.762409
## DRB_pct 1.977576 1 1.406263
## STL_pct 1.187517 1 1.089732
## BLK_pct 1.826562 1 1.351504
## Position 3.636224 8 1.084028
Heteroskatdasity
library(lmtest)
# Breusch-Pagan test for heteroskedasticity
bptest(model1)
##
## studentized Breusch-Pagan test
##
## data: model1
## BP = 19.5, df = 5, p-value = 0.00155
bptest(model2)
##
## studentized Breusch-Pagan test
##
## data: model2
## BP = 21.318, df = 9, p-value = 0.01131
bptest(model3)
##
## studentized Breusch-Pagan test
##
## data: model3
## BP = 29.738, df = 17, p-value = 0.0283
Shapiro
# Q-Q plot
qqnorm(residuals(model1)); qqline(residuals(model1), col = "red")
# Shapiro-Wilk test
shapiro.test(residuals(model1))
##
## Shapiro-Wilk normality test
##
## data: residuals(model1)
## W = 0.95312, p-value = 1.714e-10
shapiro.test(residuals(model2))
##
## Shapiro-Wilk normality test
##
## data: residuals(model2)
## W = 0.93792, p-value = 1.844e-12
shapiro.test(residuals(model3))
##
## Shapiro-Wilk normality test
##
## data: residuals(model3)
## W = 0.93981, p-value = 3.107e-12