tests/testthat/test_errorchecks.R

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

library(smcfcs)
library(survival)
context("Error trap testing")

test_that("Checking outcome model check for logistic models", {
  expect_error({
    set.seed(1234)
    n <- 100
    x <- rnorm(n)
    y <- as.factor(1 * (runif(n) < 0.5))
    x[(runif(n) < 0.5)] <- NA

    simData <- data.frame(x, y)

    imps <- smcfcs(simData,
      smtype = "logistic", smformula = "y~x",
      method = c("norm", "")
    )
  })
})

test_that("Checking outcome model check for logistic models", {
  expect_error({
    set.seed(1234)
    n <- 100
    x <- rnorm(n)
    y <- 1 + 1 * (runif(n) < 0.5)
    x[(runif(n) < 0.5)] <- NA

    simData <- data.frame(x, y)

    imps <- smcfcs(simData,
      smtype = "logistic", smformula = "y~x",
      method = c("norm", "")
    )
  })
})

test_that("Checking outcome model check for logistic models", {
  expect_output({
    set.seed(1234)
    n <- 100
    x <- rnorm(n)
    y <- 1 * (runif(n) < 0.5)
    x[(runif(n) < 0.5)] <- NA

    simData <- data.frame(x, y)

    imps <- smcfcs(simData,
      smtype = "logistic", smformula = "y~x",
      method = c("norm", "")
    )
  })
})

test_that("Checking error trap for method statement 1", {
  expect_error({
    set.seed(1234)
    n <- 100
    x1 <- rnorm(n)
    x2 <- rnorm(n)
    y <- y <- x1 + x2 + rnorm(n)
    x1[(runif(n) < 0.5)] <- NA

    simData <- data.frame(x1, x2, y)

    imps <- smcfcs(simData,
      smtype = "lm", smformula = "y~x1+x2",
      method = c("", "", "")
    )
  })
})

test_that("Checking error trap for method statement 2", {
  expect_error({
    set.seed(1234)
    n <- 100
    x1 <- rnorm(n)
    x2 <- rnorm(n)
    y <- y <- x1 + x2 + rnorm(n)
    x1[(runif(n) < 0.5)] <- NA

    simData <- data.frame(x1, x2, y)

    imps <- smcfcs(simData,
      smtype = "lm", smformula = "y~x1+x2",
      method = c("", "norm", "")
    )
  })
})

test_that("Checking measurement error error checks 1", {
  expect_error({
    set.seed(1234)
    n <- 100
    x <- rnorm(n)
    w1 <- x + rnorm(n)
    w2 <- x + rnorm(n)
    y <- y <- x + rnorm(n)
    x <- rep(NA, n)

    simData <- data.frame(x, w1, w2, y)

    imps <- smcfcs(simData,
      smtype = "lm", smformula = "y~x",
      method = c("latnorm", "", "", "")
    )
  })
})

test_that("Checking measurement error error checks 2", {
  expect_error({
    set.seed(1234)
    n <- 100
    x <- rnorm(n)
    w1 <- x + rnorm(n)
    y <- y <- x + rnorm(n)
    x <- rep(NA, n)

    simData <- data.frame(x, w1, y)
    errMat <- array(0, dim = c(3, 3))

    imps <- smcfcs(simData,
      smtype = "lm", smformula = "y~x",
      method = c("latnorm", "", ""), errorProneMatrix = errMat
    )
  })
})

test_that("Checking measurement error error checks 3", {
  expect_error({
    set.seed(1234)
    n <- 100
    x <- rnorm(n)
    w1 <- x + rnorm(n)
    y <- y <- x + rnorm(n)
    x <- rep(NA, n)

    simData <- data.frame(x, w1, y)
    errMat <- array(0, dim = c(3, 3))
    errMat[1, 1] <- 1

    imps <- smcfcs(simData,
      smtype = "lm", smformula = "y~x",
      method = c("latnorm", "", ""), errorProneMatrix = errMat
    )
  })
})

