Abstract

Do certain positions in baseball have a higher correlation to errors? Are there factors that determine if a player will play 80 or more games in a season? Does a player having more Gold Gloves and All-Star game appearances put them in special company in the Baseball Hall of Fame?

Using a logistic regression model, this analysis explores which factors are most correlated with a fielder being error-prone. A principal component analysis (PCA) is then used to show that a player’s offensive output (hits, runs, RBIs) is closely tied to how many games they play in a season – i.e. whether they are an everyday “workhorse.” Finally, a K-Means clustering model groups Hall of Fame players by All-Star appearances and Gold Gloves won, revealing three distinct types of Hall of Famer.

These models were built in R using the publicly available Lahman package (Friendly, Dalzell, Monkman, Murphy, Foot, & Zaki-Azat, 2020), which was cross-referenced against Baseball Reference for validation. The tables used were Fielding, Batting, People, HallOfFame, AwardsPlayers, and AllstarFull.

A note on reproducibility: the Lahman package is updated by its maintainers every season, so this document pulls a newer snapshot of the database than the one used when this project was first written in 2020. Where the original analysis specified a year range (1999-2018), that filter is applied explicitly below so the results stay faithful to the original methodology even as new seasons are added upstream.

library(Lahman)
library(tidyverse)
library(FactoMineR)
library(factoextra)
library(plotly)

data(Fielding)
data(Batting)
data(People)
data(HallOfFame)
data(AwardsPlayers)
data(AllstarFull)

Part 1: Are Certain Positions More Error-Prone?

The first question this project explores is whether a fielder being error-prone can be predicted from factors such as position, games played, assists, double plays turned, league, and year. Fielding data was pulled for a 20-year window, 1999-2018, a period shaped by the rise of the designated hitter and the increasing use of defensive shifts.

The fielding table is rich with defensive metrics – put outs, passed balls, wild pitches, stolen bases, zone rating, and caught stealing. For this analysis, only errors that apply broadly across all fielding positions were used, so passed balls, wild pitches, and zone rating were dropped.

myInfieldData <- Fielding

# Major league fielding data from the last 20 years used in the original analysis
myRecentInfieldData <- filter(myInfieldData, yearID > 1998, yearID <= 2018)

myALFieldData <- filter(myRecentInfieldData, lgID == "AL")
myNLFieldData <- filter(myRecentInfieldData, lgID == "NL")

myFieldData <- union(myALFieldData, myNLFieldData)

myDataSlimmed <- myFieldData %>%
  select(-WP, -ZR, -playerID, -teamID, -PB, -SB, -stint, -CS)

myDataSlimmed <- na.omit(myDataSlimmed)

# Numeric coding for position, used throughout this project
myDataSlimmed$POS[myDataSlimmed$POS == "P"]  <- 1
myDataSlimmed$POS[myDataSlimmed$POS == "C"]  <- 2
myDataSlimmed$POS[myDataSlimmed$POS == "1B"] <- 3
myDataSlimmed$POS[myDataSlimmed$POS == "2B"] <- 4
myDataSlimmed$POS[myDataSlimmed$POS == "3B"] <- 5
myDataSlimmed$POS[myDataSlimmed$POS == "SS"] <- 6
myDataSlimmed$POS[myDataSlimmed$POS == "OF"] <- 7

myDataSlimmed$POS <- as.numeric(as.character(myDataSlimmed$POS))

myDataClean <- myDataSlimmed

POS key: 1 = pitcher, 2 = catcher, 3 = first base, 4 = second base, 5 = third base, 6 = shortstop, 7 = outfield (a general outfield position – this dataset does not split left/center/right field).

Average Errors by Position

myAvgErrorData <- myDataClean %>%
  group_by(POS) %>%
  summarise(AvgErrors = mean(E))

myAvgErrorData
## # A tibble: 7 × 2
##     POS AvgErrors
##   <dbl>     <dbl>
## 1     1     0.515
## 2     2     2.55 
## 3     3     1.66 
## 4     4     2.50 
## 5     5     3.51 
## 6     6     4.57 
## 7     7     1.47
ggplot(myAvgErrorData, aes(x = factor(POS), y = AvgErrors)) +
  geom_col(fill = "#2c3e50") +
  labs(x = "Position", y = "Average Errors", title = "Average Errors by Position (1999-2018)") +
  theme_minimal()

