tests/testthat/test-popTime.R

In sahirbhatnagar/casebase: Fitting Flexible Smooth-in-Time Hazards and Risk Functions via Logistic and Multinomial Regression

context("popTime methods")
set.seed(12345)

# CRAN skip atlas check fix
testthat::skip_if(grepl(pattern = "atlas", sessionInfo()$BLAS,
                        ignore.case = TRUE))

nobs <- 500

# simulation parameters
a1 <- 1.0
b1 <- 200
a2 <- 1.0
b2 <- 50
c1 <- 0.0
c2 <- 0.0

# end of study time
eost <- 10

# e event type 0-censored, 1-event of interest, 2-competing event
# t observed time/endpoint
# z is a binary covariate
DTsim <- data.table(ID = seq_len(nobs), z = rbinom(nobs, 1, 0.5))
data.table::setkey(DTsim, ID)
DTsim[, `:=`(event_time = rweibull(nobs, a1, b1 * exp(z * c1)),
             competing_time = rweibull(nobs, a2, b2 * exp(z * c2)),
             end_of_study_time = eost)]
DTsim[, `:=`(event = 1 * (event_time < competing_time) +
                2 * (event_time >= competing_time),
            time = pmin(event_time, competing_time))]
DTsim[time >= end_of_study_time, event := 0]
DTsim[time >= end_of_study_time, time := end_of_study_time]

DFsim <- data.frame("z" = DTsim[, z],
                    "event" = DTsim[, event],
                    "time" = DTsim[, time])

# data.frames input
out1 <- popTime(data = DFsim, time = "time", event = "event")
out2 <- popTime(data = DFsim, time = "time", event = "event", exposure = "z")

# data.table input
out3 <- popTime(data = DTsim, time = "time", event = "event")
out4 <- popTime(data = DTsim, time = "time", event = "event", exposure = "z")

test_that("expect data.table or data.frame in popTime with data.frame or data.table input", {

    expect_s3_class(out1, "data.frame")
    expect_s3_class(out1, "data.table")
    expect_s3_class(out1, "popTime")

    expect_s3_class(out2, "data.frame")
    expect_s3_class(out2, "data.table")
    expect_s3_class(out2, "popTime")
    expect_equal(attr(out2, "exposure"), "z")


    expect_s3_class(out3, "data.frame")
    expect_s3_class(out3, "data.table")
    expect_s3_class(out3, "popTime")

    expect_s3_class(out4, "data.frame")
    expect_s3_class(out4, "data.table")
    expect_s3_class(out4, "popTime")
    expect_equal(attr(out4, "exposure"), "z")

})


test_that("plot methods-no error in popTime with data.frame or data.table", {
    p1 <- try(plot(out1,
                   add.case.series = F))
    p2 <- try(plot(out1,
                   add.case.series = T))
    p3 <- try(plot(out1,
                   add.case.series = T,
                   add.base.series = T,
                   ratio = 1,
                   comprisk = T))

    # all three types plotted
    p5 <- try(plot(out1,
                   add.case.series = T,
                   add.base.series = T,
                   add.competing.event = T,
                   ratio = 1,
                   comprisk = T,
                   legend = T,
                   theme.params = list(legend.position = "top")))

    # change points and labels
    p6 <- try(plot(out1,
                   add.case.series = TRUE,
                   add.base.series = TRUE,
                   add.competing.event = TRUE,
                   ratio = 1,
                   comprisk = TRUE,
                   legend = TRUE,
                   case.params = list(mapping = aes(x = time, y = yc,
                                                    color = "Relapse",
                                                    fill = "Relapse")),
                   base.params = list(mapping = aes(x = time, y = ycoord,
                                                    color = "Base series",
                                                    fill = "Base series")),
                   competing.params = list(mapping = aes(x = time, y = yc,
                                                         color = "Competing event",
                                                         fill = "Competing event")),
                   fill.params = list(name = "Legend Name",
                                        breaks = c("Relapse", "Base series",
                                                   "Competing event"),
                                        values = c("Relapse" = "blue",
                                                   "Competing event" = "yellow",
                                                   "Base series" = "orange")),
                   color.params = list(name = "Legend Name",
                                      breaks = c("Relapse", "Base series",
                                                 "Competing event"),
                                      values = c("Relapse" = "blue",
                                                 "Competing event" = "yellow",
                                                 "Base series" = "orange")),
                   theme.params = list(legend.position = "right")))


    # change points and labels and exposure stratified
    p7 <- try(plot(out2,
                   add.case.series = TRUE,
                   add.base.series = TRUE,
                   add.competing.event = TRUE,
                   ratio = 1,
                   comprisk = TRUE,
                   legend = TRUE,
                   case.params = list(mapping = aes(x = time, y = yc,
                                                    color = "Relapse",
                                                    fill = "Relapse")),
                   base.params = list(mapping = aes(x = time, y = ycoord,
                                                    color = "Base series",
                                                    fill = "Base series")),
                   competing.params = list(mapping = aes(x = time, y = yc,
                                                         color = "Competing event",
                                                         fill = "Competing event")),
                   fill.params = list(name = "Legend Name",
                                        breaks = c("Relapse", "Base series",
                                                   "Competing event"),
                                        values = c("Relapse" = "blue",
                                                   "Competing event" = "yellow",
                                                   "Base series" = "orange")),
                   color.params = list(name = "Legend Name",
                                      breaks = c("Relapse", "Base series",
                                                 "Competing event"),
                                      values = c("Relapse" = "blue",
                                                 "Competing event" = "yellow",
                                                 "Base series" = "orange")),
                   casebase.theme = FALSE))

    expect_false(inherits(p1, "try-error"))
    expect_false(inherits(p2, "try-error"))
    expect_false(inherits(p3, "try-error"))
    expect_false(inherits(p5, "try-error"))
    expect_false(inherits(p6, "try-error"))
    expect_false(inherits(p7, "try-error"))

})