# Team Payroll and the World Series

#### 2022-04-25

This vignette examines whether there is a relationship between total team salaries (payroll) and World Series success. It was inspired by Nolan & Lang (2015), “Baseball: Exploring Data in a Relational Database”, Chapter 10 in Data Science in R. They use SQL on the raw Lahman files .csv, rather than the Lahman package.

Here, We largely use dplyr for data munging and ggplot2 for plotting. In the process, we discover a few errors in the data sets.

## The data files

Start with loading the files we will use here. We do some pre-processing to make them more convenient for the analyses done later.

### The Salaries data

The Salaries data.frame contains data on all players’ salaries from 1985-2016 in the latest release, v. 10.0.1, of the Lahman package. (Additions to the Salaries table in San Lahman’s database were discontinued after 2016.) We use the sample_n function to display a random sample of observations.

data("Salaries", package="Lahman")
str(Salaries)
## 'data.frame':    26428 obs. of  5 variables:
##  $yearID : int 1985 1985 1985 1985 1985 1985 1985 1985 1985 1985 ... ##$ teamID  : Factor w/ 35 levels "ANA","ARI","ATL",..: 3 3 3 3 3 3 3 3 3 3 ...
##  $lgID : Factor w/ 2 levels "AL","NL": 2 2 2 2 2 2 2 2 2 2 ... ##$ playerID: chr  "barkele01" "bedrost01" "benedbr01" "campri01" ...
##  $salary : int 870000 550000 545000 633333 625000 800000 150000 483333 772000 250000 ... sample_n(Salaries, 10) ## yearID teamID lgID playerID salary ## 1 1995 BAL AL benitar01 125000 ## 2 1995 NYA AL fernato01 1633335 ## 3 1994 PHI NL chambwe01 350000 ## 4 1995 OAK AL aldremi01 430000 ## 5 2013 NYN NL wrighda03 10192071 ## 6 1996 SEA AL strando01 380000 ## 7 1986 BOS AL hoffmgl01 350000 ## 8 2003 MIL NL sexsori01 5125000 ## 9 1998 NYA AL seabosc01 170000 ## 10 1986 ML4 AL higuete01 195000 ### The Teams data The Teams data.frame contains a lot of information about all teams that have ever played, with a separate observation for each year. Here, we will mainly use this to get the team name (team) from teamID and also to get the information about World Series winners. data("Teams", package="Lahman") dim(Teams) ## [1] 2985 48 names(Teams) ## [1] "yearID" "lgID" "teamID" "franchID" ## [5] "divID" "Rank" "G" "Ghome" ## [9] "W" "L" "DivWin" "WCWin" ## [13] "LgWin" "WSWin" "R" "AB" ## [17] "H" "X2B" "X3B" "HR" ## [21] "BB" "SO" "SB" "CS" ## [25] "HBP" "SF" "RA" "ER" ## [29] "ERA" "CG" "SHO" "SV" ## [33] "IPouts" "HA" "HRA" "BBA" ## [37] "SOA" "E" "DP" "FP" ## [41] "name" "park" "attendance" "BPF" ## [45] "PPF" "teamIDBR" "teamIDlahman45" "teamIDretro" We are only going to use the observations from 1985 on, and a few variables, so we filter and select them now. Keep only the levels of teamID in the data. Teams <- Teams %>% select(yearID, lgID, teamID, name, divID, Rank, WSWin, attendance) %>% filter(yearID >= 1985) %>% mutate(teamID = droplevels(teamID)) sample_n(Teams, 10) ## yearID lgID teamID name divID Rank WSWin attendance ## 1 1999 NL PHI Philadelphia Phillies E 3 N 1825337 ## 2 2016 AL KCA Kansas City Royals C 3 N 2557712 ## 3 1988 NL PIT Pittsburgh Pirates E 2 N 1866713 ## 4 2010 AL NYA New York Yankees E 2 N 3765807 ## 5 1997 NL CHN Chicago Cubs C 5 N 2190308 ## 6 2015 NL SLN St. Louis Cardinals C 1 N 3520889 ## 7 1995 NL CHN Chicago Cubs C 3 N 1918265 ## 8 1992 AL BAL Baltimore Orioles E 3 N 3567819 ## 9 2005 NL MIL Milwaukee Brewers C 3 N 2211023 ## 10 1985 AL CAL California Angels W 2 N 2567427 ### The SeriesPost data Post season records go back to 1884. There are 367 observations covering all aspects of post-season play. data("SeriesPost", package="Lahman") names(SeriesPost) ## [1] "yearID" "round" "teamIDwinner" "lgIDwinner" "teamIDloser" ## [6] "lgIDloser" "wins" "losses" "ties" For each year, there are number of observations for the various levels of post-season play (Division titles, League titles, etc. A number of these designations have changed over the years, and I don’t know what they all mean.) table(SeriesPost$round)
##
## AEDIV  ALCS ALDS1 ALDS2  ALWC ALWC1 ALWC2 ALWC3 ALWC4 AWDIV    CS NEDIV  NLCS
##     1    52    27    27     9     1     1     1     1     1     1     1    52
## NLDS1 NLDS2  NLWC NLWC1 NLWC2 NLWC3 NLWC4 NWDIV    WS
##    27    27     9     1     1     1     1     1   124

