R/other.R

In twolodzko/misster: Simple tools for dealing with missing values

#' @importFrom stats formula terms update
#' @importFrom grDevices rgb col2rgb
NULL

lhs_vars <- function(formula, data = NULL) {
  if ( !is.null(data) )
    formula <- formula(terms(formula, data = data))
  lhs <- all.vars(update(formula, . ~ 1))
  if ( length(lhs) != 1L )
    stop("invalid formula")
  lhs
}

rhs_vars <- function(formula, data = NULL) {
  if ( !is.null(data) )
    formula <- formula(terms(formula, data = data))
  all.vars(update(formula, 1 ~ .))
}

Mode <- function(x, na.rm = FALSE) {
  if (na.rm)
    x <- na.omit(x)
  ux <- unique(x)
  tx <- tabulate(match(x, ux))
  ux[tx == max(tx)]
}

is_simple_vector <- function(x) {
  is.atomic(x) && !is.array(x)
}

add_alpha <- function(col, alpha = 1){
  out <- apply(sapply(col, col2rgb)/255, 2L,
               function(x) rgb(x[1L], x[2L], x[3L], alpha = alpha))
  out[is.na(col)] <- NA
  out
}