diff --git a/DESCRIPTION b/DESCRIPTION index 2bebbca..21956c5 100644 --- a/DESCRIPTION +++ b/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 diff --git a/NAMESPACE b/NAMESPACE index bbc1826..fba45ad 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/data.R b/R/data.R index a912803..8c7a2de 100644 --- a/R/data.R +++ b/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) diff --git a/grstat.Rproj b/grstat.Rproj index 028250a..6515568 100644 --- a/grstat.Rproj +++ b/grstat.Rproj @@ -1,5 +1,4 @@ Version: 1.0 -ProjectId: d350bac8-4795-42a0-a32d-ccb93a467950 RestoreWorkspace: No SaveWorkspace: No diff --git a/man/ae_plot_grade.Rd b/man/ae_plot_grade.Rd index cbd764f..5e17547 100644 --- a/man/ae_plot_grade.Rd +++ b/man/ae_plot_grade.Rd @@ -26,7 +26,7 @@ ae_plot_grade( \item{variant}{one or several of \code{c("max", "sup", "eq")}. \code{max} computes the maximum AE grade per patient, \code{sup} computes the number of patients having experienced at least one AE of grade higher or equal to X, and \code{eq} computes the number of patients having experienced at least one AE of grade equal to X.} -\item{position}{Position adjustment (cf. \code{\link[ggplot2:geom_bar]{ggplot2::geom_col()}})} +\item{position}{Position adjustment (cf. \code{\link[ggplot2:geom_col]{ggplot2::geom_col()}})} \item{type}{whether to present patients as proportions (\code{relative}) or as counts (\code{absolute})} diff --git a/man/example_fu.Rd b/man/example_fu.Rd new file mode 100644 index 0000000..c76fbab --- /dev/null +++ b/man/example_fu.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data.R +\name{example_fu} +\alias{example_fu} +\title{Generate Simulated Survival Data} +\usage{ +example_fu( + enrolres, + recist, + seed, + fu_lambda_censor = 0.2, + fu_lambda_control = 0.2, + fu_beta_arm = -0.6, + fu_beta_prog_status = 2, + ... +) +} +\arguments{ +\item{enrolres}{the enrolment result table, from \code{\link[=example_enrol]{example_enrol()}}.} + +\item{recist}{the recist table with progression date, from \code{\link[=example_rc]{example_rc()}}.} + +\item{seed}{Integer. Random seed for reproducibility (can be \code{NULL}).} + +\item{fu_lambda_censor}{numeric. Rate parameter of an exponential distribution used to simulate censoring times.} + +\item{fu_lambda_control}{numeric. Scale parameter of an exponential baseline hazard function.} + +\item{fu_beta_arm}{numeric. Parameter associated to the treatment effect.} + +\item{fu_beta_prog_status}{numeric. Parameter associated to a known progression on a RECIST assessment.} + +\item{...}{Additional arguments (currently unused).} +} +\value{ +A tibble with \code{N} rows and the following columns: +\itemize{ +\item \code{subjid}: Subject ID +\item \code{pfs_status}: Progression-free survival status of the patient +\item \code{pfs_date}: Date of latest news before progression/death +\item \code{os_status}: Overall survival status of the patient (0 - Alive/Censored , 1 - Dead) +\item \code{os_date}: Date of latest news (death date if dead, otherwise censoring date) +} +} +\description{ +Internal function that simulates survival data, which depend on treatment arm +and date of progression if applicable. +} +\keyword{internal} diff --git a/man/example_rc.Rd b/man/example_rc.Rd index 9403d52..02e0d6b 100644 --- a/man/example_rc.Rd +++ b/man/example_rc.Rd @@ -14,6 +14,7 @@ example_rc( 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, ... ) } diff --git a/man/grstat-package.Rd b/man/grstat-package.Rd index 36f4467..01c05de 100644 --- a/man/grstat-package.Rd +++ b/man/grstat-package.Rd @@ -20,9 +20,14 @@ Useful links: \author{ \strong{Maintainer}: Dan Chaltiel \email{dan.chaltiel@gustaveroussy.fr} (\href{https://orcid.org/0000-0003-3488-779X}{ORCID}) +Authors: +\itemize{ + \item Dan Chaltiel \email{dan.chaltiel@gustaveroussy.fr} (\href{https://orcid.org/0000-0003-3488-779X}{ORCID}) +} + Other contributors: \itemize{ - \item Team Oncostat (01ed4t417) [copyright holder, funder] + \item Team Oncostat (\href{https://ror.org/01ed4t417}{ROR}) [copyright holder, funder] \item Baptiste Archambaud \email{baptiste.archambaud@gustaveroussy.fr} [contributor] \item Charlotte Bargain \email{charlotte.bargain@gustaveroussy.fr} [contributor] \item Aldéric Fraslin \email{alderic.fraslin@gustaveroussy.fr} (\href{https://orcid.org/0000-0003-2235-0012}{ORCID}) [contributor] diff --git a/man/grstat_example.Rd b/man/grstat_example.Rd index 6d21e1a..0249a14 100644 --- a/man/grstat_example.Rd +++ b/man/grstat_example.Rd @@ -11,7 +11,7 @@ grstat_example(N = 200, seed = 42, ...) \item{seed}{the random seed (can be \code{NULL})} -\item{...}{passed on to internal functions. See \code{\link[=example_enrol]{example_enrol()}}, \code{\link[=example_ae]{example_ae()}}, and \code{\link[=example_rc]{example_rc()}} for the argument names.} +\item{...}{passed on to internal functions. See \code{\link[=example_enrol]{example_enrol()}}, \code{\link[=example_ae]{example_ae()}}, \code{\link[=example_rc]{example_rc()}}, and \code{\link[=example_fu]{example_fu()}} for the argument names.} } \value{ A list of datasets, like in EDCimport. diff --git a/man/reexports.Rd b/man/reexports.Rd index f0281b4..ddffaaa 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -13,10 +13,10 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{dplyr}{\code{\link[dplyr:reexports]{\%>\%}}} + \item{dplyr}{\code{\link[dplyr:\%>\%]{\%>\%}}} - \item{flextable}{\code{\link[flextable]{as_flextable}}} + \item{flextable}{\code{\link[flextable:as_flextable]{as_flextable()}}} - \item{tibble}{\code{\link[tibble]{tibble}}} + \item{tibble}{\code{\link[tibble:tibble]{tibble()}}} }} diff --git a/tests/testthat/helper-zzz_chaRlotte.R b/tests/testthat/helper-zzz_chaRlotte.R new file mode 100644 index 0000000..40debbb --- /dev/null +++ b/tests/testthat/helper-zzz_chaRlotte.R @@ -0,0 +1,14 @@ +db = grstat_example() + +data_km = db$enrolres %>% + left_join(db$fu, by = "subjid") %>% + mutate(time_OS = as.numeric(fu_date - date_inclusion)/365.25, + event_OS = 1*(fu_status == "Dead")) + +km = survival::survfit(survival::Surv(time_OS, event_OS) ~ arm, data = data_km) +p = ggsurvfit::ggsurvfit(km) + + ggsurvfit::add_censor_mark() + + ggsurvfit::add_confidence_interval() + + ggsurvfit::add_risktable() + +print(p) diff --git a/tests/testthat/helper-zzz_shiny_data.R b/tests/testthat/helper-zzz_shiny_data.R new file mode 100644 index 0000000..7eb4aa7 --- /dev/null +++ b/tests/testthat/helper-zzz_shiny_data.R @@ -0,0 +1,232 @@ +library(shiny) + +grstat_example_ui = function() { + fluidPage( + titlePanel("Paramètres de grstat_example"), + + fluidRow( + column( + width = 4, + h4("Paramètres d'entrée"), + actionButton("run_sim", "Lancer la simulation"), + br(), br(), + tabsetPanel( + id = "input_tabs", + + tabPanel( + "Plot", + fluidRow( + column( + 12, + numericInput("N", "Nombre de patients (N)", value = 200, min = 1, step = 1), + numericInput("seed", "Graine aléatoire (seed)", value = 42, step = 1) + ) + ) + ), + + tabPanel( + "Enrol", + fluidRow( + column( + 12, + sliderInput("r", "Proportion contrôle pour arm (r)", min = 0, max = 1, value = 0.5, step = 0.01), + sliderInput("r2", "Proportion contrôle pour arm3 (r2)", min = 0, max = 1, value = 1/3, step = 0.01) + ) + ) + ), + + tabPanel( + "AE", + fluidRow( + column( + 6, + sliderInput("p_na", "Proportion de NA (p_na)", min = 0, max = 1, value = 0, step = 0.01), + sliderInput("p_sae", "Proportion SAE contrôle (p_sae)", min = 0, max = 1, value = 0.1, step = 0.01), + sliderInput("p_sae_trt", "Proportion SAE traitement (p_sae_trt)", min = 0, max = 1, value = 0.1, step = 0.01), + numericInput("n_max", "AE max par patient contrôle (n_max)", value = 15, min = 1, step = 1), + numericInput("n_max_trt", "AE max par patient traité (n_max_trt)", value = 15, min = 1, step = 1), + ), + column( + 6, + numericInput("w_soc", "Poids SOC contrôle (w_soc)", value = 1, step = 0.1), + numericInput("w_soc_trt", "Poids SOC traitement (w_soc_trt)", value = 1, step = 0.1), + numericInput("beta0", "Intercept grade (beta0)", value = -1, step = 0.1), + numericInput("beta_trt", "Effet traitement (beta_trt)", value = 0.4, step = 0.1), + numericInput("beta_sae", "Effet SAE (beta_sae)", value = 1, step = 0.1) + ) + ) + ), + + tabPanel( + "RECIST", + fluidRow( + column( + 6, + numericInput("rc_delay", "Délai entre 2 évaluations (TODO rc_delay)", value = 15, step = 1), + numericInput("rc_num_timepoints", "Nombre de visites (rc_num_timepoints)", value = 5, min = 2, step = 1), + sliderInput("rc_p_new_lesions", "Proba nouvelles lésions (rc_p_new_lesions)", min = 0, max = 1, value = 0.09, step = 0.01), + sliderInput("rc_p_na", "Proba NA (rc_p_na)", min = 0, max = 1, value = 0.005, step = 0.001), + sliderInput("rc_p_nt_lesions_yn", "Présence NT (rc_p_nt_lesions_yn)", min = 0, max = 1, value = 0.5, step = 0.01), + numericInput("rc_sd_tlsum_noise", "SD bruit TLSUM (rc_sd_tlsum_noise)", value = 0.5, step = 0.1), + numericInput("rc_coef_treatement", "Coefficient traitement (rc_coef_treatement)", value = 3, step = 0.1), + ), + column( + 6, + h4("Probabilités réponse NT (rc_p_nt_lesions_resp)"), + sliderInput("rc_p_nt_CR", "CR (rc_p_nt_CR)", min = 0, max = 1, value = 0.73, step = 0.01), + sliderInput("rc_p_nt_SD", "SD (rc_p_nt_SD)", min = 0, max = 1, value = 0.25, step = 0.01), + sliderInput("rc_p_nt_PD", "PD (rc_p_nt_PD)", min = 0, max = 1, value = 0.01, step = 0.01), + sliderInput("rc_p_nt_NE", "NE (rc_p_nt_NE)", min = 0, max = 1, value = 0.01, step = 0.01) + ) + ) + ), + + tabPanel( + "Follow-up", + fluidRow( + column( + 12, + numericInput("lambda_censor", "Lambda censure (lambda_censor)", value = 0.3, step = 0.01), + numericInput("lambda_control", "Lambda contrôle (lambda_control)", value = 0.2, step = 0.01), + numericInput("beta_arm", "Effet bras (beta_arm)", value = -0.6, step = 0.1), + numericInput("beta_prog_status", "Effet statut progression (beta_prog_status)", value = 0.5, step = 0.1) + ) + ) + ) + ) + ), + + column( + width = 8, + tabsetPanel( + id = "output_tabs", + tabPanel("Plot", plotOutput("sim_plot")), + tabPanel("Enrol", tableOutput("enrol_table")), + tabPanel("AE", tableOutput("ae_table")), + tabPanel("RECIST", tableOutput("recist_table")), + tabPanel("Follow-up", tableOutput("fu_table")) + ) + ) + ) + ) +} + + + + +grstat_example_server = function(input, output, session) { + + sim = eventReactive(input$run_sim, { + grstat_example( + N = input$N, + seed = input$seed, + + r = input$r, + r2 = input$r2, + + p_na = input$p_na, + p_sae = input$p_sae, + p_sae_trt = input$p_sae_trt, + n_max = input$n_max, + n_max_trt = input$n_max_trt, + w_soc = input$w_soc, + w_soc_trt = input$w_soc_trt, + beta0 = input$beta0, + beta_trt = input$beta_trt, + beta_sae = input$beta_sae, + + rc_delay = input$rc_delay, + rc_num_timepoints = input$rc_num_timepoints, + rc_p_new_lesions = input$rc_p_new_lesions, + rc_p_na = input$rc_p_na, + rc_p_nt_lesions_yn = input$rc_p_nt_lesions_yn, + rc_p_nt_lesions_resp = list( + CR = input$rc_p_nt_CR, + SD = input$rc_p_nt_SD, + PD = input$rc_p_nt_PD, + NE = input$rc_p_nt_NE + ), + rc_sd_tlsum_noise = input$rc_sd_tlsum_noise, + rc_coef_treatement = input$rc_coef_treatement, + + lambda_censor = input$lambda_censor, + lambda_control = input$lambda_control, + beta_arm = input$beta_arm, + beta_prog_status = input$beta_prog_status + ) + }) + + output$enrol_table = renderTable({ + x = sim() + if (is.null(x)) return(NULL) + head(x$enrolres, 20) + }) + + output$ae_table = renderTable({ + x = sim() + if (is.null(x)) return(NULL) + head(x$ae, 20) + }) + + output$recist_table = renderTable({ + x = sim() + if (is.null(x)) return(NULL) + head(x$recist, 20) + }) + + output$fu_table = renderTable({ + x = sim() + if (is.null(x)) return(NULL) + head(x$fu, 20) + }) + + output$sim_plot = renderPlot({ + x = sim() + if (is.null(x)) return(NULL) + get_plot(x) + }) +} + + +# Make the plot ------------------------------------------------------------------------------- + + +get_plot = function(db){ + set.seed(42) + data_km = db$enrolres %>% + left_join(db$fu, by = "subjid") %>% + mutate( + time_OS = as.numeric(fu_date - date_inclusion)/365.25, + event_OS = fu_status == "Dead", + time_PFS = time_OS - rnorm(n(), 1, 0.5), + event_PFS = fu_status == "Dead" | rbinom(n(), 1, 0.1) + ) + + km_os = survival::survfit(survival::Surv(time_OS, event_OS) ~ arm, data = data_km) + p_os = ggsurvfit::ggsurvfit(km_os) + + ggsurvfit::add_censor_mark() + + ggsurvfit::add_confidence_interval() + + ggsurvfit::add_risktable() + + labs(title="OS") + + #TODO : faire un KM avec la PFS RECIST + km_pfs = survival::survfit(survival::Surv(time_PFS, event_PFS) ~ arm, data = data_km) + p_pfs = ggsurvfit::ggsurvfit(km_pfs) + + ggsurvfit::add_censor_mark() + + ggsurvfit::add_confidence_interval() + + ggsurvfit::add_risktable() + + labs(title="PFS (données totalement aléatoires)") + + patchwork::wrap_plots(p_os, p_pfs, ncol=1, guides="collect") +} + + +# Run the app --------------------------------------------------------------------------------- + +app = shinyApp( + ui = grstat_example_ui, + server = grstat_example_server +) +#FIXME décommente cette ligne pour que l'app soit lancée à chaque Ctrl+Shift+L +#Commande pour lancer l'appli +# runApp(app) diff --git a/tests/testthat/test-data.R b/tests/testthat/test-data.R index 349a706..906b612 100644 --- a/tests/testthat/test-data.R +++ b/tests/testthat/test-data.R @@ -98,6 +98,19 @@ test_that("RECIST plots", { rc = db$recist %>% left_join(x$enrolres, by="subjid", suffix=c("_bak", "")) + data_km = rc %>% + summarise( + date_pd = min_narm(rcdt[rcresp=="Progressive disease"]), + last_date = max_narm(rcdt), + .by=subjid + ) %>% + left_join(db$enrolres, by="subjid", suffix=c("_rc", "")) %>% + mutate( + date_pfs = pmin(date_pd, last_date, na.rm=TRUE), + time_pfs = as.numeric(date_pfs - date_inclusion)/30.4, + event_pfs = !is.na(date_pd) + ) + # KM plot km = survival::survfit(survival::Surv(time_pfs, event_pfs) ~ arm, data=data_km) ggsurvfit::ggsurvfit(km) +