#' Display Model Information
#'
#' Display information about models supplied by the \pkg{MachineShop} package.
#'
#' @param ... \link[=models]{model} functions, function names, or objects;
#' \link[=response]{observed responses} for which to display information. If
#' none are specified, information is returned on all available models by
#' default.
#'
#' @return List of named model elements each containing the following
#' components:
#' \describe{
#' \item{label}{character descriptor for the model.}
#' \item{packages}{character vector of source packages required to use the
#' model. These need only be installed with the
#' \code{\link{install.packages}} function or by equivalent means; but need
#' not be loaded with, for example, the \code{\link{library}} function.}
#' \item{response_types}{character vector of response variable types supported
#' by the model.}
#' \item{weights}{logical value or vector of the same length as
#' \code{response_types} indicating whether case weights are supported for
#' the responses.}
#' \item{arguments}{closure with the argument names and corresponding default
#' values of the model function.}
#' \item{grid}{logical indicating whether automatic generation of tuning
#' parameter grids is implemented for the model.}
#' \item{varimp}{logical indicating whether model-specific variable importance
#' is defined.}
#' }
#'
#' @examples
#' ## All models
#' modelinfo()
#'
#' ## Models by response types
#' names(modelinfo(factor(0)))
#' names(modelinfo(factor(0), numeric(0)))
#'
#' ## Model-specific information
#' modelinfo(GBMModel)
#'
modelinfo <- function(...) {
args <- list(...)
args <- if (length(args)) unname(args) else as.list(settings("models"))
info <- do.call(.modelinfo, args)
is_type <- if (length(info)) !map("logi", is, info, "list") else NULL
if (any(is_type)) {
info_models <- if (all(is_type)) modelinfo() else info[!is_type]
info_types <- do.call(.modelinfo_types, info[is_type])
info <- c(info_models, info_types)
info <- info[intersect(names(info_models), names(info_types))]
}
info[unique(names(info))]
}
.modelinfo <- function(x, ...) {
UseMethod(".modelinfo")
}
.modelinfo.default <- function(x, ...) {
info <- list(x)
if (...length()) c(info, .modelinfo(...)) else info
}
.modelinfo.character <- function(x, ...) {
model <- tryCatch(
as.MLModel(x),
error = function(cond) list()
)
.modelinfo(model, ...)
}
.modelinfo.function <- function(x, ...) {
model <- tryCatch(
as.MLModel(x),
error = function(cond) list()
)
.modelinfo(model, ...)
}
.modelinfo.list <- function(x, ...) {
if (...length()) .modelinfo(...) else list()
}
.modelinfo.MLModel <- function(x, ...) {
info <- structure(list(list(
label = x@label,
packages = x@packages,
response_types = x@response_types,
weights = x@weights,
na.rm = x@na.rm,
arguments = args(get0(x@name, mode = "function")),
grid = has_grid(x),
varimp = has_varimp(x)
)), names = x@name)
if (...length()) c(info, .modelinfo(...)) else info
}
.modelinfo_types <- function(...) {
info <- modelinfo()
check_model <- function(model) {
check_response <- function(y) any(is_response(y, model$response_types))
all(map("logi", check_response, list(...)))
}
info[map("logi", check_model, info)]
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.