85: Fix s_kaplan_meier()

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

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", , "[email protected]", role = c("cre", "aut"),

NEWS.md

@@ -1,3 +1,7 @@
+# junco 0.1.2.9000
+
+TODO
+
 # junco 0.1.2
 
 ### New Major features

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),

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

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)")