test_that("survival summary", { skip_on_cran() cdm <- mockMGUS2cdm() surv <- estimateSingleEventSurvival(cdm, targetCohortTable = "mgus_diagnosis", targetCohortId = 1, outcomeCohortTable = "death_cohort", outcomeCohortId = 1, eventGap = 7 ) res <- tableSurvival(surv, times = c(100,200), type = "tibble") expect_true(res %>% dplyr::tally() == 1) expect_true(all( colnames(res) == c('CDM name', 'Target cohort', 'Outcome name', '[header_name]Estimate name\n[header_level]Number records', '[header_name]Estimate name\n[header_level]Number events', '[header_name]Estimate name\n[header_level]Median survival (95% CI)', '[header_name]Estimate name\n[header_level]Restricted mean survival (95% CI)', '[header_name]Estimate name\n[header_level]100 days survival estimate', '[header_name]Estimate name\n[header_level]200 days survival estimate'))) survCR <- estimateCompetingRiskSurvival(cdm, targetCohortTable = "mgus_diagnosis", targetCohortId = 1, outcomeCohortTable = "progression", outcomeCohortId = 1, competingOutcomeCohortTable = "death_cohort", eventGap = 7 ) gt1 <- tableSurvival(survCR, times = c(100,200)) expect_true(gt1$`_data` %>% dplyr::tally() == 2) expect_true(all( colnames(gt1$`_data`) == c('CDM name', 'Target cohort', 'Outcome type', 'Outcome name', '[header_name]Estimate name\n[header_level]Number records', '[header_name]Estimate name\n[header_level]Number events', '[header_name]Estimate name\n[header_level]Restricted mean survival', '[header_name]Estimate name\n[header_level]100 days survival estimate', '[header_name]Estimate name\n[header_level]200 days survival estimate'))) fx1 <- tableSurvival(survCR, type = "flextable") expect_true(fx1$body$dataset %>% dplyr::tally() == 2) expect_true(all( colnames(fx1$body$dataset ) == c('CDM name', 'Target cohort', 'Outcome type', 'Outcome name', 'Estimate name\nNumber records', 'Estimate name\nNumber events', 'Estimate name\nRestricted mean survival'))) survsex <- estimateSingleEventSurvival(cdm, targetCohortTable = "mgus_diagnosis", targetCohortId = 1, outcomeCohortTable = "death_cohort", outcomeCohortId = 1, strata = list("sex" = "sex"), eventGap = 7 ) gt2 <- tableSurvival(survsex) expect_true(all( colnames(gt2$`_data`) == c('CDM name', 'Target cohort', 'Sex', 'Outcome name', '[header_name]Estimate name\n[header_level]Number records', '[header_name]Estimate name\n[header_level]Number events', '[header_name]Estimate name\n[header_level]Median survival (95% CI)', '[header_name]Estimate name\n[header_level]Restricted mean survival (95% CI)'))) gt3 <- tableSurvival(survsex, header = c("cdm_name", "group")) expect_true(all( colnames(gt3$`_data`) == c('Sex', 'Outcome name', 'Estimate name', '[header_name]CDM name\n[header_level]mock\n[header_name]Target cohort\n[header_level]mgus_diagnosis'))) # In years expect_true(all(tableSurvival(surv, times = c(365,420), type = "tibble") %>% dplyr::select(-dplyr::contains("mean"), -dplyr::contains("median")) == tableSurvival(surv, times = c(1,1.15), timeScale = "years", type = "tibble") %>% dplyr::select(-dplyr::contains("mean"), -dplyr::contains("median")) )) CDMConnector::cdmDisconnect(cdm) }) test_that("expected errors", { skip_on_cran() cdm <- mockMGUS2cdm() surv <- estimateSingleEventSurvival(cdm, targetCohortTable = "mgus_diagnosis", targetCohortId = 1, outcomeCohortTable = "death_cohort", outcomeCohortId = 1, eventGap = 7 ) expect_error(tableSurvival()) expect_error(tableSurvival("surv")) expect_error(tableSurvival(surv, times = "a")) expect_error(tableSurvival(surv, times = c(1,2,3), timeScale = "day")) CDMConnector::cdmDisconnect(cdm) }) test_that("timeScale months", { cdm <- mockMGUS2cdm() surv <- estimateCompetingRiskSurvival(cdm, "mgus_diagnosis", "progression", "death_cohort", strata = list("sex")) tabdays <- tableSurvival(surv, times = c(30,183,365,730), type = "tibble") tabmonths <- tableSurvival(surv, times = c(1,6,12,24), timeScale = "months", type = "tibble") tabyears <- tableSurvival(surv, times = c(0.5,1,2), timeScale = "years", type = "tibble") expect_true(all(tabdays %>% dplyr::pull("[header_name]Estimate name\n[header_level]30 days survival estimate") == tabmonths %>% dplyr::pull("[header_name]Estimate name\n[header_level]1 months survival estimate"))) expect_true(all(tabdays %>% dplyr::pull("[header_name]Estimate name\n[header_level]183 days survival estimate") == tabmonths %>% dplyr::pull("[header_name]Estimate name\n[header_level]6 months survival estimate"))) expect_true(all(tabdays %>% dplyr::pull("[header_name]Estimate name\n[header_level]365 days survival estimate") == tabmonths %>% dplyr::pull("[header_name]Estimate name\n[header_level]12 months survival estimate"))) expect_true(all(tabyears %>% dplyr::pull("[header_name]Estimate name\n[header_level]0.5 years survival estimate") == tabmonths %>% dplyr::pull("[header_name]Estimate name\n[header_level]6 months survival estimate"))) expect_true(all(tabyears %>% dplyr::pull("[header_name]Estimate name\n[header_level]1 years survival estimate") == tabmonths %>% dplyr::pull("[header_name]Estimate name\n[header_level]12 months survival estimate"))) expect_true(all(tabdays %>% dplyr::pull("[header_name]Estimate name\n[header_level]Restricted mean survival") %>% as.numeric() == round(tabmonths %>% dplyr::pull("[header_name]Estimate name\n[header_level]Restricted mean survival") %>% as.numeric() * 30.4375, digits = 0))) CDMConnector::cdmDisconnect(cdm) }) test_that("timeScale and times incompatible", { cdm <- mockMGUS2cdm() surv <- estimateSingleEventSurvival(cdm, targetCohortTable = "mgus_diagnosis", outcomeCohortTable = "death_cohort") expect_no_error(tableSurvival(surv, times = c(50), timeScale = "years")) CDMConnector::cdmDisconnect(cdm) })