CUNY MSDS DATA 621 - HW 1

Removal of Data

The variable TEAM_BATTING_HBP is also missing over 90% of its values. That variable will be removed completely.

The variable TEAM_PITCHING_HR and TEAM_BATTING_HR are also very closely correlated with each other. This shows that there may be some collinearity involved. The TEAM_PITCHING_HR variable will be dropped from the dataset

Using the VIF and vifstep function from the USDM package, the data will first be tested for other collinearity issues. The variables determined that have collinearity issues will be discarded.

Imputation of Missing (NA) values

The data exploration revealed multiple variables that had numerious NA values. There are multiple ways to handle NA data: deleting the observations, deleting the variables, imputation with the mean/median/mode, or imputation with a prediction.

Imputation the mean/median/mode is an easy way to fill in the missing NA’s, however it reduces the variance in the dataset and shrinks standard errors - which can invalidate hypothesis tests.

In this case, data will be imputated via prediction using the MICE (Multivariate Imputation) library using a random forest prediction method.

Variables that exceed the established threshold will be discarded to avoid collinearity issues.

vif(imputed)

##           Variables      VIF
## 1       TARGET_WINS 1.499251
## 2    TEAM_BATTING_H 3.997932
## 3   TEAM_BATTING_2B 2.457536
## 4   TEAM_BATTING_3B 2.979868
## 5   TEAM_BATTING_HR 4.918888
## 6   TEAM_BATTING_BB 5.543429
## 7   TEAM_BATTING_SO 5.231486
## 8   TEAM_BASERUN_SB 2.344517
## 9   TEAM_BASERUN_CS 1.778219
## 10  TEAM_PITCHING_H 3.683440
## 11 TEAM_PITCHING_BB 4.781545
## 12 TEAM_PITCHING_SO 2.986074
## 13  TEAM_FIELDING_E 4.774207
## 14 TEAM_FIELDING_DP 1.750808

v1 <- vifstep(imputed, th=10)

Output - The below table shows the results of above data manipulation.

The NA data has been ‘filled in’ using the MICE prediction, using the Random Forest Method. Variables with collinearity as established by the vir/virstep package have been dropped.

Model 1: All Variables

All remaining variables after the data prep. After the data has been manipulated (imputed, etc. as stated above), all of the variables will be tested to determine the base model they provided. This will allow us to see which variables are significant in our dataset, and allow us to make other models based on that.

## 
## Call:
## lm(formula = TARGET_WINS ~ ., data = imputed)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -55.523  -8.434   0.164   8.261  58.735 
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      26.1424328  5.2322110   4.996 6.29e-07 ***
## TEAM_BATTING_H    0.0466562  0.0036096  12.926  < 2e-16 ***
## TEAM_BATTING_2B  -0.0192738  0.0090513  -2.129  0.03333 *  
## TEAM_BATTING_3B   0.0408129  0.0166908   2.445  0.01455 *  
## TEAM_BATTING_HR   0.0727073  0.0097896   7.427 1.57e-13 ***
## TEAM_BATTING_BB   0.0089198  0.0051882   1.719  0.08571 .  
## TEAM_BATTING_SO  -0.0121938  0.0025086  -4.861 1.25e-06 ***
## TEAM_BASERUN_SB   0.0413004  0.0042832   9.642  < 2e-16 ***
## TEAM_BASERUN_CS   0.0009375  0.0093794   0.100  0.92039    
## TEAM_PITCHING_H  -0.0001880  0.0003690  -0.510  0.61045    
## TEAM_PITCHING_BB -0.0009933  0.0035554  -0.279  0.77999    
## TEAM_PITCHING_SO  0.0025529  0.0008606   2.966  0.00304 ** 
## TEAM_FIELDING_E  -0.0297181  0.0025185 -11.800  < 2e-16 ***
## TEAM_FIELDING_DP -0.0957177  0.0125853  -7.606 4.13e-14 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 12.9 on 2262 degrees of freedom
## Multiple R-squared:  0.333,  Adjusted R-squared:  0.3292 
## F-statistic: 86.87 on 13 and 2262 DF,  p-value: < 2.2e-16

Conclusions based on model:

F-statistic is 89.25, R-squared is 0.3352 Out of the 14 variables, 9 have statistically significant p-values at the 5% level.

Model 2: Highly Significant Variables Only

Based on model one, Model 2 will focus only on the variables that are statistically significant - in order to see if only those variables allow for a better model. Variables will be choosen based on their significance level from the R output.

