Merge pull request #267 from Merck/266-correct-the-output-column-name…

…-of-the-counting_process

266 Correct the output column name of `counting_process()`

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: simtrial
 Type: Package
 Title: Clinical Trial Simulation
-Version: 0.4.1.6
+Version: 0.4.1.7
 Authors@R: c(
     person("Keaven", "Anderson", email = "keaven_anderson@merck.com", role = c("aut")),
     person("Yujie", "Zhao", email = "yujie.zhao@merck.com", role =  c("ctb","cre")),

R/counting_process.R

@@ -44,11 +44,11 @@
 #' is at risk in both treatment group and control group.
 #' Other variables in this represent the following within each stratum at
 #' each time at which one or more events are observed:
-#' - `events`: Total number of events
-#' - `n_event_tol`: Total number of events at treatment group
-#' - `n_risk_tol`: Number of subjects at risk
+#' - `event_total`: Total number of events
+#' - `event_trt`: Total number of events at treatment group
+#' - `n_risk_total`: Number of subjects at risk
 #' - `n_risk_trt`: Number of subjects at risk in treatment group
-#' - `S`: Left-continuous Kaplan-Meier survival estimate
+#' - `s`: Left-continuous Kaplan-Meier survival estimate
 #' - `o_minus_e`: In treatment group, observed number of events minus expected
 #'   number of events. The expected number of events is estimated by assuming
 #'   no treatment effect with hypergeometric distribution with parameters total
@@ -97,50 +97,53 @@ counting_process <- function(x, arm) {
     stop("counting_process: event indicator must be 0 (censoring) or 1 (event).")
   }
 
+  # initilize the number of subjects at risk
   ans <- as.data.table(x)
   ans <- ans[order(tte, decreasing = TRUE), ]
   ans[, one := 1]
   ans[, `:=`(
-    n_risk_tol = cumsum(one),
+    n_risk_total = cumsum(one),
     n_risk_trt = cumsum(treatment == arm)
   ), by = "stratum"]
 
   # Handling ties using Breslow's method
   if (uniqueN(ans[, .(stratum, tte)]) < nrow(ans)) { # ties
     ans[, mtte := -tte]
     ans <- ans[, .(
-      events = sum(event),
-      n_event_tol = sum((treatment == arm) * event),
+      event_total = sum(event),
+      event_trt = sum((treatment == arm) * event),
       tte = tte[1],
-      n_risk_tol = max(n_risk_tol),
+      n_risk_total = max(n_risk_total),
       n_risk_trt = max(n_risk_trt)
     ), by = c("stratum", "mtte")]
     ans[, mtte := NULL]
   } else { # no ties
     ans <- ans[, .(
       stratum,
-      events = event,
-      n_event_tol = (treatment == arm) * event,
+      event_total = event,
+      event_trt = (treatment == arm) * event,
       tte,
-      n_risk_tol,
+      n_risk_total,
       n_risk_trt
     )]
   }
 
   # Keep calculation for observed time with at least one event,
   # at least one subject is at risk in both treatment group and control group.
-  ans <- ans[events > 0 & n_risk_tol - n_risk_trt > 0 & n_risk_trt > 0, ]
-  ans[, s := 1 - events / n_risk_tol]
+  ans <- ans[event_total > 0 & n_risk_total - n_risk_trt > 0 & n_risk_trt > 0, ]
+  ans[, s := 1 - event_total / n_risk_total]
   ans <- ans[order(stratum, tte), ]
   # Left continuous Kaplan-Meier Estimator
   ans[, s := c(1, cumprod(s)[-length(s)]), by = "stratum"]
   # Observed events minus Expected events in treatment group
-  ans[, o_minus_e := n_event_tol - n_risk_trt / n_risk_tol * events]
+  ans[, o_minus_e := event_trt - n_risk_trt / n_risk_total * event_total]
   # Variance of o_minus_e
-  ans[, var_o_minus_e := (n_risk_tol - n_risk_trt) *
-    n_risk_trt * events * (n_risk_tol - events) /
-    n_risk_tol^2 / (n_risk_tol - 1)]
+  ans[, var_o_minus_e := (n_risk_total - n_risk_trt) *
+    n_risk_trt * event_total * (n_risk_total - event_total) /
+    n_risk_total^2 / (n_risk_total - 1)]
 
   setDF(ans)
+  class(ans) <- c("counting_process", class(ans))
+
   return(ans)
 }

tests/testthat/test-unvalidated-data.table.R

@@ -8,7 +8,7 @@ test_that("functions that use data.table still return a data frame", {
     tte = 1:16,
     event = rep(c(0, 1), 8)
   )
-  expect_identical(class(counting_process(x, arm = 1)), class_expected)
+  expect_identical(class(counting_process(x, arm = 1)), c("counting_process", class_expected))
 
   # cut_data_by_date()
   x <- sim_pw_surv(n = 20)
@@ -21,7 +21,7 @@ test_that("functions that use data.table still return a data frame", {
   expect_identical(class(early_zero_weight(x, early_period = 2)), class_expected)
 
   # fh_weight()
-  expect_identical(class(fh_weight()), class_expected)
+  expect_identical(class(fh_weight()), c("counting_process", class_expected))
 
   # mb_weight()
   x <- sim_pw_surv()