Data : ajouter table FU dans grstat_example()

DESCRIPTION

@@ -64,7 +64,7 @@ Suggests:
     vdiffr
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.2
 Config/testthat/edition: 3
 Config/testthat/parallel: true
 VignetteBuilder: knitr
+Config/roxygen2/version: 8.0.0

NAMESPACE

@@ -99,6 +99,7 @@ importFrom(flextable,width)
 importFrom(forcats,as_factor)
 importFrom(forcats,fct_drop)
 importFrom(forcats,fct_infreq)
+importFrom(forcats,fct_recode)
 importFrom(forcats,fct_relevel)
 importFrom(forcats,fct_reorder)
 importFrom(forcats,fct_rev)
@@ -146,6 +147,9 @@ importFrom(ggplot2,unit)
 importFrom(ggplot2,vars)
 importFrom(glue,glue)
 importFrom(lifecycle,deprecated)
+importFrom(lubridate,as_date)
+importFrom(lubridate,days)
+importFrom(lubridate,ymd)
 importFrom(purrr,discard)
 importFrom(purrr,imap)
 importFrom(purrr,iwalk)
@@ -181,6 +185,7 @@ importFrom(scales,breaks_width)
 importFrom(scales,label_percent)
 importFrom(stats,na.omit)
 importFrom(stats,rbinom)
+importFrom(stats,rexp)
 importFrom(stats,rnorm)
 importFrom(stats,runif)
 importFrom(stringr,fixed)

R/data.R

@@ -6,7 +6,7 @@
 #'
 #' @param N the number of patients
 #' @param seed the random seed (can be `NULL`)
-#' @param ... passed on to internal functions. See [example_enrol()],  [example_ae()], and  [example_rc()] for the argument names.
+#' @param ... passed on to internal functions. See [example_enrol()],  [example_ae()], [example_rc()], and [example_fu()] for the argument names.
 #'
 #' @returns A list of datasets, like in EDCimport.
 #'
@@ -16,17 +16,21 @@
 #' @importFrom tibble lst
 grstat_example = function(N=200, seed=42, ...){
 
-  enrolres = example_enrol(N, seed, ...)
+  enrolres = example_enrol(N=N, seed=seed, ...)
 
-  ae = example_ae(enrolres, seed, ...)
+  ae = example_ae(enrolres=enrolres, seed=seed, ...)
 
-  recist = example_rc(enrolres, seed, ...)
+  recist = example_rc(enrolres=enrolres, seed=seed, ...)
 
-  rtn = lst(enrolres, ae, recist) %>%
+  fu = example_fu(enrolres=enrolres, recist=recist, seed=seed, ...)
+
+  rtn = lst(enrolres, ae, recist, fu) %>%
     imap(~.x %>% mutate(crfname=.y %>% set_label("Form name")))
   rtn$date_extraction = "2024/01/01"
   rtn$datetime_extraction = structure(1704067200, class = c("POSIXct", "POSIXt"),
                                       tzone = "Europe/Paris")
+
+  # rtn = .remove_post_event(rtn)
   rtn
 }
 
@@ -159,6 +163,7 @@ example_ae = function(enrolres, seed, p_na=0,
 }
 
 
+
 #' Simulate a RECIST dataset
 #'
 #' Internal function that simulates a synthetic RECIST dataset following the
@@ -197,12 +202,14 @@ example_rc = function(enrolres, seed,
                       rc_p_nt_lesions_resp = list("CR"=0.73, "SD"=0.25, "PD"=0.01, "NE"=0.01),
                       rc_sd_tlsum_noise = 0.5,
                       rc_coef_treatement = 3,
+                      rc_subj_delai = 42,
                       ...) {
   set.seed(seed)
   recist_data = enrolres %>%
     mutate(
       data = .simulate_one_patient(arm, rc_num_timepoints, rc_p_na,
-                                   rc_sd_tlsum_noise, rc_coef_treatement),
+                                   rc_sd_tlsum_noise, rc_coef_treatement,
+                                   rc_subj_delai),
       .by = subjid
     ) %>%
     unnest(data) %>%
@@ -283,6 +290,205 @@ example_rc = function(enrolres, seed,
 }
 
 
