R/imputed-class.R

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

#' Additional functions for working with "imputed" objects
#'
#' @param x object.
#'
#' @details
#'
#' \code{restore_na} unclasses the object from the "imputed" class
#' and fills missing values in their original positions.
#'
#' \code{na_positions} returns (initial) positions of the missing
#' values in the "imputed" object.
#'
#' @examples
#'
#' x <- c(NA, 1, 2, NA, 4, NA, NA, 7, NA)
#' x
#' x <- na_prev(x)
#' x
#' na_positions(x)
#' na_restore(x)
#'
#' @export

as_imputed <- function(x) {
  if (is_imputed(x))
    return(x)
  structure(x,
    class = c(attr(x, "class"), "imputed"),
    na_positions = c(which(is.na(x)))
  )
}

#' @rdname as_imputed
#' @export

is_imputed <- function(x) {
  inherits(x, "imputed") &&
  "na_positions" %in% names(attributes(x))
}

#' @rdname as_imputed
#' @export

na_restore <- function(x) {
  if (!is_imputed(x))
    stop("x in not a imputed class object")
  class(x) <- class(x)[-inherits(x, "imputed", TRUE)]
  x[attr(x, "na_positions")] <- NA
  attr(x, "na_positions") <- NULL
  x
}

#' @rdname as_imputed
#' @export

na_positions <- function(x) {
  if ( !is_imputed(x) )
    x <- as_imputed(x)
  attr(x, "na_positions")
}

#' @export

print.imputed <- function(x, ...) {
  class(x) <- class(x)[-inherits(x, "imputed", TRUE)]
  attr(x, "na_positions") <- NULL
  print(x, ...)
}