Updates when no censoring observed (#99)

* progress

* increment version number

* workflow update

* Update R-CMD-check.yaml

* Update broom_methods.R

.github/workflows/R-CMD-check.yaml

@@ -27,12 +27,12 @@ jobs:
           - {os: windows-latest, r: 'release'}
 
           # Use older ubuntu to maximise backward compatibility
-          - {os: ubuntu-18.04,   r: 'devel', http-user-agent: 'release'}
-          - {os: ubuntu-18.04,   r: 'release'}
-          - {os: ubuntu-18.04,   r: 'oldrel-1'}
-          - {os: ubuntu-18.04,   r: 'oldrel-2'}
-          - {os: ubuntu-18.04,   r: 'oldrel-3'}
-          - {os: ubuntu-18.04,   r: 'oldrel-4'}
+          - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
+          - {os: ubuntu-latest,   r: 'release'}
+          - {os: ubuntu-latest,   r: 'oldrel-1'}
+          - {os: ubuntu-latest,   r: 'oldrel-2'}
+          - {os: ubuntu-latest,   r: 'oldrel-3'}
+          - {os: ubuntu-latest,   r: 'oldrel-4'}
 
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
@@ -43,7 +43,7 @@ jobs:
 
       - uses: r-lib/actions/setup-pandoc@v1
 
-      - uses: r-lib/actions/setup-r@v1
+      - uses: r-lib/actions/setup-r@v2
         with:
           r-version: ${{ matrix.config.r }}
           http-user-agent: ${{ matrix.config.http-user-agent }}

.github/workflows/pkgdown.yaml

@@ -17,7 +17,7 @@ jobs:
 
       - uses: r-lib/actions/setup-pandoc@v1
 
-      - uses: r-lib/actions/setup-r@v1
+      - uses: r-lib/actions/setup-r@v2
         with:
           use-public-rspm: true
 

.github/workflows/pr-commands.yaml

@@ -20,7 +20,7 @@ jobs:
         with:
           repo-token: ${{ secrets.GITHUB_TOKEN }}
 
-      - uses: r-lib/actions/setup-r@v1
+      - uses: r-lib/actions/setup-r@v2
         with:
           use-public-rspm: true
 

.github/workflows/render-readme.yaml

@@ -17,7 +17,7 @@ jobs:
 
       - uses: r-lib/actions/setup-pandoc@v1
 
-      - uses: r-lib/actions/setup-r@v1
+      - uses: r-lib/actions/setup-r@v2
         with:
           use-public-rspm: true
 

.github/workflows/test-coverage.yaml

@@ -17,7 +17,7 @@ jobs:
     steps:
       - uses: actions/checkout@v2
 
-      - uses: r-lib/actions/setup-r@v1
+      - uses: r-lib/actions/setup-r@v2
         with:
           use-public-rspm: true
 

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: tidycmprsk
 Title: Competing Risks Estimation
-Version: 0.2.0.9002
+Version: 0.2.0.9003
 Authors@R: c(
     person(c("Daniel", "D."), "Sjoberg", , "[email protected]", role = c("aut", "cre", "cph"),
            comment = c(ORCID = "0000-0003-0862-2018")),
@@ -23,8 +23,8 @@ Imports:
     cmprsk (>= 2.2.10),
     dplyr (>= 1.0.7),
     ggplot2 (>= 3.3.5),
-    gtsummary (>= 1.6.2),
-    hardhat (>= 0.2.0),
+    gtsummary (>= 1.7.2),
+    hardhat (>= 1.3.0),
     purrr (>= 0.3.4),
     rlang (>= 1.0.0),
     stringr (>= 1.4.0),
@@ -36,7 +36,7 @@ Suggests:
     ggsurvfit,
     knitr (>= 1.36),
     spelling,
-    testthat (>= 3.1.0)
+    testthat (>= 3.2.0)
 Config/testthat/edition: 3
 Encoding: UTF-8
 Language: en-US

NEWS.md

@@ -1,5 +1,7 @@
 # tidycmprsk (development version)
 
+* Corrected regression and `cuminc()` can again handle models with no observed censoring. (#89)
+
 * Performance improvements to `cuminc()`. (@pteridin; #73)
 
 * Updates ahead of the {purrr} v1.0 release.

R/broom_methods.R

@@ -299,86 +299,86 @@ add_n_stats <- function(df_tidy, x) {
   }
 
   ## Determine n at risk (t = 0) --------
-  df_n_risk0 <- df_Surv |>
-    dplyr::group_by(across(any_of(c("strata")))) |>
+  df_n_risk0 <- df_Surv %>%
+    dplyr::group_by(across(any_of(c("strata")))) %>%
     dplyr::summarize(n.risk = dplyr::n(),
                      .groups = "drop")
 
   ## Determine censored & events each t --------
-  df_n_cens_event <- df_Surv |>
-    dplyr::group_by(across(any_of(c("time", "strata", "status")))) |>
+  df_n_cens_event <- df_Surv %>%
+    dplyr::group_by(across(any_of(c("time", "strata", "status")))) %>%
     dplyr::summarize(n = dplyr::n(),
                      .groups = "drop")
 
   ## Determine censored overall each t ---------
-  df_n_event_overall <- df_Surv |>
-    filter(.data$status != 0) |>
-    dplyr::group_by(across(any_of(c("time", "strata")))) |>
+  df_n_event_overall <- df_Surv %>%
+    filter(.data$status != 0) %>%
+    dplyr::group_by(across(any_of(c("time", "strata")))) %>%
     dplyr::summarise(n.event.overall = dplyr::n(),
                      .groups = "drop")
 
   ## Joining the data --------
   if(is_strata) {
-    df_result <- df_tidy |>
+    df_result <- df_tidy %>%
       dplyr::left_join(df_n_risk0,
-                       by = "strata") |>
-      dplyr::left_join(df_n_cens_event |>
-                         filter(.data$status != 0) |>
+                       by = "strata") %>%
+      dplyr::left_join(df_n_cens_event %>%
+                         filter(.data$status != 0) %>%
                          mutate(outcome = factor(.data$status,
                                                  x$failcode,
-                                                 names(x$failcode))) |>
-                         select(-dplyr::all_of(c("status"))) |>
+                                                 names(x$failcode))) %>%
+                         select(-dplyr::all_of(c("status"))) %>%
                          dplyr::rename(n.event = dplyr::all_of("n")),
-                       by = c("strata", "time", "outcome")) |>
-      dplyr::left_join(df_n_cens_event |>
-                         filter(.data$status == 0) |>
-                         select(-dplyr::all_of("status")) |>
+                       by = c("strata", "time", "outcome")) %>%
+      dplyr::left_join(df_n_cens_event %>%
+                         filter(.data$status == 0) %>%
+                         select(-dplyr::all_of("status")) %>%
                          dplyr::rename(n.censor = dplyr::all_of("n")),
-                       by = c("strata", "time"))   |>
+                       by = c("strata", "time"))   %>%
       dplyr::left_join(df_n_event_overall,
                        by = c("strata", "time"),
                        relationship = "many-to-many")
   } else {
-    df_result <- df_tidy |>
-      dplyr::cross_join(df_n_risk0) |>
-      dplyr::left_join(df_n_cens_event |>
-                         filter(.data$status != 0) |>
+    df_result <- df_tidy %>%
+      dplyr::cross_join(df_n_risk0) %>%
+      dplyr::left_join(df_n_cens_event %>%
+                         filter(.data$status != 0) %>%
                          mutate(outcome = factor(.data$status,
                                                  x$failcode,
-                                                 names(x$failcode))) |>
-                         select(-dplyr::all_of(c("status"))) |>
+                                                 names(x$failcode))) %>%
+                         select(-dplyr::all_of(c("status"))) %>%
                          dplyr::rename(n.event = dplyr::all_of("n")),
-                       by = c("time", "outcome")) |>
-      dplyr::left_join(df_n_cens_event |>
-                         filter(.data$status == 0) |>
-                         select(-dplyr::all_of("status")) |>
+                       by = c("time", "outcome")) %>%
+      dplyr::left_join(df_n_cens_event %>%
+                         filter(.data$status == 0) %>%
+                         select(-dplyr::all_of("status")) %>%
                          dplyr::rename(n.censor = dplyr::all_of("n")),
-                       by = c("time")) |>
+                       by = c("time")) %>%
       dplyr::left_join(df_n_event_overall,
                        by = c("time"))
   }
 
   # Fill missing values and build cum. sum ------