test_that("Checking measurement error error checks 4", {
  expect_error({
    set.seed(1234)
    n <- 100
    x <- rnorm(n)
    w1 <- x + rnorm(n)
    w2 <- x + rnorm(n)
    y <- y <- x + rnorm(n)
    x <- rep(NA, n)

    simData <- data.frame(x, w1, w2, y)
    errMat <- array(0, dim = c(4, 4))
    errMat[1, 2] <- 1
    errMat[1, 3] <- 1
    errMat[4, 2] <- 1

    imps <- smcfcs(simData,
      smtype = "lm", smformula = "y~x",
      method = c("latnorm", "", "", ""), errorProneMatrix = errMat
    )
  })
})

test_that("Checking measurement error error checks 5", {
  expect_error({
    set.seed(1234)
    n <- 100
    x <- rnorm(n)
    w1 <- x + rnorm(n)
    w2 <- x + rnorm(n)
    y <- y <- x + rnorm(n)
    x <- rep(NA, n)

    simData <- data.frame(x, w1, w2, y)
    errMat <- array(0, dim = c(4, 4))
    errMat[1, 2] <- 1
    errMat[1, 3] <- 1
    errMat[4, 2] <- 2

    imps <- smcfcs(simData,
      smtype = "lm", smformula = "y~x",
      method = c("latnorm", "", "", ""), errorProneMatrix = errMat
    )
  })
})


test_that("Checking measurement error error checks 6", {
  expect_error({
    set.seed(1234)
    n <- 100
    x <- rnorm(n)
    w1 <- x + rnorm(n)
    w2 <- x + rnorm(n)
    y <- y <- x + rnorm(n)
    x <- rep(NA, n)

    simData <- data.frame(x, w1, w2, y)
    errMat <- array(0, dim = c(5, 5))
    errMat[1, 2] <- 1
    errMat[1, 3] <- 1

    imps <- smcfcs(simData,
      smtype = "lm", smformula = "y~x",
      method = c("latnorm", "", "", ""), errorProneMatrix = errMat
    )
  })
})

test_that("Checking measurement error error checks 7", {
  expect_error({
    set.seed(1234)
    n <- 100
    x <- rnorm(n)
    w1 <- x + rnorm(n)
    w2 <- x + rnorm(n)
    y <- y <- x + rnorm(n)
    x <- rep(NA, n)
    z <- rnorm(n)
    z[1:50] <- NA

    simData <- data.frame(w1, w2, y, z)
    errMat <- array(0, dim = c(4, 4))
    errMat[3, 1] <- 1
    errMat[3, 2] <- 1

    imps <- smcfcs(simData,
      smtype = "lm", smformula = "y~x",
      method = c("", "", "", "norm"), errorProneMatrix = errMat
    )
  })
})

test_that("Cox imputation fails if event indicator is not coded right", {
  expect_error({
    set.seed(1234)
    n <- 1000
    z <- rnorm(n)
    x <- z + rnorm(n)
    t <- -log(runif(n)) / (1 * exp(x + z))
    d <- 1 * (t < 10) + 1
    t[d == 1] <- 10
    x[(runif(n) < 0.5)] <- NA

    simData <- data.frame(t, d, x, z)

    imps <- smcfcs(simData,
      smtype = "coxph", smformula = "Surv(t, d)~x+z",
      method = c("", "", "norm", "")
    )
  })
})

test_that("Cox error check doesn't fail when events are 1 1 1 0 0 0", {
  expect_error(
    {
      set.seed(1234)
      n <- 100
      z <- rnorm(n)
      x <- z + rnorm(n)
      t <- runif(n)
      d <- c(rep(1, n / 2), rep(0, n / 2))
      x[(runif(n) < 0.5)] <- NA

      simData <- data.frame(t, d, x, z)

      imps <- smcfcs(simData,
        smtype = "coxph", smformula = "Surv(t, d)~x+z",
        method = c("", "", "norm", "")
      )
    },
    NA
  )
})