R/complete.R

In MatchThem: Matching and Weighting Multiply Imputed Datasets

#' @title Extracts Multiply Imputed Datasets
#'
#' @name complete
#'
#' @aliases complete complete.mimids complete.wimids
#'
#' @param data A \code{mimids} or \code{wimids} object.
#' @param action The imputed dataset number, intended to extract its data, or an action. The input must be a positive integer or a keyword. The keywords include \code{"all"} (produces a \code{mild} object of the multiply imputed datasets), \code{"long"} (produces a dataset with multiply imputed datasets stacked vertically), and \code{"broad"} (produces a dataset with multiply imputed datasets stacked horizontally). The default is \code{1}.
#' @param include Whether the original data with the missing values should be included. The input must be a logical value. The default is \code{FALSE}.
#' @param mild Whether the return value should be an object of \code{mild} class. Please note that setting \code{mild = TRUE} overrides \code{action} keywords of \code{"long"}, \code{"broad"}, and \code{"repeated"}. The default is \code{FALSE}.
#' @param all Whether to include observations with a zero estimated weight. The default is \code{TRUE}.
#' @param ... Ignored.
#'
#' @description \code{complete()} function extracts data from an object of the \code{mimids} or \code{wimids} class.
#'
#' @details \code{complete()} works by running \code{\link[mice:complete]{mice::complete()}} on the \code{mids} object stored within the \code{mimids} or \code{wimids} object and appending the outputs of the matching or weighting procedure. For \code{mimids} objects, the appended outputs include the matching weights, the propensity score (if included), pair membership (if included), and whether each unit was discarded. For \code{wimids} objects, the appended output is the estimated weights.
#'
#' @return This function returns the imputed dataset within the supplied \code{mimids} or \code{wimids} objects.
#'
#' @seealso \code{\link[=mimids]{mimids}}
#' @seealso \code{\link[=wimids]{wimids}}
#' @seealso \code{\link[mice:complete]{mice::complete}}
#'
#' @references Stef van Buuren and Karin Groothuis-Oudshoorn (2011). \code{mice}: Multivariate Imputation by Chained Equations in \code{R}. \emph{Journal of Statistical Software}, 45(3): 1-67. \doi{10.18637/jss.v045.i03}
#'
#' @export complete
#'
#' @examples \donttest{#Loading libraries
#' library(MatchThem)
#'
#' #Loading the dataset
#' data(osteoarthritis)
#'
#' #Multiply imputing the missing values
#' imputed.datasets <- mice::mice(osteoarthritis, m = 5)
#'
#' #Matching the multiply imputed datasets
#' matched.datasets <- matchthem(OSP ~ AGE + SEX + BMI + RAC + SMK,
#'                               imputed.datasets,
#'                               approach = 'within',
#'                               method = 'nearest')
#'
#' #Extracting the first imputed dataset
#' matched.dataset.1 <- complete(matched.datasets, n = 1)}

#' @rdname complete
#'
#' @method complete mimids
#'
#' @export

complete.mimids <- function(data, action = 1, include = FALSE, mild = FALSE, all = TRUE, ...) {

  #External function
  #S3 method

  #Based on: The mice::complete()
  #URL: <https://cran.r-project.org/package=mice>
  #URL: <https://github.com/stefvanbuuren/mice>
  #URL: <https://cran.r-project.org/web/packages/mice/mice.pdf>
  #URL: <https://www.jstatsoft.org/article/view/v045i03/v45i03.pdf>
  #Authors: Stef van Buuren et al.
  #Changes: Some

  #Importing functions
  #' @importFrom mice complete
  mice::complete
  #' @export

  #Polishing variables
  object <- data
  m <- as.integer(data$object$m)

  #mimids and wimids
  #Shape
  if (is.numeric(action)) {
    action <- as.integer(action)
    idx <- action[action >= 0L & action <= m]
    if (include && all(idx != 0L))
      idx <- c(0L, idx)
    shape <- if (mild) "mild" else "stacked"
  } else if (is.character(action)) {
    if (include)
      idx <- 0L:m
    else idx <- 1L:m
    shape <- match.arg(action, c("all", "long", "broad", "repeated", "stacked"))
    shape <- if (shape == "all" || mild) "mild" else shape
  } else {
    stop("The input for the action argument is invalid.")
  }

  #Select created variables from matchit/weightit models to add
  if (is.mimids(data)) {
    modelvars <- c("weights", "subclass", "distance", "discard")
  }
  else modelvars <- "weights"

  modelvars <- intersect(modelvars, names(object$models[[2]]))

  #Do it
  mylist <- lapply(idx, function(j) {
    out <- mice::complete(data$object, j)
    for (v in modelvars) {
      out[[v]] <- if (j == 0) NA_real_ else object$models[[j]][[v]]
    }
    out
  })

  #Return the output
  if (shape == "stacked") {
    cmp <- do.call("rbind", mylist)
    if (!all) cmp <- cmp[cmp$weights > 0, ,drop = FALSE]
    return(cmp)
  }

  if (shape == "mild") {
    if (!all) {
      for (i in seq_along(mylist)) {
        mylist[[i]] <- mylist[[i]][mylist[[i]]$weights > 0, ,drop = FALSE]
      }
    }
    names(mylist) <- as.character(idx)
    class(mylist) <- "mild"
    return(mylist)
  }

  if (shape == "long") {
    cmp <- do.call("rbind", lapply(idx, function(i) data.frame(.imp = i, .id = seq_len(nrow(mylist[[i]])),
                                                               mylist[[i]])))
    if (is.integer(attr(mylist[[1]], "row.names")))
      row.names(cmp) <- seq_len(nrow(cmp))
    else row.names(cmp) <- as.character(seq_len(nrow(cmp)))

    if (!all) cmp <- cmp[cmp$weights > 0, ,drop = FALSE]

    return(cmp)
  }

  if (!all) stop(paste0("'all' cannot be set to FALSE if action = '", shape, "'."))
  cmp <- do.call("cbind", mylist)
  names(cmp) <- paste(rep.int(names(mylist[[1]]), m), rep.int(idx, rep.int(ncol(mylist[[1]]), length(idx))), sep = ".")
  if (shape == "broad")
    return(cmp)
  else {
    return(cmp[, order(rep.int(seq_len(ncol(mylist[[1]])), length(idx)))])
  }
}

#' @rdname complete
#'
#' @method complete wimids
#'
#' @export

complete.wimids <- complete.mimids