diff --git a/tests/testthat/test-competing.R b/tests/testthat/test-competing.R new file mode 100644 index 0000000..f6c7a09 --- /dev/null +++ b/tests/testthat/test-competing.R @@ -0,0 +1,249 @@ +data(cancer, package = "survival") + +cancer <- cancer %>% + tibble::as_tibble() %>% + dplyr::filter(ph.ecog < 3) %>% + dplyr::mutate( + # The exposure (here, 'sex') must be categorical (a factor) + sex = factor( + sex, + levels = 1:2, + labels = c( + "Male", + "Female" + ) + ), + time = time / 365.25, # transform to years + status = factor( + ph.ecog, + levels = 0:2, + labels = c("Censor", "Event of interest", "Other event") + ) + ) + +test_that( + desc = "Competing event models work", + code = { + object <- tibble::tribble( + ~label, ~type, + "**Absolute estimates**", "", + "*Counts and sums*", "", + " Observations, *N*", "total", + " Events, *n*", "events", + " Events/observations", "events/total", + " Events/person-years", "events/time", + "*Follow-up*", "", + " Person-years", "time", + " Maximum follow-up, years", "maxfu", + " Median follow-up, years", "medfu", + " Median follow-up (IQR), years", "medfu (iqr)", + "*Rates*", "", + " Rate per 1000 person-years", "rate", + " Rate per 1000 person-years (95% CI)", "rate (ci)", + " Events/py (rate per 1000 py)", "events/time (rate)", + "*Risks*", "", + # " 1-year survival", "surv", + # " 1-year survival (95% CI)", "surv (ci)", + " 1-year risk/cumulative incidence", "cuminc", + " 1-year risk (95% CI)", "cuminc (ci)", + # " Median survival, years", "medsurv", + # " Median survival (95 CI), years", "medsurv (ci)", + "", "", + "**Comparative estimates**", "", + # " 1-year survival difference", "survdiff", + " 1-year risk difference", "cumincdiff", + # " 1-year survival ratio", "survratio", + " 1-year risk ratio", "cumincratio", + " Hazard ratio (95% CI)", "hr" + ) %>% + dplyr::mutate( + time = "time", + event = "status@Event of interest", + exposure = "sex", + arguments = list(list(timepoint = 1)) + ) %>% + rifttable( + data = cancer, + overall = TRUE + ) + + expected <- tibble::tribble( + ~Summary, ~Overall, ~Male, ~Female, + "**Absolute estimates**", "", "", "", + "*Counts and sums*", "", "", "", + " Observations, *N*", "226", "136", "90", + " Events, *n*", "113", "71", "42", + " Events/observations", "113/226", "71/136", "42/90", + " Events/person-years", "113/190", "71/106", "42/84", + "*Follow-up*", "", "", "", + " Person-years", "190", "106", "84", + " Maximum follow-up, years", "2.80", "2.80", "2.64", + " Median follow-up, years", "1.06", "1.08", "1.05", + " Median follow-up (IQR), years", "1.06 (0.65, 1.94)", "1.08 (0.62, 1.94)", "1.05 (0.65, 1.93)", + "*Rates*", "", "", "", + " Rate per 1000 person-years", "594.7", "666.7", "502.9", + " Rate per 1000 person-years (95% CI)","594.7 (494.5, 715.1)","666.7 (528.3, 841.3)","502.9 (371.6, 680.4)", + " Events/py (rate per 1000 py)", "113/190 (594.7)", "71/106 (666.7)", "42/84 (502.9)", + "*Risks*", "", "", "", + " 1-year risk/cumulative incidence", "0.39", "0.45", "0.31", + " 1-year risk (95% CI)", "0.39 (0.33, 0.47)", "0.45 (0.36, 0.54)", "0.31 (0.22, 0.43)", + "", "", "", "", + "**Comparative estimates**", "", "", "", + " 1-year risk difference", "", "0 (reference)", "-0.14 (-0.27, 0.01)", + " 1-year risk ratio", "", "1 (reference)", "0.69 (0.47, 1.03)", + " Hazard ratio (95% CI)", "", "1 (reference)", "0.73 (0.50, 1.07)" + ) + + expect_equal( + object = object, + expected = expected + ) + } +) + + +test_that( + desc = "Survival is not calculated for competing events", + code = { + expect_error( + object = tibble::tibble( + type = "surv (ci)", + time = "time", + event = "status@Event of interest", + exposure = "sex" + ) %>% + rifttable( + data = cancer, + overall = TRUE + ), + regexp = "Survival \\(type = 'surv'\\) is not estimated with competing risks" + ) + + expect_warning( + object = tibble::tibble( + type = "medsurv", + time = "time", + event = "status@Event of interest", + exposure = "sex" + ) %>% + rifttable(data = cancer), + regexp = "Note the presence of competing events" + ) + + expect_error( + object = tibble::tribble( + ~label, ~type, + "1-year survival difference", "survdiff", + "1-year survival ratio", "survratio" + ) %>% + dplyr::mutate( + time = "time", + event = "status@Event of interest", + exposure = "sex", + arguments = list(list(timepoint = 1)) + ) %>% + rifttable( + data = cancer, + overall = TRUE + ), + regexp = "may not be meaningful with competing events" + ) + } +) + +test_that( + desc = "Missing time horizon is caught", + code = { + expect_error( + object = tibble::tibble( + type = "survdiff", + time = "time", + event = "status@Event of interest", + exposure = "sex" + ) %>% + rifttable( + data = cancer, + overall = TRUE + ), + regexp = "Must provide a time horizon for survival analysis of type" + ) + } +) + +test_that( + desc = "Wrong event types are caught", + code = { + expect_error( + object = tibble::tibble( + type = "survdiff", + time = "time", + event = "status@Nonsense", + exposure = "sex" + ) %>% + rifttable( + data = cancer, + overall = TRUE + ), + regexp = "event variable 'status', the specified event type 'Nonsense' is not available" + ) + } +) + +test_that( + desc = "Non-competing events setting is identified", + code = { + expect_error( + object = tibble::tibble( + type = "survdiff", + time = "time", + event = "sex@Male", + exposure = "status" + ) %>% + rifttable( + data = cancer, + overall = TRUE + ), + regexp = "event variable does not appear to have more than two levels" + ) + } +) + +test_that( + desc = "Missing event type is found", + code = { + expect_error( + object = tibble::tibble( + type = "survdiff", + time = "time", + event = "status", + exposure = "sex" + ) %>% + rifttable( + data = cancer %>% + dplyr::filter(!is.na(ph.ecog)), + overall = TRUE + ), + regexp = "competing events may be encoded, but no specific event type" + ) + } +) + +test_that( + desc = "Wrong event variable class is found", + code = { + expect_error( + object = tibble::tibble( + type = "survdiff", + time = "time", + event = "pat.karno@50", + exposure = "sex" + ) %>% + rifttable( + data = cancer %>% + dplyr::filter(!is.na(pat.karno)), + overall = TRUE + ), + regexp = "to presumably encode competing events must be a factor" + ) + } +) diff --git a/tests/testthat/test-design-type2.R b/tests/testthat/test-design-type2.R new file mode 100644 index 0000000..70e2091 --- /dev/null +++ b/tests/testthat/test-design-type2.R @@ -0,0 +1,131 @@ +test_that( + desc = "designs with type2 work", + code = { + data(breastcancer, package = "risks") + + design <- tibble::tibble( + type = c("outcomes", "total"), + type2 = c("risk", "risk (ci)") + ) %>% + dplyr::mutate( + exposure = "stage", + outcome = "death" + ) + + object <- rifttable( + design = design, + data = breastcancer + ) + expected <- tibble::tribble( + ~Stage, ~`Stage I`, ~`Stage II`, ~`Stage III`, + "outcomes", "7", "26", "21", + "", "0.10", "0.27", "0.72", + "total", "67", "96", "29", + "", "0.10 (0.05, 0.20)", "0.27 (0.19, 0.37)", "0.72 (0.54, 0.85)" + ) + expect_equal( + object = object, + expected = expected + ) + + object <- rifttable( + design = design, + data = breastcancer, + layout = "cols", + ) + expected <- tibble::tribble( + ~Stage, ~outcomes, ~total, + "Stage I", "7", "67", + "", "0.10", "0.10 (0.05, 0.20)", + "Stage II", "26", "96", + "", "0.27", "0.27 (0.19, 0.37)", + "Stage III", "21", "29", + "", "0.72", "0.72 (0.54, 0.85)" + ) + expect_equal( + object = object, + expected = expected + ) + + object <- rifttable( + design = design, + data = breastcancer, + layout = "cols", + type2_layout = "cols", + ) %>% + dplyr::mutate(Stage = as.character(Stage)) + expected <- tibble::tribble( + ~Stage, ~outcomes, ~`outcomes `, ~total, ~`total `, + "Stage I", "7", "0.10", "67", "0.10 (0.05, 0.20)", + "Stage II", "26", "0.27", "96", "0.27 (0.19, 0.37)", + "Stage III", "21", "0.72", "29", "0.72 (0.54, 0.85)" + ) + expect_equal( + object = object, + expected = expected + ) + + object <- rifttable( + design = design, + data = breastcancer, + layout = "rows", + type2_layout = "cols", + ) + expected <- tibble::tribble( + ~Stage, ~`Stage I`, ~`Stage I `, ~`Stage II`, ~`Stage II `, ~`Stage III`, ~`Stage III `, + "outcomes", "7", "0.10", "26", "0.27", "21", "0.72", + "total", "67", "0.10 (0.05, 0.20)", "96", "0.27 (0.19, 0.37)", "29", "0.72 (0.54, 0.85)" + ) + expect_equal( + object = object, + expected = expected + ) + + # Blanks in the label + object <- design %>% + dplyr::mutate(label = c("label", "")) %>% + rifttable( + data = breastcancer, + layout = "cols" + ) + expected <- tibble::tribble( + ~Stage, ~`1_label`, ~`2_`, + "Stage I", "7", "67", + "", "0.10", "0.10 (0.05, 0.20)", + "Stage II", "26", "96", + "", "0.27", "0.27 (0.19, 0.37)", + "Stage III", "21", "29", + "", "0.72", "0.72 (0.54, 0.85)" + ) + expect_equal( + object = object, + expected = expected + ) + + object <- design %>% + dplyr::mutate(label = c("label", "")) %>% + rifttable( + data = breastcancer, + layout = "cols", + type2_layout = "cols" + ) %>% + dplyr::mutate(Stage = as.character(Stage)) + expected <- tibble::tribble( + ~Stage, ~`1_label`, ~`1_label `, ~`2_`, ~`2_ `, + "Stage I", "7", "0.10", "67", "0.10 (0.05, 0.20)", + "Stage II", "26", "0.27", "96", "0.27 (0.19, 0.37)", + "Stage III", "21", "0.72", "29", "0.72 (0.54, 0.85)" + ) + expect_equal( + object = object, + expected = expected + ) + + expect_error( + object = design %>% + dplyr::mutate(exposure = NA) %>% + rifttable(data = breastcancer), + regexp = "'exposure' must be specified for each row" + ) + } +) diff --git a/tests/testthat/test-estimators-continuous.R b/tests/testthat/test-estimators-continuous.R index c9d0ca2..db98434 100644 --- a/tests/testthat/test-estimators-continuous.R +++ b/tests/testthat/test-estimators-continuous.R @@ -28,6 +28,7 @@ testthat::test_that( "Mean ratio", "", " of arithmetic means", "fold", " of arithmetic means, empirical SE", "irrrob", + " of arithmetic means, Poisson SE", "irr", " of geometric means", "foldlog" ) %>% dplyr::mutate( @@ -62,6 +63,7 @@ testthat::test_that( "Mean ratio", "", "", "", "", " of arithmetic means", "", "1 (reference)", "1.005 (0.961, 1.051)","1.083 (1.028, 1.140)", " of arithmetic means, empirical SE","", "1 (reference)", "1.005 (0.959, 1.053)","1.083 (1.029, 1.139)", + " of arithmetic means, Poisson SE", "", "1 (reference)", "1.005 (0.966, 1.045)", "1.083 (1.034, 1.134)", " of geometric means", "", "1 (reference)", "1.007 (0.961, 1.055)","1.088 (1.029, 1.151)", ) diff --git a/tests/testthat/test-input-checks.R b/tests/testthat/test-input-checks.R new file mode 100644 index 0000000..fe5ef10 --- /dev/null +++ b/tests/testthat/test-input-checks.R @@ -0,0 +1,322 @@ +test_that( + desc = "Basic inputs are present", + code = { + expect_error( + object = rifttable( + design = 1, + data = tibble::tibble() + ), + regexp = "No 'design' data frame" + ) + + expect_error( + object = rifttable( + design = tibble::tibble(), + data = 1 + ), + regexp = "No 'data' data frame" + ) + + design <- tibble::tibble() + attr(x = design, which = "rt_data") <- tibble::tibble() + expect_error( + object = rifttable( + design = design + ), + regexp = "The 'design' data frame must contain a 'type' column" + ) + } +) + +test_that( + desc = "Invalid design variables get caught", + code = { + data(breastcancer, package = "risks") + + design <- tibble::tibble( + stratum = c("Stage I", "Stage II") + ) %>% + dplyr::mutate( + type = "risk", + exposure = "receptor", + outcome = "death", + effect_modifier = "stage" + ) + + expect_warning( + object = rifttable( + design = design, + data = breastcancer %>% + dplyr::filter(stage != "Stage I") + ), + regexp = "Stratum 'Stage I' is empty" + ) + + expect_error( + object = rifttable( + design = design %>% + dplyr::mutate(outcome = "d"), + data = breastcancer + ), + regexp = "Outcome variable 'd' is not valid" + ) + + expect_error( + object = rifttable( + design = design %>% + dplyr::mutate(weights = "w"), + data = breastcancer + ), + regexp = "Variable is not valid" + ) + + expect_error( + object = rifttable( + design = design %>% + dplyr::mutate(weights = "stage"), + data = breastcancer + ), + regexp = "'stage': Variable is not numeric" + ) + + expect_warning( + object = rifttable( + design = design %>% + dplyr::mutate(exposure = "row"), + data = breastcancer |> + dplyr::mutate(row = dplyr::row_number()) + ), + regexp = "Exposure variable 'row' is not categorical" + ) + + expect_error( + object = rifttable( + design = design %>% + dplyr::mutate(type = "nonsense"), + data = breastcancer + ), + regexp = "An estimator type = 'nonsense' is not implemented by default" + ) + + expect_error( + object = rifttable( + design = design %>% + dplyr::mutate(type = "regress_binary"), + data = breastcancer + ), + regexp = "Invalid estimator type = 'regress_binary'." + ) + } +) + +testthat::test_that( + desc = "catch time containing NA", + code = { + expect_warning( + object = rifttable( + design = tibble::tibble( + type = "rate", + time = "death", + event = "death" + ), + data = breastcancer %>% + dplyr::mutate( + death = dplyr::if_else( + dplyr::row_number() < 5, + true = NA_real_, + false = death + ) + ) + ), + regexp = "'death' and/or the time variable 'death' contain missing values" + ) + } +) + + +testthat::test_that( + desc = "catch time of wrong type", + code = { + data(cancer, package = "survival") + expect_error( + object = rifttable( + design = tibble::tibble( + type = "rate", + time = "stage", + event = "death" + ), + data = breastcancer + ), + regexp = "Time variable 'stage' must be continuous" + ) + } +) + +testthat::test_that( + desc = "catch wrong time variable", + code = { + data(cancer, package = "survival") + expect_error( + object = rifttable( + design = tibble::tibble( + type = "rate", + time = "aaa", + event = "death" + ), + data = breastcancer + ), + regexp = "Time variable 'aaa' is not valid" + ) + } +) + + +test_that( + desc = "Rounding digits are valid", + code = { + expect_error( + object = rifttable( + design = tibble::tibble( + type = "total", + digits = 11 + ), + data = tibble::tibble() + ), + regexp = "must be an integer number from 0 to 10" + ) + expect_error( + object = rifttable( + design = tibble::tibble( + type = "total", + digits = "a" + ), + data = tibble::tibble() + ), + regexp = "must be numeric. 'a' is not numeric." + ) + + } +) + +testthat::test_that( + desc = "event variable is valid", + code = { + data(breastcancer, package = "risks") + expect_error( + object = rifttable( + design = tibble::tibble( + type = "rate", + time = "death", + event = "aaa" + ), + data = cancer + ), + regexp = "Event variable 'aaa' is not valid for the dataset" + ) + } +) + +testthat::test_that( + desc = "time and event variable are present if needed", + code = { + data(breastcancer, package = "risks") + expect_error( + object = rifttable( + design = tibble::tibble( + type = "rate", + time = "death", + ), + data = cancer + ), + regexp = " The 'design' must contain 'event' and 'time' variables" + ) + expect_error( + object = rifttable( + design = tibble::tibble( + type = "rate", + event = "death", + ), + data = cancer + ), + regexp = " The 'design' must contain 'event' and 'time' variables" + ) + } +) + +testthat::test_that( + desc = "extra arguments get checked", + code = { + data(breastcancer, package = "risks") + expect_error( + object = rifttable( + design = tibble::tibble( + type = "cuminc", + time = "death", + event = "death", + arguments = list(list(timepoint = "a")) + ), + data = breastcancer + ), + regexp = "A timepoint argument was supplied, but timepoint = 'a' is not numeric." + ) + expect_error( + object = rifttable( + design = tibble::tibble( + type = "rr", + exposure = "receptor", + outcome = "death", + arguments = list(list(approach = "a")) + ), + data = breastcancer + ), + regexp = "approach = 'a' is not among the accepted choices, which include: auto" + ) + } +) + +testthat::test_that( + desc = "ratio digits decrease errors are found", + code = { + data(breastcancer, package = "risks") + expect_error( + object = rifttable( + design = tibble::tibble( + type = "rr", + exposure = "receptor", + outcome = "death", + ratio_digits_decrease = c(a = 1) + ), + data = breastcancer + ), + regexp = "Names of 'ratio_digits_decrease' for rounding, if provided, must be convertible into numbers" + ) + expect_error( + object = rifttable( + design = tibble::tibble( + type = "rr", + exposure = "receptor", + outcome = "death", + ratio_digits_decrease = c(`-1` = "a") + ), + data = breastcancer + ), + regexp = "Values of 'ratio_digits_decrease' for rounding, if provided, must be numeric" + ) + } +) + +testthat::test_that( + desc = "scoreci midpoint", + code = { + expect_contains( + object = names( + scoreci( + success = 5, + total = 10, + return_midpoint = TRUE + ) + ), + expected = "midpoint" + ) + } +) diff --git a/tests/testthat/test-joint_model.R b/tests/testthat/test-joint_model.R new file mode 100644 index 0000000..dc9e269 --- /dev/null +++ b/tests/testthat/test-joint_model.R @@ -0,0 +1,84 @@ +test_that( + desc = "stratified and joint models work", + code = { + data(breastcancer, package = "risks") + + design <- tibble::tibble( + stratum = c("Low", "High"), + label = stratum, + type = "rr", + exposure = "stage", + outcome = "death", + effect_modifier = "receptor" + ) + + object <- rifttable( + design = design, + data = breastcancer + ) + expected <- tibble::tribble( + ~Stage, ~`Stage I`, ~`Stage II`, ~`Stage III`, + "Low", "1 (reference)", "2.45 (0.63, 9.6)", "5.1 (1.43, 19)", + "High", "1 (reference)", "2.53 (0.99, 6.4)", "6.6 (2.60, 17)" + ) + expect_equal( + object = object, + expected = expected + ) + + design <- design %>% + dplyr::mutate(type = "rr_joint") + + object <- rifttable( + design = design, + data = breastcancer + ) + expected <- tibble::tribble( + ~Stage, ~`Stage I`, ~`Stage II`, ~`Stage III`, + "Low", "1.83 (0.40, 8.4)", "4.5 (1.70, 12)", "9.4 (4.0, 22)", + "High", "1 (reference)", "2.53 (0.99, 6.4)", "6.6 (2.60, 17)" + ) + expect_equal( + object = object, + expected = expected + ) + + expect_error( + object = design %>% + dplyr::mutate(stratum = "") %>% + rifttable(data = breastcancer), + regexp = "stratum cannot be an empty string" + ) + + expect_error( + object = design %>% + dplyr::mutate(stratum = NA) %>% + rifttable(data = breastcancer), + regexp = "or missing" + ) + + expect_error( + object = rifttable( + design = design |> + dplyr::select(-"stratum"), + data = breastcancer), + regexp = "stratum must be specified" + ) + + expect_error( + object = rifttable( + design = design |> + dplyr::mutate(stratum = NULL), + data = breastcancer), + regexp = "stratum must be specified" + ) + + expect_error( + object = rifttable( + design = design |> + dplyr::select(-"stratum"), + data = breastcancer), + regexp = "stratum must be specified" + ) + } +) diff --git a/tests/testthat/test-layout-cols.R b/tests/testthat/test-layout-cols.R new file mode 100644 index 0000000..94c8fbb --- /dev/null +++ b/tests/testthat/test-layout-cols.R @@ -0,0 +1,48 @@ +test_that("layout as columns works", { + data(breastcancer, package = "risks") + + design <- tibble::tibble( + type = c("outcomes/total", "risk"), + ) %>% + dplyr::mutate( + exposure = "stage", + outcome = "death" + ) + + object <- rifttable( + design = design, + data = breastcancer, + layout = "cols", + overall = TRUE + ) + expected <- tibble::tribble( + ~Stage, ~`outcomes/total`, ~risk, + "Overall", "54/192", "0.28", + "Stage I", "7/67", "0.10", + "Stage II", "26/96", "0.27", + "Stage III", "21/29", "0.72" + ) + expect_equal( + object = object, + expected = expected + ) + + object <- design %>% + dplyr::mutate(label = "") %>% + rifttable( + data = breastcancer, + layout = "cols", + overall = TRUE + ) + expected <- tibble::tribble( + ~.exposure, ~`1_`, ~`2_`, + "Overall", "54/192", "0.28", + "Stage I", "7/67", "0.10", + "Stage II", "26/96", "0.27", + "Stage III", "21/29", "0.72" + ) + expect_equal( + object = object, + expected = expected + ) +}) diff --git a/tests/testthat/test-missing_data.R b/tests/testthat/test-missing_data.R index dd6e225..2315ac1 100644 --- a/tests/testthat/test-missing_data.R +++ b/tests/testthat/test-missing_data.R @@ -299,3 +299,26 @@ test_that("Missing outcome or outcome of wrong type gets detected", { rifttable(data = df), "Outcome variable 'receptor' must be continuous") }) + +test_that( + desc = "Logical exposure has 'all' levels shown", + code = { + expect_equal( + object = tibble::tibble( + exposure = "allempty_lgl", + outcome = "death", + type = "outcomes" + ) %>% + rifttable( + data = df, + exposure_levels = "all" + ), + expected = tibble::tibble( + allempty_lgl = "outcomes", + `FALSE` = "0", + `TRUE` = "0", + `NA` = "--" + ) + ) + } +) diff --git a/tests/testthat/test-rt_gt.R b/tests/testthat/test-rt_gt.R new file mode 100644 index 0000000..ff35232 --- /dev/null +++ b/tests/testthat/test-rt_gt.R @@ -0,0 +1,12 @@ +test_that( + desc = "rt_gt works", + code = { + expect_visible( + call = + tibble::tibble( + a = " a", + b = 1) %>% + rt_gt() + ) + } +) diff --git a/tests/testthat/test-table1_design.R b/tests/testthat/test-table1_design.R index 0b35698..09b52fe 100644 --- a/tests/testthat/test-table1_design.R +++ b/tests/testthat/test-table1_design.R @@ -11,7 +11,8 @@ result <- table1_design( death, receptor, dplyr::everything(), - data = df) + data = df +) test_that("Table 1 design dimensions are correct", { expect_equal(nrow(result), expected = 16) @@ -28,3 +29,84 @@ test_that("Table 1 design picks up missing values", { test_that("Table 1 design finds variable labels", { expect_equal(result$label[[2]], expected = "Death") }) + +test_that( + desc = "Table 1 gets generated", + code = { + object <- rifttable( + design = result, + data = df + ) + expected <- tibble::tribble( + ~Summary, ~Overall, + "N", "192", + "Death", "54 (29%)", + " Unknown", "3", + "Hormone receptor", "", + " High", "144 (76%)", + " Low", "45 (24%)", + " Unknown", "3", + "Stage", "", + " Stage I", "67 (35%)", + " Stage II", "96 (50%)", + " Stage III", "29 (15%)", + "continuous", "96.50 (48.75, 144.25)", + "allempty", "", + " Unknown", "192", + "allempty_lgl", "", + " Unknown", "192" + ) + expect_equal( + object = object, + expected = expected + ) + } +) + +test_that( + desc = "Table 1: by = works", + code = { + object <- table1_design( + continuous, + by = receptor, + data = df + ) + attr(x = object, which = "rt_data") <- NULL + expect_equal( + object = object, + expected = tibble::tribble( + ~label, ~outcome, ~type, ~exposure, + "N", "", "total", "receptor", + "continuous", "continuous", "median (iqr)", "receptor" + ) + ) + } +) + + +test_that( + desc = "Table 1 works without variables", + code = { + expect_equal( + object = nrow(table1_design(data = df)), + expected = 16 + ) + } +) + +test_that( + desc = "Table 1 with empty levels", + code = { + levels(df$stage) <- c(levels(df$stage), "Stage IV") + object <- table1_design( + stage, + by = receptor, + data = df, + empty_levels = TRUE + ) + expect_equal( + object = nrow(object), + expected = 6 + ) + } +) diff --git a/tests/testthat/test-time2.R b/tests/testthat/test-time2.R new file mode 100644 index 0000000..a407569 --- /dev/null +++ b/tests/testthat/test-time2.R @@ -0,0 +1,317 @@ +data(cancer, package = "survival") + +cancer <- cancer %>% + tibble::as_tibble() %>% + dplyr::mutate( + # The exposure (here, 'sex') must be categorical (a factor) + sex = factor( + sex, + levels = 1:2, + labels = c( + "Male", + "Female" + ) + ), + time2 = time / 365.25, # transform to years + time = 0.1, + status = status - 1 + ) %>% + dplyr::filter(time2 > time) + +testthat::test_that( + desc = "time2 works", + code = { + object <- tibble::tribble( + ~label, ~type, + "**Absolute estimates**", "", + "*Counts and sums*", "", + " Observations, *N*", "total", + " Events, *n*", "events", + " Events/observations", "events/total", + " Events/person-years", "events/time", + "*Follow-up*", "", + " Person-years", "time", + " Maximum follow-up, years", "maxfu", + " Median follow-up, years", "medfu", + " Median follow-up (IQR), years", "medfu (iqr)", + "*Rates*", "", + " Rate per 1000 person-years", "rate", + " Rate per 1000 person-years (95% CI)", "rate (ci)", + " Events/py (rate per 1000 py)", "events/time (rate)", + "*Risks*", "", + " 1-year survival", "surv", + " 1-year survival (95% CI)", "surv (ci)", + " 1-year risk/cumulative incidence", "cuminc", + " 1-year risk (95% CI)", "cuminc (ci)", + " Median survival, years", "medsurv", + " Median survival (95 CI), years", "medsurv (ci)", + "", "", + "**Comparative estimates**", "", + " 1-year survival difference", "survdiff", + " 1-year risk difference", "cumincdiff", + " 1-year survival ratio", "survratio", + " 1-year risk ratio", "cumincratio", + " Hazard ratio (95% CI)", "hr" + ) %>% + dplyr::mutate( + time = "time", + time2 = "time2", + event = "status", + exposure = "sex", + arguments = list(list(timepoint = 1)) + ) %>% + rifttable( + data = cancer, + overall = TRUE + ) + + expected <- tibble::tribble( + ~Summary, ~Overall, ~Male, ~Female, + "**Absolute estimates**", "", "", "", + "*Counts and sums*", "", "", "", + " Observations, *N*", "217", "128", "89", + " Events, *n*", "154", "102", "52", + " Events/observations", "154/217", "102/128", "52/89", + " Events/person-years", "154/168", "102/94", "52/75", + "*Follow-up*", "", "", "", + " Person-years", "168", "94", "75", + " Maximum follow-up, years", "2.70", "2.70", "2.54", + " Median follow-up, years", "1.61", "2.30", "1.45", + " Median follow-up (IQR), years", "1.61 (0.82, 2.64)", "2.30 (1.11, 2.77)", "1.45 (0.76, 2.25)", + "*Rates*", "", "", "", + " Rate per 1000 person-years", "914.8", "1088.1", "697.0", + " Rate per 1000 person-years (95% CI)","914.8 (781.1, 1071.3)","1088.1 (896.2, 1321.2)","697.0 (531.1, 914.6)", + " Events/py (rate per 1000 py)", "154/168 (914.8)", "102/94 (1088.1)", "52/75 (697.0)", + "*Risks*", "", "", "", + " 1-year survival", "0.43", "0.36", "0.53", + " 1-year survival (95% CI)", "0.43 (0.36, 0.51)", "0.36 (0.28, 0.46)", "0.53 (0.43, 0.66)", + " 1-year risk/cumulative incidence", "0.57", "0.64", "0.47", + " 1-year risk (95% CI)", "0.57 (0.49, 0.64)", "0.64 (0.54, 0.72)", "0.47 (0.34, 0.57)", + " Median survival, years", "0.93", "0.78", "1.17", + " Median survival (95 CI), years", "0.93 (0.80, 1.02)", "0.78 (0.63, 0.97)", "1.17 (0.95, 1.51)", + "", "", "", "", + "**Comparative estimates**", "", "", "", + " 1-year survival difference", "", "0 (reference)", "0.17 (0.02, 0.32)", + " 1-year risk difference", "", "0 (reference)", "-0.17 (-0.32, -0.02)", + " 1-year survival ratio", "", "1 (reference)", "1.47 (1.05, 2.05)", + " 1-year risk ratio", "", "1 (reference)", "0.73 (0.56, 1.04)", + " Hazard ratio (95% CI)", "", "1 (reference)", "0.63 (0.45, 0.87)" + ) + + expect_equal( + object = object, + expected = expected + ) + } +) + +testthat::test_that( + desc = "catch time2 containing NA", + code = { + expect_warning( + object = rifttable( + design = tibble::tibble( + type = "rate", + time = "time", + time2 = "time2", + event = "status" + ), + data = cancer %>% + dplyr::mutate( + time2 = dplyr::if_else( + dplyr::row_number() < 5, + true = NA_real_, + false = time2 + ) + ) + ), + regexp = "'time2' contains missing values" + ) + } +) + +testthat::test_that( + desc = "catch time2 of wrong type", + code = { + expect_error( + object = rifttable( + design = tibble::tibble( + type = "rate", + time = "time", + time2 = "sex", + event = "status" + ), + data = cancer + ), + regexp = "time2 variable 'sex' must be continuous" + ) + } +) + +testthat::test_that( + desc = "catch wrong time2 variable", + code = { + expect_error( + object = rifttable( + design = tibble::tibble( + type = "rate", + time = "time", + time2 = "aaa", + event = "status" + ), + data = cancer + ), + regexp = "time2 variable 'aaa' is not valid" + ) + } +) + + +testthat::test_that( + desc = "squareadd risk difference works", + code = { + result <- survdiff_ci( + formula = survival::Surv( + time = time, + event = status + ) ~ + sex, + data = cancer, + time = 365.25, + approach = "squareadd" + ) + + expect_equal( + object = result$term, + expected = "Female" + ) + expect_equal( + object = result$estimate, + expected = 0.21260534 + ) + expect_equal( + object = result$conf.low, + expected = 0.0887429 + ) + expect_equal( + object = result$conf.high, + expected = 0.33646778 + ) + } +) + + +testthat::test_that( + desc = "Invalid ID variable is found", + code = { + expect_error( + object = rifttable( + design = tibble::tibble( + type = "surv", + time = "time", + event = "status", + exposure = "sex", + arguments = list(list(id = "nonsense")) + ), + data = cancer + ), + regexp = "is not an ID variable that is valid" + ) + } +) + +testthat::test_that( + desc = "ID variable gets used", + code = { + expect_equal( + object = rifttable( + design = tibble::tibble( + type = "surv (ci)", + time = "time", + time2 = "time2", + event = "status", + arguments = list( + list(timepoint = 1), + list( + id = "idvar", + timepoint = 1 + ) + ) + ), + data = cancer %>% + dplyr::mutate( + idvar = rep( + 1:50, + length.out = nrow(cancer) + ) + ) + ), + expected = tibble::tibble( + Summary = c("surv (ci)", "surv (ci)"), + Overall = c("0.43 (0.36, 0.51)", "0.43 (0.37, 0.50)") + ) + ) + } +) + +testthat::test_that( + desc = "old options are not used", + code = { + expect_error( + object = rifttable( + design = tibble::tibble( + type = "hr", + time = "time", + event = "status", + exposure = "sex", + arguments = list(list(weights = "aaa")) + ), + data = cancer + ), + regexp = "Breaking change in rifttable" + ) + } +) + +testthat::test_that( + desc = "Cox model does not return results without exposure", + code = { + expect_equal( + object = rifttable( + design = tibble::tibble( + type = "hr", + time = "time", + event = "status", + ), + data = cancer + ), + expected = tibble::tibble( + Summary = "hr", + Overall = "" + ) + ) + } +) + + +testthat::test_that( + desc = "Cox model does not return results with one exposure group", + code = { + expect_equal( + object = rifttable( + design = tibble::tibble( + type = "hr", + time = "time", + event = "status", + exposure = "sex" + ), + data = cancer %>% + dplyr::filter(sex == "Male") + ), + expected = tibble::tibble( + sex = "hr", + Male = "" + ) + ) + } +) diff --git a/tests/testthat/test-trend.R b/tests/testthat/test-trend.R new file mode 100644 index 0000000..a16274a --- /dev/null +++ b/tests/testthat/test-trend.R @@ -0,0 +1,161 @@ +data(breastcancer, package = "risks") + +test_that( + desc = "trend works for binary", + code = { + design <- tibble::tibble( + type = "rr", + exposure = "stage", + outcome = "death", + trend = "stage_num" + ) + + expect_equal( + object = rifttable( + design = design, + data = breastcancer %>% + dplyr::mutate( + stage_num = as.numeric(stage) + ) + ), + expected = tibble::tibble( + Stage = "rr", + `Stage I` = "1 (reference)", + `Stage II` = "2.59 (1.20, 5.6)", + `Stage III` = "6.9 (3.3, 14)", + Trend = "2.50 (1.97, 3.2)" + ) + ) + } +) + +test_that( + desc = "trend works for continuous", + code = { + design <- tibble::tibble( + type = "diff", + exposure = "stage", + outcome = "cont", + trend = "stage_num" + ) + + expect_equal( + object = rifttable( + design = design, + data = breastcancer %>% + dplyr::mutate( + stage_num = as.numeric(stage), + cont = death * 10 + ), + diff_digits = 0 + ), + expected = tibble::tibble( + Stage = "diff", + `Stage I` = "0 (reference)", + `Stage II` = "2 (0, 3)", + `Stage III` = "6 (4, 8)", + Trend = "3 (2, 4)" + ) + ) + } +) + +test_that( + desc = "trend input errors are caught", + code = { + design <- tibble::tibble( + type = "diff", + outcome = "death", + trend = "stage" + ) + expect_error( + object = rifttable( + design = design, + data = breastcancer + ), + regexp = "Trend variable 'stage' is not continuous" + ) + + expect_error( + object = rifttable( + design = design %>% + dplyr::mutate(trend = "aaa"), + data = breastcancer + ), + regexp = "Trend variable 'aaa' is not valid for the dataset." + ) + } +) + +test_that( + desc = "trend is blank for type = 'blank'", + code = { + design <- tibble::tibble( + type = "", + exposure = "stage", + trend = "death", + outcome = "death" + ) + expect_equal( + object = rifttable( + design = design, + data = breastcancer + ), + expected = tibble::tibble( + Stage = "", + `Stage I` = "", + `Stage II` = "", + `Stage III` = "", + Trend = "" + ) + ) + } +) + +test_that( + desc = "confounders = NA is fine", + code = { + design <- tibble::tibble( + type = "rr", + exposure = "stage", + outcome = "death", + confounders = NA + ) + expect_equal( + object = rifttable( + design = design, + data = breastcancer + ), + expected = tibble::tribble( + ~Stage, ~`Stage I`, ~`Stage II`, ~`Stage III`, + "rr", "1 (reference)", "2.59 (1.20, 5.6)", "6.9 (3.3, 14)" + ) + ) + } +) + + +test_that( + desc = "Non-comparative tables work", + code = { + design <- tibble::tibble( + type = c("rr", "diff"), + exposure = "receptor", + outcome = "death" + ) + + expect_equal( + object = rifttable( + design = design, + data = breastcancer %>% + dplyr::filter(receptor == "Low") + ), + expect = tibble::tribble( + ~`Hormone receptor`, ~Low, + "rr", "", + "diff", "" + ) + ) + } +) +