R/dimensionality-reduction.R

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

#' Dimmensionality reduction to visualize missing data
#'
#' @param data       a data.frame.
#' @param formula    an object of class "\code{\link[stats]{formula}}":
#'                   a symbolic description of the model to be fitted.
#' @param \dots      further arguments passed to other methods.
#' @param plot       if \code{TRUE} prints plots of the first two
#'                   components extracted using PCA or t-SNE with
#'                   highlited missing values.
#'
#' @seealso \code{\link[stats]{princomp}}, \code{\link[Rtsne]{Rtsne}}
#'
#' @examples
#'
#' set.seed(1234)
#'
#' dat <- mtcars
#' dat$disp[sample.int(nrow(dat), 10)] <- NA
#'
#' na_pca(dat, disp ~ mpg + cyl + disp)
#' na_tsne(dat, disp ~ ., perplexity = 10)
#'
#' @importFrom stats princomp na.pass
#' @importFrom Rtsne Rtsne
#'
#' @export

na_pca <- function(data, formula, ..., plot = TRUE) {

  y_var <- lhs_vars(formula)
  mf <- model.frame(formula, data = data, na.action = na.pass)
  y <- mf[, 1L]
  X <- mf[, -1L, drop = FALSE]
  nas <- is.na(y)

  pc <- princomp(X, ...)
  out <- cbind(data[, y_var], pc$scores)
  colnames(out)[1L] <- y_var
  if ( plot ) {
    na_scatter(out)
  }
  invisible(out)
}

#' @rdname na_pca
#' @export

na_tsne <- function(data, formula, ..., plot = TRUE) {

  y_var <- lhs_vars(formula)
  mf <- model.frame(formula, data = data, na.action = na.pass)
  y <- mf[, 1L]
  X <- mf[, -1L, drop = FALSE]
  nas <- is.na(y)

  pc <- Rtsne(X, ...)
  out <- cbind(data[, y_var], pc$Y)
  colnames(out) <- c(y_var, paste0("Comp.", 1:ncol(pc$Y)))
  if ( plot ) {
    na_scatter(out)
  }
  invisible(out)
}