+
+
+
+# Calculer le temps de décès selon bras et statut progression.
+
+
+#' Generate Simulated Survival Data
+#'
+#' Internal function that simulates survival data, which depend on treatment arm
+#' and date of progression if applicable.
+#'
+#' @param enrolres the enrolment result table, from [example_enrol()].
+#' @param recist the recist table with progression date, from [example_rc()].
+#' @param seed Integer. Random seed for reproducibility (can be `NULL`).
+#' @param fu_lambda_censor numeric. Rate parameter of an exponential distribution used to simulate censoring times.
+#' @param fu_lambda_control numeric. Scale parameter of an exponential baseline hazard function.
+#' @param fu_beta_arm numeric. Parameter associated to the treatment effect.
+#' @param fu_beta_prog_status numeric. Parameter associated to a known progression on a RECIST assessment.
+#' @param ... Additional arguments (currently unused).
+#'
+#' @return A tibble with `N` rows and the following columns:
+#'
+#' - `subjid`: Subject ID
+#' - `pfs_status`: Progression-free survival status of the patient
+#' - `pfs_date`: Date of latest news before progression/death
+#' - `os_status`: Overall survival status of the patient (0 - Alive/Censored , 1 - Dead)
+#' - `os_date`: Date of latest news (death date if dead, otherwise censoring date)
+#'
+#' @keywords internal
+#' @importFrom dplyr arrange select mutate left_join if_else n
+#' @importFrom lubridate ymd as_date days
+#' @importFrom stats rexp
+#' @importFrom forcats as_factor fct_recode
+example_fu = function(enrolres, recist, seed,
+                      fu_lambda_censor = 0.2, fu_lambda_control = 0.2,
+                      fu_beta_arm = -0.6, fu_beta_prog_status = 2, ...){
+
+  stopifnot(is.data.frame(enrolres), is.data.frame(recist))
+  assert_names_exists(enrolres, c("subjid", "date_inclusion", "arm"))
+  assert_names_exists(recist, c("subjid", "rcdt", "rcresp"))
+
+  assert_not_null(seed)
+  set.seed(seed)
+
+  data_progression_status = .progression_status(recist)
+  data_progression_date = .progression_date(recist)
+
+  # Survival rate assigned for each subject, according to arm of treatment and progression status
+  lambda = .surv_coef(arm = enrolres$arm, prog_status = data_progression_status$status,
+                      fu_lambda_control = fu_lambda_control, fu_beta_arm = fu_beta_arm,
+                      fu_beta_prog_status = fu_beta_prog_status)
+
+  time_to_death = rexp(n = nrow(enrolres), rate = lambda)
+  time_to_censor = rexp(n = nrow(enrolres), rate = fu_lambda_censor)
+
+  fu_data = enrolres %>%
+
+    select(subjid, date_inclusion) %>%
+    left_join(data_progression_status, by = join_by(subjid)) %>%
+    left_join(data_progression_date, by = join_by(subjid)) %>%
+
+    mutate(
+      date_inclusion = as.Date(date_inclusion),
+
+      origin_date = if_else(!is.na(prog_date), prog_date, date_inclusion),
+
+      death_date = origin_date + days(ceiling(time_to_death*365.25)),
+      censoring_date = origin_date + days(ceiling(time_to_censor*365.25)),
+
+      # Status and date of progression
+      pfs_status = case_when(
+        !is.na(prog_date) & prog_date <= death_date & prog_date <= censoring_date ~ 1,
+        death_date <= censoring_date ~ 1,
+        .default = 0
+      ),
+      pfs_date = pmin(prog_date, death_date, censoring_date, na.rm = TRUE),
+
+      # Status and date of latest news
+      os_status = fct_recode(as_factor(as.integer(death_date <= censoring_date)),
+                             "Alive/censored" = "0",
+                             "Dead" = "1"),
+      os_date = if_else(condition = death_date <= censoring_date,
+                        true = death_date,
+                        false = censoring_date)
+    ) %>%
+    arrange(subjid) %>%
+    select(subjid, pfs_status, pfs_date, os_status, os_date) %>%
+    apply_labels(subjid = "Subject ID",
+                 pfs_status = "Status PFS",
+                 pfs_date = "Date of progression",
+                 os_status = "Status OS",
+                 os_date = "Date of last known OS status")
+
+  return(fu_data)
+}
+
+
+
+# Internals FU -----------------------------------------------------------------
+
+
+#' Used in `example_fu()`
+#' Extract the progression status of RECIST evaluation for each patient and return a tibble
+#' @param recist a tibble with RECIST progression status for each patients
+#' @return tibble with columns `subjid`, `prog_status` (binary variable : progressive disease or not)
+#' @noRd
+#' @keywords internal
+#' @importFrom dplyr select summarise
+.progression_status = function(recist) {
+
+  stopifnot(is.data.frame(recist))
+  assert_names_exists(recist, c("subjid", "rcresp"))
+
+  if(!any(recist$rcresp == "Progressive disease")) {
+    cli::cli_abort("No patient has 'Progressive disease' in `recist$rcresp`.")
+  }
+
+  progression_status = recist %>%
+    select(subjid, rcresp) %>%
+    summarise(status = any(rcresp == "Progressive disease", na.rm = TRUE), .by = 'subjid') %>%
+    mutate(status = as_factor(if_else(!is.na(status),
+                                      true = "Progressive disease",
+                                      false = "No progression")))
+}
+
+
+#' Used in `example_fu()`
+#' Extract first progression date per patient
+#' @param recist a tibble with RECIST progression status for each patients
+#' @return tibble with columns `subjid`, `prog_date`
+#' @noRd
+#' @keywords internal
+#' @importFrom dplyr filter summarise
+.progression_date = function(recist) {
+
+  stopifnot(is.data.frame(recist))
+  assert_names_exists(recist, c("subjid", "rcresp", "rcdt"))
+
+  if(!any(recist$rcresp == "Progressive disease")) {
+    cli::cli_abort("No patient has 'Progressive disease' in `recist$rcresp`.")
+  }
+
+  progression_date = recist %>%
+    summarise(
+      prog_date = if(any(rcresp == "Progressive disease", na.rm = TRUE)) {
+        min(rcdt[rcresp == "Progressive disease"], na.rm = TRUE)
+      } else { NA },
+      .by = subjid)
+}
+
+
+#' Used in `example_fu()`
+#' Assign a survival rate parameter (exponential lambda) for each patient, depending on treatment and progression status
+#' @param arm factor vector of treatment arms (`Control` versus `Treatment`)
+#' @param prog_status factor vector of progression status (`No progressive disease` versus `progressive disease`)
+#' @param fu_lambda_control scale parameter of an exponential baseline hazard function
+#' @param fu_beta_arm parameter associated to the treatment effect
+#' @param fu_beta_prog_status parameter associated to a known progression on a RECIST assessment
+#' @return numeric vector of rates (lambda) per subject, aligned with `arm` and `prog_status`
+#' @noRd
+#' @keywords internal
+.surv_coef = function(arm, prog_status, fu_lambda_control, fu_beta_arm, fu_beta_prog_status) {
+
+  assert_not_null(arm)
+  assert_not_null(prog_status)
+
+  if(nlevels(arm) != 2) {
+    cli::cli_abort("Number of arm of treatment must be 2 (`Control` versus `Treatment`")
+  }
+
+  beta = fu_beta_arm*(arm == "Treatment") + fu_beta_prog_status*(prog_status == "Progressive disease")
+  lambda = fu_lambda_control * exp(beta)
+  lambda
+}
+
+
+#' Used in `grstat_example()`
+#' Remove recist evaluation rows posterior to the end of the follow-up
+#' @param rtn list of data frames with enrolment, adverse event, recist evaluation and follow-up information
+#' @noRd
+#' @return list of data frames with enrolment, adverse event, recist evaluation and follow-up information with recist evaluation truncated with last follow-up date
+#' @keywords internal
+#' @importFrom dplyr left_join select filter
+.remove_post_event = function(rtn){
+
+  if(!is.list(rtn)) {stop("`rtn` must be a list of data frames.")}
+
+  if (! ("recist" %in% names(rtn)) ) { stop("One data frame in `rtn` list must be 'recist'. Found: ", names(rtn, collapse = ", ")) }
+  if (! ("fu" %in% names(rtn)) ) { stop("One data frame in `rtn` list must be 'fu'. Found: ", names(rtn, collapse = ", ")) }
+
+  rtn$recist <- rtn$recist %>%
+    left_join(rtn$fu %>% select(- crfname), by = join_by(subjid)) %>%
+    filter(rcdt <= os_date) %>%
+    select(- c(os_date, os_status))
+
+  rtn
+}
+
+
 # Internals RC ------------------------------------------------------------
 
 #' Used in `example_rc()`
