Code to calculate in-sample rms error, BIC, and out-of-sample (by group) rms error for linear models

evaluate-models.R

# evaluate model fit by predicting years, one-by-one, out-of-sample
evaluate_models <- function(..., data, group, model_names) {
  require(dplyr, warn.conflicts = FALSE, quietly = TRUE)
  formulas <- list(...)
  # in-sample rmse
  eval1 <- NULL
  for (i in 1:length(formulas)) {
    f <- formulas[[i]]
    fit0 <- lm(f, data = data)
    df0 <- data.frame(model = model_names[i], 
                      BIC = BIC(fit0),
                      rms_error = sqrt(mean(residuals(fit0)^2)))
    eval1 <- rbind(eval1, df0)
  }
  # leave-groups-out rmse
  groups <- sort(unique(as.matrix(data[, group])))
  oos_df <- df0 <- NULL
  for (i in 1:length(formulas)) {
    f <- formulas[[i]]
    df0 <- NULL
    for (j in 1:length(groups)) {
      train00 <- filter(data, data[, group] != groups[j])
      pred00 <- filter(data, data[, group] == groups[j])
      fit00 <- lm(f, data = train00)
      df00 <- data.frame(model = model_names[i], 
                         group = groups[j], 
                         oos_predicted = predict(fit00, newdata = pred00),
                         actual = pred00$tax_change)
      df0 <- rbind(df0, df00)
    }
    oos_df <- rbind(oos_df, df0)
  }
  eval2 <- summarize(group_by(oos_df, model), 
                     oos_rms_error = sqrt(mean((oos_predicted - actual)^2)))
  eval <- left_join(eval1, eval2)
  return(eval)
}