Building the Error Indicator

An ErrorInd flag was created for each player-season: it is set to 1 when a player committed more errors than the rounded-up positional average for that season, and 0 otherwise.

myDataClean$ErrorInd <- ifelse(
  myDataClean$POS == 1 & myDataClean$E > 1 |
  myDataClean$POS == 2 & myDataClean$E > 3 |
  myDataClean$POS == 5 & myDataClean$E > 4 |
  myDataClean$POS == 3 & myDataClean$E > 2 |
  myDataClean$POS == 4 & myDataClean$E > 3 |
  myDataClean$POS == 6 & myDataClean$E > 5 |
  myDataClean$POS == 7 & myDataClean$E > 1,
  1, 0
)

Logistic Regression

The data was split 70/30 into training and test sets, and a logistic regression model was fit using ErrorInd as the response variable against position, games played, assists, double plays, league, and year.

set.seed(1234)

smp_size <- floor(0.7 * nrow(myDataClean))
train_ind <- sample(seq_len(nrow(myDataClean)), size = smp_size)
train <- myDataClean[train_ind, ]
test  <- myDataClean[-train_ind, ]

fit_log_new <- glm(ErrorInd ~ POS + G + A + DP + lgID + yearID, data = train, family = binomial)
summary(fit_log_new)
## 
## Call:
## glm(formula = ErrorInd ~ POS + G + A + DP + lgID + yearID, family = binomial, 
##     data = train)
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept) 42.7490051  7.2422403   5.903 3.58e-09 ***
## POS          0.0539150  0.0086177   6.256 3.94e-10 ***
## G            0.0381485  0.0006612  57.695  < 2e-16 ***
## A            0.0114753  0.0007351  15.611  < 2e-16 ***
## DP           0.0048596  0.0020708   2.347   0.0189 *  
## lgIDNL      -0.0301056  0.0417408  -0.721   0.4708    
## yearID      -0.0230081  0.0036063  -6.380 1.77e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 26607  on 25286  degrees of freedom
## Residual deviance: 15722  on 25280  degrees of freedom
## AIC: 15736
## 
## Number of Fisher Scoring iterations: 6

Position stands out as the strongest factor in the model, followed by games played, assists, and year. To evaluate the model against the null hypothesis, the null and residual deviance were run through a chi-squared test:

null_dev  <- fit_log_new$null.deviance
null_df   <- fit_log_new$df.null
resid_dev <- fit_log_new$deviance
resid_df  <- fit_log_new$df.residual

# Null hypothesis check -- expect a very small p-value here
1 - pchisq(null_dev, null_df)
## [1] 3.790002e-09
# Residual deviance check -- close to 1 supports a model with a constant term plus these predictors
1 - pchisq(resid_dev, resid_df)
## [1] 1

The null-deviance test comes back far below 0.05, rejecting the null hypothesis with high confidence. The residual-deviance test comes back close to 1, which means it is highly plausible that the data emanate from a logistic regression model built from a constant term plus these five predictors.

Suggested next step: this model could benefit from additional factors such as player age, team, and more advanced defensive metrics beyond raw error counts.

Part 2: What Makes a Workhorse?

The second question is about a player’s durability: can we predict whether a player is a “workhorse” – someone who plays in the large majority of their team’s games – from their performance stats? This analysis was inspired by legendary iron men like Cal Ripken Jr. and Lou Gehrig.

Like the fielding analysis, this uses data from 1999-2018, but pitchers are excluded. Starting pitchers typically work on a five-day rotation and relievers appear irregularly, so “games played” doesn’t mean the same thing for pitchers as it does for everyday position players.

myPositionData <- filter(Fielding, yearID > 1998, yearID <= 2018)

myPositionPlayer <- myPositionData %>%
  select(yearID, POS, playerID, G) %>%
  filter(POS != "P")

summary(myPositionPlayer$G)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1.00    5.00   18.00   40.83   64.00  162.00

Average Games Played, by Position

myavgGames <- myPositionPlayer %>%
  group_by(playerID, yearID) %>%
  summarise(G = sum(G), .groups = "drop")

myavgGamesByPos <- myPositionPlayer %>%
  group_by(playerID, yearID, POS) %>%
  summarise(G = sum(G), .groups = "drop")

