tests/testthat/test-misc.R

In insightsengineering/rbmi: Reference Based Multiple Imputation

test_that("rbmi can handle 'grouped' dplyr data", {

    dat <- simulate_test_data(100) %>%
        as_tibble() %>%
        mutate(outcome = if_else(rbinom(n(), 1, 0.2) == 1, NA_real_, outcome))

    dat <- expand_locf(
        dat,
        id = levels(dat$id),
        visit = levels(dat$visit),
        vars = c("age", "group", "sex"),
        group = c("id"),
        order = c("id", "visit")
    )

    dat_ice <- dat %>%
        arrange(id, visit) %>%
        filter(is.na(outcome)) %>%
        group_by(id) %>%
        slice(1) %>%
        ungroup() %>%
        select(id, visit) %>%
        mutate(strategy = "JR")

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

    method <- method_condmean(
        n_samples = 10
    )

    set.seed(987)
    drawObj <- draws(
        data = dplyr::group_by(dat, id),
        data_ice = dplyr::group_by(dat_ice, id),
        vars = vars,
        method = method,
        quiet = TRUE
    )

    imputeObj <- impute(drawObj, references = c("A" = "A", "B" = "A"))

    vars2 <- vars
    vars2$covariates <- c("sex*age")
    anaObj <- analyse(imputeObj, vars = vars2)
    poolObj_1 <- pool(anaObj)



    devnull <- capture.output({
        print(drawObj)
        print(imputeObj)
        print(anaObj)
        print(poolObj_1)
    })
    expect_true(length(devnull) >= 1)


    set.seed(987)
    drawObj <- draws(
        data = dat,
        data_ice = dat_ice,
        vars = vars,
        method = method,
        quiet = TRUE
    )

    imputeObj <- impute(drawObj, references = c("A" = "A", "B" = "A"))

    vars2 <- vars
    vars2$covariates <- c("sex*age")
    anaObj <- analyse(imputeObj, vars = vars2)
    poolObj_2 <- pool(anaObj)

    expect_equal(poolObj_1, poolObj_2)
})




test_that("`rbmi` can handle character data", {
    dat <- simulate_test_data(100) %>%
        as_tibble() %>%
        mutate(outcome = if_else(rbinom(n(), 1, 0.2) == 1, NA_real_, outcome)) %>%
        mutate(charvar = sample(c("A", "B", "C"), size = nrow(.), replace = TRUE, prob = c(0.4, 0.2, 0.1)))

    dat2 <- expand_locf(
        dat,
        id = levels(dat$id),
        visit = levels(dat$visit),
        vars = c("age", "group", "sex"),
        group = c("id"),
        order = c("id", "visit")
    )

    dat_ice <- dat2 %>%
        arrange(id, visit) %>%
        filter(is.na(outcome)) %>%
        group_by(id) %>%
        slice(1) %>%
        ungroup() %>%
        select(id, visit) %>%
        mutate(strategy = "JR")

    vars <- set_vars(
        outcome = "outcome",
        visit = "visit",
        subjid = "id",
        group = "group",
        covariates = c("sex*age", "visit*group", "charvar*group*age")
    )

    method <- method_condmean(
        n_samples = 2
    )

    set.seed(987)
    drawObj <- draws(
        data = dat,
        data_ice = dat_ice,
        vars = vars,
        method = method,
        quiet = TRUE
    )

    imputeObj <- impute(
        drawObj,
        references = c("A" = "A", "B" = "A")
    )

    expect_s3_class(imputeObj, "imputation")

    vars2 <- set_vars(
        outcome = "outcome",
        visit = "visit",
        subjid = "id",
        group = "group",
        covariates = c("sex*age", "charvar*age")
    )

    anaobj <- analyse(
        imputations = imputeObj,
        vars = vars2
    )
    new_dat <- extract_imputed_dfs(imputeObj, 1)[[1]]
    expect_true(is.factor(new_dat$charvar))
    expect_false(any(is.na(new_dat$charvar)))

    poolobj <- pool(anaobj)
    expect_s3_class(as.data.frame(poolobj), "data.frame")
})