-  df_result <- df_result |>
+  df_result <- df_result %>%
     mutate(n.event  = dplyr::coalesce(.data$n.event, 0L),
            n.censor = dplyr::coalesce(.data$n.censor, 0L),
-           n.event.overall = dplyr::coalesce(.data$n.event.overall, 0L)) |>
-    group_by(across(any_of(c("strata", "outcome")))) |>
-    arrange("time") |>
+           n.event.overall = dplyr::coalesce(.data$n.event.overall, 0L)) %>%
+    group_by(across(any_of(c("strata", "outcome")))) %>%
+    arrange("time") %>%
     mutate(cum.event  = cumsum(.data$n.event),
            cum.censor = cumsum(.data$n.censor),
            cum.event.overall = cumsum(.data$n.event.overall),
            n.risk = .data$n.risk - .data$cum.event.overall - .data$cum.censor +
-             .data$n.event.overall + .data$n.censor) |>
-    dplyr::ungroup() |>
-    arrange(across(any_of(c("strata", "outcome", "time", "n.risk")))) |>
+             .data$n.event.overall + .data$n.censor) %>%
+    dplyr::ungroup() %>%
+    arrange(across(any_of(c("strata", "outcome", "time", "n.risk")))) %>%
     select(any_of(c("time", "outcome", "strata")),
-           everything()) |>
+           everything()) %>%
     select(-any_of(c("cum.event.overall",
                      "n.event.overall")))
 
   if(is_strata)
