diff --git a/CHANGELOG.md b/CHANGELOG.md index 7f5002b..861133c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,11 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [0.1.x] - Unreleased + +### Fixed +- Fixed `s_kaplan_meier()` range censoring indicator handling to no longer produce `NA` values in the output when either all subjects are censored or none are censored. + ## [0.1.2] - 2025-12-10 ### Added and Removed diff --git a/DESCRIPTION b/DESCRIPTION index b40caaa..8c8920d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: junco Title: Create Common Tables and Listings Used in Clinical Trials -Version: 0.1.2 +Version: 0.1.2.9000 Date: 2025-12-04 Authors@R: c( person("Gabriel", "Becker", , "gabembecker@gmail.com", role = c("cre", "aut"), diff --git a/NEWS.md b/NEWS.md index 49f41f3..2549f77 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# junco 0.1.2.9000 + +TODO + # junco 0.1.2 ### New Major features diff --git a/R/kaplan_meier.R b/R/kaplan_meier.R index 02a43a1..f083ac8 100644 --- a/R/kaplan_meier.R +++ b/R/kaplan_meier.R @@ -67,12 +67,25 @@ s_kaplan_meier <- function(df, .var, is_event, control = control_surv_time()) { quantiles_lower <- vapply(srv_qt_tab, "[", 1, FUN.VALUE = numeric(1)) median_ci <- vapply(srv_qt_tab, "[", 2, FUN.VALUE = numeric(1)) quantiles_upper <- vapply(srv_qt_tab, "[", 3, FUN.VALUE = numeric(1)) - range_censor <- range_noinf(df[[.var]][!df[[is_event]]], na.rm = TRUE) - range_event <- range_noinf(df[[.var]][df[[is_event]]], na.rm = TRUE) - range <- range_noinf(df[[.var]], na.rm = TRUE) - lower_censored <- as.numeric(range_censor[1] < range_event[1]) - upper_censored <- as.numeric(range_censor[2] > range_event[2]) + + x <- df[[.var]] + has_event <- df[[is_event]] + x_censored <- x[!has_event] + x_event <- x[has_event] + + any_censored <- !all(has_event) + no_event <- !any(has_event) + + range_censor <- range_noinf(x_censored, na.rm = TRUE) + range_event <- range_noinf(x_event, na.rm = TRUE) + range <- range_noinf(x, na.rm = TRUE) + + lower_censored <- any_censored && + (no_event || as.numeric(range_censor[1] < range_event[1])) + upper_censored <- any_censored && + (no_event || as.numeric(range_censor[2] > range_event[2])) range_with_cens_info <- c(range, lower_censored, upper_censored) + list( quantiles_lower = with_label( unname(quantiles_lower), diff --git a/inst/WORDLIST b/inst/WORDLIST index 35a9dd8..c169b3c 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -20,7 +20,6 @@ Lapply MMRM Miettinen Nurminen -Optimality PARAMCD Parallelisation Parallelise @@ -36,7 +35,6 @@ Toeplitz TrueType Unlist VTableTree -Vectorized XLSX afun allparts @@ -116,8 +114,6 @@ pseudocolumn px rbmi removerowtext -repo -reproducibility responder responders rlistings diff --git a/tests/testthat/test-kaplan_meier.R b/tests/testthat/test-kaplan_meier.R index 7891ef9..51b43c0 100644 --- a/tests/testthat/test-kaplan_meier.R +++ b/tests/testthat/test-kaplan_meier.R @@ -1,10 +1,10 @@ library(tern) test_that("s_kaplan_meier works with default arguments", { - adtte_f <- tern::tern_ex_adtte |> + adtte_f <- tern_ex_adtte |> dplyr::filter(PARAMCD == "OS") |> dplyr::mutate( - AVAL = tern::day2month(AVAL), + AVAL = day2month(AVAL), is_event = CNSR == 0 ) @@ -21,7 +21,7 @@ test_that("s_kaplan_meier works with customized arguments", { adtte_f <- tern_ex_adtte |> dplyr::filter(PARAMCD == "OS") |> dplyr::mutate( - AVAL = tern::day2month(AVAL), + AVAL = day2month(AVAL), is_event = CNSR == 0 ) # Make sure the highest value is censored to check range censor information. @@ -41,11 +41,46 @@ test_that("s_kaplan_meier works with customized arguments", { expect_snapshot(result) }) +test_that("s_kaplan_meier returns correct censoring indicators in edge cases", { + adtte_f <- tern_ex_adtte |> + dplyr::filter(PARAMCD == "OS") |> + dplyr::mutate( + AVAL = day2month(AVAL), + is_event = CNSR == 0 + ) + + # Case 1: All events + adtte_f_all_events <- adtte_f |> + dplyr::mutate(is_event = TRUE) + result_all_events <- expect_silent(s_kaplan_meier( + adtte_f_all_events, + .var = "AVAL", + is_event = "is_event" + )) + expect_identical( + result_all_events$range_with_cens_info[c(3, 4)], + c(0, 0) # No censored observations, so the range is also not censored. + ) + + # Case 2: All censored + adtte_f_all_censored <- adtte_f |> + dplyr::mutate(is_event = FALSE) + result_all_censored <- expect_silent(s_kaplan_meier( + adtte_f_all_censored, + .var = "AVAL", + is_event = "is_event" + )) + expect_identical( + result_all_censored$range_with_cens_info[c(3, 4)], + c(1, 1) # All observations are censored, so the range is also censored. + ) +}) + test_that("a_kaplan_meier works with default arguments", { - adtte_f <- tern::tern_ex_adtte |> + adtte_f <- tern_ex_adtte |> dplyr::filter(PARAMCD == "OS") |> dplyr::mutate( - AVAL = tern::day2month(AVAL), + AVAL = day2month(AVAL), is_event = CNSR == 0 ) adtte_f$is_event[adtte_f$AVAL == max(adtte_f$AVAL)] <- FALSE @@ -61,10 +96,10 @@ test_that("a_kaplan_meier works with default arguments", { }) test_that("a_kaplan_meier works with customized arguments", { - adtte_f <- tern::tern_ex_adtte |> + adtte_f <- tern_ex_adtte |> dplyr::filter(PARAMCD == "OS") |> dplyr::mutate( - AVAL = tern::day2month(AVAL), + AVAL = day2month(AVAL), is_event = CNSR == 0 ) adtte_f$is_event[adtte_f$AVAL == max(adtte_f$AVAL)] <- FALSE @@ -88,7 +123,7 @@ test_that("a_kaplan_meier works inside analyze in table", { adtte_f <- tern_ex_adtte |> dplyr::filter(PARAMCD == "OS") |> dplyr::mutate( - AVAL = tern::day2month(AVAL), + AVAL = day2month(AVAL), is_event = CNSR == 0 ) adtte_f$is_event[ @@ -118,7 +153,7 @@ test_that("a_kaplan_meier works inside analyze in table with custom arguments", adtte_f <- tern_ex_adtte |> dplyr::filter(PARAMCD == "OS") |> dplyr::mutate( - AVAL = tern::day2month(AVAL), + AVAL = day2month(AVAL), is_event = CNSR == 0 ) adtte_f$is_event[ @@ -136,7 +171,7 @@ test_that("a_kaplan_meier works inside analyze in table with custom arguments", show_labels = "visible", extra_args = list( is_event = "is_event", - control = tern::control_surv_time(conf_level = 0.9, conf_type = "log"), + control = control_surv_time(conf_level = 0.9, conf_type = "log"), .stats = c("median_ci_3d", "range_with_cens_info"), .formats = c( median_ci_3d = jjcsformat_xx("xx.xxxx (xx.xxxx, xx.xxxx)")