Final Project Sports Analytics
getwd()## [1] "/cloud/project"Intro to Linear Regression: First Base hitting stats
#setwd("cloud/project")
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"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 ($)")
# 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.
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 861754 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.
# Sum of Squared Errors
SSE = sum(lm_best$residuals^2)
SSE## [1] 1353497423704957Decision 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.043921 0.3149211
## 2 0.09138502 1 0.5309883 1.237885 0.3250304
## 3 0.02300795 2 0.4396032 1.177699 0.3417400
## 4 0.01000000 3 0.4165953 1.176274 0.3418513
##
## 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+13Root (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 bucketprintcp(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.0439 0.31492
## 2 0.091385 1 0.53099 1.2379 0.32503
## 3 0.023008 2 0.43960 1.1777 0.34174
## 4 0.010000 3 0.41660 1.1763 0.34185Variables 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: 59816595699813
## % Var explained: 34.68Overall, this model explains 33.67% of the variation in player’s salary and maintains an average squared error of 60,741,476,193,600 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: 60,741,476,193,600 Taking the square root gives you an OOB RMSE for context: √60,741,476,193,600 ≈ $7,793,681 % Var explained: 33.67% 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: $ 10463361Linear Regression RMSE: $9,636,697 prediction error Decision Tree: $11,420,270 average prediction error Random Forest: $10,836,440 average prediction error
Decision Tree likely makes big absolute-dollar mistakes on a few high-salary players (it only splits on AB, Age and WAR, 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.
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), ]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 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")