R/burgled.R

Defines functions `discrete` `is.discrete` `as.discrete.default` `as.discrete`

# generated by {burglr}

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# as.discrete (copied from Hmisc:::as.discrete)

# from Hmisc 4.4-2
`as.discrete` <- function(x, ...) {
  UseMethod("as.discrete")
}

# from Hmisc 4.4-2
#' @export
`as.discrete.default` <- function(x, ...) {
  if (is.discrete(x)) {
    x
  } else {
    discrete(x)
  }
}

# from Hmisc 4.4-2
`is.discrete` <- function(x) {
  inherits(x, "discrete")
}

# from Hmisc 4.4-2
`discrete` <- function(x, levels = sort(unique.default(x), na.last = TRUE),
                       exclude = NA) {
  if (!is.numeric(x)) {
    stop("x must be a numeric vairable")
  }
  exclude <- as.vector(exclude, typeof(x))
  levels <- levels[is.na(match(levels, exclude))]
  f <- x[!(x %in% exclude)]
  attr(f, "levels") <- levels
  class(f) <- "discrete"
  f
}
moodymudskipper/burglr documentation built on Dec. 21, 2021, 9:02 p.m.