We are interested only in the World Series (WS), which was first played in 1903. We filter for the years for which we have salary data, and drop a couple of variables. The league IDs of the winner and loser are factors, so we use droplevels to include only the levels in recent history.

WS <- SeriesPost %>%
filter(yearID >= 1985 & round == "WS") %>%
select(-ties, -round) %>%
mutate(lgIDloser = droplevels(lgIDloser),
lgIDwinner = droplevels(lgIDwinner))
dim(WS)
## [1] 36  7
sample_n(WS, 6)
##   yearID teamIDwinner lgIDwinner teamIDloser lgIDloser wins losses
## 1   1988          LAN         NL         OAK        AL    4      1
## 2   2006          SLN         NL         DET        AL    4      1
## 3   2005          CHA         AL         HOU        NL    4      0
## 4   1987          MIN         AL         SLN        NL    4      3
## 5   2021          ATL         NL         HOU        AL    4      2
## 6   2016          CHN         NL         CLE        AL    4      3

## A first look at Salaries

How many players do we have in each year?

table(Salaries$yearID) ## ## 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 ## 550 738 627 663 711 867 685 769 923 884 986 931 925 998 1006 836 ## 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 ## 860 846 827 831 831 819 842 856 813 830 839 848 815 802 817 853 What is the range of salaries, across all years? range(Salaries$salary)
## [1]        0 33000000

And, year by year?

Salaries %>%
group_by(yearID) %>%
summarise(min=min(salary),
max=max(salary))
## # A tibble: 32 x 3
##    yearID    min     max
##     <int>  <int>   <int>
##  1   1985  60000 2130300
##  2   1986  60000 2800000
##  3   1987  62500 2127333
##  4   1988  62500 2340000
##  5   1989  62500 2766667
##  6   1990 100000 3200000
##  7   1991 100000 3800000
##  8   1992 109000 6100000
##  9   1993      0 6200000
## 10   1994  50000 6300000
## # ... with 22 more rows

Hmm, there is a salary==0 in 1993, maybe there are others.

which(Salaries$salary==0) ## [1] 6180 12008 Who are they? (We could also look up their playerIDs in Lahman::People.) Salaries[which(Salaries$salary==0),]
##       yearID teamID lgID  playerID salary
## 6180    1993    NYA   AL jamesdi01      0
## 12008   1999    PIT   NL martija02      0

These must be errors. Get rid of them. Reminder: Check further; maybe file an issue in the Lahman package!

Salaries <- Salaries %>%
filter(salary !=0)

### Get team payrolls

We want to sum the salary for each team for each year. We might as well make it in millions. All those zeros hurt my eyes.

payroll <- Salaries %>%
group_by(teamID, yearID) %>%
summarise(payroll = sum(salary)/1000000)
## # A tibble: 6 x 3
## # Groups:   teamID [1]
##   teamID yearID payroll
##   <fct>   <int>   <dbl>
## 1 ANA      1997    31.1
## 2 ANA      1998    41.3
## 3 ANA      1999    55.4
## 4 ANA      2000    51.5
## 5 ANA      2001    47.5
## 6 ANA      2002    61.7

### Merge team names into payroll

It will be more convenient to have the team names included in the payroll data.frame. The Teams data frame also contains the Y/N indicator WSWin for World Series winners, so we might as well include this too.

payroll <- merge(payroll, Teams[,c("yearID", "teamID","name", "WSWin")],
by=c("yearID", "teamID"))
sample_n(payroll, 10)
##    yearID teamID payroll                          name WSWin
## 1    2002    DET   55.05                Detroit Tigers     N
## 2    2006    MIN   63.40               Minnesota Twins     N
## 3    2007    MIL   70.99             Milwaukee Brewers     N
## 4    2016    LAA  137.25 Los Angeles Angels of Anaheim     N
## 5    2005    OAK   55.43             Oakland Athletics     N
## 6    2003    FLO   49.45               Florida Marlins     Y
## 7    2009    COL   75.20              Colorado Rockies     N
## 8    2000    MIL   36.51             Milwaukee Brewers     N
## 9    1999    ANA   55.39                Anaheim Angels     N
## 10   2013    NYA  231.98              New York Yankees     N