-    df_result <- df_result |>
+    df_result <- df_result %>%
       mutate(strata = factor(.data$strata,
                              levels(df_tidy$strata)))
 

R/cuminc.R

@@ -36,8 +36,6 @@ NULL
 #' @rdname cuminc
 #' @export
 cuminc.formula <- function(formula, data, strata, rho = 0, conf.level = 0.95, ...) {
-  if (!missing(data)) data <- droplevels(data)
-
   # extracting failure level ---------------------------------------------------
   failcode_numeric <-
     as_numeric_failcode(formula = formula, data = data, keep_all = TRUE)

tests/testthat/test-crr.R

@@ -52,4 +52,22 @@ test_that("crr() works", {
   expect_error(
     crr(letters)
   )
+
+  # `crr()` works with no observed censoring
+  expect_error(
+    crr_no_censor<-
+      crr(
+        Surv(ttdeath, death_cr) ~ trt,
+        data = trial %>% dplyr::filter(!death_cr %in% "censor")
+      ),
+    NA
+  )
+  expect_equal(
+    cmprsk::crr(
+      ftime = trial$ttdeath[!trial$death_cr %in% "censor"],
+      fstatus = as.numeric(trial$death_cr[!trial$death_cr %in% "censor"]) - 1L,
+      cov1 = model.matrix(~., data = trial[!trial$death_cr %in% "censor", "trt"])[, -1, drop = FALSE]
+    )[1:6],
+    crr_no_censor$cmprsk[1:6]
+  )
 })

tests/testthat/test-cuminc.R

@@ -108,5 +108,23 @@ test_that("cuminc() works", {
     ) %>%
       dplyr::mutate(strata = factor(strata, levels = c("I", "II", "III")))
   )
+
+
+  # `cuminc()` works with no observed censoring
+  expect_error(
+    cuminc_no_censor<-
+      cuminc(
+        Surv(ttdeath, death_cr) ~ 1,
+        data = trial %>% dplyr::filter(!death_cr %in% "censor")
+      ),
+    NA
+  )
+  expect_equal(
+    cmprsk::cuminc(
+      ftime = trial$ttdeath[!trial$death_cr %in% "censor"],
+      fstatus = as.numeric(trial$death_cr[!trial$death_cr %in% "censor"]) - 1L
+    ),
+    cuminc_no_censor$cmprsk
+  )
 })