Shrinking Batting Averages: Part II

In last week’s post, I illustrated using a function shrink to compute and graph improved estimates of baseball rates. Here’s a quick summary of the R work that I did to create this graph.

• From the Batting data frame in the Lahman package, I collected the season batting statistics for all players in a particular season with at least a given number of at-bats.
• I used the laplace function in the LearnBayes package to fit the random effects model described in the earlier post. From the model estimates, I compute the improved estimates.
• Using traditional graphics, I use the plot function to plot the basic estimates, the points function to overlay the improved estimate points in red, and use the legend function to add a legend.

Here’s another example of using of using shrink to estimate the true batting averages from all players in the famous 1941 season with at least 100 AB. Although Ted Williams hit .406 that particular season, we estimate his true batting average to be closer to .350.

data.1941 <- shrink(1941, "H", "AB")

One problem with this graph is that it does not clearly display the shrinkage or movement of the observed batting averages towards the overall average. This motivates the use of a ggplot2 display that is easy to construct using the data frame data.1941 returned from the previous function.

Here’s the new plotting function ggplot.shrink that requires the ggplot2 package. It illustrates the use of the geometric object function geom_segment that will connect a player’s AVG with his improved estimate using a separate line segment.

ggplot.shrink <- function(stuff){
  require(ggplot2)
  require(grid)
  names(stuff$data)[2:3] <- c("y", "n")
  ggplot(stuff$data, aes(x=n, xend=n, 
                y=observed, yend=estimate)) + 
    geom_segment(arrow = arrow(length = unit(0.3, "cm"))) +
    geom_hline(yintercept=stuff$p.ALL, color="red") +
    labs(title = paste("Shrinkage of Multilevel Estimates", 
                       ", K =", round(stuff$K))) +
    theme(plot.title = element_text(size = rel(2))) +
    xlab("OPPORTUNITIES") + ylab("ESTIMATE") 
}

Here is an example of this new function on the 1941 hit data.

ggplot.shrink(data.1941)

I think this plot is better for illustrating the dramatic movement of the observed batting averages towards the overall average. In particular, note that the movement is largest for the players with a small number of at-bats. One has less information about a player’s true average based on only 100 AB, and so you want to adjust this average more towards the overall average.

By the way, the size of the shrinkage depends on what rate you are estimating. Suppose instead that we’re interested in estimating the true home run rates for all hitters in the 1941 season. A home run rate reflects a batter’s ability more than a batting average, so we see smaller shrinkage of the raw rates towards the average.

data.1941.HR <- shrink(1941, "HR", "AB")
ggplot.shrink(data.1941.HR)

Advertisement