#' Assess the AIC for all models in a list of models
#'
#' @param object the list of models
#' @param \dots parameters passed to the underlying AIC function (typically the
#' parameter k)
#' @param assess.best determine which model is the best (by lowest AIC)
#' @seealso [get.best.model()]
#' @returns a data frame with row names matching the names of the list `x` and
#' columns for degrees of freedom (`df`) and `AIC`. If `assess.best` is true,
#' then there will be another column `isBest`.
#' @noRd
AIC.list <- function(object, ..., assess.best=TRUE) {
allAICs <-
lapply(object, FUN=function(subobject, ...) {
# Return the AIC of the new model relative to the reference model
if (identical(NA, subobject)) {
ret <- data.frame(AIC=NA, df=NA, indentation=0)
} else {
ret <- stats::AIC(subobject, ...)
if (is.numeric(ret)) {
ret <- data.frame(AIC=ret,
df=attr(stats::logLik(subobject), "df"),
indentation=0)
} else if (is.data.frame(ret)) {
if ("indentation" %in% names(ret)) {
ret$indentation <- ret$indentation + 1
} else {
stop("Unknown way to get a data.frame without indentation set. This is likely a bug.") # nocov
}
}
}
ret
})
retnames <- names(allAICs)
if (is.null(retnames))
retnames <- rep("", length(allAICs))
ret <- data.frame()
for (i in seq_len(length(allAICs))) {
tmpAICs <- allAICs[[i]]
# If the best value has already been established, drop it for assessment
# later.
tmpAICs$isBest <- NULL
# Assign the correct rownames to tmpAICs
if (!(retnames[i] %in% ""))
if (nrow(tmpAICs) > 1 |
!identical(rownames(tmpAICs), as.character(seq_len(nrow(tmpAICs))))) {
rownames(tmpAICs) <- paste(retnames[i], rownames(tmpAICs))
} else {
rownames(tmpAICs) <- retnames[i]
}
# Add tmpAICs to the data frame to return
ret <- rbind(ret, tmpAICs)
}
if (assess.best) {
ret$isBest <- ""
# The next row prevents warnings about no data when na.rm=TRUE
if (any(!is.na(ret$AIC)))
ret$isBest[ret$AIC %in% min(ret$AIC, na.rm=TRUE)] <- "Best Model"
}
ret
}
#' Extract the best model from a list of models using the AIC.
#'
#' @param object the list of models
#' @param \dots Parameters passed to AIC.list
#' @returns The model which is assessed as best. If more than one are equal,
#' the first is chosen.
#' @export
get.best.model <- function(object, ...) {
object[stats::AIC(object, ...)$isBest %in% "Best Model"][[1]]
}
#' Get the first model from a list of models
#'
#' @param object the list of (lists of, ...) models
#' @returns The first item in the `object` that is not a list or `NA`. If `NA`
#' is passed in or the list (of lists) is all `NA`, then `NA` is returned.
get.first.model <- function(object) {
ret <- NA
if (inherits(object, "list")) {
idx <- 0
while (identical(NA, ret) & idx < length(object)) {
idx <- idx + 1
if (identical(NA, object[[idx]])) {
# Do nothing
} else if (inherits(object[[idx]], "list")) {
ret <- get.first.model(object[[idx]])
} else {
# It is neither NA or a list, it's our first usable object;
# return it.
ret <- object[[idx]]
}
}
} else {
ret <- object
}
ret
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.