Note that we could also do this using left_join in the dplyr package. There is probably a more tidy way to subset the variables from the Teams data set than using Teams[, c()], but, hey– this works.

left_join(payroll, Teams[,c("yearID", "teamID","name", "WSWin")],
by=c("yearID", "teamID")) %>%
sample_n(10)

WSWin is a character variable. Convert it to a factor.

payroll <- payroll %>%
mutate(WSWin = factor(WSWin))

Check the values:

table(payroll$WSWin, useNA="ifany") ## ## N Y <NA> ## 859 31 28 There is something wrong here! There shouldn’t be any NAs. We leave this for further study, and another Reminder to file an issue if we figure out what the problem is. ## Boxplots of payroll Let’s look at the distributions of payroll by year. The observations are teams. boxplot(payroll ~ yearID, data=payroll, ylab="Payroll ($ millions)")

What are the outliers? Are there any teams that crop up repeatedly? car::Boxplot makes this easy, and also returns the labels of the outliers. We don’t load the car package, because car also contains a Salary dataset.

out <- car::Boxplot(payroll ~ yearID, data=payroll,
id=list(n=1,
labels=as.character(payroll$teamID)), ylab="Payroll ($ millions)")

Most of the outliers are the New York Yankees (NYA):

table(out)
## out
## CLE LAN MON NYA PIT SEA
##   1   2   1  11   1   1

Payroll has obviously increased dramatically over time. So has the variability across teams. For any modelling, we would probably want to use \log(payroll). We might also want to look separately at the American and National leagues.

### Correcting for inflation

For proper comparisons, we should correct for inflation. Lets do this by scaling salary back to 1985 dollars, The data below gives inflation rates for all subsequent years. It comes from Nolan & Lang, extended to 2015 using (https://www.in2013dollars.com/).

inflation = c(1,    1.02, 1.06, 1.10, 1.15, 1.21,
1.27, 1.30, 1.34, 1.38, 1.42, 1.46, 1.49, 1.51, 1.55, 1.60,
1.65, 1.67, 1.71, 1.76, 1.82, 1.87, 1.93, 2.00, 1.99, 2.03,
2.09, 2.13, 2.16, 2.20, 2.20 )

inflation.df <- data.frame(year=1985:2015, inflation)

# plot inflation rate
ggplot(inflation.df, aes(y=inflation, x=year)) +
geom_point() +
geom_line() +
geom_smooth(method="lm")

This is close enough to linear, that we could use the linear regression predicted value as a simple computation of the inflation rate. (A better way, of course, would be to use the actual inflation rate; this would entail merging payroll with inflation.df by year, and doing the computation.)

infl.lm <- lm(inflation ~ year, data=inflation.df)
(coefs <- coef(infl.lm))
## (Intercept)        year
##   -81.57032     0.04159

Scale payroll by dividing by linear prediction of inflation rate, producing payrollStd.

payroll <- payroll %>%
mutate(payrollStd = payroll / (coefs[1] + coefs[2] * yearID))

Boxplot again, of inflation-adjusted payroll. The increase after 2000 doesn’t seem so large.

car::Boxplot(payrollStd ~ yearID, data=payroll,
id = list(labels=as.character(payroll$teamID)), ylab="Payroll (1985-adjusted$ millions)")

##  [1] "SEA" "CLE" "MON" "PIT" "NYA" "NYA" "NYA" "NYA" "NYA" "NYA" "NYA" "NYA"
## [13] "NYA" "NYA" "LAN" "NYA" "LAN" "NYA" "BOS" "DET" "LAN" "NYA"

## Salaries of World Series winning teams

To what extent are the World Series winners those among the highest in payroll? A simple way to look at this is to plot the team payrolls across years, and mark the World Series winner for each year.

This plot shows inflation-adjusted payroll on a log scale to avoid the dominating influence of the most recent years. We jitter the points to avoid overplotting, and use a transparent gray color for the non-winners, red for the winner in each year.

Cols <- ifelse(payroll$WSWin=='Y', "red", gray(.7, alpha=0.5)) with(payroll, { plot(payrollStd ~ jitter(yearID, 0.5), ylab = "Payroll (inflation-adjusted$ millions)",
ylim = c(5,125), log = "y",
xlab = "Year",
pch = 19, cex = 0.8, col = Cols)
})
with(payroll[payroll\$WSWin == 'Y',],
text(y = payrollStd, x = yearID, labels = teamID, pos = 3, cex = 0.8) )

By and large, the World Series winners tend to be in the upper portion of the payrolls for each year.

• Follow-up the suggestion to fit a linear model predicting log(payroll) from some of the available predictors.