tests/testthat/test-validate-longdata.R

In rbmi: Reference Based Multiple Imputation

suppressPackageStartupMessages({
    library(dplyr)
    library(testthat)
    library(tibble)
})

n <- 10
nv <- 3

covars <- tibble(
    subjid = 1:n,
    age = rnorm(n),
    group = factor(sample(c("A", "B"), size = n, replace = TRUE), levels = c("A", "B")),
    sex = factor(sample(c("M", "F"), size = n, replace = TRUE), levels = c("M", "F")),
    strata = c("A","A","A","A","A","A","A","A","B", "B")
)

dat <- tibble(
    subjid = rep.int(1:n, nv)
) %>%
    left_join(covars, by = "subjid") %>%
    mutate( outcome = rnorm(
        n(),
        age * 3 + (as.numeric(sex) - 1) * 3 + (as.numeric(group) - 1) * 4,
        sd = 3
    )) %>%
    arrange(subjid) %>%
    group_by(subjid) %>%
    mutate( visit = factor(paste0("Visit ", 1:n())))  %>%
    ungroup() %>%
    mutate(subjid = factor(subjid))

dat[c(1,2,3,4,5,7), "outcome"] <- NA


vars <- set_vars(
    outcome = "outcome",
    visit = "visit",
    subjid = "subjid",
    group = "group",
    strata = "strata",
    strategy = "strategy",
    covariates = c("sex", "age")
)



test_that("extract_covariates",{
    expect_equal(extract_covariates("age"), "age")
    expect_equal(extract_covariates(c("age", "sex")), c("age", "sex"))
    expect_equal(extract_covariates(c("age:sex")), c("age", "sex"))
    expect_equal(extract_covariates(c("age*sex")), c("age", "sex"))
    expect_equal(extract_covariates(c("age", "age*sex")), c("age", "sex"))
    expect_equal(extract_covariates(c("age", " age*sex ")), c("age", "sex"))
    expect_equal(extract_covariates(c("age", " age *sex ")), c("age", "sex"))
    expect_equal(extract_covariates(c("age", " age * sex")), c("age", "sex"))
    expect_equal(extract_covariates(c("age", " age :   sex ")), c("age", "sex"))
    expect_equal(extract_covariates(""), character(0))
})





test_that("validate.ivars", {

    expect_true(validate(vars))

    vars2 <- vars
    vars2$subjid <- NULL
    expect_error(validate(vars2))

    vars2 <- vars
    vars2$outcome <- NULL
    expect_error(validate(vars2))

    vars2 <- vars
    vars2$group <- NULL
    expect_error(validate(vars2))


    vars2 <- vars
    vars2$visit <- NULL
    expect_error(validate(vars2))

    vars2 <- vars
    vars2$strata <- 1
    expect_error(validate(vars2))

    vars2 <- vars
    vars2$strata <- NULL
    expect_true(validate(vars2))

    vars2 <- vars
    vars2$covariates <- 1
    expect_error(validate(vars2))

    vars2 <- vars
    vars2$covariates <- NULL
    expect_true(validate(vars2))

    vars2 <- vars
    vars2$subjid <- c("v1", "v2")
    expect_error(validate(vars2))
})




test_that("validate_datalong_varExists", {

    expect_true(validate_datalong_varExists(dat, vars))

    dat2 <- dat
    dat2$subjid <- NULL
    expect_error(validate_datalong_varExists(dat2, vars))

    dat2 <- dat
    dat2$age <- NULL
    expect_error(validate_datalong_varExists(dat2, vars))

    dat2 <- dat
    dat2$group <- NULL
    expect_error(validate_datalong_varExists(dat2, vars))

    dat2 <- dat
    dat2$sex <- NULL
    expect_error(validate_datalong_varExists(dat2, vars))

    dat2 <- dat
    dat2$strata <- NULL
    expect_error(validate_datalong_varExists(dat2, vars))

    dat2 <- dat
    dat2$outcome <- NULL
    expect_error(validate_datalong_varExists(dat2, vars))

    dat2 <- dat
    dat2$visit <- NULL
    expect_error(validate_datalong_varExists(dat2, vars))

})