myavgGamesByPosViz <- myPositionPlayer %>%
  group_by(POS) %>%
  summarise(G = mean(G))

ggplot(myavgGamesByPosViz, aes(x = factor(POS), y = G)) +
  geom_col(fill = "#2c3e50") +
  labs(x = "Position", y = "Average Games Played", title = "Average Games Played by Position") +
  theme_minimal()

Across all position players, the average games played per season comes out to roughly 41 games – far lower than expected. Doubling that figure gives a round threshold of 80 games, which becomes the cutoff for the WH (workhorse) indicator: a player who appears in more than 80 games in a season is flagged as a workhorse.

myavgGames$WH <- ifelse(myavgGames$G > 79, 1, 0)

Yadier Molina’s data was used throughout this build-out as a validation baseline to make sure every join and merge behaved as expected.

Assembling the Modeling Dataset

Player age, batting stats (hits, runs, stolen bases, RBIs, walks, strikeouts), and fielding totals (assists, errors, double plays) were joined onto the games-played data to build the final dataset for principal component analysis.

myPlayerPrimaryPosition <- myavgGamesByPos %>%
  group_by(playerID, yearID) %>%
  filter(G == max(G)) %>%
  arrange(playerID, yearID, POS)

mycleanPrimaryData <- myPlayerPrimaryPosition %>%
  select(playerID, yearID, POS)

myPlayerGames <- merge(myavgGames, People, by = "playerID")

myPlayerAge <- myPlayerGames %>%
  select(playerID, yearID, G, WH, birthYear)
myPlayerAge$age <- myPlayerAge$yearID - myPlayerAge$birthYear
myPlayerAge <- myPlayerAge %>% select(playerID, yearID, G, WH, age)

myPlayerAge$yearPlayer <- paste(myPlayerAge$playerID, myPlayerAge$yearID)
mycleanPrimaryData$yearPlayer <- paste(mycleanPrimaryData$playerID, mycleanPrimaryData$yearID)

myCombinedData <- merge(x = mycleanPrimaryData, y = myPlayerAge, by = "yearPlayer", all.x = TRUE)

myData1 <- myCombinedData %>%
  select(playerID.x, yearID.x, POS, G, WH, age) %>%
  rename(yearID = yearID.x, playerID = playerID.x)

myBattingData <- filter(Batting, yearID > 1998, yearID <= 2018)

myTestBattingData <- myBattingData %>%
  select(playerID, yearID, H, R, SB, RBI, BB, SO)
myTestBattingData$playerYear <- paste(myTestBattingData$playerID, myTestBattingData$yearID)

myTestBattingDataClean <- myTestBattingData %>%
  select(playerID, yearID, playerYear, H, R, SB, RBI, BB, SO)

myFieldData <- myPositionData %>%
  select(playerID, yearID, A, E, DP)

myFieldDataSummarized <- myFieldData %>%
  group_by(playerID, yearID) %>%
  summarise(A = sum(A), E = sum(E), DP = sum(DP), .groups = "drop")
myFieldDataSummarized$playerYear <- paste(myFieldDataSummarized$playerID, myFieldDataSummarized$yearID)

myData2 <- merge(x = myFieldDataSummarized, y = myTestBattingDataClean, by = "playerYear", all.x = TRUE) %>%
  select(playerYear, playerID.x, A, E, DP, H, R, RBI, BB, SO) %>%
  rename(player_ID = playerID.x)

myData1$playerYear <- paste(myData1$playerID, myData1$yearID)

myFinalData <- merge(x = myData1, y = myData2, by = "playerYear", all.x = TRUE) %>%
  select(playerID, yearID, POS, G, WH, age, A, E, DP, H, R, RBI, BB, SO) %>%
  na.omit() %>%
  select(yearID, POS, age, G, WH, A, E, DP, H, R, RBI, BB, SO)

myFinalData$POS[myFinalData$POS == "P"]  <- 1
myFinalData$POS[myFinalData$POS == "C"]  <- 2
myFinalData$POS[myFinalData$POS == "1B"] <- 3
myFinalData$POS[myFinalData$POS == "2B"] <- 4
myFinalData$POS[myFinalData$POS == "3B"] <- 5
myFinalData$POS[myFinalData$POS == "SS"] <- 6
myFinalData$POS[myFinalData$POS == "OF"] <- 7
myFinalData$POS <- as.numeric(as.character(myFinalData$POS))

