Working Theory

We are working on the premise that there are “good” teams and there are “bad” teams. The good teams win more than the bad teams. We are assuming that some of the predictors will be higher for the good teams than for the bad teams. Consequently we can use these variables to predict how many times a team will win in a season.

Notes About the Data

There are some difficulties with this dataset. First it covers such a wide time period. We know there are different “eras” of baseball. This data will span multiple eras. Has the fundamental relationships between winning and these predictors change over time? We think it has. If so this will be a challenge.

First Look at the Data

We will first look at the data to get a sense of what we have.

training %>%
  gather(variable, value, TARGET_WINS:TEAM_FIELDING_DP) %>%
  ggplot(., aes(value)) + 
  geom_density(fill = "indianred4", color="indianred4") + 
  facet_wrap(~variable, scales ="free", ncol = 4) +
  labs(x = element_blank(), y = element_blank())

quick_summary <- function(df){
  df %>%
    summary() %>%
    kable() %>%
    kable_styling()
}

quick_summary(training)

Some initial observations:

• The response variable (TARGET_WINS) looks to be normally distributed. This supports the working theory that there are good teams and bad teams. There are also a lot of average teams.
• There are also quite a few variables with missing values. We may need to deal with these in order to have the largest data set possible for modeling.
• A couple variables are bimodal (TEAM_BATTING_HR, TEAM_BATTING_SO TEAM_PITCHING_HR). This may be a challenge as some of them are missing values and that may be a challenge in filling in missing values.
• Some variables are right skewed (TEAM_BASERUN_CS, TEAM_BASERUN_SB, etc.). This might support the good team theory. It may also introduce non-normally distributed residuals in the model. We shall see.

Correlations

Let’s take a look at the correlations. The following is the correlations from the complete cases only:

training %>% 
  cor(., use = "complete.obs") %>%
  corrplot(., method = "color", type = "upper", tl.col = "black", diag = FALSE)

temp <- training %>% 
  cor(., use = "complete.obs") #%>%
  
temp[lower.tri(temp, diag=TRUE)] <- ""
temp <- temp %>%
  as.data.frame() %>%
  rownames_to_column() %>%
  gather(Variable, Correlation, -rowname) %>%
  filter(Variable != rowname) %>%
  filter(Correlation != "") %>%
  mutate(Correlation = as.numeric(Correlation)) %>%
  rename(` Variable` = rowname) %>%
  arrange(desc(abs(Correlation))) 

training %>%
  gather(variable, value, -TARGET_WINS) %>%
  ggplot(., aes(value, TARGET_WINS)) + 
  geom_point(fill = "indianred4", color="indianred4") + 
  geom_smooth(method = "lm", se = FALSE, color = "black") + 
  facet_wrap(~variable, scales ="free", ncol = 4) +
  labs(x = element_blank(), y = "Wins")

temp %>%
  filter(` Variable` == "TARGET_WINS") %>%
  kable() %>%
  kable_styling()

temp %>%
  filter(abs(Correlation) > .5) %>%
  kable() %>%
  kable_styling()

Strange Data Values

training %>% 
  gather(variable, value) %>%
  filter(is.na(value)) %>%
  group_by(variable) %>%
  tally() %>%
  mutate(percent = n / nrow(training) * 100) %>%
  mutate(percent = paste0(round(percent, ifelse(percent < 10, 1, 0)), "%")) %>%
  arrange(desc(n)) %>%
  rename(`Variable Missing Data` = variable,
         `Number of Records` = n,
         `Share of Total` = percent) %>%
  kable() %>%
  kable_styling()

training %>% 
  gather(variable, value) %>%
  filter(value == 0) %>%
  group_by(variable) %>%
  tally() %>%
  mutate(percent = n / nrow(training) * 100) %>%
  mutate(percent = paste0(round(percent, ifelse(percent < 10, 1, 0)), "%")) %>%
  arrange(desc(n)) %>%
  rename(`Variable With Zeros` = variable,
         `Number of Records` = n,
         `Share of Total` = percent) %>%
  kable() %>%
  kable_styling()

Deeper Dive into the Variables

training %>% 
  ggplot(aes(TARGET_WINS)) + 
  geom_histogram(bins = 50) +
  geom_vline(aes(xintercept = mean(TARGET_WINS)), col = "red", lty = 2) +
  geom_vline(aes(xintercept = median(TARGET_WINS)), col = "green", lty = 2) +
  labs(x = element_blank(), 
       y = "Count",
       title = "Distribution of Wins",
       caption = "* Red line is the mean value and green is the median")

