R/MCAR.R

In iriseekhout/Makemissing: Generate missing observations in a data frame

## written by Iris Eekhout mrt 2012 (www.iriseekhout.com)
## translated from JPL Brand et al (Brand, J. P. L., van Buuren, S., Groothuis-Oudshoorn, K., & Gelsema, E. S. (2003). A toolkit in SAS for the evaluation of multiple imputation methods. Statistica Neerlandica, 57(1), 36-45).

#' Generate MCAR (missign completely at random) data
#'
#' @param x data frame where missing observations should be generated in.
#' @param alpha proportion of cases that will get a missing data pattern
#' @param pattern a matrix with ncol=ncol(data), nrow=numer of missing data patterns; for each patter 0 indicates missing and 1 observed.
#' @param f frequency of each pattern
#'
#' @return A data frame that contains missing observations
#' @export
#'
#' @examples
#' library(MASS)
#' x <- mvrnorm(n=100,mu=c(0,0,0), Sigma=matrix(c(5,1,1,1,5,1,1,1,5),3,3))
#' alpha <- 0.25
#' pattern <- matrix(c(1,1,0,1,0,1),2,3, byrow=T)
#' f <- c(0.5,0.5)
#' MCAR(x,alpha,pattern,f)

MCAR <- function(x, alpha, pattern, f)
{
  xobs <- testcand1 <- testincompl <- testcand2 <- testresp <- list()
  x <- data.matrix(x)
  n <- NROW(x)
  m <- NCOL(x)
  sf <- sum (f)
  f <- data.matrix (f/sf)
  u <- runif(n)
  res <- outer(u, cumsum(f), ">")   # vervanging voor loop
  cand <- rowSums(res) + 1          # vervanging voor loop
  testcand1 <- cbind(u, cand)
  u <- data.matrix(runif(n))
  incompl <- ifelse(u<=alpha, 1, 0)
  testincompl <- cbind (u, incompl)
  cand <- cand * incompl
  testcand2 <- (cand)
  resp <- diag(0, n, m)
  bool <- cand == 0
  bool <- ifelse(bool == T, 1, 0)
  resp[which(bool !=0), c(1:m)] <- matrix(1, sum(bool), m)
  bool <- cand > 0
  bool <- ifelse(bool == T, 1, 0)
  if ( any(bool == 1) )  {resp[which(bool !=0), c(1:m)] <- matrix((pattern[cand,]), byrow = T)}
  testresp <- (apply (resp, 1, prod))
  xobs <- ifelse(resp==1, x , NA)
  xobs
  #list (xobs=xobs, testcand1=testcand1, testincompl=testincompl, testcand2=testcand2, testresp=testresp)
}