context("Testing checkInputs function")
library(survtmle)
library(survival)
library(cmprsk)
test_that("checkInputs errors with bad inputs", {
ftime <- rep(10, 3)
ftype <- rep(10, 3)
trt <- 1:3
# too many trt levels
expect_error(survtmle(
ftime = ftime, ftype = ftype, trt = trt,
adjustVars = NULL, glm.trt = "1",
glm.ftime = "1",
glm.ctime = "1"
))
# wrong trt format
trt <- cbind(1, 2, 2)
expect_error(survtmle(
ftime = ftime, ftype = ftype, trt = trt,
adjustVars = NULL, glm.trt = "1",
glm.ftime = "1",
glm.ctime = "1"
))
# no events observed prior to t0
trt <- c(1, 1, 0)
expect_error(survtmle(
ftime = ftime, ftype = ftype, trt = trt,
adjustVars = NULL, glm.trt = "1",
glm.ftime = "1",
glm.ctime = "1", t0 = 3
))
# adjustVars has column 't'
expect_error(survtmle(
ftime = ftime, ftype = ftype, trt = trt,
adjustVars = data.frame(t = 1:3), glm.trt = "1",
glm.ftime = "1",
glm.ctime = "1"
))
})
test_that("NAs/NULLs throw errors", {
ftime <- rep(10, 3)
ftime[3] <- NA
ftype <- rep(10, 3)
trt <- c(0, 0, 1)
expect_error(survtmle(
ftime = ftime, ftype = ftype, trt = trt,
adjustVars = NULL, glm.trt = "1",
glm.ftime = "1",
glm.ctime = "1"
))
# add a NULL
ftime <- NULL
expect_error(survtmle(
ftime = ftime, ftype = ftype, trt = trt,
adjustVars = NULL, glm.trt = "1",
glm.ftime = "1",
glm.ctime = "1"
))
# add missing in adjustVars
ftime <- rep(10, 3)
expect_error(survtmle(
ftime = ftime, ftype = ftype, trt = trt,
adjustVars = data.frame(grbg = c(NA, 1, 1)), glm.trt = "1",
glm.ftime = "1",
glm.ctime = "1"
))
# no observed events in trt arm
expect_error(survtmle(
ftime = ftime, ftype = ftype, trt = trt,
adjustVars = NULL, glm.trt = "1",
glm.ftime = "1",
glm.ctime = "1", ftypeOfInterest = 1
))
})
test_that("ftime < 0 throw errors", {
ftime <- rep(10, 3)
ftime[3] <- -10
ftype <- rep(10, 3)
trt <- c(0, 0, 1)
expect_error(survtmle(
ftime = ftime, ftype = ftype, trt = trt,
adjustVars = NULL, glm.trt = "1",
glm.ftime = "1",
glm.ctime = "1"
))
})
test_that("adjustVars = NULL works as expected", {
set.seed(1234)
n <- 200
trt <- rbinom(n, 1, 0.5)
ftime <- round(runif(n, 0, 4)) + 1
ftype <- round(runif(n, 0, 1)) + round(runif(n, 0, 1))
expect_warning(fit1 <- survtmle(
ftime = ftime, ftype = ftype, trt = trt,
adjustVars = NULL
))
expect_true(is.numeric(fit1$est))
})
test_that("adjustVars constantly valued works as expected", {
set.seed(1234)
n <- 200
trt <- rbinom(n, 1, 0.5)
adjustVars <- data.frame(W1 = rep(1, n), W2 = rep(0, n))
ftime <- round(runif(n, 0, 4)) + 1
ftype <- round(runif(n, 0, 1)) + round(runif(n, 0, 1))
expect_warning(fit1 <- survtmle(
ftime = ftime, ftype = ftype, trt = trt,
adjustVars = adjustVars
))
expect_true(is.numeric(fit1$est))
# this one should go ahead fitting ctime and ftime glm's because they don't
# use W
expect_warning(fit2 <- survtmle(
ftime = ftime, ftype = ftype, trt = trt,
adjustVars = adjustVars, glm.trt = "W1", glm.ctime = "trt",
glm.ftime = "trt", t0 = 3
))
expect_true(is.numeric(fit2$est))
# this one should remove SL and fit unadjusted estimates
expect_warning(fit3 <- survtmle(
ftime = ftime, ftype = ftype, trt = trt,
adjustVars = adjustVars, glm.trt = "W1", SL.ctime = "SL.glm",
SL.ftime = "SL.glm", t0 = 3
))
expect_true(is.numeric(fit3$est))
})
test_that("when glm and super learner are specified, things behave.", {
set.seed(1234)
n <- 100
trt <- rbinom(n, 1, 0.5)
adjustVars <- data.frame(W1 = rnorm(n), W2 = rnorm(n))
ftime <- round(runif(n, 0, 4)) + 1
ftype <- round(runif(n, 0, 1)) + round(runif(n, 0, 1))
expect_warning(fit1 <- survtmle(
ftime = ftime, ftype = ftype, trt = trt,
adjustVars = adjustVars, glm.trt = "1", SL.trt = "SL.glm",
glm.ctime = "t + W1", SL.ctime = "SL.glm", glm.ftime = "trt + t",
SL.ftime = "SL.glm", t0 = 3
))
expect_true(is.numeric(fit1$est))
})
test_that("bad formulas cause errors.", {
set.seed(1234)
n <- 100
trt <- rbinom(n, 1, 0.5)
adjustVars <- data.frame(W1 = rnorm(n), W2 = rnorm(n))
ftime <- round(runif(n, 0, 4)) + 1
ftype <- round(runif(n, 0, 1)) + round(runif(n, 0, 1))
expect_error(survtmle(
ftime = ftime, ftype = ftype, trt = trt, t0 = 3,
adjustVars = adjustVars, glm.trt = "1245$%", glm.ftime = "1", glm.ctime = "1"
))
expect_error(survtmle(
ftime = ftime, ftype = ftype, trt = trt, t0 = 3,
adjustVars = adjustVars, glm.ftime = "1245$%", glm.trt = "1", glm.ctime = "1"
))
expect_error(survtmle(
ftime = ftime, ftype = ftype, trt = trt, t0 = 3,
adjustVars = adjustVars, glm.ctime = "1245$%", glm.trt = "1", glm.ftime = "1"
))
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.