training %>% 
  ggplot(aes(TEAM_BATTING_3B)) + 
  geom_histogram(bins = 50) +
  geom_vline(aes(xintercept = mean(TEAM_BATTING_3B)), col = "red", lty = 2) +
  geom_vline(aes(xintercept = median(TEAM_BATTING_3B)), col = "green", lty = 2) +
  labs(x = element_blank(), 
       y = "Count",
       title = "Distribution of Triples",
       caption = "* Red line is the mean value and green is the median")

training %>% 
  ggplot(aes(TEAM_BATTING_HR)) + 
  geom_histogram(bins = 50) +
  geom_vline(aes(xintercept = mean(TEAM_BATTING_HR)), col = "red", lty = 2) +
  geom_vline(aes(xintercept = median(TEAM_BATTING_HR)), col = "green", lty = 2) +
  labs(x = element_blank(), 
       y = "Count",
       title = "Distribution of Homeruns",
       caption = "* Red line is the mean value and green is the median")

training %>% 
  ggplot(aes(TEAM_BATTING_BB)) + 
  geom_histogram(bins = 50) +
  geom_vline(aes(xintercept = mean(TEAM_BATTING_BB)), col = "red", lty = 2) +
  geom_vline(aes(xintercept = median(TEAM_BATTING_BB)), col = "green", lty = 2) +
  labs(x = element_blank(), 
       y = "Count",
       title = "Distribution of Walks (Base on Balls)",
       caption = "* Red line is the mean value and green is the median")

training %>% 
  ggplot(aes(TEAM_BATTING_SO)) + 
  geom_histogram(bins = 50) +
  geom_vline(aes(xintercept = mean(TEAM_BATTING_SO,na.rm = T)), col = "red", lty = 2) +
  geom_vline(aes(xintercept = median(TEAM_BATTING_SO, na.rm = T)), col = "green", lty = 2) +
  labs(x = element_blank(), 
       y = "Count",
       title = "Distribution of Strikeouts (Batter)",
       caption = "* Red line is the mean value and green is the median")

training %>% 
  ggplot(aes(TEAM_BASERUN_SB)) + 
  geom_histogram(bins = 50) +
  geom_vline(aes(xintercept = mean(TEAM_BASERUN_SB, na.rm = T)), col = "red", lty = 2) +
  geom_vline(aes(xintercept = median(TEAM_BASERUN_SB, na.rm = T)), col = "green", lty = 2) +
  labs(x = element_blank(),
       y = "Count",
       title = "Distribution of Stolen Bases",
       caption = "* Red line is the mean value and green is the median")

training %>% 
  ggplot(aes(TEAM_BASERUN_CS)) + 
  geom_histogram(bins = 50) +
  geom_vline(aes(xintercept = mean(TEAM_BASERUN_CS, na.rm = T)), col = "red", lty = 2) +
  geom_vline(aes(xintercept = median(TEAM_BASERUN_CS, na.rm = T)),col = "green", lty = 2) +
  labs(x = element_blank(),
       y = "Count",
       title = "Distribution of Caught Stealing Bases",
       caption = "* Red line is the mean value and green is the median")

training %>% 
  ggplot(aes(TEAM_BATTING_HBP)) + 
  geom_histogram(bins = 50) +
  geom_vline(aes(xintercept = mean(TEAM_BATTING_HBP, na.rm = T)), col = "red", lty = 2) +
  geom_vline(aes(xintercept = median(TEAM_BATTING_HBP, na.rm = T)), col = "green", lty = 2) +
  labs(x = element_blank(),
       y = "Count",
       title = "Distribution of Being Hit By a Pitch",
       caption = "* Red line is the mean value and green is the median")

training %>% 
  ggplot(aes(TEAM_PITCHING_HR)) + 
  geom_histogram(bins = 50) +
  geom_vline(aes(xintercept = mean(TEAM_PITCHING_HR, na.rm = T)), col = "red", lty = 2) +
  geom_vline(aes(xintercept = median(TEAM_PITCHING_HR, na.rm = T)), col = "green", lty = 2) +
  labs(x = element_blank(),
       y = "Count",
       title = "Distribution of Homeruns Pitched",
       caption = "* Red line is the mean value and green is the median")