@@ -291,7 +497,8 @@ example_rc = function(enrolres, seed,
 #' @keywords internal
 #' @importFrom tibble tibble
 .simulate_one_patient = function(arm, rc_num_timepoints, rc_p_na,
-                                 rc_sd_tlsum_noise, rc_coef_treatement) {
+                                 rc_sd_tlsum_noise, rc_coef_treatement,
+                                 rc_subj_delai) {
   rc_num_timepoints = rc_num_timepoints-1 #add baseline later
   rctlsum_b = rnorm(1, 50, 30)
   rctlsum_b = ifelse(rctlsum_b <10, runif(1, 10, 150), rctlsum_b)
@@ -300,7 +507,7 @@ example_rc = function(enrolres, seed,
                    percent_change_per_month > 0 ~ 1 / rc_coef_treatement,
                    .default = rc_coef_treatement)
   percent_change_per_month = percent_change_per_month * coef
-  subj_delai = 42 * seq(rc_num_timepoints) + runif(rc_num_timepoints, -7, 7)
+  subj_delai = rc_subj_delai * seq(rc_num_timepoints) + runif(rc_num_timepoints, -7, 7)
   percent_change = percent_change_per_month * subj_delai / 30.5
   percent_change = percent_change + rnorm(rc_num_timepoints, 0, rc_sd_tlsum_noise)
   percent_change = c(0, percent_change)

grstat.Rproj

@@ -1,5 +1,4 @@
 Version: 1.0
-ProjectId: d350bac8-4795-42a0-a32d-ccb93a467950
 
 RestoreWorkspace: No
 SaveWorkspace: No