R/f_auto.R

In collinear: Automated Multicollinearity Management

#' Automatic selection of predictor scoring method
#'
#' @description
#' Internal function to select a proper \code{f_...()} function to compute preference order depending on the types of the response variable and the predictors. The selection criteria is available as a dataframe generated by [f_auto_rules()].
#'
#'
#' @inheritParams collinear
#'
#' @param response (optional, character string) Name of a response variable in \code{df}. Default: NULL.
#'
#' @return function name
#' @examples
#' data(
#'   vi_smol,
#'   vi_predictors_numeric,
#'   vi_predictors_categorical,
#'   vi_predictors
#'   )
#'
#' f_auto(
#'   df = vi_smol,
#'   response = "vi_numeric",
#'   predictors = vi_predictors_numeric
#'   )
#'
#' f_auto(
#'   df = vi_smol,
#'   response = "vi_binomial",
#'   predictors = vi_predictors_numeric
#'   )
#'
#' f_auto(
#'   df = vi_smol,
#'   response = "vi_categorical",
#'   predictors = vi_predictors_categorical
#'   )
#'
#'
#' @family preference_order_tools
#' @export
#' @autoglobal
f_auto <- function(
  df = NULL,
  response = NULL,
  predictors = NULL,
  quiet = FALSE,
  ...
) {
  function_name <- validate_arg_function_name(
    default_name = "collinear::f_auto()",
    ... = ...
  )

  quiet <- validate_arg_quiet(
    quiet = quiet,
    function_name = function_name
  )

  df <- validate_arg_df_not_null(
    df = df,
    function_name = function_name
  )

  response <- validate_arg_responses(
    df = df,
    responses = response,
    max_responses = 1,
    quiet = quiet,
    function_name = function_name
  )

  predictors <- validate_arg_predictors(
    df = df,
    responses = response,
    predictors = predictors,
    quiet = quiet,
    function_name = function_name
  )

  df <- validate_arg_df(
    df = df,
    responses = response,
    predictors = predictors,
    quiet = quiet,
    function_name = function_name
  )

  if (is.null(response)) {
    stop(
      "\n",
      function_name,
      ": argument 'response' must not be NULL."
    )
  }

  response_type <- identify_response_type(
    df = df,
    response = response,
    quiet = quiet,
    function_name = function_name
  )

  if (response_type == "unknown") {
    stop(
      function_name,
      ": response type is 'unknown', please select an f_...() function suitable for your response data.",
      call. = FALSE
    )
  }

  #identify types of the predictors
  predictors_type <- lapply(
    X = df[, predictors, drop = FALSE],
    FUN = class
  ) |>
    unlist() |>
    gsub(
      pattern = "integer",
      replacement = "numeric"
    ) |>
    gsub(
      pattern = "character|factor",
      replacement = "categorical"
    ) |>
    unique()

  if (length(predictors_type) > 1) {
    predictors_type <- "mixed"
  }

  if (!(predictors_type %in% c("numeric", "categorical", "mixed"))) {
    stop(
      "\n",
      function_name,
      ": predictors type is 'unknown', please select an f_...() function suitable for your predictors.",
      call. = FALSE
    )
  }

  #select function
  rules <- f_auto_rules()

  f_name <- rules[
    rules$response_type == response_type &
      rules$predictors_type == predictors_type,
    "name"
  ]

  if (quiet == FALSE) {
    message(
      "\n",
      function_name,
      ": selected function '",
      f_name,
      "()' to compute preference order."
    )
  }

  f_name
}