## 
## Call:
## lm(formula = TARGET_WINS ~ TEAM_BATTING_H + TEAM_BATTING_3B + 
##     TEAM_BATTING_HR + TEAM_BATTING_SO + TEAM_BASERUN_SB + TEAM_PITCHING_SO + 
##     TEAM_FIELDING_E + TEAM_FIELDING_DP, data = imputed)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -55.312  -8.551   0.171   8.267  58.000 
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      34.0046383  4.5179148   7.527 7.47e-14 ***
## TEAM_BATTING_H    0.0407043  0.0026698  15.246  < 2e-16 ***
## TEAM_BATTING_3B   0.0495451  0.0162081   3.057 0.002263 ** 
## TEAM_BATTING_HR   0.0783195  0.0091365   8.572  < 2e-16 ***
## TEAM_BATTING_SO  -0.0134377  0.0023291  -5.770 9.03e-09 ***
## TEAM_BASERUN_SB   0.0446690  0.0037826  11.809  < 2e-16 ***
## TEAM_PITCHING_SO  0.0019535  0.0005818   3.358 0.000799 ***
## TEAM_FIELDING_E  -0.0325609  0.0017680 -18.417  < 2e-16 ***
## TEAM_FIELDING_DP -0.0922242  0.0123648  -7.459 1.24e-13 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 12.92 on 2267 degrees of freedom
## Multiple R-squared:  0.3299, Adjusted R-squared:  0.3275 
## F-statistic: 139.5 on 8 and 2267 DF,  p-value: < 2.2e-16

Conclusions based on model: F-statistic is 143, R-squared is 0.333

The F-statistic is better than the first model, however the R-squared drops slightly.

Model 3: Backwards Elimination and Significance

Variables will be removed one by one to determine best fit model. After each variable is removed, the model will be ‘ran’ again - until the most optimal output (r2, f-stat) are produced. Only the final output will be shown. This model is similar to the ‘forward selection’ variant - however I find it easier to work our way backwards and to eliminate variables rather than add them.

## 
## Call:
## lm(formula = TARGET_WINS ~ TEAM_BATTING_H + TEAM_BASERUN_SB + 
##     TEAM_FIELDING_E + TEAM_BATTING_HR, data = imputed)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -50.322  -9.029   0.006   8.508  57.962 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      5.314710   2.896116   1.835   0.0666 .  
## TEAM_BATTING_H   0.049751   0.002022  24.608  < 2e-16 ***
## TEAM_BASERUN_SB  0.049378   0.003391  14.560  < 2e-16 ***
## TEAM_FIELDING_E -0.026155   0.001630 -16.049  < 2e-16 ***
## TEAM_BATTING_HR  0.023860   0.005956   4.006 6.38e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 13.19 on 2271 degrees of freedom
## Multiple R-squared:  0.3005, Adjusted R-squared:  0.2992 
## F-statistic: 243.8 on 4 and 2271 DF,  p-value: < 2.2e-16

Conclusions based on model: F-statistic is 245.5, R-squared is 0.3006 The F-statistic is larger than both of the other two models, however the R-squared is slightly lower than the other two.

Predictions

Similar to the train data, the evaulation data also needs some prep work. Similar to what was done for the test data, the eval data has had columns removed, and NA values imputed using the MICE - Random Forest method to predict what the NA values could be.

After imputing and cleaning the data, using the predict function and Model 3, the following are the predicted values for the test set of the data, including prediction intervals:

##       fit              lwr              upr        
##  Min.   : 28.38   Min.   : 2.269   Min.   : 54.49  
##  1st Qu.: 75.97   1st Qu.:50.101   1st Qu.:101.85  
##  Median : 81.55   Median :55.677   Median :107.42  
##  Mean   : 80.50   Mean   :54.608   Mean   :106.38  
##  3rd Qu.: 86.01   3rd Qu.:60.133   3rd Qu.:111.90  
##  Max.   :114.40   Max.   :88.421   Max.   :140.39

##        1 
## 81.01443

##        fit      lwr      upr
## 1 81.01443 55.14843 106.8804

Appendex

moneyball_training_data <- read_csv("https://raw.githubusercontent.com/nschettini/CUNY-MSDS-DATA-621/master/moneyball-training-data.csv")


mbd1 <- describe(moneyball_training_data, na.rm = F)

mbd1$na_count <- sapply(moneyball_training_data, function(y) sum(length(which(is.na(y)))))
mbd1 <- mbd1[-1,]


kable(mbd1, "html", escape = F) %>%
  kable_styling("striped", full_width = T) %>%
  column_spec(1, bold = T) %>%
  scroll_box(width = "100%", height = "700px")