df <- myFinalData
head(df)
##   yearID POS age  G WH   A E DP  H  R RBI BB SO
## 1   2001   3  29  1  0   0 0  1  0  0   0  0  0
## 2   2003   3  31  8  0   1 1  2  2  1   0  2  5
## 3   1999   7  27 17  0   0 1  0  9  5   6  5 12
## 4   2000   7  28 65  0   2 2  0 59 31  29 21 38
## 5   2001   7  29 17  0   0 1  0 11  5   5  3  7
## 6   1999   4  30 81  1 151 4 42 78 41  41 16 69

Workhorses by Position

myWHViz <- df %>%
  filter(WH == 1) %>%
  group_by(POS) %>%
  summarise(G = mean(G))

ggplot(myWHViz, aes(x = factor(POS), y = G)) +
  geom_col(fill = "#c0392b") +
  labs(x = "Position", y = "Average Games Played", title = "Average Games Played by Workhorse Players") +
  theme_minimal()

Once restricted to players who cleared the 80-game workhorse threshold, the average games-played figure by position looks much closer to what a fan would expect from an everyday player.

Principal Component Analysis

df_model <- df[-1] # drop yearID label column not needed for PCA input ordering

set.seed(42)
samp <- sample(nrow(df_model), nrow(df_model) * 0.8)
training <- df_model[samp, ]
testing  <- df_model[-samp, ]

df.pca <- prcomp(training[, -4], center = TRUE, scale. = TRUE) # remove WH; center & scale
summary(df.pca)
## Importance of components:
##                           PC1    PC2     PC3     PC4    PC5     PC6     PC7
## Standard deviation     2.5109 1.2414 1.04318 0.91549 0.6328 0.46688 0.45302
## Proportion of Variance 0.5732 0.1401 0.09893 0.07619 0.0364 0.01982 0.01866
## Cumulative Proportion  0.5732 0.7133 0.81218 0.88838 0.9248 0.94459 0.96325
##                            PC8     PC9    PC10    PC11
## Standard deviation     0.40746 0.38181 0.25862 0.15986
## Proportion of Variance 0.01509 0.01325 0.00608 0.00232
## Cumulative Proportion  0.97834 0.99160 0.99768 1.00000
plot(df.pca, type = "l", main = "PCA Variance by Component")

res.pca <- PCA(training[, -4], graph = FALSE)
get_eig(res.pca)
##       eigenvalue variance.percent cumulative.variance.percent
## Dim.1  6.3046924        57.315385                    57.31539
## Dim.2  1.5411030        14.010027                    71.32541
## Dim.3  1.0882259         9.892962                    81.21837
## Dim.4  0.8381248         7.619316                    88.83769
## Dim.5  0.4004160         3.640146                    92.47784

The first three dimensions account for roughly 75% of the variation in the model – a substantial share.

fviz_screeplot(res.pca, addlabels = TRUE)

fviz_contrib(res.pca, choice = "var", axes = 1, top = 10)

fviz_contrib(res.pca, choice = "var", axes = 2, top = 10)

fviz_contrib(res.pca, choice = "var", axes = 3, top = 10)

fviz_cos2(res.pca, choice = "var", axes = 1:2)

The cos2 chart (a technique recommended by STHDA – Statistical Tools for High-Throughput Data Analysis) makes it easiest to see which variables matter most across the first two dimensions: offensive metrics – runs, hits, and RBIs – stand out as the strongest contributors to whether a player logs a workhorse-level number of games.

Suggested next step: the 80-game workhorse threshold was derived from one overall average across all positions. A position-specific average, doubled, might produce a more meaningful cutoff per position.

Part 3: Clustering the Hall of Fame

The final part of this project looks at Hall of Fame position players and clusters them by All-Star selections and Gold Glove awards using K-Means. This was partly inspired by a randomForest-based Hall of Fame classification analysis from the Exploring Baseball Data blog (bmmills, 2014).

Because the first All-Star Game was played in 1933 but the first Gold Gloves were not awarded until 1957, the analysis is restricted to Hall of Famers whose careers extended past 1957 so that both awards were possible during their playing days.

myDataHOF <- HallOfFame %>%
  select(playerID, votedBy, ballots, needed, votes, needed_note) %>%
  filter(HallOfFame$inducted == "Y" & HallOfFame$category == "Player")