training %>% 
  ggplot(aes(TEAM_PITCHING_BB)) + 
  geom_histogram(bins = 50) +
  geom_vline(aes(xintercept = mean(TEAM_PITCHING_BB, na.rm = T)), col = "red", lty = 2) +
  geom_vline(aes(xintercept = median(TEAM_PITCHING_BB, na.rm = T)), col = "green", lty = 2) +
  labs(x = element_blank(),
       y = "Count",
       title = "Distribution of Walks Pitched",
       caption = "* Red line is the mean value and green is the median")

training %>% 
  ggplot(aes(TEAM_PITCHING_SO)) + 
  geom_histogram(bins = 50) +
  geom_vline(aes(xintercept = mean(TEAM_PITCHING_SO, na.rm = T)), col = "red", lty = 2) +
  geom_vline(aes(xintercept = median(TEAM_PITCHING_SO, na.rm = T)), col = "green", lty = 2) +
  labs(x = element_blank(),
       y = "Count",
       title = "Distribution of Strikeouts Pitched",
       caption = "* Red line is the mean value and green is the median")

training %>% 
  ggplot(aes(TEAM_FIELDING_DP)) + 
  geom_histogram(bins = 50) +
  geom_vline(aes(xintercept = mean(TEAM_FIELDING_DP, na.rm = T)), col = "red", lty = 2) +
  geom_vline(aes(xintercept = median(TEAM_FIELDING_DP, na.rm = T)), col = "green", lty = 2) +
  labs(x = element_blank(),
       y = "Counts",
       title = "Distribution of Double Plays",
       caption = "* Red line is the mean value and green is the median")

Fixing Missing/Zero Values

First we will remove the invalid data and prep it for imputation. We will drop the hit by pitcher variable from the dataset. We will then impute the data using KNN.

training <- training %>%
  mutate(TEAM_BATTING_SO = ifelse(TEAM_BATTING_SO == 0, NA, TEAM_BATTING_SO)) %>%
  mutate(TEAM_PITCHING_SO = ifelse(TEAM_PITCHING_SO > 5346, NA, TEAM_PITCHING_SO)) %>%
  select(-TEAM_BATTING_HBP)

set.seed(42)
knn <- training %>% knnImputation()
impute_me <- is.na(training$TEAM_BATTING_SO)
training[impute_me,"TEAM_BATTING_SO"] <- knn[impute_me,"TEAM_BATTING_SO"] 
impute_me <- is.na(training$TEAM_BASERUN_SB)
training[impute_me,"TEAM_BASERUN_SB"] <- knn[impute_me,"TEAM_BASERUN_SB"] 
impute_me <- is.na(training$TEAM_BASERUN_CS)
training[impute_me,"TEAM_BASERUN_CS"] <- knn[impute_me,"TEAM_BASERUN_CS"] 
impute_me <- is.na(training$TEAM_PITCHING_SO)
training[impute_me,"TEAM_PITCHING_SO"] <- knn[impute_me,"TEAM_PITCHING_SO"]
impute_me <- is.na(training$TEAM_FIELDING_DP)
training[impute_me,"TEAM_FIELDING_DP"] <- knn[impute_me,"TEAM_FIELDING_DP"]

Feature Engineering

The batting singles is not included but we can back it out of the hits. We will do this.

add_features <- function(df){
  df %>%
    mutate(TEAM_BATTING_1B = TEAM_BATTING_H - TEAM_BATTING_2B - TEAM_BATTING_3B - TEAM_BATTING_HR)
}

training <- add_features(training)
evaluation <- add_features(evaluation)

Results

Here’s what the data look like after imputation and correction:

training %>%
  gather(variable, value) %>%
  ggplot(., aes(value)) + 
  geom_density(fill = "indianred4", color="indianred4") + 
  facet_wrap(~variable, scales ="free", ncol = 4) +
  labs(x = element_blank(), y = element_blank())

quick_summary <- function(df){
  df %>%
    summary() %>%
    kable() %>%
    kable_styling()
}

quick_summary(training)

Kitchen Sink Model

We will begin with a “kitchen sink” model.

kitchen_sink <- lm(TARGET_WINS ~ ., moneyball_train)
summary(kitchen_sink)