test_that("validate_datalong_types",{


    expect_true(validate_datalong_types(dat, vars))


    dat2 <- dat
    dat2$subjid <- rnorm(nrow(dat))
    expect_error(validate_datalong_types(dat2, vars))

    dat2 <- dat
    dat2$subjid <- as.character(dat$subjid)
    expect_error(validate_datalong_types(dat2, vars))

    dat2 <- dat
    dat2$subjid <- factor(dat$subjid)
    expect_true(validate_datalong_types(dat2, vars))


    dat2 <- dat
    dat2$group <- rnorm(nrow(dat))
    expect_error(validate_datalong_types(dat2, vars))

    dat2 <- dat
    dat2$group <- factor(dat$subjid)
    expect_true(validate_datalong_types(dat2, vars))


    dat2 <- dat
    dat2$outcome <- as.character(dat$outcome)
    expect_error(validate_datalong_types(dat2, vars))

    dat2 <- dat
    dat2$outcome <- as.factor(dat$outcome)
    expect_error(validate_datalong_types(dat2, vars))


    dat2 <- dat
    dat2$visit <- rnorm(nrow(dat))
    expect_error(validate_datalong_types(dat2, vars))

    dat2 <- dat
    dat2$visit <- as.character(dat$visit)
    expect_error(validate_datalong_types(dat2, vars))

    # Show that we can catch covariates that only have 1 level
    dat2 <- dat
    dat2$sex <- factor("M")
    expect_error(validate_datalong_types(dat2, vars), "`sex`")

    # Show that covariate 1 level checks only apply to covariates
    dat2 <- dat
    dat2$group <- factor("A")
    expect_true(validate_datalong_types(dat2, vars))

    # But then show that it will catch group if it is listed as a covariate
    dat2 <- dat
    dat2$group <- factor("A")
    vars2 <- vars
    vars2$covariates <- c(vars2$covariates, "group*sex")
    expect_error(validate_datalong_types(dat2, vars2), "`group`")

    # Show that stratification variables are not affected by this
    dat2 <- dat
    dat2$strata <- factor("A")
    expect_true(validate_datalong_types(dat2, vars))

    # Show that the visit variable is not affected by this
    dat2 <- dat
    dat2$visit <- factor("A")
    expect_true(validate_datalong_types(dat2, vars))

    # Test that if group or visit variables have unobserved levels return error
    dat2 <- dat[dat$visit != "Visit 1",]
    expect_error(
        validate_datalong_types(dat2, vars),
        "`visit`"
    )
    dat2 <- dat[dat$group == "B",]
    expect_error(
        validate_datalong_types(dat2, vars),
        "`group`"
    )
})


test_that("validate_datalong_notMissing",{

    expect_true(validate_datalong_notMissing(dat,vars))

    dat2 <- dat
    dat2$age[c(1,2,3)] <- NA
    expect_error(validate_datalong_notMissing(dat2,vars))

    dat2 <- dat
    dat2$group[c(1,2,3)] <- NA
    expect_error(validate_datalong_notMissing(dat2,vars))

    dat2 <- dat
    dat2$visit[c(1,2,3)] <- NA
    expect_error(validate_datalong_notMissing(dat2,vars))

    dat2 <- dat
    dat2$subjid[c(1,2,3)] <- NA
    expect_error(validate_datalong_notMissing(dat2,vars))

    dat2 <- dat
    dat2$sex[c(1,2,3)] <- NA
    expect_error(validate_datalong_notMissing(dat2,vars))

    dat2 <- dat
    dat2$strata[c(1,2,3)] <- NA
    expect_error(validate_datalong_notMissing(dat2,vars))

})



test_that("validate_datalong_complete", {

    expect_true(validate_datalong_complete(dat, vars))

    ### Duplicate visits per patient
    dat2 <- bind_rows(dat, dat)
    expect_error(validate_datalong_complete(dat2, vars))

    dat2 <- dat
    dat2 <- dat2[-1,]
    expect_error(validate_datalong_complete(dat2, vars))

    ### Completely remove 1 visit (should check against the levels)
    dat2 <- dat %>% filter(visit != "Visit 1")
    expect_error(validate_datalong_complete(dat2, vars))
})


test_that("validate_datalong_unifromStrata",{

    expect_true(validate_datalong_unifromStrata(dat,vars))

    vars2 <- vars
    vars2$strata <- character(0)
    expect_true(validate_datalong_unifromStrata(dat,vars2))

    dat2 <- dat
    dat2$strata[[1]] <- "AXS"
    expect_error(validate_datalong_unifromStrata(dat2,vars))

})


test_that("validate_data_long",{
    expect_true(validate_datalong(dat, vars))
})


test_that("validate_data_ice",{

    di <- data.frame(
        subjid = c("1", "1"),
        strategy = c("MAR", "MAR"),
        visit = c("Visit 1"),
        stringsAsFactors = FALSE
    )

    expect_error(validate_dataice(dat, di, vars), regexp = "must contain at most 1 row per")

    di <- data.frame(
        subjid = c("1", "2"),
        strategy = c("MAR", "MAR"),
        visit = c("Visit 20"),
        stringsAsFactors = FALSE
    )

    expect_error(validate_dataice(dat, di, vars),  regexp = "vars\\$visit.*contains values that are")

    di <- data.frame(
        subjid = c("1", "2"),
        strategy = c("MAR", NA),
        visit = c("Visit 1"),
        stringsAsFactors = FALSE
    )

    expect_error(validate_dataice(dat, di, vars),  regexp = "vars\\$strategy.* must be a non")

    di <- data.frame(
        subjid = c("1", "abc"),
        strategy = c("MAR", "CR"),
        visit = c("Visit 1"),
        stringsAsFactors = FALSE
    )

    expect_error(validate_dataice(dat, di, vars),  regexp = "vars\\$subjid.* contains values that aren't")

    di <- data.frame(
        subjid = c("1", "2"),
        strategy = c("MAR", "CR"),
        visit = c("Visit 1"),
        stringsAsFactors = FALSE
    )

    expect_true(validate_dataice(dat, di, vars))

    di <- data.frame(
        subjid = c("1", "2"),
        strategy = c("MAR", "CR"),
        visit = c("Visit 122"),
        stringsAsFactors = FALSE
    )

    expect_true(validate_dataice(dat, di, vars, update = TRUE))

})