R/model.R

In aelhabr/temisc: Tony's Personal Package

#' Normalize a variable
#'
#' @description Transforms a numeric array to be between 0 and 1.
#' @details None.
#' @param data numeric vector, numeric column in a data.frame, or a numeric column/row in a matrix.
#' @param ... dots. Passed on to calculation functions (e.g. na.rm).
#' @rdname unitize
#' @export
unitize <- function(data, ...) {
  (data - min(data, ...)) / (max(data, ...) - min(data, ...))
}

#' Normalize a variable
#'
#' @description Transforms a numeric array using z-score standardization.
#' @details None.
#' @inheritParams unitize
#' @export
#' @importFrom stats sd
standardize_z <- function(data, ...) {
  (data - stats::sd(data, ...)) / (mean(data, ...))
}

#'
#' Create a formula
#'
#' @description Adds tickmarks to formula variables.
#' @details Intended to be called exclusively by \code{create_fmla()}.
#' @param x character. Variable (x or y) in a formula to which tickmarks should be added.
#' @export
add_tickmarks <- function(x) {
  ifelse(grepl("^[0-9]", x) == TRUE, paste0("`", x, "`"), x)
}

#'
#' Create a formula
#'
#' @description Funcion to create formula from x and y variables.
#' @details Implements independent regressor only (not interaction terms).
#' This originally spawned in my NBA project.
#' @param y character. Y variable,
#' @param x character. x variable,
#' @param as_fmla logical. Indicates whether to return a formula,
#' @export
#' @importFrom stats as.formula
create_fmla <- function(y = NULL,
                        x = NULL,
                        as_fmla = TRUE) {
  stopifnot(!is.null(y) && !is.null(x))
  x <- add_tickmarks(x)
  y <- add_tickmarks(y)
  fmla <- paste0(y, " ~ ", paste(x, collapse = " + "))

  if (as_fmla == TRUE) {
    fmla <- stats::as.formula(fmla)
  }
  fmla
}

#'
#' Create a formula
#'
#' @description Function to convert a formula from a formula object to a character (for printing purposes).
#' @details This originally spawned in my NBA project.
#' @param fmla Formula.
#' @export
convert_fmla_to_char <- function(fmla = NULL) {
  stopifnot(!is.null(fmla))
  if (class(fmla) != "formula") {
    warning("fmla is not of type \"formula\".",
            "Returning formula unchanged.")
    return(fmla)
  }
  paste(fmla[2], fmla[3], sep = "~")
}