Call:
lm(formula = TARGET_WINS ~ ., data = moneyball_train)

Residuals:
    Min      1Q  Median      3Q     Max 
-49.393  -8.577  -0.072   8.370  61.635 

Coefficients: (1 not defined because of singularities)
                   Estimate Std. Error t value Pr(>|t|)    
(Intercept)       5.9460976  7.0651290   0.842  0.40013    
TEAM_BATTING_H    0.0546947  0.0045070  12.135  < 2e-16 ***
TEAM_BATTING_2B  -0.0237996  0.0110657  -2.151  0.03165 *  
TEAM_BATTING_3B   0.0368255  0.0205168   1.795  0.07286 .  
TEAM_BATTING_HR   0.0860825  0.0354739   2.427  0.01535 *  
TEAM_BATTING_BB  -0.0001871  0.0060299  -0.031  0.97526    
TEAM_BATTING_SO  -0.0016401  0.0043993  -0.373  0.70934    
TEAM_BASERUN_SB  -0.0011231  0.0066068  -0.170  0.86503    
TEAM_BASERUN_CS   0.1097642  0.0188991   5.808 7.63e-09 ***
TEAM_PITCHING_H  -0.0006330  0.0005148  -1.229  0.21908    
TEAM_PITCHING_HR -0.0019716  0.0313430  -0.063  0.94985    
TEAM_PITCHING_BB  0.0128312  0.0039117   3.280  0.00106 ** 
TEAM_PITCHING_SO -0.0020795  0.0031650  -0.657  0.51126    
TEAM_FIELDING_E  -0.0204896  0.0029772  -6.882 8.47e-12 ***
TEAM_FIELDING_DP -0.1077032  0.0169111  -6.369 2.49e-10 ***
TEAM_BATTING_1B          NA         NA      NA       NA    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 12.95 on 1580 degrees of freedom
Multiple R-squared:  0.3286,    Adjusted R-squared:  0.3226 
F-statistic: 55.23 on 14 and 1580 DF,  p-value: < 2.2e-16

It does a fairly good job predicting, but there are a lot of variables that are not statistically significant.

plot(kitchen_sink)

Simple Model

Let’s try to create a simplier model. We will pick variables that had high correlations and exclude the pitching variables which would introduce autocorrelation issues.

simple_fit <- lm(TARGET_WINS ~ TEAM_BATTING_H + TEAM_BATTING_BB + TEAM_FIELDING_E, data = moneyball_train)
summary(simple_fit)

Call:
lm(formula = TARGET_WINS ~ TEAM_BATTING_H + TEAM_BATTING_BB + 
    TEAM_FIELDING_E, data = moneyball_train)

Residuals:
    Min      1Q  Median      3Q     Max 
-51.833  -9.025   0.218   8.837  50.486 

Coefficients:
                 Estimate Std. Error t value Pr(>|t|)    
(Intercept)      4.800109   4.004492   1.199    0.231    
TEAM_BATTING_H   0.048614   0.002519  19.299  < 2e-16 ***
TEAM_BATTING_BB  0.015707   0.003792   4.142 3.62e-05 ***
TEAM_FIELDING_E -0.012961   0.002115  -6.129 1.11e-09 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 13.8 on 1591 degrees of freedom
Multiple R-squared:  0.2314,    Adjusted R-squared:  0.2299 
F-statistic: 159.7 on 3 and 1591 DF,  p-value: < 2.2e-16

This model isn’t as fitted to the data as well but the variables are statistically significant.

plot(simple_fit)

Higher Order Stepwise Regression

For the third model we will use a stepwise regression method using a backwards elimination process. We also introduce some higher order polynomial variables.