myDataPlayerAwards <- AwardsPlayers
myDataAllStar <- AllstarFull

myDataHOF <- merge(myDataHOF, People, by = "playerID")

myDetailHOFData <- myDataHOF %>%
  select(playerID, nameFirst, nameLast, votedBy, ballots, needed, votes, needed_note,
         weight, height, bats, throws, birthCity, birthState, debut, finalGame)

# Players excluded because their careers ended before Gold Gloves existed
myDataHOFHist <- myDetailHOFData %>%
  select(playerID, nameFirst, nameLast) %>%
  filter(myDetailHOFData$finalGame < "1957-01-01")
nrow(myDataHOFHist)
## [1] 152
myDataHOF <- myDetailHOFData %>%
  select(playerID, nameFirst, nameLast) %>%
  filter(myDetailHOFData$finalGame > "1957-01-01")
nrow(myDataHOF)
## [1] 124
myDataHOF$Name <- paste(myDataHOF$nameFirst, myDataHOF$nameLast)
myDataHOF <- myDataHOF %>% select(playerID, Name)

Gold Gloves and All-Star Appearances

myGoldGLoves <- myDataPlayerAwards %>%
  subset(awardID == "Gold Glove") %>%
  count(playerID) %>%
  rename(GoldGLoves = n)

myAllStarDataTrend <- myDataAllStar %>%
  count(playerID) %>%
  rename(AllStarGames = n)

myDataHOF <- merge(x = myDataHOF, y = myAllStarDataTrend, by = "playerID", all.x = TRUE)
myDataHOF <- merge(x = myDataHOF, y = myGoldGLoves, by = "playerID", all.x = TRUE)

myDataHOF <- myDataHOF %>% select(Name, AllStarGames, GoldGLoves)
myDataHOF[is.na(myDataHOF)] <- 0

mydata_tib <- as_tibble(myDataHOF)

K-Means Clustering

A plain scatterplot of this data fights an uphill battle: dozens of Hall of Famers sit at or near zero Gold Gloves and zero All-Star games, so static point labels pile on top of each other no matter how they’re nudged. Instead, points below are lightly jittered for visual separation, shaded by a convex hull per cluster, and made interactive with plotly – hover over any point to see exactly who it is.

set.seed(1234)
y <- mydata_tib$Name
x <- as.data.frame(mydata_tib[2:3])
rownames(x) <- y

