From 2410f9c9f6c97a6c0e93753c02c62a72ba96bd37 Mon Sep 17 00:00:00 2001
From: Hugo Najberg <hugo.najberg@gmail.com>
Date: Mon, 27 Aug 2018 16:45:06 +0200
Subject: [PATCH] #83

---
 R/find_best_model.lmerModLmerTest.R | 82 +++++++++++++++++++++++++++++
 1 file changed, 82 insertions(+)
 create mode 100644 R/find_best_model.lmerModLmerTest.R

diff --git a/R/find_best_model.lmerModLmerTest.R b/R/find_best_model.lmerModLmerTest.R
new file mode 100644
index 0000000..06734b8
--- /dev/null
+++ b/R/find_best_model.lmerModLmerTest.R
@@ -0,0 +1,82 @@
+#' Returns the best combination of predictors for lmerTest objects.
+#'
+#' Returns the best combination of predictors for lmerTest objects.
+#'
+#' @param fit A merModLmerTest object.
+#' @param interaction Include interaction term.
+#' @param fixed Additional formula part to add at the beginning of
+#' each formula
+#' @param ... Arguments passed to or from other methods.
+#'
+#' @return list containing all combinations.
+#'
+#' @examples
+#' \dontrun{
+#' library(psycho)
+#' library(lmerTest)
+#'
+#' data <- standardize(iris)
+#' fit <- lmerTest::lmer(Sepal.Length ~ Sepal.Width + Petal.Length + (1|Species), data=data)
+#'
+#' best <- find_best_model(fit)
+#' best_formula <- best$formula
+#' best$table
+#'
+#' }
+#'
+#' @author \href{https://dominiquemakowski.github.io/}{Dominique Makowski}
+#'
+#' @importFrom stats update
+#' @import dplyr
+#'
+#' @method find_best_model lmerModLmerTest
+#' @export
+find_best_model.lmerModLmerTest <- function(fit, interaction=TRUE, fixed=NULL, ...) {
+
+  # Extract infos
+  combinations <- find_combinations(as.formula(get_formula(fit)), interaction = interaction, fixed = fixed)
+
+  
+  # Recreating the dataset without NA
+  dataComplete <- get_all_vars(fit)[complete.cases(get_all_vars(fit)), ]
+  
+  
+  # fit models
+  models <- c()
+  for (formula in combinations) {
+    newfit <- update(fit, formula, data = dataComplete)
+    models <- c(models, newfit)
+  }
+
+
+  # No warning messages for this part
+  options(warn = -1)
+  
+  # Model comparison
+  comparison <- as.data.frame(do.call("anova", models))
+  comparison$formula <- combinations
+
+  # Re-displaying warning messages
+  options(warn = 0)
+  
+
+  # Best model by criterion
+  best_aic <- dplyr::arrange_(comparison, "AIC") %>%
+    dplyr::select_("formula") %>%
+    head(1)
+  best_aic <- as.character(best_aic[[1]])
+
+  best_bic <- dplyr::arrange_(comparison, "BIC") %>%
+    dplyr::select_("formula") %>%
+    head(1)
+  best_bic <- as.character(best_bic[[1]])
+
+  by_criterion <- data.frame(formula = c(best_aic, best_bic), criterion = c("AIC", "BIC"))
+
+  # Best formula
+  best <- table(by_criterion$formula)
+  best <- names(best[which.max(best)])
+
+  best <- list(formula = best, by_criterion = by_criterion, table = comparison)
+  return(best)
+}