Add missing support of transition 22

R/renewnetTPreg.R

@@ -313,7 +313,7 @@ renewnetTPreg <- function(s = 0,
     if (sum(comdata$delta1 < comdata$delta) != 0) {
       stop("'delta' must be 0 when 'delta1' is 0")
     }
-    if (!(trans %in% c("11", "12", "13", "23", "all"))) {
+    if (!(trans %in% c("11", "12", "22", "13", "23", "all"))) {
       stop(paste(trans, "is not a valid transition for a progressive illness-death model"))
     }
 
@@ -341,7 +341,7 @@ renewnetTPreg <- function(s = 0,
     }
 
     if (trans == "all") {
-      transitions <- c("11", "12", "13", "23")
+      transitions <- c("11", "12", "22", "13", "23")
     } else {
       transitions <- c(trans)
     }
@@ -613,6 +613,8 @@ get_survival_at <- function(t, survfit_data, safe = TRUE) {
 
 fit_single_time_point_estimate <-
   function(s, t, transition, X, data_df, ratetable, rmap) {
+    # Assume data_df and X have already been subsetted to conform to time s
+
     # Convert data_df to data.table for efficiency
     if (!data.table::is.data.table(data_df)) {
       data_df <- data.table::as.data.table(data_df)
@@ -626,15 +628,13 @@ fit_single_time_point_estimate <-
     censor_indicators <- NULL
     shorthand_fun <- function(x) get_survival_at(x, cens_surv)
     if (transition == "11") {
-      # FIXME implement data filtering based on state at time s
       # Construct \Delta^{1}_{t} = 1_{min(Z,t) \leq C} in Azarang 2017
       # data_df==delta1 already implies Z \leq C, update indicator based on t
       data_df[t <= Zt & delta1 == 0, delta1 := 1]
       censor_surv_t <- shorthand_fun(pmin(data_df$Zt, t))
       censor_indicators <- data_df$delta1
     }
     else {
-      # FIXME implement data filtering based on state at time s
       # \Delta_{t} = 1_{min(T,t) \leq C} in Azarang 2017, same reasoning as
       # before
       data_df[t <= Tt & delta == 0, delta := 1]

tests/testthat/test-netidmtpreg_fit.R

@@ -58,7 +58,7 @@ testthat::test_that("IDM crude survival model estimates", {
       age = runif(n = n_ind, min = 50, max = 80)
     )
   estimates <- list()
-  for (transition in c("11", "12", "13", "23")) {
+  for (transition in c("11", "12", "22", "13", "23")) {
     estimates[transition] <-
       renewnetTPreg(~1, synth_idm_data,
         ratetable = NULL,
@@ -109,10 +109,10 @@ testthat::test_that("IDM crude survival model estimates", {
   ## Check 22 transition estimates: survival probability
   expected_tp$set("22", pexp(estimates[["22"]]$time - s_time,
     rate = l_death,
-    lower = FALSE # P(T<t)
+    lower = FALSE # P(T>t)
   ))
 
-  for (transition in c("11", "12", "13", "23")) {
+  for (transition in c("11", "12", "22", "13", "23")) {
     tp_val <- expected_tp$get(transition)
 
     testthat::expect_equal(
@@ -153,7 +153,7 @@ testthat::test_that("IDM Net survival model fitting runs inside futures", {
     ))
   for (session_type in c("sequential", "multisession")){
     future::plan(session_type)
-    for (transition in c("all", "11", "12", "13", "23")) {
+    for (transition in c("all", "11", "12", "22", "13", "23")) {
       renewnetTPreg(
         formula = ~1,
         synth_idm_data,
@@ -274,7 +274,7 @@ population mortality are equal",
       population_death_times
     )
 
-    for (transition in c("11", "12", "13", "23")) {
+    for (transition in c("11", "12", "22", "13", "23")) {
       net_truth <- renewnetTPreg(
         formula = ~1,
         synth_idm_data,