k_means_fit <- kmeans(x, 3)
table(y, k_means_fit$cluster)
##                    
## y                   1 2 3
##   Adrian Beltre     1 0 0
##   Al Kaline         0 1 0
##   Alan Trammell     1 0 0
##   Andre Dawson      0 1 0
##   Barry Larkin      0 0 1
##   Bert Blyleven     1 0 0
##   Bill Mazeroski    0 1 0
##   Billy Wagner      1 0 0
##   Billy Williams    1 0 0
##   Bob Gibson        0 1 0
##   Bob Lemon         1 0 0
##   Brooks Robinson   0 1 0
##   Bruce Sutter      1 0 0
##   Cal Ripken        0 0 1
##   Carl Yastrzemski  0 0 1
##   Carlton Fisk      1 0 0
##   Catfish Hunter    1 0 0
##   CC Sabathia       1 0 0
##   Chipper Jones     1 0 0
##   Craig Biggio      1 0 0
##   Dave Parker       1 0 0
##   Dave Winfield     0 1 0
##   David Ortiz       1 0 0
##   Dennis Eckersley  1 0 0
##   Derek Jeter       0 0 1
##   Dick Allen        1 0 0
##   Don Drysdale      1 0 0
##   Don Sutton        1 0 0
##   Duke Snider       1 0 0
##   Early Wynn        1 0 0
##   Eddie Mathews     0 0 1
##   Eddie Murray      1 0 0
##   Edgar Martinez    1 0 0
##   Enos Slaughter    1 0 0
##   Ernie Banks       0 0 1
##   Fergie Jenkins    1 0 0
##   Frank Robinson    0 0 1
##   Frank Thomas      1 0 0
##   Fred McGriff      1 0 0
##   Gary Carter       1 0 0
##   Gaylord Perry     1 0 0
##   George Brett      0 0 1
##   George Kell       1 0 0
##   Gil Hodges        1 0 0
##   Greg Maddux       0 1 0
##   Hank Aaron        0 0 1
##   Harmon Killebrew  0 0 1
##   Harold Baines     1 0 0
##   Hoyt Wilhelm      1 0 0
##   Ichiro Suzuki     0 1 0
##   Ivan Rodriguez    0 1 0
##   Jack Morris       1 0 0
##   Jeff Bagwell      1 0 0
##   Jeff Kent         1 0 0
##   Jim Bunning       1 0 0
##   Jim Kaat          0 1 0
##   Jim Palmer        1 0 0
##   Jim Rice          1 0 0
##   Jim Thome         1 0 0
##   Joe Mauer         1 0 0
##   Joe Morgan        1 0 0
##   John Smoltz       1 0 0
##   Johnny Bench      0 1 0
##   Juan Marichal     1 0 0
##   Ken Griffey       0 1 0
##   Kirby Puckett     0 1 0
##   Larry Doby        1 0 0
##   Larry Walker      1 0 0
##   Lee Smith         1 0 0
##   Lou Brock         1 0 0
##   Luis Aparicio     0 1 0
##   Mariano Rivera    0 0 1
##   Mickey Mantle     0 0 1
##   Mike Mussina      1 0 0
##   Mike Piazza       0 0 1
##   Mike Schmidt      0 1 0
##   Minnie Miñoso     1 0 0
##   Nellie Fox        0 0 1
##   Nolan Ryan        1 0 0
##   Orlando Cepeda    1 0 0
##   Ozzie Smith       0 1 0
##   Paul Molitor      1 0 0
##   Pedro Martinez    1 0 0
##   Pee Wee Reese     1 0 0
##   Phil Niekro       1 0 0
##   Randy Johnson     1 0 0
##   Red Schoendienst  1 0 0
##   Reggie Jackson    0 0 1
##   Rich Gossage      1 0 0
##   Richie Ashburn    1 0 0
##   Rickey Henderson  1 0 0
##   Roberto Alomar    0 1 0
##   Roberto Clemente  0 1 0
##   Robin Roberts     1 0 0
##   Robin Yount       1 0 0
##   Rod Carew         0 0 1
##   Rollie Fingers    1 0 0
##   Ron Santo         1 0 0
##   Roy Campanella    1 0 0
##   Roy Halladay      1 0 0
##   Ryne Sandberg     0 1 0
##   Sandy Koufax      1 0 0
##   Satchel Paige     1 0 0
##   Scott Rolen       0 1 0
##   Stan Musial       0 0 1
##   Steve Carlton     1 0 0
##   Ted Simmons       1 0 0
##   Ted Williams      0 0 1
##   Tim Raines        1 0 0
##   Todd Helton       1 0 0
##   Tom Glavine       1 0 0
##   Tom Seaver        0 0 1
##   Tony Gwynn        0 0 1
##   Tony Oliva        1 0 0
##   Tony Perez        1 0 0
##   Trevor Hoffman    1 0 0
##   Vladimir Guerrero 1 0 0
##   Wade Boggs        0 0 1
##   Warren Spahn      0 0 1
##   Whitey Ford       1 0 0
##   Willie Mays       0 1 0
##   Willie McCovey    1 0 0
##   Willie Stargell   1 0 0
##   Yogi Berra        0 0 1
plot_df <- x
plot_df$Name <- y
plot_df$Cluster <- factor(k_means_fit$cluster)

hulls_km <- plot_df %>%
  group_by(Cluster) %>%
  slice(chull(AllStarGames, GoldGLoves))

set.seed(1)
p_kmeans <- ggplot(plot_df, aes(
    x = AllStarGames, y = GoldGLoves, color = Cluster, fill = Cluster,
    text = paste0(Name, "<br>All-Star Games: ", AllStarGames, "<br>Gold Gloves: ", GoldGLoves)
  )) +
  geom_polygon(data = hulls_km, alpha = 0.12, color = NA) +
  geom_jitter(width = 0.15, height = 0.15, size = 2.5, alpha = 0.85) +
  scale_color_brewer(palette = "Dark2") +
  scale_fill_brewer(palette = "Dark2") +
  labs(title = "K-Means: Hall of Famers by All-Star Games and Gold Gloves",
       x = "All-Star Games", y = "Gold Gloves") +
  theme_minimal(base_size = 12)

