tests/testthat/test_biasreduced.r

In smcfcs: Multiple Imputation of Covariates by Substantive Model Compatible Fully Conditional Specification

library(smcfcs)
context("Bias reduced model testing")

test_that("smcfcs gives error with perfect prediction and logreg method", {
  #note that this is not guaranteed (for an arbitrary seed) to give an error
  #because smcfcs initialises by randomly selecting some observed values, and
  #these are used in the covariate model fits (unlike in mice)
  suppressWarnings(
  expect_error({
    n <- 10
    z <- c(0,0,0,0,0,1,1,1,1,1)
    x <- z
    y <- x+rnorm(n)
    x[c(5,10)] <- NA

    simData <- data.frame(x,z,y)
    #impute x using z as an auxiliary variable
    predMat <- array(0, dim=c(3,3))
    predMat[1,2] <- 1
    rm(x,z,y)
    set.seed(62377)
    imps <- smcfcs(simData, smtype="lm", smformula="y~x",
                   method=c("logreg", "", ""), predictorMatrix=predMat, m=1)
  }))
})

test_that("smcfcs gives no warnings or errors with perfect prediction and brlogreg method", {
  expect_error({
    n <- 10
    z <- c(0,0,0,0,0,1,1,1,1,1)
    x <- z
    y <- x+rnorm(n)
    x[c(5,10)] <- NA

    simData <- data.frame(x,z,y)
    rm(x,z,y)
    #impute x using z as an auxiliary variable
    predMat <- array(0, dim=c(3,3))
    predMat[1,2] <- 1
    set.seed(62377)
    imps <- smcfcs(simData, smtype="lm", smformula="y~x",
                   method=c("brlogreg", "", ""), predictorMatrix=predMat, m=1)
  }, NA)
})

test_that("brlogreg gives results with minimal bias under perfect prediction between predictors", {
  skip_on_cran()
  expect_equal({
    set.seed(1234)
    n <- 1000
    nSim <- 100
    expit <- function(x) {
      exp(x)/(1+exp(x))
    }

    simEsts <- array(0, dim=c(nSim,2))

    for (i in 1:nSim) {
      z <- 1*(runif(n)<0.5)
      #true log odds parameters of x|z are finite but very large
      x <- 1*(runif(n)<expit(-10+20*z))
      x[runif(n)<0.25] <- NA
      y <- x+rnorm(n)

      simData <- data.frame(x,z,y)
      rm(x,z,y)
      #impute x using z as an auxiliary variable
      predMat <- array(0, dim=c(3,3))
      predMat[1,2] <- 1

      imps <- smcfcs(simData, smtype="lm", smformula="y~x",
                     method=c("brlogreg", "", ""), predictorMatrix=predMat)
      library(mitools)
      impobj <- imputationList(imps$impDatasets)
      smcfcsRes <- MIcombine(with(impobj, lm(y~x)))
      simEsts[i,] <- smcfcsRes$coefficients
    }
    ttestRes <- t.test(simEsts[,2], mu=1)
    ttestRes$p.value>0.05
  }, TRUE)
})


test_that("smcfcs gives no warnings or errors with perfect prediction and brlogistic method
          for substantive model and covariate model", {
  expect_error({
    n <- 10
    x <- c(0,0,0,0,0,1,1,1,1,1)
    y <- c(0,0,0,0,0,1,1,1,1,1)
    x[c(5,10)] <- NA

    simData <- data.frame(x,y)
    rm(x,y)
    set.seed(62377)
    imps <- smcfcs(simData, smtype="brlogistic", smformula="y~x",
                   method=c("brlogreg", ""), m=1)
  }, NA)
})