MLB Stats
Kagiso Mthimkulu
2026-08-09
1. Introduction
Im going to use the data on MLB players to create a supervised learning model. ## 2. Data load
library(readr)
MLB = read_csv("/Users/kennyg/Downloads/baseball_hitting.csv.xls")
head(MLB)## # A tibble: 6 × 18
## `Player name` position Games `At-bat` Runs Hits `Double (2B)`
## <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 B Bonds LF 2986 9847 2227 2935 601
## 2 H Aaron RF 3298 12364 2174 3771 624
## 3 B Ruth RF 2504 8399 2174 2873 506
## 4 A Pujols 1B 3080 11421 1914 3384 686
## 5 A Rodriguez SS 2784 10566 2021 3115 548
## 6 W Mays CF 2992 10881 2062 3283 523
## # ℹ 11 more variables: `third baseman` <dbl>, `home run` <dbl>,
## # `run batted in` <dbl>, `a walk` <dbl>, Strikeouts <chr>,
## # `stolen base` <dbl>, `Caught stealing` <chr>, AVG <dbl>,
## # `On-base Percentage` <dbl>, `Slugging Percentage` <dbl>,
## # `On-base Plus Slugging` <dbl>MLB = MLB %>%
clean_names()
any(is.na(MLB))## [1] TRUEhead(128)## [1] 128MLB %>%
head(128)## # A tibble: 128 × 18
## player_name position games at_bat runs hits double_2b third_baseman
## <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 B Bonds LF 2986 9847 2227 2935 601 77
## 2 H Aaron RF 3298 12364 2174 3771 624 98
## 3 B Ruth RF 2504 8399 2174 2873 506 136
## 4 A Pujols 1B 3080 11421 1914 3384 686 16
## 5 A Rodriguez SS 2784 10566 2021 3115 548 31
## 6 W Mays CF 2992 10881 2062 3283 523 140
## 7 K Griffey CF 2671 9801 1662 2781 524 38
## 8 J Thome 1B 2543 8422 1583 2328 451 26
## 9 S Sosa RF 2354 8813 1475 2408 379 45
## 10 F Robinson RF 2808 10006 1829 2943 528 72
## # ℹ 118 more rows
## # ℹ 10 more variables: home_run <dbl>, run_batted_in <dbl>, a_walk <dbl>,
## # strikeouts <chr>, stolen_base <dbl>, caught_stealing <chr>, avg <dbl>,
## # on_base_percentage <dbl>, slugging_percentage <dbl>,
## # on_base_plus_slugging <dbl># Remove NAs
MLB_clean = MLB %>%
drop_na()
any(is.na(MLB_clean))## [1] FALSEMLB_clean %>%
head(200)## # A tibble: 200 × 18
## player_name position games at_bat runs hits double_2b third_baseman
## <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 B Bonds LF 2986 9847 2227 2935 601 77
## 2 H Aaron RF 3298 12364 2174 3771 624 98
## 3 B Ruth RF 2504 8399 2174 2873 506 136
## 4 A Pujols 1B 3080 11421 1914 3384 686 16
## 5 A Rodriguez SS 2784 10566 2021 3115 548 31
## 6 W Mays CF 2992 10881 2062 3283 523 140
## 7 K Griffey CF 2671 9801 1662 2781 524 38
## 8 J Thome 1B 2543 8422 1583 2328 451 26
## 9 S Sosa RF 2354 8813 1475 2408 379 45
## 10 F Robinson RF 2808 10006 1829 2943 528 72
## # ℹ 190 more rows
## # ℹ 10 more variables: home_run <dbl>, run_batted_in <dbl>, a_walk <dbl>,
## # strikeouts <chr>, stolen_base <dbl>, caught_stealing <chr>, avg <dbl>,
## # on_base_percentage <dbl>, slugging_percentage <dbl>,
## # on_base_plus_slugging <dbl>MLB_clean <- MLB_clean %>%
mutate(
strikeouts = suppressWarnings(as.numeric(as.character(strikeouts))),
at_bat = suppressWarnings(as.numeric(as.character(at_bat))),
caught_stealing = suppressWarnings(as.numeric(as.character(caught_stealing)))
)3. Exploratory Data Analysis
3.1 Summary of Statistics
summary(MLB_clean)## player_name position games at_bat
## Length:2488 Length:2488 Min. : 2 Min. : 262
## Class :character Class :character 1st Qu.: 615 1st Qu.: 1868
## Mode :character Mode :character Median : 995 Median : 3249
## Mean :1085 Mean : 3711
## 3rd Qu.:1440 3rd Qu.: 5115
## Max. :3562 Max. :14053
##
## runs hits double_2b third_baseman
## Min. : 32.0 Min. : 57.0 Min. : 7.0 Min. : 0.00
## 1st Qu.: 229.5 1st Qu.: 467.8 1st Qu.: 86.0 1st Qu.: 9.00
## Median : 422.0 Median : 849.0 Median :154.0 Median : 20.00
## Mean : 521.2 Mean :1009.8 Mean :181.9 Mean : 32.06
## 3rd Qu.: 719.2 3rd Qu.:1400.2 3rd Qu.:250.0 3rd Qu.: 42.00
## Max. :2295.0 Max. :4256.0 Max. :792.0 Max. :309.00
##
## home_run run_batted_in a_walk strikeouts
## Min. : 17.0 Min. : 37.0 Min. : 19.0 Min. : 1.0
## 1st Qu.: 33.0 1st Qu.: 220.8 1st Qu.: 162.0 1st Qu.: 268.0
## Median : 69.0 Median : 403.5 Median : 292.0 Median : 447.5
## Mean :100.9 Mean : 494.2 Mean : 373.1 Mean : 545.3
## 3rd Qu.:130.0 3rd Qu.: 657.2 3rd Qu.: 487.0 3rd Qu.: 713.2
## Max. :762.0 Max. :2297.0 Max. :2558.0 Max. :2597.0
##
## stolen_base caught_stealing avg on_base_percentage
## Min. : 0.00 Min. : 0.00 Min. :0.1230 Min. :0.1570
## 1st Qu.: 11.00 1st Qu.: 7.00 1st Qu.:0.2470 1st Qu.:0.3110
## Median : 32.00 Median : 18.00 Median :0.2620 Median :0.3300
## Mean : 75.58 Mean : 29.26 Mean :0.2633 Mean :0.3316
## 3rd Qu.: 89.00 3rd Qu.: 39.00 3rd Qu.:0.2780 3rd Qu.:0.3510
## Max. :1406.00 Max. :335.00 Max. :0.3670 Max. :0.4820
## NA's :192
## slugging_percentage on_base_plus_slugging
## Min. :0.1970 Min. :0.3540
## 1st Qu.:0.3750 1st Qu.:0.6930
## Median :0.4070 Median :0.7380
## Mean :0.4101 Mean :0.7417
## 3rd Qu.:0.4410 3rd Qu.:0.7840
## Max. :0.6900 Max. :1.1640
## num_vars = MLB_clean %>%
select(where(is.numeric))
cor_matrix = cor(num_vars, use = "complete.obs")
print(round(cor_matrix, 2))## games at_bat runs hits double_2b third_baseman home_run
## games 1.00 0.98 0.94 0.97 0.93 0.66 0.69
## at_bat 0.98 1.00 0.97 0.99 0.96 0.70 0.70
## runs 0.94 0.97 1.00 0.97 0.95 0.72 0.75
## hits 0.97 0.99 0.97 1.00 0.97 0.73 0.68
## double_2b 0.93 0.96 0.95 0.97 1.00 0.66 0.72
## third_baseman 0.66 0.70 0.72 0.73 0.66 1.00 0.24
## home_run 0.69 0.70 0.75 0.68 0.72 0.24 1.00
## run_batted_in 0.90 0.92 0.93 0.93 0.93 0.60 0.87
## a_walk 0.86 0.85 0.91 0.85 0.83 0.55 0.75
## strikeouts 0.71 0.70 0.70 0.65 0.69 0.22 0.82
## stolen_base 0.55 0.58 0.63 0.59 0.53 0.65 0.20
## caught_stealing 0.65 0.66 0.67 0.66 0.59 0.59 0.28
## avg 0.54 0.58 0.62 0.66 0.64 0.58 0.34
## on_base_percentage 0.48 0.49 0.60 0.55 0.55 0.44 0.44
## slugging_percentage 0.30 0.34 0.46 0.39 0.46 0.18 0.71
## on_base_plus_slugging 0.41 0.45 0.57 0.50 0.55 0.31 0.68
## run_batted_in a_walk strikeouts stolen_base
## games 0.90 0.86 0.71 0.55
## at_bat 0.92 0.85 0.70 0.58
## runs 0.93 0.91 0.70 0.63
## hits 0.93 0.85 0.65 0.59
## double_2b 0.93 0.83 0.69 0.53
## third_baseman 0.60 0.55 0.22 0.65
## home_run 0.87 0.75 0.82 0.20
## run_batted_in 1.00 0.86 0.73 0.41
## a_walk 0.86 1.00 0.68 0.48
## strikeouts 0.73 0.68 1.00 0.34
## stolen_base 0.41 0.48 0.34 1.00
## caught_stealing 0.48 0.55 0.44 0.85
## avg 0.59 0.48 0.19 0.36
## on_base_percentage 0.57 0.69 0.28 0.28
## slugging_percentage 0.58 0.44 0.46 0.05
## on_base_plus_slugging 0.65 0.60 0.44 0.16
## caught_stealing avg on_base_percentage
## games 0.65 0.54 0.48
## at_bat 0.66 0.58 0.49
## runs 0.67 0.62 0.60
## hits 0.66 0.66 0.55
## double_2b 0.59 0.64 0.55
## third_baseman 0.59 0.58 0.44
## home_run 0.28 0.34 0.44
## run_batted_in 0.48 0.59 0.57
## a_walk 0.55 0.48 0.69
## strikeouts 0.44 0.19 0.28
## stolen_base 0.85 0.36 0.28
## caught_stealing 1.00 0.40 0.31
## avg 0.40 1.00 0.74
## on_base_percentage 0.31 0.74 1.00
## slugging_percentage 0.05 0.52 0.57
## on_base_plus_slugging 0.17 0.67 0.82
## slugging_percentage on_base_plus_slugging
## games 0.30 0.41
## at_bat 0.34 0.45
## runs 0.46 0.57
## hits 0.39 0.50
## double_2b 0.46 0.55
## third_baseman 0.18 0.31
## home_run 0.71 0.68
## run_batted_in 0.58 0.65
## a_walk 0.44 0.60
## strikeouts 0.46 0.44
## stolen_base 0.05 0.16
## caught_stealing 0.05 0.17
## avg 0.52 0.67
## on_base_percentage 0.57 0.82
## slugging_percentage 1.00 0.94
## on_base_plus_slugging 0.94 1.00corrplot(cor_matrix, method = "color", type = "upper",
tl.cex = 0.6, tl.col = "black")
### 3.2 Distributions
# Home Runs by position
top_positions10 = MLB_clean %>%
group_by(position) %>%
summarise(
avg_HR = mean(home_run, na.rm = TRUE),
count = n()
) %>%
arrange(desc(count)) %>%
head(10) %>%
pull(position)
MLB_clean %>%
filter(position %in% top_positions10) %>%
ggplot(aes(x = reorder(position, home_run, median), y = home_run, fill = position)) +
geom_boxplot() +
coord_flip() +
labs(title = "Home Runs by Position",
x = "Position",
y = "Home Runs") +
theme_minimal()
# Rate statistics by games played
top10plys_avg = MLB_clean %>%
arrange(desc(avg)) %>%
head(10) %>%
select(player_name, home_run, avg, on_base_percentage, slugging_percentage)
top10plys_obp = MLB_clean %>%
arrange(desc(on_base_percentage)) %>%
head(10) %>%
select(player_name, home_run, avg, on_base_percentage, slugging_percentage)
top10_plys_slg = MLB_clean %>%
arrange(desc(slugging_percentage)) %>%
head(10) %>%
select(player_name, home_run, avg, on_base_percentage, slugging_percentage)
top10plys_hr = MLB_clean %>%
arrange(desc(home_run)) %>%
head(10) %>%
select(player_name, home_run, avg, on_base_percentage, slugging_percentage)
top10_all = list(
AVG = top10plys_avg,
OBP = top10plys_obp,
SLG = top10_plys_slg,
HR = top10plys_hr
)
print(top10_all)## $AVG
## # A tibble: 10 × 5
## player_name home_run avg on_base_percentage slugging_percentage
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 T Cobb 117 0.367 0.433 0.513
## 2 R Hornsby 301 0.358 0.434 0.577
## 3 J Jackson 54 0.356 0.423 0.517
## 4 L O'Doul 113 0.349 0.413 0.532
## 5 E Delahanty 101 0.346 0.411 0.505
## 6 T Speaker 117 0.345 0.428 0.5
## 7 T Williams 521 0.344 0.482 0.634
## 8 B Hamilton 40 0.344 0.455 0.432
## 9 B Hamilton 40 0.344 0.455 0.432
## 10 B Ruth 714 0.342 0.474 0.69
##
## $OBP
## # A tibble: 10 × 5
## player_name home_run avg on_base_percentage slugging_percentage
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 T Williams 521 0.344 0.482 0.634
## 2 B Ruth 714 0.342 0.474 0.69
## 3 B Hamilton 40 0.344 0.455 0.432
## 4 B Hamilton 40 0.344 0.455 0.432
## 5 L Gehrig 493 0.34 0.447 0.632
## 6 B Bonds 762 0.298 0.444 0.607
## 7 B Joyce 70 0.294 0.435 0.467
## 8 R Hornsby 301 0.358 0.434 0.577
## 9 T Cobb 117 0.367 0.433 0.513
## 10 J Foxx 534 0.325 0.428 0.609
##
## $SLG
## # A tibble: 10 × 5
## player_name home_run avg on_base_percentage slugging_percentage
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 B Ruth 714 0.342 0.474 0.69
## 2 T Williams 521 0.344 0.482 0.634
## 3 L Gehrig 493 0.34 0.447 0.632
## 4 J Foxx 534 0.325 0.428 0.609
## 5 B Bonds 762 0.298 0.444 0.607
## 6 H Greenberg 331 0.313 0.412 0.605
## 7 F Tatis Jr. 81 0.292 0.369 0.596
## 8 Y Alvarez 99 0.297 0.385 0.591
## 9 M McGwire 583 0.263 0.394 0.588
## 10 M Trout 351 0.303 0.415 0.588
##
## $HR
## # A tibble: 10 × 5
## player_name home_run avg on_base_percentage slugging_percentage
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 B Bonds 762 0.298 0.444 0.607
## 2 H Aaron 755 0.305 0.374 0.555
## 3 B Ruth 714 0.342 0.474 0.69
## 4 A Pujols 703 0.296 0.374 0.544
## 5 A Rodriguez 696 0.295 0.38 0.55
## 6 W Mays 660 0.302 0.384 0.557
## 7 K Griffey 630 0.284 0.37 0.538
## 8 J Thome 612 0.276 0.402 0.554
## 9 S Sosa 609 0.273 0.344 0.534
## 10 F Robinson 586 0.294 0.389 0.537# Add total bases
MLB_clean = MLB_clean %>%
mutate(total_bases = (1 * hits) + (2 * double_2b) + (3 * third_baseman) + (4 * home_run))
# Add walk percentage
MLB_clean = MLB_clean %>%
mutate(walk_percentage = (a_walk / at_bat) * 100)
# Add strikeout percentage
MLB_clean = MLB_clean %>%
mutate(strikeout_percentage = (strikeouts / at_bat) * 100)
# Add Isolated Power
MLB_clean = MLB_clean %>%
mutate(isolated_power = slugging_percentage - avg)
# Add Runs created
MLB_clean = MLB_clean %>%
mutate(runs_created = (hits + a_walk) + (total_bases / (at_bat + a_walk))
)
# Add base running
MLB_clean = MLB_clean %>%
mutate(base_running = stolen_base / (stolen_base + caught_stealing))
# Hitting and production
hitting = c("hits", "runs", "total_bases")
MLB_clean = MLB_clean %>%
mutate(
hits_norm = (hits - mean(hits, na.rm = TRUE)) / sd(hits, na.rm = TRUE),
run_batted_in_norm = (run_batted_in - mean(run_batted_in, na.rm = TRUE)) /
sd(run_batted_in, na.rm = TRUE),
runs_norm = (runs - mean(runs, na.rm = TRUE)) / sd(runs, na.rm = TRUE),
total_bases_norm = (total_bases - mean(total_bases, na.rm = TRUE)) / sd(total_bases, na.rm = TRUE),
hitting_combined_norm = (hits_norm + runs_norm + total_bases_norm + run_batted_in_norm) / 4
)
# Top 10 Hitting and Production
top_10hitting = MLB_clean %>%
arrange(desc(hitting_combined_norm)) %>%
head(10) %>%
mutate(player_name = reorder(player_name, hitting_combined_norm))
print(top_10hitting)## # A tibble: 10 × 29
## player_name position games at_bat runs hits double_2b third_baseman
## <fct> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 H Aaron RF 3298 12364 2174 3771 624 98
## 2 T Cobb CF 3034 11429 2246 4191 723 297
## 3 A Pujols 1B 3080 11421 1914 3384 686 16
## 4 S Musial OF 3026 10972 1949 3630 725 177
## 5 B Ruth RF 2504 8399 2174 2873 506 136
## 6 B Bonds LF 2986 9847 2227 2935 601 77
## 7 W Mays CF 2992 10881 2062 3283 523 140
## 8 A Rodriguez SS 2784 10566 2021 3115 548 31
## 9 P Rose 1B 3562 14053 2165 4256 746 135
## 10 C Yastrzemski LF 3308 11988 1816 3419 646 59
## # ℹ 21 more variables: home_run <dbl>, run_batted_in <dbl>, a_walk <dbl>,
## # strikeouts <dbl>, stolen_base <dbl>, caught_stealing <dbl>, avg <dbl>,
## # on_base_percentage <dbl>, slugging_percentage <dbl>,
## # on_base_plus_slugging <dbl>, total_bases <dbl>, walk_percentage <dbl>,
## # strikeout_percentage <dbl>, isolated_power <dbl>, runs_created <dbl>,
## # base_running <dbl>, hits_norm <dbl>, run_batted_in_norm <dbl>,
## # runs_norm <dbl>, total_bases_norm <dbl>, hitting_combined_norm <dbl>ggplot(top_10hitting, aes(x = player_name, y = hitting_combined_norm, group = 1)) +
geom_line(color = "steelblue", size = 1.5) +
geom_point(color = "darkred", size = 3) +
geom_text(aes(label = round(hitting_combined_norm, 2)), hjust = 0.2, size = 3) +
geom_hline(yintercept = 0, linetype = "dashed", color = "grey50") +
geom_hline(yintercept = 1, linetype = "dotted", color = "green", alpha = 0.5) +
geom_hline(yintercept = 2, linetype = "dotted", color = "orange", alpha = 0.5) +
geom_hline(yintercept = 3, linetype = "dotted", color = "red", alpha = 0.5) +
labs(title = "Top 10 Players by Basic Hitting and Production",
x = "Player",
y = "Combined Z-score") +
coord_flip() +
theme_minimal()
Hank Aaron has the highest hitting production out of any player in this
dataset. The reason he is here speaks to his exceptionally consistent
production over a long period of time. The data also shows tat players
like Ty Cobb from the 1920s can be just as productive as players like
Barry Bonds.
# Efficiency and discipline
efficiency = c("avg", "on_base_percentage", "slugging_percentage",
"walk_percentage", "strikeout_percentage")
MLB_clean = MLB_clean %>%
mutate(
avg_norm = (avg - mean(avg, na.rm = TRUE)) / sd(avg, na.rm = TRUE),
on_base_percentage_norm = (on_base_percentage - mean(on_base_percentage, na.rm = TRUE)) / sd(on_base_percentage, na.rm = TRUE),
slugging_percentage_norm = (slugging_percentage - mean(slugging_percentage, na.rm = TRUE)) /
sd(slugging_percentage, na.rm = TRUE),
walk_percentage_norm = (walk_percentage - mean(walk_percentage, na.rm = TRUE)) /
sd(walk_percentage, na.rm = TRUE),
strikeout_percentage_norm = (strikeout_percentage - mean(strikeout_percentage, na.rm = TRUE)) / sd(strikeout_percentage, na.rm = TRUE),
efficiency_norm = (avg_norm + on_base_percentage_norm + slugging_percentage_norm +
walk_percentage_norm + strikeout_percentage_norm) / 5
)
# Top 10 efficiency and discipline
top_10efficiency = MLB_clean %>%
arrange(desc(efficiency_norm)) %>%
head(10) %>%
mutate(player_name = reorder(player_name, efficiency_norm))
print(top_10efficiency)## # A tibble: 10 × 35
## player_name position games at_bat runs hits double_2b third_baseman
## <fct> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 B Ruth RF 2504 8399 2174 2873 506 136
## 2 T Williams LF 2292 7706 1798 2654 525 71
## 3 B Bonds LF 2986 9847 2227 2935 601 77
## 4 L Gehrig 1B 2164 8001 1888 2721 534 163
## 5 J Foxx 1B 2317 8134 1751 2646 458 125
## 6 M Trout CF 1410 5105 1055 1547 298 51
## 7 M Mantle CF 2401 8102 1677 2415 344 72
## 8 A Judge RF 732 2651 538 754 121 4
## 9 J Thome 1B 2543 8422 1583 2328 451 26
## 10 M Ramirez LF 2302 8244 1544 2574 547 20
## # ℹ 27 more variables: home_run <dbl>, run_batted_in <dbl>, a_walk <dbl>,
## # strikeouts <dbl>, stolen_base <dbl>, caught_stealing <dbl>, avg <dbl>,
## # on_base_percentage <dbl>, slugging_percentage <dbl>,
## # on_base_plus_slugging <dbl>, total_bases <dbl>, walk_percentage <dbl>,
## # strikeout_percentage <dbl>, isolated_power <dbl>, runs_created <dbl>,
## # base_running <dbl>, hits_norm <dbl>, run_batted_in_norm <dbl>,
## # runs_norm <dbl>, total_bases_norm <dbl>, hitting_combined_norm <dbl>, …ggplot(top_10efficiency, aes(x = player_name, y = efficiency_norm, group = 1)) +
geom_line(color = "steelblue", size = 1.5) +
geom_point(color = "darkred", size = 3) +
geom_text(aes(label = round(efficiency_norm, 2)), hjust = -0.2, size = 3) +
geom_hline(yintercept = 0, linetype = "dashed", color = "grey50") +
geom_hline(yintercept = 1, linetype = "dotted", color = "green", alpha = 0.5) +
geom_hline(yintercept = 2, linetype = "dotted", color = "orange", alpha = 0.5) +
labs(title = "Top 10 Players by Efficiency and Discipline",
x = "Player",
y = "Combined Z-score") +
coord_flip() +
theme_minimal()
Babe Ruth is the most efficient player with a z-score of 3.52, falling
in the top 0.13% of the normal distribution, illustrating his historical
dominance. Ted Williams and Babe Ruth are the only players with a
z-score above 3, separating them as a significant outliers in the
dataset. Every player from Barry Bonds to Manny Ramirez has a z-score
above 2, meaning every player has atleast two standard deviations above
the average player.
# Power and Creation
power = c("on_base_plus_slugging", "isolated_power", "runs_created")
MLB_clean = MLB_clean %>%
mutate(
on_base_plus_slugging_norm = (on_base_plus_slugging - mean(on_base_plus_slugging, na.rm = TRUE)) / sd(on_base_plus_slugging, na.rm = TRUE),
isolated_power_norm = (isolated_power - mean(isolated_power, na.rm = TRUE)) /
sd(isolated_power, na.rm = TRUE),
runs_created_norm = (runs_created - mean(runs_created, na.rm = TRUE)) /
sd(runs_created, na.rm = TRUE),
power_norm = (on_base_plus_slugging_norm + isolated_power_norm + runs_created_norm) / 3
)
# Top 10 Power and Creation
top_10power = MLB_clean %>%
arrange(desc(power_norm)) %>%
head(10) %>%
mutate(player_name = reorder(player_name, power_norm))
print(top_10power)## # A tibble: 10 × 39
## player_name position games at_bat runs hits double_2b third_baseman
## <fct> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 B Ruth RF 2504 8399 2174 2873 506 136
## 2 B Bonds LF 2986 9847 2227 2935 601 77
## 3 T Williams LF 2292 7706 1798 2654 525 71
## 4 L Gehrig 1B 2164 8001 1888 2721 534 163
## 5 J Foxx 1B 2317 8134 1751 2646 458 125
## 6 S Musial OF 3026 10972 1949 3630 725 177
## 7 M Ramirez LF 2302 8244 1544 2574 547 20
## 8 M McGwire 1B 1874 6187 1167 1626 252 6
## 9 H Aaron RF 3298 12364 2174 3771 624 98
## 10 J Thome 1B 2543 8422 1583 2328 451 26
## # ℹ 31 more variables: home_run <dbl>, run_batted_in <dbl>, a_walk <dbl>,
## # strikeouts <dbl>, stolen_base <dbl>, caught_stealing <dbl>, avg <dbl>,
## # on_base_percentage <dbl>, slugging_percentage <dbl>,
## # on_base_plus_slugging <dbl>, total_bases <dbl>, walk_percentage <dbl>,
## # strikeout_percentage <dbl>, isolated_power <dbl>, runs_created <dbl>,
## # base_running <dbl>, hits_norm <dbl>, run_batted_in_norm <dbl>,
## # runs_norm <dbl>, total_bases_norm <dbl>, hitting_combined_norm <dbl>, …ggplot(top_10power, aes(x = player_name, y = power_norm, group = 1)) +
geom_line(color = "steelblue", size = 1.5) +
geom_point(color = "darkred", size = 3) +
geom_text(aes(label = round(power_norm, 2)), hjust = -0.2, size = 3) +
geom_hline(yintercept = 0, linetype = "dashed", color = "grey50") +
geom_hline(yintercept = 1, linetype = "dotted", color = "green", alpha = 0.5) +
geom_hline(yintercept = 2, linetype = "dotted", color = "orange", alpha = 0.5) +
labs(title = "Top 10 Players by Power and Creation",
x = "Player",
y = "Combined Z-score") +
coord_flip() +
theme_minimal()
Agai, Babe Ruth leads in power and creation with a z-score of 4,76. Babe
Ruth and Barry Bonds all have a z-score above 4, roughly top 0,0013%
compared to the other players on this list, establishing themselves as
real power hitters in this list, nine of the top 10 players are above
three, meaning every player has atleast three standard deviations above
the average ## 4. Build the KNN Model ### 4.1 Prepare the data
KNN_fts = c("games", "at_bat", "runs", "hits", "double_2b", "third_baseman",
"home_run", "run_batted_in", "a_walk", "strikeouts", "stolen_base",
"caught_stealing", "avg", "on_base_percentage", "slugging_percentage",
"on_base_plus_slugging", "isolated_power", "runs_created", "total_bases")
# Correlation check
cor_mx = cor(MLB_clean[, KNN_fts], use = "complete.obs")
# Find Highly correlated pairs
library(caret)
high_cor = findCorrelation(cor_mx, cutoff = 0.9, names = TRUE)
print(high_cor)## [1] "total_bases" "runs" "runs_created"
## [4] "run_batted_in" "hits" "double_2b"
## [7] "at_bat" "on_base_plus_slugging"# Remove Highly correlated features
Reduced_fts = KNN_fts[!KNN_fts %in% high_cor]
# Create thresholds
MLB_clean = MLB_clean %>%
mutate(
home_run_norm = (home_run - mean(home_run, na.rm = TRUE)) /
sd(home_run, na.rm = TRUE),
power_score = (isolated_power_norm + home_run_norm + slugging_percentage_norm + on_base_plus_slugging_norm) / 4,
power_class = ifelse(power_score >= median(power_score, na.rm = TRUE), 1, 0)
)
KNN_MLB = MLB_clean %>%
select(player_name, all_of(Reduced_fts), power_class, power_score) %>%
na.omit()
# Recreate features and targets from clean data
X = KNN_MLB[, Reduced_fts]
y_class = KNN_MLB$power_class
y_reg = KNN_MLB$power_score
player_names = KNN_MLB$player_name
# Scale features
X_scaled <- scale(X)
# Check for any NAs (should be 0)
cat("Missing values in X_scaled:", sum(is.na(X_scaled)), "\n")## Missing values in X_scaled: 0cat("Missing values in y_class:", sum(is.na(y_class)), "\n")## Missing values in y_class: 0cat("Missing values in y_reg:", sum(is.na(y_reg)), "\n")## Missing values in y_reg: 04.2 Split and train the data
# Split data
set.seed(123)
Train_index = sample(1:nrow(X_scaled), 0.7 * nrow(X_scaled))
X_train = X_scaled[Train_index, ]
X_test = X_scaled[-Train_index, ]
y_train_reg = y_reg[Train_index]
y_test_reg = y_reg[-Train_index]
y_train_class = y_class[Train_index] # This will now have no NAs
y_test_class = y_class[-Train_index]
player_train = player_names[Train_index]
player_test = player_names[-Train_index]
# Create factor versions for confusion matrix
y_train_class_factor = factor(y_train_class, levels = c(0, 1),
labels = c("Low Power", "High Power"))
y_test_class_factor = factor(y_test_class, levels = c(0, 1),
labels = c("Low Power", "High Power"))
cat("\n=== Split Sizes ===\n")##
## === Split Sizes ===cat("Training set:", nrow(X_train), "players\n")## Training set: 1607 playerscat("Test set:", nrow(X_test), "players\n")## Test set: 689 playerscat("Training class distribution:\n")## Training class distribution:print(table(y_train_class_factor))## y_train_class_factor
## Low Power High Power
## 765 842cat("Test class distribution:\n")## Test class distribution:print(table(y_test_class_factor))## y_test_class_factor
## Low Power High Power
## 346 3434.3 Classification
library(FNN)
# KNN classification
k_values = c(3, 5, 7, 9, 11, 15, 21, 31, 41, 51)
accuracy_results = data.frame(k = k_values, accuracy = NA)
for (i in 1:length(k_values)) {
# Run KNN classification
predictions_num = knn(train = X_train, test = X_test,
cl = y_train_class, k = k_values[i])
# Convert to factor for confusion matrix
predictions = factor(predictions_num, levels = c(0, 1),
labels = c("Low Power", "High Power"))
# Calculate accuracy
cm = confusionMatrix(predictions, y_test_class_factor)
accuracy_results$accuracy[i] = cm$overall["Accuracy"]
}
# Find best k
best_k_class = k_values[which.max(accuracy_results$accuracy)]
best_accuracy = max(accuracy_results$accuracy)
cat("\n========== CLASSIFICATION RESULTS ==========\n")##
## ========== CLASSIFICATION RESULTS ==========cat("Best k:", best_k_class, "\n")## Best k: 21cat("Best accuracy:", round(best_accuracy * 100, 1), "%\n")## Best accuracy: 96.7 %print(accuracy_results)## k accuracy
## 1 3 0.9608128
## 2 5 0.9579100
## 3 7 0.9651669
## 4 9 0.9579100
## 5 11 0.9608128
## 6 15 0.9651669
## 7 21 0.9666183
## 8 31 0.9651669
## 9 41 0.9651669
## 10 51 0.9637155# Run final classification with best k
final_class_num = knn(train = X_train, test = X_test,
cl = y_train_class, k = best_k_class)
final_class = factor(final_class_num, levels = c(0, 1),
labels = c("Low Power", "High Power"))
# Confusion Matrix
cm_final = confusionMatrix(final_class, y_test_class_factor)
cat("\n=== Confusion Matrix ===\n")##
## === Confusion Matrix ===print(cm_final$table)## Reference
## Prediction Low Power High Power
## Low Power 342 19
## High Power 4 324cat("\nAccuracy:", round(cm_final$overall["Accuracy"] * 100, 1), "%\n")##
## Accuracy: 96.7 %cat("Kappa:", round(cm_final$overall["Kappa"], 3), "\n")## Kappa: 0.933# Classification results with names
classification_results = data.frame(
Player = player_test,
Actual = y_test_class_factor,
Predicted = final_class,
Correct = ifelse(y_test_class_factor == final_class, "Correct", "Incorrect")
)
# Show misclassified palyers
cat("\n=== Misclassified Players ===\n")##
## === Misclassified Players ===misclassified = classification_results %>%
filter(Correct == "Incorrect")
if(nrow(misclassified) > 0) {
print(misclassified)
} else {
cat("No Misclassified Players \n")
}## Player Actual Predicted Correct
## 1 W Davis High Power Low Power Incorrect
## 2 B Buckner High Power Low Power Incorrect
## 3 C Lansford High Power Low Power Incorrect
## 4 T Harper Low Power High Power Incorrect
## 5 P Feliz High Power Low Power Incorrect
## 6 K Bass High Power Low Power Incorrect
## 7 A Hicks Low Power High Power Incorrect
## 8 B Roberts High Power Low Power Incorrect
## 9 G Redus High Power Low Power Incorrect
## 10 G Zaun Low Power High Power Incorrect
## 11 S Vogt High Power Low Power Incorrect
## 12 L Dykstra High Power Low Power Incorrect
## 13 J Arencibia High Power Low Power Incorrect
## 14 B Lewis High Power Low Power Incorrect
## 15 R Rolfe High Power Low Power Incorrect
## 16 M Lamb High Power Low Power Incorrect
## 17 L Boudreau High Power Low Power Incorrect
## 18 F Robinson High Power Low Power Incorrect
## 19 R Hudler High Power Low Power Incorrect
## 20 M Pi?a High Power Low Power Incorrect
## 21 L Fonseca High Power Low Power Incorrect
## 22 S Stahoviak Low Power High Power Incorrect
## 23 L Niekro High Power Low Power Incorrect# Show correctly classified players
cat("\n=== Correctly classified players (first 10) ===\n")##
## === Correctly classified players (first 10) ===correctly_classified = classification_results %>%
filter(Correct == "Correct")
head(correctly_classified, 10)## Player Actual Predicted Correct
## 1 B Ruth High Power High Power Correct
## 2 A Rodriguez High Power High Power Correct
## 3 M Ramirez High Power High Power Correct
## 4 F Thomas High Power High Power Correct
## 5 T Williams High Power High Power Correct
## 6 G Sheffield High Power High Power Correct
## 7 F McGriff High Power High Power Correct
## 8 D Kingman High Power High Power Correct
## 9 J Giambi High Power High Power Correct
## 10 J Gonzalez High Power High Power Correct4.3 KNN Regression
library(FNN)
rmse_results = data.frame(k = k_values, rmse = NA, r2 = NA)
for (i in 1:length(k_values)) {
predictions = knn.reg(train = X_train, test = X_test,
y = y_train_reg, k = k_values[i])
rmse_results$rmse[i] = sqrt(mean((predictions$pred - y_test_reg)^2))
ss_res = sum((predictions$pred - y_test_reg)^2)
ss_tot = sum((y_test_reg - mean(y_test_reg))^2)
rmse_results$r2[i] = 1 - (ss_res / ss_tot)
}
# Find best k regression
best_k_reg = k_values[which.min(rmse_results$rmse)]
best_rmse = min(rmse_results$rmse)
best_r2 = rmse_results$r2[which.min(rmse_results$rmse)]
cat("\n=== Regression Results ===\n")##
## === Regression Results ===cat("Best k:", best_k_reg, "\n")## Best k: 3cat("Best RMSE:", round(best_rmse, 4), "\n")## Best RMSE: 0.153cat("Best R²:", round(best_r2, 4), "\n")## Best R²: 0.9709print(rmse_results)## k rmse r2
## 1 3 0.1530122 0.9709283
## 2 5 0.1559614 0.9697968
## 3 7 0.1606047 0.9679716
## 4 9 0.1680464 0.9649347
## 5 11 0.1733122 0.9627027
## 6 15 0.1826086 0.9585942
## 7 21 0.1932416 0.9536319
## 8 31 0.2123171 0.9440257
## 9 41 0.2287331 0.9350354
## 10 51 0.2432548 0.9265247# Run final regressions with best k
final_reg = knn.reg(train = X_train, test = X_test,
y = y_test_reg, k = best_k_reg)
# Regression results with player names
regression_results = data.frame(
Player = player_test,
Actual_Score = y_test_reg,
Predicted_Score = final_reg$pred,
Error = abs(final_reg$pred - y_test_reg),
Error_Pct = abs((final_reg$pred - y_test_reg) / y_test_reg) * 100
) %>%
arrange(desc(Error))
cat("\n=== Largest Predictions Errors (Top 10) ===\n")##
## === Largest Predictions Errors (Top 10) ===head(regression_results, 10)## Player Actual_Score Predicted_Score Error Error_Pct
## 1 J Gonzalez 2.837763 -0.53100397 3.368767 118.71206
## 2 M Piazza 2.635344 -0.24955673 2.884901 109.46961
## 3 M Conforto 1.025545 -0.92848487 1.954030 190.53576
## 4 M Ordonez 1.657047 -0.16908444 1.826132 110.20396
## 5 J Cruz Jr. 0.867344 -0.92869178 1.796036 207.07306
## 6 J Votto 2.152355 0.44839577 1.703959 79.16720
## 7 D Murphy 1.620977 -0.04228739 1.663264 102.60876
## 8 N Arenado 2.161078 0.54918118 1.611897 74.58762
## 9 B Lowe 1.262655 -0.27261491 1.535270 121.59061
## 10 S Horn 0.849582 -0.63765633 1.487238 175.05530cat("\n=== Best Predictions (Top 10) ===\n")##
## === Best Predictions (Top 10) ===regression_results %>%
arrange(Error) %>%
head(10)## Player Actual_Score Predicted_Score Error Error_Pct
## 1 F Frisch 0.14737735 0.1463363 0.001041076 0.7064019
## 2 D Spencer -0.32329990 -0.3331913 0.009891416 3.0595172
## 3 L Herndon -0.09588601 -0.0630905 0.032795508 34.2026000
## 4 G Cimoli -0.59592990 -0.6722011 0.076271232 12.7986918
## 5 B Kielty -0.03908625 -0.1605730 0.121486708 310.8170216
## 6 B Melton 0.35239065 0.4786402 0.126249577 35.8265964
## 7 T Hulett -0.72350296 -0.5793381 0.144164892 19.9259574
## 8 O Timmons 0.21035791 0.3947647 0.184406754 87.6633329
## 9 J Logan -0.51001911 -0.3245697 0.185449442 36.3612735
## 10 C Lemon 0.76437098 0.9662281 0.201857106 26.40826384.4 Visualize
# Accuracy vs. k
plot1 = ggplot(accuracy_results, aes(x = k, y = accuracy)) +
geom_line(color = "steelblue", size = 1.2) +
geom_line(color = "darkred", size = 3) +
geom_vline(xintercept = best_k_class, linetype = "dashed", color = "green") +
labs(title = "Classification: Accuracy vs. K",
x = "K value",
y = "Accuracy") +
theme_minimal()
print(plot1)
Accuracy reaches its peak at the k value 21, providing the best balance
for making the most correct predictions.At very low k values the
accuracy is unstable and low. The model is overfitting, paying too much
attention to individual data points rather than the overall trend. By
the time k value gets to 50, accuracy falls to around 0.9637.
# RMSE vs. k
plot2 = ggplot(rmse_results, aes(x = k, y = rmse)) +
geom_line(color = "steelblue", size = 1.2) +
geom_line(color = "darkred", size = 3) +
geom_vline(xintercept = best_k_class, linetype = "dashed", color = "green") +
labs(title = "Classification: RMSE vs. K",
x = "K value",
y = "RMSE") +
theme_minimal()
print(plot2)
The error is at its lowest at around 0.150, meaning the model is at its
most accurate predictions when it looks at a few close neighbours. The
error keeps increasing as k increases suggesting that larger k values
are causing the model to overfit.
# Confusion Matrix Heatmap
cm_df = as.data.frame(cm_final$table)
colnames(cm_df) = c("Predicted", "Actual", "Freq")
plot3 = ggplot(cm_df, aes(x = Actual, y = Predicted, fill = Freq)) +
geom_tile() +
geom_text(aes(label = Freq), size = 6) +
scale_fill_gradient(low = "white", high = "steelblue") +
labs(title = "Confusion Matrix",
x = "Actual Class") +
theme_minimal()
print(plot3)
The model is highly reliable at identifying both classes, with only a
slight tendency to miss “High Power” cases (19 misses) more often than
“Low Power” cases (4 misses).
# Predicted vs. Actual (Regression)
plot4 = ggplot(regression_results, aes(x = Actual_Score, y = Predicted_Score)) +
geom_point(alpha = 0.5, color = "steelblue") +
geom_abline(slope = 1, intercept = 0, color = "red", linetype = "dashed", size = 1.2) +
geom_smooth(method = "lm", color = "darkgreen", se = FALSE) +
annotate("text", x = 0.2, y = 0.9, label = paste("R² =", round(best_r2, 3)),
color = "darkgreen", size = 5) +
labs(title = "Regression: Predicted vs. Actual Power Score",
x = "Actual Power Score",
y = "Predicted Power Score") +
theme_minimal()
print(plot4)
The green line is almost horizontal line indicating actual power has
very little influence on predicted power. However r-squared is 0.971
meaning it is highly accurate however the dots do not go around the line
of bestfit, meaning the model is not a good predictor of power.