ggplotly(p_kmeans, tooltip = "text")

Hank Aaron and Stan Musial stand out for All-Star appearances, Brooks Robinson hits the sweet spot of many Gold Gloves and many All-Star games, and Greg Maddux is the clear standout for Gold Gloves with a strong handful of All-Star appearances too. The convex hulls make the three clusters – the All-Star-heavy group, the balanced-awards group, and the low-award majority – easy to tell apart at a glance, while hover text still gives the exact player behind any point.

Hierarchical Clustering for a Clearer View

d <- dist(x, method = "euclidean")
hc1 <- hclust(d, method = "complete")
sub_grp <- cutree(hc1, k = 3)
table(y, sub_grp)
##                    sub_grp
## y                   1 2 3
##   Adrian Beltre     0 1 0
##   Al Kaline         1 0 0
##   Alan Trammell     0 1 0
##   Andre Dawson      0 1 0
##   Barry Larkin      1 0 0
##   Bert Blyleven     0 1 0
##   Bill Mazeroski    0 1 0
##   Billy Wagner      0 1 0
##   Billy Williams    0 1 0
##   Bob Gibson        0 1 0
##   Bob Lemon         0 1 0
##   Brooks Robinson   1 0 0
##   Bruce Sutter      0 1 0
##   Cal Ripken        1 0 0
##   Carl Yastrzemski  1 0 0
##   Carlton Fisk      1 0 0
##   Catfish Hunter    0 1 0
##   CC Sabathia       0 1 0
##   Chipper Jones     0 1 0
##   Craig Biggio      0 1 0
##   Dave Parker       0 1 0
##   Dave Winfield     1 0 0
##   David Ortiz       1 0 0
##   Dennis Eckersley  0 1 0
##   Derek Jeter       1 0 0
##   Dick Allen        0 1 0
##   Don Drysdale      0 1 0
##   Don Sutton        0 1 0
##   Duke Snider       0 1 0
##   Early Wynn        0 1 0
##   Eddie Mathews     1 0 0
##   Eddie Murray      0 1 0
##   Edgar Martinez    0 1 0
##   Enos Slaughter    1 0 0
##   Ernie Banks       1 0 0
##   Fergie Jenkins    0 1 0
##   Frank Robinson    1 0 0
##   Frank Thomas      0 1 0
##   Fred McGriff      0 1 0
##   Gary Carter       1 0 0
##   Gaylord Perry     0 1 0
##   George Brett      1 0 0
##   George Kell       1 0 0
##   Gil Hodges        0 1 0
##   Greg Maddux       0 0 1
##   Hank Aaron        1 0 0
##   Harmon Killebrew  1 0 0
##   Harold Baines     0 1 0
##   Hoyt Wilhelm      0 1 0
##   Ichiro Suzuki     0 1 0
##   Ivan Rodriguez    1 0 0
##   Jack Morris       0 1 0
##   Jeff Bagwell      0 1 0
##   Jeff Kent         0 1 0
##   Jim Bunning       0 1 0
##   Jim Kaat          0 0 1
##   Jim Palmer        0 1 0
##   Jim Rice          0 1 0
##   Jim Thome         0 1 0
##   Joe Mauer         0 1 0
##   Joe Morgan        0 1 0
##   John Smoltz       0 1 0
##   Johnny Bench      1 0 0
##   Juan Marichal     1 0 0
##   Ken Griffey       1 0 0
##   Kirby Puckett     0 1 0
##   Larry Doby        0 1 0
##   Larry Walker      0 1 0
##   Lee Smith         0 1 0
##   Lou Brock         0 1 0
##   Luis Aparicio     1 0 0
##   Mariano Rivera    1 0 0
##   Mickey Mantle     1 0 0
##   Mike Mussina      0 1 0
##   Mike Piazza       1 0 0
##   Mike Schmidt      1 0 0
##   Minnie Miñoso     1 0 0
##   Nellie Fox        1 0 0
##   Nolan Ryan        0 1 0
##   Orlando Cepeda    1 0 0
##   Ozzie Smith       1 0 0
##   Paul Molitor      0 1 0
##   Pedro Martinez    0 1 0
##   Pee Wee Reese     1 0 0
##   Phil Niekro       0 1 0
##   Randy Johnson     1 0 0
##   Red Schoendienst  1 0 0
##   Reggie Jackson    1 0 0
##   Rich Gossage      0 1 0
##   Richie Ashburn    0 1 0
##   Rickey Henderson  1 0 0
##   Roberto Alomar    1 0 0
##   Roberto Clemente  1 0 0
##   Robin Roberts     0 1 0
##   Robin Yount       0 1 0
##   Rod Carew         1 0 0
##   Rollie Fingers    0 1 0
##   Ron Santo         0 1 0
##   Roy Campanella    1 0 0
##   Roy Halladay      0 1 0
##   Ryne Sandberg     0 1 0
##   Sandy Koufax      0 1 0
##   Satchel Paige     0 1 0
##   Scott Rolen       0 1 0
##   Stan Musial       1 0 0
##   Steve Carlton     1 0 0
##   Ted Simmons       0 1 0
##   Ted Williams      1 0 0
##   Tim Raines        0 1 0
##   Todd Helton       0 1 0
##   Tom Glavine       1 0 0
##   Tom Seaver        1 0 0
##   Tony Gwynn        1 0 0
##   Tony Oliva        0 1 0
##   Tony Perez        0 1 0
##   Trevor Hoffman    0 1 0
##   Vladimir Guerrero 0 1 0
##   Wade Boggs        1 0 0
##   Warren Spahn      1 0 0
##   Whitey Ford       1 0 0
##   Willie Mays       1 0 0
##   Willie McCovey    0 1 0
##   Willie Stargell   0 1 0
##   Yogi Berra        1 0 0
plot_df2 <- x
plot_df2$Name <- y
plot_df2$Cluster <- factor(sub_grp)

