Add adaptive timepoint/plan switching to Trial.R and id_map support to Population.R

.Rbuildignore

@@ -10,3 +10,4 @@
 ^_pkgdown\.yml$
 ^docs$
 ^pkgdown$
+^.nfs*$

.gitignore

@@ -147,3 +147,8 @@ $RECYCLE.BIN/
 # End of https://www.toptal.com/developers/gitignore/api/r,windows,macos,linux
 /doc/
 /Meta/
+
+
+# Testing file
+Testimgall*.Rmd
+Testimgall*.html

NAMESPACE

@@ -17,11 +17,18 @@ export(trigger_by_fraction)
 export(vector_to_dataframe)
 importFrom(dplyr,.data)
 importFrom(dplyr,arrange)
+importFrom(dplyr,bind_rows)
 importFrom(dplyr,filter)
 importFrom(dplyr,group_by)
+importFrom(dplyr,inner_join)
 importFrom(dplyr,mutate)
 importFrom(dplyr,select)
+importFrom(dplyr,summarise)
 importFrom(dplyr,ungroup)
+importFrom(purrr,map)
+importFrom(purrr,map_dfr)
+importFrom(purrr,pwalk)
 importFrom(rlang,":=")
+importFrom(rlang,.data)
 importFrom(rlang,enquos)
 importFrom(utils,tail)

R/Population.R

@@ -53,6 +53,9 @@ Population <- R6::R6Class(
     #' @field n_readouts `integer` Number of readout_times in the population.
     n_readouts = NULL,
 
+    #' @field id_map `vector` Canonical subject id order used to align enrolled/dropped with `id`.
+    id_map = NULL,
+
     # --- constructor ---
     #' @description
     #' Create a new `Population` instance.
@@ -70,12 +73,12 @@ Population <- R6::R6Class(
     #' @examples
     #' Population$new(name = "Intervention", data = vector_to_dataframe(rnorm(5)))
     initialize = function(
-      name,
-      data = NULL,
-      enrolled = NULL,
-      dropped = NULL,
-      n = NULL,
-      n_readouts = NULL
+    name,
+    data = NULL,
+    enrolled = NULL,
+    dropped = NULL,
+    n = NULL,
+    n_readouts = NULL
     ) {
       stopifnot(is.character(name))
       self$name <- name
@@ -94,7 +97,11 @@ Population <- R6::R6Class(
       }
 
       self$data <- data
-      self$n <- length(unique(self$data$id))
+
+      # id_map fixes the id/enrolled alignment: enrolled[i] and dropped[i] correspond to id_map[i]
+      self$id_map <- unique(self$data$id)
+
+      self$n <- length(self$id_map)
       self$n_readouts <- (dim(self$data)[1] / self$n)
 
       # Initialize enrollment/dropout status if not provided
@@ -195,7 +202,11 @@ Population <- R6::R6Class(
         data$arm <- self$name
       }
       self$data <- data
-      self$n <- nrow(self$data)
+
+      self$id_map <- unique(self$data$id)
+      self$n <- length(self$id_map)
+      self$n_readouts <- (dim(self$data)[1] / self$n)
+
       self$dropped <- rep(NA, self$n)
       self$enrolled <- rep(NA, self$n)
       invisible(self)

R/Timer.R

@@ -134,7 +134,7 @@ Timer <- R6::R6Class(
     #' @param ... `expression` Boolean expression(s) for `dplyr::filter()`.
     #' @param analysis `function` or `NULL` Optional function to apply.
     #' @param name `character` Unique condition identifier.
-     #' 
+     #'
     #' @examples
     #' #' t <- Timer$new(name = "Timer")
     #'
@@ -323,7 +323,7 @@ Timer <- R6::R6Class(
         }
 
         if (nrow(df_i) == 0L) {
-          warning(sprintf("Skipping condition '%s' at time %s: filtered data is empty", key, as.character(current_time)), call. = FALSE)
+          #warning(sprintf("Skipping condition '%s' at time %s: filtered data is empty", key, as.character(current_time)), call. = FALSE)
           next
         }