ggplot(stack(moneyball_training_data), aes(x = ind, y = values)) + 
  geom_boxplot() +
  theme(legend.position="none") +
  theme(axis.text.x=element_text(angle=45, hjust=1)) + 
  theme(panel.background = element_rect(fill = '#d0ddf2'))


ggplot(stack(moneyball_training_data), aes(x = ind, y = values)) + 
  geom_boxplot() +
  coord_cartesian(ylim = c(0, 800)) +
  theme(legend.position="none") +
  theme(axis.text.x=element_text(angle=45, hjust=1)) + 
  theme(panel.background = element_rect(fill = '#d0ddf2'))


mb_hist <- moneyball_training_data
mb_hist <- mb_hist[,-1 ]

mb_hist %>%
  keep(is.numeric) %>%                     
  gather() %>%                             
  ggplot(aes(value)) +                     
    facet_wrap(~ key, scales = "free") +  
    geom_histogram(bins = 35)                 



kable(cor(drop_na(mb_hist))[,1], "html", escape = F) %>%
  kable_styling("striped", full_width = F) %>%
  column_spec(1, bold = T) %>%
  scroll_box(height = "500px")

corrgram(drop_na(mb_hist), order=TRUE,
         upper.panel=panel.cor, main="Moneyball")



mbd2 <- moneyball_training_data
mbd2 <- mbd2[,-1]
mbd2 <- mbd2[,-10]
mbd2 <- mbd2[,-12]




init = mice(mbd2, maxit=0) 
meth = init$method
predM = init$predictorMatrix

predM[, c("TARGET_WINS")]=0

imputed = mice(mbd2, method="rf", predictorMatrix=predM, m=5)

imputed <- complete(imputed)

imputedtable <- describe(imputed)

kable(imputedtable, "html", escape = F) %>%
  kable_styling("striped", full_width = T) %>%
  column_spec(1, bold = T) %>%
  scroll_box(width = "100%", height = "700px")





mbd2 <- moneyball_training_data
mbd2 <- mbd2[,-c(1, 11, 13)]

init = mice(mbd2, maxit=0) 
meth = init$method
predM = init$predictorMatrix

predM[, c("TARGET_WINS")]=0

imputed = mice(mbd2, method="rf", predictorMatrix=predM, m=5)

imputed <- complete(imputed)


vif(imputed)
v1 <- vifstep(imputed, th=10)


imputedtable <- describe(imputed)

kable(imputedtable, "html", escape = F) %>%
  kable_styling("striped", full_width = T) %>%
  column_spec(1, bold = T) %>%
  scroll_box(width = "100%", height = "700px")



model1 <- lm(TARGET_WINS ~., imputed)


model2 <- lm(TARGET_WINS ~ TEAM_BATTING_H  + TEAM_BATTING_3B  + TEAM_BATTING_HR  + TEAM_BATTING_SO + TEAM_BASERUN_SB + TEAM_PITCHING_SO + TEAM_FIELDING_E + TEAM_FIELDING_DP, imputed)

summary(model2)


model4 <- lm(TARGET_WINS ~ TEAM_BATTING_H + TEAM_BASERUN_SB  + TEAM_FIELDING_E  + TEAM_BATTING_HR, imputed)

summary(model4)




compare_model1 <- c(m1mse, m1root, m1ar, m1fs )
compare_model2 <- c(m2mse, m2root, m2ar, m2fs )
compare_model3 <- c(m3mse, m3root, m3ar, m3fs )

compare <- data.frame(compare_model1, compare_model2, compare_model3)
colnames(compare) <- c("Model 1", "Model 2", "Model 3")

kable(compare)




mbeval <- mbeval[,-c(1, 10, 12)]


init = mice(mbeval, maxit=0) 
meth = init$method
predM = init$predictorMatrix


imputed1 = mice(mbeval, method="rf", predictorMatrix=predM, m=5)

imputed1 <- complete(imputed1)

imputedtable1 <- describe(imputed1)

kable(imputedtable1, "html", escape = F) %>%
  kable_styling("striped", full_width = T) %>%
  column_spec(1, bold = T) %>%
  scroll_box(width = "100%", height = "700px")

predict1 <- predict(model4, newdata = imputed1, interval="prediction")
kable(predict1, "html", escape = F) %>%
  kable_styling("striped", full_width = T) %>%
  column_spec(1, bold = T) %>%
  scroll_box(width = "100%", height = "700px")


summary(predict1)