hulls_hc <- plot_df2 %>%
  group_by(Cluster) %>%
  slice(chull(AllStarGames, GoldGLoves))

set.seed(2)
p_hclust <- ggplot(plot_df2, aes(
    x = AllStarGames, y = GoldGLoves, color = Cluster, fill = Cluster,
    text = paste0(Name, "<br>All-Star Games: ", AllStarGames, "<br>Gold Gloves: ", GoldGLoves)
  )) +
  geom_polygon(data = hulls_hc, alpha = 0.12, color = NA) +
  geom_jitter(width = 0.15, height = 0.15, size = 2.5, alpha = 0.85) +
  scale_color_brewer(palette = "Set1") +
  scale_fill_brewer(palette = "Set1") +
  labs(title = "Hierarchical Clustering of Hall of Famers",
       x = "All-Star Games", y = "Gold Gloves") +
  theme_minimal(base_size = 12)

ggplotly(p_hclust, tooltip = "text")

Plotting hierarchical clusters in the original All-Star/Gold-Glove units (rather than fviz_cluster’s default PCA-rotated axes) keeps this plot directly comparable to the K-Means plot above. The split tells a similar story from a different algorithm: a small high-Gold-Glove group anchored by Greg Maddux and Jim Kaat, a balanced-awards middle group, and a large group of Hall of Famers who got in on the strength of their overall career rather than All-Star nods or Gold Gloves.

Suggested next step: this clustering only considers two award types. Since Gold Gloves weren’t awarded until 1957, a meaningful number of Hall of Famers are excluded outright – a limitation worth keeping in mind when generalizing these clusters to “greatness” as a whole.

Presentation Slides

This project was also delivered as a slide presentation. The original deck (Capstone Presentation.pdf) is reproduced below, slide by slide, for reference alongside the full written analysis above.

Conclusion

This project set out to make a few intelligent inferences from publicly available baseball data:

  • Errors are most strongly predicted by position, followed by games played, assists, and year – and the logistic regression model clears the chi-squared significance bar with room to spare.
  • Workhorse status (80+ games in a season) is closely tied to offensive production – runs, hits, and RBIs carry the most weight in the PCA model, more than fielding or age.
  • Hall of Fame players cluster into recognizable archetypes based on All-Star appearances and Gold Gloves: pure hitters with many All-Star nods and few Gold Gloves, well-rounded stars with both, and at least one player (Greg Maddux) who is a category of his own.

A general critique across all three analyses: each model uses a relatively small set of factors given what’s available in the Lahman database. Team context, more granular defensive metrics, and a position-specific workhorse threshold are the most promising directions for extending this project.

This analysis is aimed at a general audience: baseball knowledge helps make the results land, but isn’t required to follow the statistics.

References