full_formula <- "TARGET_WINS ~ TEAM_BATTING_2B + TEAM_BATTING_3B + TEAM_BATTING_HR + TEAM_BATTING_BB + TEAM_BATTING_SO + TEAM_BASERUN_SB + TEAM_BASERUN_CS + TEAM_PITCHING_H + TEAM_PITCHING_HR + TEAM_PITCHING_BB + TEAM_PITCHING_SO + TEAM_FIELDING_E + TEAM_FIELDING_DP + TEAM_BATTING_1B + I(TEAM_BATTING_2B^2) + I(TEAM_BATTING_3B^2) + I(TEAM_BATTING_HR^2) + I(TEAM_BATTING_BB^2) + I(TEAM_BATTING_SO^2) + I(TEAM_BASERUN_SB^2) + I(TEAM_BASERUN_CS^2) + I(TEAM_PITCHING_H^2) + I(TEAM_PITCHING_HR^2) + I(TEAM_PITCHING_BB^2) + I(TEAM_PITCHING_SO^2) + I(TEAM_FIELDING_E^2) + I(TEAM_FIELDING_DP^2) + I(TEAM_BATTING_1B^2) + I(TEAM_BATTING_2B^3) + I(TEAM_BATTING_3B^3) + I(TEAM_BATTING_HR^3) + I(TEAM_BATTING_BB^3) + I(TEAM_BATTING_SO^3) + I(TEAM_BASERUN_SB^3) + I(TEAM_BASERUN_CS^3) + I(TEAM_PITCHING_H^3) + I(TEAM_PITCHING_HR^3) + I(TEAM_PITCHING_BB^3) + I(TEAM_PITCHING_SO^3) + I(TEAM_FIELDING_E^3) + I(TEAM_FIELDING_DP^3) + I(TEAM_BATTING_1B^3) + I(TEAM_BATTING_2B^4) + I(TEAM_BATTING_3B^4) + I(TEAM_BATTING_HR^4) + I(TEAM_BATTING_BB^4) + I(TEAM_BATTING_SO^4) + I(TEAM_BASERUN_SB^4) + I(TEAM_BASERUN_CS^4) + I(TEAM_PITCHING_H^4) + I(TEAM_PITCHING_HR^4) + I(TEAM_PITCHING_BB^4) + I(TEAM_PITCHING_SO^4) + I(TEAM_FIELDING_E^4) + I(TEAM_FIELDING_DP^4) + I(TEAM_BATTING_1B^4)"

full_model <- lm(full_formula, moneyball_train)
step_back <- MASS::stepAIC(full_model, direction="backward", trace = F)
poly_call <- summary(step_back)$call
step_back <- lm(poly_call[2], moneyball_train)
summary(step_back)

Call:
lm(formula = poly_call[2], data = moneyball_train)

Residuals:
    Min      1Q  Median      3Q     Max 
-41.197  -7.453  -0.130   7.130  57.064 

Coefficients:
                        Estimate Std. Error t value Pr(>|t|)    
