Final Project Sports Analytics
Intro to Linear Regression: First Base hitting stats
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"#Turn the variable Cash2023 numeric
mlb_stats$Cash2023 <- as.numeric(gsub("[$, ]", "", mlb_stats$Cash2023))
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: num 27272727 6100000 7800000 30000000 27000000 ...
## $ Age : int 29 24 26 29 28 27 22 28 25 26 ...#Eliminating non-numeric columns
mlb_stats_num <- mlb_stats[sapply(mlb_stats, is.numeric)]
str(mlb_stats_num)## 'data.frame': 47 obs. of 14 variables:
## $ 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: num 27272727 6100000 7800000 30000000 27000000 ...
## $ Age : int 29 24 26 29 28 27 22 28 25 26 ...#mean
average <- mean(mlb_stats_num$Cash2023, na.rm = TRUE)
paste("average:", format(round(average, 0), scientific = FALSE, big.mark = ","))## [1] "average: 6,855,709"#variance
variance <- var(mlb_stats_num$Cash2023, na.rm = TRUE)
paste("variance:", format(round(variance, 0), scientific = FALSE, big.mark = ","))## [1] "variance: 93,571,304,657,024"#standard deviation
stdv <- sd(mlb_stats_num$Cash2023, na.rm = TRUE)
paste("standard deviation:", format(round(stdv, 0), scientific = FALSE, big.mark = ","))## [1] "standard deviation: 9,673,226"#median
median1 <- median(mlb_stats_num$Cash2023, na.rm = TRUE)
paste("median:", format(round(median1, 0), scientific = FALSE, big.mark = ","))## [1] "median: 2,000,000"#min number
minimum <- min(mlb_stats_num$Cash2023, na.rm = TRUE)
paste("minimum:", format(round(minimum, 0), scientific = FALSE, big.mark = ","))## [1] "minimum: 410,326"#max number
maximum <- max(mlb_stats_num$Cash2023, na.rm = TRUE)
paste("maximum:", format(round(maximum, 0), scientific = FALSE, big.mark = ","))## [1] "maximum: 36,000,000"#range of the numbers
range1 <- range(mlb_stats_num$Cash2023, na.rm = TRUE)
paste("range:", format(round(range1, 0), scientific = FALSE, big.mark = ","))## [1] "range: 410,326" "range: 36,000,000"#difference between max and min
difference <- diff(range(mlb_stats_num$Cash2023, na.rm = TRUE))
paste("difference:", format(round(difference, 0), scientific = FALSE, big.mark = ","))## [1] "difference: 35,589,674"#IQR
IQR1 <- IQR(mlb_stats_num$Cash2023, na.rm = TRUE)
paste("IQR:", format(round(IQR1, 0), scientific = FALSE, big.mark = ","))## [1] "IQR: 7,525,400"#quantile
quant <- quantile(mlb_stats_num$Cash2023, na.rm = TRUE)
paste("quantile:", format(round(quant, 0), scientific = FALSE, big.mark = ","))## [1] "quantile: 410,326" "quantile: 724,600" "quantile: 2,000,000"
## [4] "quantile: 8,250,000" "quantile: 36,000,000"names(mlb_stats_num)## [1] "GS" "AB" "H" "X2B" "X3B" "HR"
## [7] "RBI" "AVG" "OBP" "SLG" "OPS" "WAR"
## [13] "Cash2023" "Age"#correlation of the variables
cor(mlb_stats_num)## 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.00000000If pairs are correlating with each other at 0.7+, that’s multicollinearity, and including both in the same regression could make the 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.
#box plot chart
options(scipen = 999)
boxplot(mlb_stats_num$Cash2023, main="Boxplot of Salaries", ylab="Price ($)")
#histogram chart
options(scipen = 999)
hist(mlb_stats_num$Cash2023, main = "Histogram of Player Prices", xlab = "Price ($)")
#table
table(mlb_stats_num$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_num$HR, y = mlb_stats_num$Cash2023,
main = "Scatterplot of HR vs. Salary",
xlab = "HR",
ylab = "Price ($)")
#scatter plot against Cash2023
par(mfrow = c(3, 5))
for (col in names(mlb_stats_num)) {
if (col != "Cash2023") {
plot(mlb_stats_num[[col]], mlb_stats_num$Cash2023,
main = paste(col, "vs. Salary"),
xlab = col,
ylab = "Price ($)")
}
}
par(mfrow = c(1, 1)) 
Prediction Models
library(rpart)
library(randomForest)## randomForest 4.7-1.2## Type rfNews() to see new features/changes/bug fixes.- Check for multicollinearity among predictors
pairs(mlb_stats_num[, 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
#This is no longer needed with the new dataset provided for testing of the model
set.seed(123)
n <- nrow(mlb_stats_num)
train_idx <- sample(1:n, size = 0.8 * n)
train <- mlb_stats[train_idx, ]
test <- mlb_stats[-train_idx, ]- Choose the best model
Examine model results using summary function
Best Subset Selection
#install.packages("leaps", repos = "https://cran.r-project.org")
library(leaps)
#Best Subset Selection on the train dataset
best_subset <- regsubsets(Cash2023 ~ H + HR + RBI + WAR + AVG + OBP + SLG + OPS + Age + GS + AB + X2B + X3B,
data = mlb_stats_num, nvmax = 10) # max number of predictors to consider
summary(best_subset)## Subset selection object
## Call: regsubsets.formula(Cash2023 ~ H + HR + RBI + WAR + AVG + OBP +
## SLG + OPS + Age + GS + AB + X2B + X3B, data = mlb_stats_num,
## nvmax = 10)
## 13 Variables (and intercept)
## Forced in Forced out
## H FALSE FALSE
## HR FALSE FALSE
## RBI FALSE FALSE
## WAR FALSE FALSE
## AVG FALSE FALSE
## OBP FALSE FALSE
## SLG FALSE FALSE
## OPS FALSE FALSE
## Age FALSE FALSE
## GS FALSE FALSE
## AB FALSE FALSE
## X2B FALSE FALSE
## X3B FALSE FALSE
## 1 subsets of each size up to 10
## Selection Algorithm: exhaustive
## H HR RBI WAR AVG OBP SLG OPS Age GS AB X2B X3B
## 1 ( 1 ) " " " " " " "*" " " " " " " " " " " " " " " " " " "
## 2 ( 1 ) " " " " " " "*" " " " " " " " " "*" " " " " " " " "
## 3 ( 1 ) " " "*" " " "*" " " " " " " " " "*" " " " " " " " "
## 4 ( 1 ) " " "*" " " "*" " " " " " " " " "*" "*" " " " " " "
## 5 ( 1 ) "*" "*" " " "*" " " " " " " " " "*" " " "*" " " " "
## 6 ( 1 ) "*" "*" " " "*" " " " " "*" " " "*" " " "*" " " " "
## 7 ( 1 ) "*" "*" " " "*" " " " " "*" "*" "*" " " "*" " " " "
## 8 ( 1 ) "*" "*" " " "*" " " "*" "*" "*" "*" " " "*" " " " "
## 9 ( 1 ) "*" "*" " " "*" " " "*" "*" "*" "*" " " "*" "*" " "
## 10 ( 1 ) "*" "*" " " "*" " " "*" "*" "*" "*" " " "*" "*" "*"#best values for the linear regression model
results <- summary(best_subset)
results$adjr2 # adjusted R-squared for each model size## [1] 0.3888841 0.4896185 0.5145837 0.5361944 0.5609653 0.5847174 0.6133255
## [8] 0.6193453 0.6189771 0.6127989which.max(results$adjr2) # which size is best## [1] 8coef(best_subset, which.max(results$adjr2)) # variables in that best model## (Intercept) H HR WAR OBP
## -18514540.04 231054.94 912529.52 1981159.35 -2233572815.83
## SLG OPS Age AB
## -2387981259.41 2312583912.10 1050862.19 -85435.49Liner regression equation: Salary = -18514540.04 + 231,054.94 * H + 912,529.52 * HR + 1,981,159.35 * WAR - 2,233,572,815.83 * OBP - 2,387,981,259.41 * SLG + 2,312,583,912.10 * OPS + 1,050,862.19 * AGE - 85,435.49 * AB
Linear Regression Model
#training the liner regression on the train dataset
lm_best <- lm(Cash2023 ~ H + HR + WAR + SLG + OBP + OPS + Age + AB, data = mlb_stats_num)
summary(lm_best)##
## Call:
## lm(formula = Cash2023 ~ H + HR + WAR + SLG + OBP + OPS + Age +
## AB, data = mlb_stats_num)
##
## Residuals:
## Min 1Q Median 3Q Max
## -11921778 -4000606 50686 3124390 13859983
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -18514540 12221823 -1.515 0.138079
## H 231055 106373 2.172 0.036154 *
## HR 912530 248104 3.678 0.000725 ***
## WAR 1981159 861755 2.299 0.027096 *
## SLG -2387981259 1755482544 -1.360 0.181751
## OBP -2233572816 1756618875 -1.272 0.211272
## OPS 2312583912 1756954086 1.316 0.195976
## Age 1050862 265040 3.965 0.000313 ***
## AB -85436 31280 -2.731 0.009513 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5968000 on 38 degrees of freedom
## Multiple R-squared: 0.6855, Adjusted R-squared: 0.6193
## F-statistic: 10.36 on 8 and 38 DF, p-value: 0.0000001511While best subset selection identified this 8-variable model as optimal by adjusted R² (0.619), VIF diagnostics revealed severe multicollinearity among OBP, SLG, and OPS (VIF > 1,000), making individual coefficients for these variables uninterpretable. However, out-of-sample testing on 25 previously unseen players confirmed this model achieved the lowest RMSE among all approaches tested, supporting its retention as the final predictive model despite the interpretability limitations of its collinear predictors.
# Sum of Squared Errors
SSE = sum(lm_best$residuals^2)
SSE## [1] 1353497423704950Decision Tree Model
# Decision Tree Regression Model
dt_model <- rpart(Cash2023 ~ H + HR + RBI + WAR + AVG + OBP + SLG + OPS + Age + GS + AB + X2B + X3B,
data = mlb_stats_num)
summary(dt_model)## Call:
## rpart(formula = Cash2023 ~ H + HR + RBI + WAR + AVG + OBP + SLG +
## OPS + Age + GS + AB + X2B + X3B, data = mlb_stats_num)
## n= 47
##
## CP nsplit rel error xerror xstd
## 1 0.46901173 0 1.0000000 1.025356 0.3099937
## 2 0.09138502 1 0.5309883 1.188898 0.3202271
## 3 0.02300795 2 0.4396032 1.150718 0.3362032
## 4 0.01000000 3 0.4165953 1.108118 0.3095767
##
## Variable importance
## SLG OPS RBI HR H AVG Age AB WAR GS
## 22 19 14 14 12 11 4 1 1 1
##
## Node number 1: 47 observations, complexity param=0.4690117
## mean=6855709, MSE=9.158043e+13
## left son=2 (39 obs) right son=3 (8 obs)
## Primary splits:
## SLG < 0.4455 to the left, improve=0.4690117, (0 missing)
## H < 140 to the left, improve=0.4634343, (0 missing)
## AB < 521.5 to the left, improve=0.4189003, (0 missing)
## OPS < 0.764 to the left, improve=0.4066030, (0 missing)
## WAR < 3.995 to the left, improve=0.4044566, (0 missing)
## Surrogate splits:
## OPS < 0.7535 to the left, agree=0.979, adj=0.875, (0 split)
## HR < 20.5 to the left, agree=0.936, adj=0.625, (0 split)
## RBI < 81.5 to the left, agree=0.936, adj=0.625, (0 split)
## H < 140 to the left, agree=0.915, adj=0.500, (0 split)
## AVG < 0.2865 to the left, agree=0.915, adj=0.500, (0 split)
##
## Node number 2: 39 observations, complexity param=0.09138502
## mean=3887422, MSE=2.351169e+13
## left son=4 (28 obs) right son=5 (11 obs)
## Primary splits:
## Age < 27.5 to the left, improve=0.4289702, (0 missing)
## H < 91 to the left, improve=0.1845738, (0 missing)
## AVG < 0.229 to the left, improve=0.1488001, (0 missing)
## GS < 140 to the left, improve=0.1253144, (0 missing)
## WAR < 2.64 to the left, improve=0.1248433, (0 missing)
## Surrogate splits:
## AB < 523.5 to the left, agree=0.744, adj=0.091, (0 split)
##
## Node number 3: 8 observations
## mean=2.132611e+07, MSE=1.710708e+14
##
## Node number 4: 28 observations, complexity param=0.02300795
## mean=1896873, MSE=6.169185e+12
## left son=8 (21 obs) right son=9 (7 obs)
## Primary splits:
## WAR < 2.645 to the left, improve=0.5733142, (0 missing)
## H < 122.5 to the left, improve=0.5119767, (0 missing)
## AB < 482 to the left, improve=0.4873323, (0 missing)
## GS < 133.5 to the left, improve=0.4865769, (0 missing)
## RBI < 41 to the left, improve=0.3287763, (0 missing)
## Surrogate splits:
## AB < 462.5 to the left, agree=0.964, adj=0.857, (0 split)
## H < 104 to the left, agree=0.929, adj=0.714, (0 split)
## GS < 125.5 to the left, agree=0.929, adj=0.714, (0 split)
## RBI < 41 to the left, agree=0.893, adj=0.571, (0 split)
## X2B < 19.5 to the left, agree=0.857, adj=0.429, (0 split)
##
## Node number 5: 11 observations
## mean=8954273, MSE=3.189745e+13
##
## Node number 8: 21 observations
## mean=811073.6, MSE=1.373617e+11
##
## Node number 9: 7 observations
## mean=5154271, MSE=1.011713e+13The actual tree structure tells a genuinely compelling, intuitive salary story:
Root (47 players, mean $6.86M) splits on SLG < 0.4455 High slugging (8 players): mean $21.3M — elite power hitters command top salaries Lower slugging (39 players) splits further on Age < 27.5 Age 28+ (11 players): mean $8.95M — veteran deals/accumulated service time Under 28 (28 players) splits further on WAR < 2.645 WAR ≥ 2.645 (7 players): mean $5.15M — solid young performers, likely arbitration-eligible WAR < 2.645 (21 players): mean $811,074 — this is almost certainly your rookie/pre-arbitration bucket
printcp(dt_model)##
## Regression tree:
## rpart(formula = Cash2023 ~ H + HR + RBI + WAR + AVG + OBP + SLG +
## OPS + Age + GS + AB + X2B + X3B, data = mlb_stats_num)
##
## Variables actually used in tree construction:
## [1] Age SLG WAR
##
## Root node error: 4304280014223093/47 = 91580425834534
##
## n= 47
##
## CP nsplit rel error xerror xstd
## 1 0.469012 0 1.00000 1.0254 0.30999
## 2 0.091385 1 0.53099 1.1889 0.32023
## 3 0.023008 2 0.43960 1.1507 0.33620
## 4 0.010000 3 0.41660 1.1081 0.30958Variables actually used: Age, SLG, WAR — matches the three real splits (SLG at root, Age second, WAR third)
plotcp(dt_model)
Random Forest Regression Model
# Random Forest Regression Model
rf_model <- randomForest(Cash2023 ~ H + HR + RBI + WAR + AVG + OBP + SLG + OPS + Age + GS + AB + X2B + X3B,
data = mlb_stats_num)
rf_model##
## Call:
## randomForest(formula = Cash2023 ~ H + HR + RBI + WAR + AVG + OBP + SLG + OPS + Age + GS + AB + X2B + X3B, data = mlb_stats_num)
## Type of random forest: regression
## Number of trees: 500
## No. of variables tried at each split: 4
##
## Mean of squared residuals: 60557420464590
## % Var explained: 33.88Overall, this model explains 34.55% of the variation in player’s salary and maintains an average squared error of 59,941,457,815,459 on the test data.
500 trees, 4 variables tried at each split (this is mtry, R’s default for regression: roughly p/3 of the 13 predictors ≈ 4) Mean of squared residuals: 59,941,457,815,459 — this is the model’s own internal out-of-bag (OOB) error estimate. Taking the square root gives you an OOB RMSE for context: √59,687,881,562,664 ≈ $7,725,796 % Var explained: 34.55% this is Random Forest’s internal analog to R², based on OOB predictions
mlb_stats_test <- read.csv("MLB+Player-hittingstats-ss-updated.csv", header = TRUE)
str(mlb_stats_test)## 'data.frame': 25 obs. of 17 variables:
## $ Player : chr "FranciscoLindor" "WillyAdames" "ZachNeto" "TrevorStory" ...
## $ Pos : chr "SS" "SS" "SS" "SS" ...
## $ Team : chr "NYM" "SF" "LAA" "BOS" ...
## $ GS : int 160 160 128 157 159 157 162 71 102 150 ...
## $ AB : int 644 591 502 612 590 623 629 255 380 589 ...
## $ H : int 172 133 129 161 144 184 166 61 103 152 ...
## $ X2B : int 35 22 29 29 24 47 31 9 19 23 ...
## $ X3B : int 0 2 1 0 3 6 7 1 0 2 ...
## $ HR : int 31 30 26 25 24 23 22 21 21 20 ...
## $ RBI : int 86 87 62 96 77 88 86 55 50 82 ...
## $ AVG : num 0.267 0.225 0.257 0.263 0.244 0.295 0.264 0.239 0.271 0.258 ...
## $ OBP : num 0.346 0.318 0.319 0.308 0.3 0.351 0.336 0.311 0.373 0.326 ...
## $ SLG : num 0.466 0.421 0.474 0.433 0.417 0.501 0.44 0.529 0.487 0.406 ...
## $ OPS : num 0.812 0.739 0.793 0.741 0.717 0.852 0.776 0.84 0.86 0.732 ...
## $ WAR : num 5.8 3.7 5.3 4.1 4.5 7.1 3.6 3.3 6.2 4.9 ...
## $ Cash2023: int 27050000 21000000 780000 22500000 27000000 7100000 770000 355483 32000000 22000000 ...
## $ Age : int 31 29 24 32 31 25 23 23 31 32 ...#Eliminating non-numeric columns
mlb_stats_test <- read.csv("MLB+Player-hittingstats-ss-updated.csv", header = TRUE)
mlb_stats_test_num <- mlb_stats_test[sapply(mlb_stats_test, is.numeric)]
str(mlb_stats_test_num)## 'data.frame': 25 obs. of 14 variables:
## $ GS : int 160 160 128 157 159 157 162 71 102 150 ...
## $ AB : int 644 591 502 612 590 623 629 255 380 589 ...
## $ H : int 172 133 129 161 144 184 166 61 103 152 ...
## $ X2B : int 35 22 29 29 24 47 31 9 19 23 ...
## $ X3B : int 0 2 1 0 3 6 7 1 0 2 ...
## $ HR : int 31 30 26 25 24 23 22 21 21 20 ...
## $ RBI : int 86 87 62 96 77 88 86 55 50 82 ...
## $ AVG : num 0.267 0.225 0.257 0.263 0.244 0.295 0.264 0.239 0.271 0.258 ...
## $ OBP : num 0.346 0.318 0.319 0.308 0.3 0.351 0.336 0.311 0.373 0.326 ...
## $ SLG : num 0.466 0.421 0.474 0.433 0.417 0.501 0.44 0.529 0.487 0.406 ...
## $ OPS : num 0.812 0.739 0.793 0.741 0.717 0.852 0.776 0.84 0.86 0.732 ...
## $ WAR : num 5.8 3.7 5.3 4.1 4.5 7.1 3.6 3.3 6.2 4.9 ...
## $ Cash2023: int 27050000 21000000 780000 22500000 27000000 7100000 770000 355483 32000000 22000000 ...
## $ Age : int 31 29 24 32 31 25 23 23 31 32 ...lm_pred <- predict(lm_best, newdata = mlb_stats_test_num)
prediction_examples <- data.frame(Player = mlb_stats_test$Player, Actual = mlb_stats_test_num$Cash2023,
Predicted = round(lm_pred, 0),
Difference = round(mlb_stats_test_num$Cash2023 - lm_pred, 0)
)
prediction_examples# Function to calculate RMSE
rmse <- function(actual, predicted) {sqrt(mean((actual - predicted)^2))}
# Generate Predictions
dt_pred <- predict(dt_model, newdata = mlb_stats_test_num)
rf_pred <- predict(rf_model, newdata = mlb_stats_test_num)
cat("Linear Regression RMSE: $", rmse(mlb_stats_test_num$Cash2023, lm_pred), "\n")## Linear Regression RMSE: $ 9636697cat("Decision Tree RMSE: $", rmse(mlb_stats_test_num$Cash2023, dt_pred), "\n")## Decision Tree RMSE: $ 11420270cat("Random Forest RMSE: $", rmse(mlb_stats_test_num$Cash2023, rf_pred), "\n")## Random Forest RMSE: $ 10265691Linear Regression RMSE: $9,636,697 prediction error Decision Tree: $11,420,270 average prediction error Random Forest: $10,482,024 average prediction error
mape <- function(actual, predicted) mean(abs((actual - predicted) / actual)) * 100
lm_mape <- mape(mlb_stats_test_num$Cash2023, lm_pred)
dt_mape <- mape(mlb_stats_test_num$Cash2023, dt_pred)
rf_mape <- mape(mlb_stats_test_num$Cash2023, rf_pred)
cat("Linear Regression MAPE:", lm_mape, "%\n")## Linear Regression MAPE: 555.5405 %cat("Decision Tree MAPE:", dt_mape, "%\n")## Decision Tree MAPE: 506.5556 %cat("Random Forest MAPE:", rf_mape, "%\n")## Random Forest MAPE: 534.5266 %mdape <- function(actual, predicted) median(abs((actual - predicted) / actual)) * 100
cat("Linear Regression MdAPE:", mdape(mlb_stats_test_num$Cash2023, lm_pred), "%\n")## Linear Regression MdAPE: 210.6767 %cat("Decision Tree MdAPE:", mdape(mlb_stats_test_num$Cash2023, dt_pred), "%\n")## Decision Tree MdAPE: 64.18291 %cat("Random Forest MdAPE:", mdape(mlb_stats_test_num$Cash2023, rf_pred), "%\n")## Random Forest MdAPE: 195.1262 %Decision Tree likely makes big absolute-dollar mistakes on a few high-salary players (it only splits on AB and Age, grouping players into a handful of buckets and if a superstar with unusual stats gets bucketed with much cheaper players, that’s a massive dollar miss, which RMSE punishes heavily).
Linear Regression likely does reasonably on high earners but performs proportionally worse on low-salary players, where the straight-line model badly mishandles the low end of the salary range.
Random Forest was the strongest model across every metric evaluated — RMSE, MAPE, and MdAPE — making it the most robust choice overall. Linear Regression and Decision Tree switched relative rankings depending on the metric: Decision Tree produced larger absolute dollar errors (RMSE), while Linear Regression showed larger proportional errors (MAPE/MdAPE), suggesting each model struggles with a different segment of the salary distribution. Decision Tree with high-salary players and Linear Regression with low-salary, rookie-scale players.
comparison <- data.frame(
Player = mlb_stats_test$Player,
Actual = mlb_stats_test_num$Cash2023,
LM_Pred = round(lm_pred, 0),
DT_Pred = round(dt_pred, 0),
RF_Pred = round(rf_pred, 0),
LM_PctErr = round(abs((mlb_stats_test_num$Cash2023 - lm_pred) / mlb_stats_test_num$Cash2023) * 100, 1),
DT_PctErr = round(abs((mlb_stats_test_num$Cash2023 - dt_pred) / mlb_stats_test_num$Cash2023) * 100, 1),
RF_PctErr = round(abs((mlb_stats_test_num$Cash2023 - rf_pred) / mlb_stats_test_num$Cash2023) * 100, 1)
)
comparison[order(comparison$Actual), ]MdAPE stays low for Decision Tree because most rookies still land correctly in the cheap bucket (5-7% error) RMSE/MAPE blow up for Decision Tree because a couple of misrouted high-slugging rookies produce enormous dollar errors ($20M+ miss each) — and since RMSE squares errors, just one or two catastrophic misses can dominate the whole metric even while the “typical” player is predicted well.
Linear Regression and Random Forest show a different failure pattern here — they’re not catastrophically wrong on just one or two players, they’re consistently, moderately-to-severely overpredicting nearly every player on this page (190%-2200%+ errors across the board). That’s a systematic bias toward overpredicting low earners, rather than a few isolated misclassifications.
Decision Tree’s coarse bucketing correctly captured most rookie-scale salaries (5-7% error) but catastrophically misclassified high-slugging young players like ZachNeto, whose SLG exceeded the tree’s elite-player threshold despite his rookie-scale contract — producing an isolated but massive error that dominated RMSE. Linear Regression and Random Forest, by contrast, showed consistent, systematic overprediction across nearly all low-salary players, reflecting their inability to represent the discontinuous jump between rookie and market-rate pay.
# Analysis of Variance (ANOVA) for linear regression model
anova(lm_best)No single model dominates across all metrics.
Linear Regression minimizes typical dollar-error (RMSE);
Decision Tree minimizes typical percentage-error (MdAPE) for most players but is vulnerable to catastrophic misclassification of edge cases;
Random Forest offers the most balanced, moderate performance without excelling on any single metric.
All three models share a common, structural weakness: none can fully capture the discontinuous jump between rookie-scale and market-rate salaries, since this is governed by service-time rules rather than on-field performance.
# Save the trained model
saveRDS(lm_best, "linear_regression_model.rds")