Final Project Sports Analytics
Exploratory Data Analysis
setwd("E:/S9510/CAP4936")
mlb_stats <- read.csv("MLB Players-hittingstats-ss.csv", header = TRUE)
#Data structure
str(mlb_stats)## 'data.frame': 47 obs. of 17 variables:
## $ Player : chr "Trea Turner" "Bo Bichette" "Amed Rosario" "Xander Bogaerts" ...
## $ Pos : chr "SS" "SS" "SS" "SS" ...
## $ Team : chr "LAD" "TOR" "CLE" "BOS" ...
## $ GS : int 160 158 151 148 161 133 148 151 129 138 ...
## $ AB : int 652 652 637 557 630 522 591 593 481 563 ...
## $ H : int 194 189 180 171 170 152 150 145 135 134 ...
## $ X2B : int 39 43 26 38 25 24 31 24 22 31 ...
## $ X3B : int 4 1 9 0 5 1 6 1 5 0 ...
## $ HR : int 21 24 11 15 26 22 20 33 10 31 ...
## $ RBI : int 100 93 71 73 107 64 80 83 55 98 ...
## $ AVG : num 0.298 0.29 0.283 0.307 0.27 0.291 0.254 0.245 0.281 0.238 ...
## $ OBP : num 0.343 0.333 0.312 0.377 0.339 0.366 0.294 0.317 0.327 0.298 ...
## $ SLG : num 0.466 0.469 0.403 0.456 0.449 0.467 0.428 0.455 0.41 0.458 ...
## $ OPS : num 0.809 0.802 0.715 0.833 0.788 0.834 0.722 0.772 0.736 0.756 ...
## $ WAR : num 4.84 3.44 3.95 5.42 5.4 5.55 1.05 4.04 4.5 4.42 ...
## $ Cash2023: chr "$27,272,727 " "$6,100,000 " "$7,800,000 " "$30,000,000 " ...
## $ Age : int 29 24 26 29 28 27 22 28 25 26 ...names(mlb_stats)## [1] "Player" "Pos" "Team" "GS" "AB" "H"
## [7] "X2B" "X3B" "HR" "RBI" "AVG" "OBP"
## [13] "SLG" "OPS" "WAR" "Cash2023" "Age"mlb_stats <- mlb_stats[ , -c(1,3)]
summary(mlb_stats)## Pos GS AB H
## Length :47 Min. : 7.00 Min. : 29.0 Min. : 7.00
## N.unique : 1 1st Qu.: 55.50 1st Qu.:204.5 1st Qu.: 41.00
## N.blank : 0 Median :100.00 Median :365.0 Median : 88.00
## Min.nchar: 2 Mean : 96.36 Mean :363.7 Mean : 91.34
## Max.nchar: 2 3rd Qu.:142.00 3rd Qu.:521.5 3rd Qu.:132.50
## Max. :161.00 Max. :652.0 Max. :194.00
## X2B X3B HR RBI
## Min. : 1.00 Min. :0.000 Min. : 1.000 Min. : 2.00
## 1st Qu.: 8.00 1st Qu.:0.000 1st Qu.: 4.000 1st Qu.: 18.50
## Median :19.00 Median :2.000 Median : 7.000 Median : 36.00
## Mean :17.45 Mean :1.936 Mean : 9.915 Mean : 42.32
## 3rd Qu.:25.00 3rd Qu.:3.000 3rd Qu.:14.500 3rd Qu.: 63.50
## Max. :43.00 Max. :9.000 Max. :33.000 Max. :107.00
## AVG OBP SLG OPS
## Min. :0.1570 Min. :0.2360 Min. :0.2620 Min. :0.5300
## 1st Qu.:0.2165 1st Qu.:0.2815 1st Qu.:0.3265 1st Qu.:0.6265
## Median :0.2450 Median :0.2990 Median :0.3860 Median :0.6910
## Mean :0.2449 Mean :0.3040 Mean :0.3830 Mean :0.6870
## 3rd Qu.:0.2705 3rd Qu.:0.3250 3rd Qu.:0.4265 3rd Qu.:0.7360
## Max. :0.3450 Max. :0.4410 Max. :0.5860 Max. :1.0270
## WAR Cash2023 Age
## Min. :-0.980 Length :47 Min. :20.00
## 1st Qu.: 0.255 N.unique :45 1st Qu.:24.00
## Median : 1.150 N.blank : 0 Median :26.00
## Mean : 1.819 Min.nchar: 9 Mean :26.21
## 3rd Qu.: 3.115 Max.nchar:12 3rd Qu.:28.00
## Max. : 5.550 Max. :35.00mlb_stats$Cash2023 <- as.numeric(gsub("[$, ]", "", mlb_stats$Cash2023))
mean(mlb_stats$Cash2023, na.rm = TRUE)## [1] 6855709var(mlb_stats$Cash2023, na.rm = TRUE)## [1] 9.35713e+13sd(mlb_stats$Cash2023, na.rm = TRUE)## [1] 9673226format(median(mlb_stats$Cash2023, na.rm = TRUE), scientific = FALSE)## [1] "2000000"min(mlb_stats$Cash2023, na.rm = TRUE)## [1] 410326format(max(mlb_stats$Cash2023, na.rm = TRUE), scientific = FALSE)## [1] "36000000"range(mlb_stats$Cash2023, na.rm = TRUE)## [1] 410326 36000000diff(range(mlb_stats$Cash2023, na.rm = TRUE))## [1] 35589674IQR(mlb_stats$Cash2023, na.rm = TRUE)## [1] 7525400quantile(mlb_stats$Cash2023, na.rm = TRUE)## 0% 25% 50% 75% 100%
## 410326 724600 2000000 8250000 36000000mlb_numeric <- mlb_stats[sapply(mlb_stats, is.numeric)]
cor(mlb_numeric)## GS AB H X2B X3B HR
## GS 1.0000000 0.9878832 0.9387030 0.8804607 0.366752978 0.7339877
## AB 0.9878832 1.0000000 0.9741364 0.9156261 0.389106791 0.7840134
## H 0.9387030 0.9741364 1.0000000 0.9356879 0.375379829 0.7724508
## X2B 0.8804607 0.9156261 0.9356879 1.0000000 0.293089007 0.7399494
## X3B 0.3667530 0.3891068 0.3753798 0.2930890 1.000000000 0.1576920
## HR 0.7339877 0.7840134 0.7724508 0.7399494 0.157692045 1.0000000
## RBI 0.8833421 0.9243508 0.9298298 0.8896238 0.315943566 0.8973054
## AVG 0.2527911 0.3350714 0.4999607 0.4540903 0.115910827 0.2808246
## OBP 0.1430023 0.1935521 0.3283211 0.2978383 0.001986825 0.2055263
## SLG 0.1628489 0.2577958 0.3830350 0.3966754 0.102071214 0.5288822
## OPS 0.1672546 0.2520635 0.3908039 0.3880660 0.069776549 0.4423801
## WAR 0.7585507 0.7838553 0.8122353 0.7383154 0.308012465 0.7154940
## Cash2023 0.4710708 0.5099290 0.5628422 0.4634702 0.030049924 0.6053461
## Age 0.2663626 0.2643532 0.2483782 0.2137952 -0.098017716 0.1988217
## RBI AVG OBP SLG OPS WAR
## GS 0.8833421 0.2527911 0.143002251 0.1628489 0.16725465 0.7585507
## AB 0.9243508 0.3350714 0.193552094 0.2577958 0.25206353 0.7838553
## H 0.9298298 0.4999607 0.328321103 0.3830350 0.39080388 0.8122353
## X2B 0.8896238 0.4540903 0.297838268 0.3966754 0.38806597 0.7383154
## X3B 0.3159436 0.1159108 0.001986825 0.1020712 0.06977655 0.3080125
## HR 0.8973054 0.2808246 0.205526332 0.5288822 0.44238007 0.7154940
## RBI 1.0000000 0.3961871 0.285046646 0.4542913 0.42255309 0.7653890
## AVG 0.3961871 1.0000000 0.807340495 0.7975364 0.86254468 0.4335819
## OBP 0.2850466 0.8073405 1.000000000 0.7032172 0.87380311 0.3843565
## SLG 0.4542913 0.7975364 0.703217214 1.0000000 0.96018521 0.4288262
## OPS 0.4225531 0.8625447 0.873803113 0.9601852 1.00000000 0.4439624
## WAR 0.7653890 0.4335819 0.384356543 0.4288262 0.44396237 1.0000000
## Cash2023 0.5789837 0.3434524 0.373311756 0.3875104 0.41241558 0.6341681
## Age 0.2358260 0.1043517 0.054119374 0.1016015 0.09065536 0.1841738
## Cash2023 Age
## GS 0.47107079 0.26636259
## AB 0.50992895 0.26435320
## H 0.56284220 0.24837822
## X2B 0.46347021 0.21379517
## X3B 0.03004992 -0.09801772
## HR 0.60534606 0.19882166
## RBI 0.57898374 0.23582598
## AVG 0.34345236 0.10435169
## OBP 0.37331176 0.05411937
## SLG 0.38751040 0.10160148
## OPS 0.41241558 0.09065536
## WAR 0.63416813 0.18417379
## Cash2023 1.00000000 0.44225191
## Age 0.44225191 1.00000000cash_cor <- cor(mlb_numeric)[, "Cash2023"]
cash_cor[abs(cash_cor) >= 0.5]## AB H HR RBI WAR Cash2023
## 0.5099290 0.5628422 0.6053461 0.5789837 0.6341681 1.0000000these four are the best candidates to build a strong predictive model around. HR and RBI are very likely correlated with each other (players who hit a lot of home runs also tend to drive in a lot of runs), and H is likely correlated with both too, since accumulating hits, RBIs, and home runs all partly reflect the same underlying thing: playing time and offensive production. WAR itself is even partially built from stats like these.
If pairs are correlating with each other at 0.7+, that’s multicollinearity, and including both in the same regression could make your coefficients unstable or misleading. In that case, it’s often better to pick just one or two representative predictors rather than throwing all four in together — WAR is a strong single choice since it already tries to summarize overall value in one number.
options(scipen = 999)
boxplot(mlb_stats$Cash2023, main="Boxplot of Salaries", ylab="Price ($)")
options(scipen = 999)
hist(mlb_stats$Cash2023, main = "Histogram of Player Prices", xlab = "Price ($)")
table(mlb_stats$Cash2023)##
## 410326 520429 536130 541940 632766 654193 661941 720000
## 1 1 1 1 1 1 1 1
## 720100 722000 723200 724200 725000 727600 730000 734500
## 1 1 1 1 1 1 1 1
## 738600 745750 754900 850000 950000 1800000 2000000 2525000
## 1 1 1 1 1 1 2 1
## 2662000 3000000 5000000 5585000 6000000 6100000 6500000 7000000
## 1 1 1 1 2 1 1 1
## 7800000 8700000 9000000 10000000 10250000 12500000 16000000 22000000
## 1 1 1 1 1 1 1 1
## 27000000 27272727 30000000 35000000 36000000
## 1 1 1 1 1# scatterplot
plot(x = mlb_stats$RBI, y = mlb_stats$Cash2023,
main = "Scatterplot of RBI vs. Salary",
xlab = "RBI",
ylab = "Price ($)")
Predictive Modeling
1.First we check correlations with Cash2023 variable to determine which of the variables moves together
mlb_numeric <- mlb_stats[sapply(mlb_stats, is.numeric)]
cor(mlb_numeric)[, "Cash2023"]## GS AB H X2B X3B HR RBI
## 0.47107079 0.50992895 0.56284220 0.46347021 0.03004992 0.60534606 0.57898374
## AVG OBP SLG OPS WAR Cash2023 Age
## 0.34345236 0.37331176 0.38751040 0.41241558 0.63416813 1.00000000 0.44225191- Check for multicollinearity among predictors
pairs(mlb_numeric[, c("WAR", "OPS", "HR", "RBI", "AVG", "OBP", "Age")])
If two predictors are highly correlated with each other (like AVG and
OBP are), keeping both adds little and can destabilize the model.
- Split into training and test sets
set.seed(123)
n <- nrow(mlb_stats)
train_idx <- sample(1:n, size = 0.8 * n)
train <- mlb_stats[train_idx, ]
test <- mlb_stats[-train_idx, ]- Build and compare model types
#install.packages("randomForest")
library(rpart)
library(randomForest)## randomForest 4.7-1.2## Type rfNews() to see new features/changes/bug fixes.# Linear Regression Model
lm_model <- lm(Cash2023 ~ WAR + HR + RBI + OPS + Age, data = train)
# Decision Tree Model
dt_model <- rpart(Cash2023 ~ WAR + HR + RBI + OPS + Age, data = train)
# Random Forest Model
rf_model <- randomForest(Cash2023 ~ WAR + HR + RBI + OPS + Age, data = train)Examine model results using summary function
summary(lm_model)##
## Call:
## lm(formula = Cash2023 ~ WAR + HR + RBI + OPS + Age, data = train)
##
## Residuals:
## Min 1Q Median 3Q Max
## -12393438 -3891187 -408537 3144577 15439094
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -26350099 12106598 -2.177 0.0373 *
## WAR 1591134 907658 1.753 0.0895 .
## HR 378137 287601 1.315 0.1982
## RBI -29542 98115 -0.301 0.7654
## OPS 7684229 12276780 0.626 0.5360
## Age 840146 330903 2.539 0.0164 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6552000 on 31 degrees of freedom
## Multiple R-squared: 0.5138, Adjusted R-squared: 0.4354
## F-statistic: 6.552 on 5 and 31 DF, p-value: 0.0002888round(summary(lm_model)$r.squared, 4) # R-squared## [1] 0.5138summary(dt_model)## Call:
## rpart(formula = Cash2023 ~ WAR + HR + RBI + OPS + Age, data = train)
## n= 37
##
## CP nsplit rel error xerror xstd
## 1 0.44128363 0 1.0000000 1.0458792 0.3919677
## 2 0.05757289 1 0.5587164 1.0168065 0.2512868
## 3 0.01000000 2 0.5011435 0.9568695 0.2410878
##
## Variable importance
## RBI HR OPS WAR Age
## 46 23 13 13 6
##
## Node number 1: 37 observations, complexity param=0.4412836
## mean=6225058, MSE=7.398353e+13
## left son=2 (29 obs) right son=3 (8 obs)
## Primary splits:
## RBI < 66.5 to the left, improve=0.4412836, (0 missing)
## Age < 27.5 to the left, improve=0.3793108, (0 missing)
## WAR < 2.64 to the left, improve=0.3685210, (0 missing)
## HR < 14.5 to the left, improve=0.2757077, (0 missing)
## OPS < 0.7485 to the left, improve=0.2233266, (0 missing)
## Surrogate splits:
## HR < 13 to the left, agree=0.892, adj=0.50, (0 split)
## WAR < 3.45 to the left, agree=0.838, adj=0.25, (0 split)
## OPS < 0.7535 to the left, agree=0.838, adj=0.25, (0 split)
##
## Node number 2: 29 observations, complexity param=0.05757289
## mean=3224013, MSE=1.253374e+13
## left son=4 (17 obs) right son=5 (12 obs)
## Primary splits:
## Age < 26.5 to the left, improve=0.43358700, (0 missing)
## WAR < 1.14 to the left, improve=0.16128850, (0 missing)
## HR < 2.5 to the left, improve=0.07882805, (0 missing)
## RBI < 24.5 to the left, improve=0.06942796, (0 missing)
## OPS < 0.6045 to the left, improve=0.04825745, (0 missing)
## Surrogate splits:
## WAR < 1.06 to the left, agree=0.69, adj=0.25, (0 split)
## OPS < 0.703 to the right, agree=0.69, adj=0.25, (0 split)
##
## Node number 3: 8 observations
## mean=1.710384e+07, MSE=1.457433e+14
##
## Node number 4: 17 observations
## mean=1265419, MSE=2.319694e+12
##
## Node number 5: 12 observations
## mean=5998689, MSE=1.387034e+13summary(rf_model)## Length Class Mode
## call 3 -none- call
## type 1 -none- character
## predicted 37 -none- numeric
## mse 500 -none- numeric
## rsq 500 -none- numeric
## oob.times 37 -none- numeric
## importance 5 -none- numeric
## importanceSD 0 -none- NULL
## localImportance 0 -none- NULL
## proximity 0 -none- NULL
## ntree 1 -none- numeric
## mtry 1 -none- numeric
## forest 11 -none- list
## coefs 0 -none- NULL
## y 37 -none- numeric
## test 0 -none- NULL
## inbag 0 -none- NULL
## terms 3 terms callWhichever has the lowest RMSE is the best-performing model on unseen data. RMSE matters more than R-squared alone, since R-squared only measures fit on training data.
# RMSE formula
rmse <- function(actual, predicted) sqrt(mean((actual - predicted)^2))
# Generate Predictions
lm_pred <- predict(lm_model, newdata = test)
cat("Linear Regression RMSE:", rmse(test$Cash2023, lm_pred), "\n")## Linear Regression RMSE: 7744438# Generate Predictions
dt_pred <- predict(dt_model, newdata = test)
cat("Decision Tree RMSE:", rmse(test$Cash2023, dt_pred), "\n")## Decision Tree RMSE: 11268091# Generate Predictions
rf_pred <- predict(rf_model, newdata = test)
cat("Random Forest RMSE:", rmse(test$Cash2023, rf_pred), "\n")## Random Forest RMSE: 8116095Linear Regression: $7,744,438 average prediction error Random Forest: $8,293,119 average prediction error Decision Tree: $11,268,091 average prediction error
Conclusion: The linear regression model’s predictions are, on average, about $7.7 million off from the actual salary and by that measure, the linear regression model performed best since it has the lowest RMSE
mape <- function(actual, predicted) mean(abs((actual - predicted) / actual)) * 100
lm_mape <- mape(test$Cash2023, lm_pred)
dt_mape <- mape(test$Cash2023, dt_pred)
rf_mape <- mape(test$Cash2023, rf_pred)
cat("Linear Regression MAPE:", lm_mape,"%\n")## Linear Regression MAPE: 217.175 %cat("Decision Tree MAPE:", dt_mape,"%\n")## Decision Tree MAPE: 159.4375 %cat("Random Forest MAPE:", rf_mape,"%\n")## Random Forest MAPE: 101.5946 %The model predicts a negative salary of -$5,346,806 for the player who actually made $722,000. This is a classic sign of linear regression extrapolating badly outside the range it was trained on, especially for low-salary/low-stat players.
results <- data.frame(
actual = test$Cash2023,
predicted = lm_pred,
pct_error = abs((test$Cash2023 - lm_pred) / test$Cash2023) * 100
)
results[order(-results$pct_error), ][1:10, ]Linear regression’s biggest weakness here isn’t randomness. MLB salary isn’t a smooth linear function of stats, especially at the low end where rookie contracts dominate. Performance-based regression works reasonably for veteran players but breaks down for rookie players.