Nothing
testthat::context("Testing empty survival intervals in survtab")
testthat::test_that("removing consecutively bad surv.ints is logical w/ & w/out adjusting", {
sire2 <- sire[dg_date < ex_date, ]
sire2[, agegr := cut(dg_age, c(0,45,60,Inf), right=FALSE, labels=FALSE)]
BL <- list(fot= seq(0,10,1/12), per=c(2008,2013))
x <- lexpand(sire2, birth = bi_date, entry = dg_date, exit = ex_date,
status = status %in% 1:2, breaks=BL)
setDT(x)
setattr(x, "class", c("Lexis", "data.table", "data.frame"))
## NOTE: neither should give any messages!
testthat::expect_message({
st1 <- survtab(Surv(fot, lex.Xst) ~ agegr,
subset = !(agegr == 1L & fot > 8.49),
data = x, surv.type="surv.obs")
}, regexp = NA)
## INTENTION: 7.5+ intervals empty for one age group.
## this should make adjusted estimates missing altogether for 7.5+.
testthat::expect_message({
st2 <- survtab(Surv(fot, lex.Xst) ~ adjust(agegr),
data = x, surv.type="surv.obs",
subset = !(agegr == 1L & fot > 8.49),
weights = list(agegr = c(0.33, 0.33, 0.33)))
}, regexp = NA)
setDT(st1)
setDT(st2)
testthat::expect_equal(st1[agegr==3 & Tstop>8.5, .N] , 18L)
testthat::expect_equal(st1[agegr==1 & Tstop>8.5, .N] , 0L)
testthat::expect_equal(st2[Tstop > 8.5, .N] , 0L)
})
## non-consecutively bad surv.ints ---------------------------------------------
testthat::test_that("survtab_ag messages & results due to non-consecutively bad surv.ints are OK", {
## non-consecutively bad surv.ints (missing years 5-6)
sire2 <- sire[dg_date < ex_date, ]
sire2[, agegr := cut(dg_age, c(0,45,60,Inf), right=FALSE, labels=FALSE)]
sire2 <- sire2[!(dg_age > 60 & as.integer(as.integer(ex_date-dg_date)/365.25) %in% 5:6)]
BL <- list(fot= seq(0,10,1/12), per=c(2008,2013))
x <- lexpand(sire2, birth = bi_date, entry = dg_date, exit = ex_date,
status = status %in% 1:2,
breaks=BL)
tf1 <- quote(
st1 <- survtab(Surv(fot, lex.Xst)~1, data = x, surv.type="surv.obs",
subset=!(fot >= 5 & fot < 7))
)
tf2 <- quote(
st2 <- survtab(Surv(fot, lex.Xst)~adjust(agegr), data = x, surv.type="surv.obs",
subset=!(agegr==3 & fot >= 5 & fot < 7),
weights = list(agegr = c(0.33, 0.33, 0.33)))
)
## NOTE: \\ needed before "(" or ")"
msgs <- c(paste0("The total person-time was zero in some survival ",
"intervals summed to the margins \\(over any stratifying ",
"/ adjusting variables\\) _non-consecutively_, i.e. some ",
"intervals after an empty interval had person-time in ",
"them. Keeping all survival intervals with some estimates ",
"as NA for inspection."),
"Some cumulative surv.obs were zero or NA:")
testthat::expect_message(eval(tf1), msgs[1],ignore.case=TRUE)
testthat::expect_message(eval(tf1), msgs[2],ignore.case=TRUE)
setDT(st1)
testthat::expect_equal(st1[is.na(surv.obs), .N], 60L)
msgs <- c(paste0("The total person-time was zero in some survival ",
"intervals, when summed to the variable\\(s\\) ",
"'agegr' \\(i.e. over all other variables, if any",
"\\) _non-consecutively_, i.e. some intervals after ",
"an empty interval had person-time in them. ",
"Keeping all survival intervals with some ",
"estimates as NA for inspection."),
"Some cumulative surv.obs were zero or NA:")
testthat::expect_message(eval(tf2), msgs[1])
testthat::expect_message(eval(tf2), msgs[2])
setDT(st2)
testthat::expect_equal(st2[is.na(surv.obs.as), .N], 60L)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.