(Intercept)            1.721e+02  7.268e+01   2.368 0.018011 *  
TEAM_BATTING_2B       -1.264e+00  7.704e-01  -1.641 0.101053    
TEAM_PITCHING_H        2.634e-02  6.173e-03   4.267 2.10e-05 ***
TEAM_PITCHING_BB       2.401e-01  4.163e-02   5.766 9.76e-09 ***
TEAM_FIELDING_E       -2.257e-01  2.575e-02  -8.765  < 2e-16 ***
TEAM_FIELDING_DP      -3.092e+00  1.875e+00  -1.649 0.099352 .  
I(TEAM_BATTING_2B^2)   1.257e-02  4.968e-03   2.530 0.011503 *  
I(TEAM_BATTING_3B^2)   1.914e-03  4.189e-04   4.569 5.29e-06 ***
I(TEAM_BATTING_BB^2)  -7.454e-04  1.490e-04  -5.004 6.26e-07 ***
I(TEAM_BATTING_SO^2)   1.190e-04  2.980e-05   3.994 6.80e-05 ***
I(TEAM_BASERUN_SB^2)   4.939e-05  1.323e-05   3.733 0.000196 ***
I(TEAM_PITCHING_H^2)  -5.287e-06  1.114e-06  -4.747 2.25e-06 ***
I(TEAM_PITCHING_HR^2)  1.352e-03  3.473e-04   3.894 0.000103 ***
I(TEAM_PITCHING_BB^2) -3.054e-04  5.339e-05  -5.720 1.27e-08 ***
I(TEAM_PITCHING_SO^2) -5.613e-05  9.962e-06  -5.634 2.09e-08 ***
I(TEAM_FIELDING_E^2)   3.503e-04  6.256e-05   5.600 2.53e-08 ***
I(TEAM_FIELDING_DP^2)  3.198e-02  2.113e-02   1.514 0.130285    
I(TEAM_BATTING_2B^3)  -4.506e-05  1.389e-05  -3.244 0.001205 ** 
I(TEAM_BATTING_3B^3)  -6.372e-06  2.690e-06  -2.369 0.017974 *  
I(TEAM_BATTING_HR^3)   8.187e-07  4.736e-07   1.729 0.084096 .  
I(TEAM_BATTING_BB^3)   1.565e-06  3.265e-07   4.793 1.80e-06 ***
I(TEAM_BATTING_SO^3)  -1.283e-07  4.649e-08  -2.759 0.005864 ** 
I(TEAM_BASERUN_CS^3)   1.147e-05  2.496e-06   4.594 4.70e-06 ***
I(TEAM_PITCHING_H^3)   3.317e-10  7.906e-11   4.195 2.88e-05 ***
I(TEAM_PITCHING_HR^3) -8.134e-06  2.985e-06  -2.725 0.006497 ** 
I(TEAM_PITCHING_BB^3)  1.488e-07  2.539e-08   5.860 5.64e-09 ***
I(TEAM_PITCHING_SO^3)  3.989e-08  7.580e-09   5.262 1.62e-07 ***
I(TEAM_FIELDING_E^3)  -2.455e-07  5.708e-08  -4.301 1.80e-05 ***
I(TEAM_FIELDING_DP^3) -1.515e-04  1.027e-04  -1.475 0.140401    
I(TEAM_BATTING_1B^3)   1.097e-08  1.086e-09  10.106  < 2e-16 ***
I(TEAM_BATTING_2B^4)   5.422e-08  1.422e-08   3.814 0.000142 ***
I(TEAM_BATTING_BB^4)  -8.775e-10  2.085e-10  -4.208 2.72e-05 ***
I(TEAM_BATTING_SO^4)   3.654e-11  2.070e-11   1.765 0.077712 .  
I(TEAM_BASERUN_CS^4)  -4.467e-08  1.378e-08  -3.242 0.001212 ** 
I(TEAM_PITCHING_H^4)  -6.315e-15  1.742e-15  -3.626 0.000297 ***
I(TEAM_PITCHING_HR^4)  1.345e-08  6.111e-09   2.200 0.027934 *  
I(TEAM_PITCHING_BB^4) -2.198e-11  3.762e-12  -5.843 6.24e-09 ***
I(TEAM_PITCHING_SO^4) -7.847e-12  1.473e-12  -5.329 1.13e-07 ***
I(TEAM_FIELDING_E^4)   5.595e-11  1.732e-11   3.230 0.001262 ** 
I(TEAM_FIELDING_DP^4)  2.668e-07  1.824e-07   1.463 0.143723    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 11.54 on 1555 degrees of freedom
Multiple R-squared:  0.4748,    Adjusted R-squared:  0.4616 
F-statistic: 36.04 on 39 and 1555 DF,  p-value: < 2.2e-16

This model has the highest adjusted R-squared but has some variables that are statistically insignificant.

plot(step_back)

Kitchen Sink Results

moneyball_test$kitchen_sink <- round(predict(kitchen_sink, moneyball_test), 0)
moneyball_test <- moneyball_test %>%
  mutate(kitchen_sink_error = TARGET_WINS - kitchen_sink)

ggplot(moneyball_test, aes(kitchen_sink_error)) +
  geom_histogram(bins = 50)

summary(moneyball_test$kitchen_sink_error)

    Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
-47.0000  -9.0000   1.0000  -0.2819   8.0000  49.0000 

Simple Model

moneyball_test$simple <- round(predict(simple_fit, moneyball_test), 0)
moneyball_test <- moneyball_test %>%
  mutate(simple_error = TARGET_WINS - simple)

ggplot(moneyball_test, aes(simple_error)) +
  geom_histogram(bins = 50)

summary(moneyball_test$simple_error)

    Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
-46.0000 -10.0000   0.0000  -0.3862   9.0000  47.0000 

Stepwise Results

moneyball_test$step_back <- round(predict(step_back, moneyball_test), 0)
moneyball_test <- moneyball_test %>%
  mutate(step_back_error = TARGET_WINS - step_back)

moneyball_test %>%
  filter(step_back_error > -100) %>%
  ggplot(., aes(step_back_error)) +
  geom_histogram(bins = 50) +
  labs(caption = "Outlier removed")

summary(moneyball_test$step_back_error)

    Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
-175.000   -9.000   -1.000   -0.141    7.000  435.000 

This model did not preform very well on the out of sample data.