## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment  = "#>"
)
set.seed(1)

## ----setup, include = FALSE---------------------------------------------------
library(ccwr)

## ----data---------------------------------------------------------------------
data(lungcancer)
head(lungcancer)

## ----read-trial-data, eval = FALSE--------------------------------------------
# my_data <- read_trial_data("path/to/your-data.csv")

## ----setup-arms---------------------------------------------------------------
arms         <- c("Control", "Surgery")
grace_period <- 182.62

## ----clone--------------------------------------------------------------------
clones <- clone_arms(lungcancer, arms)
names(clones)
sapply(clones, nrow)

## ----patients13-data----------------------------------------------------------
data(patients13)
patients13

## ----patients13-hand-trace----------------------------------------------------
## --- Surgery-arm clone: surgery must occur within the grace period ---
##   * surgery in time                -> adherent, follow to end of observation
##   * still unoperated when the
##     grace period closes            -> censored there
##   * follow-up ends before that     -> no deviation, observed outcome stands
surg_clone <- within(patients13, {
  adherent <- !is.na(time_to_surgery) & time_to_surgery <= grace_period
  deviates <- !adherent & followup > grace_period
  fu_time  <- ifelse(deviates, grace_period, followup)
  status   <- ifelse(deviates, 0, death)   # censored -> status = 0
  arm      <- "Surgery"
})

## --- Control-arm clone: surgery must NOT occur within the grace period ---
##   * surgery within the grace period -> censored at the time of surgery
##   * otherwise                       -> adherent, follow to end of observation
ctrl_clone <- within(patients13, {
  deviates <- !is.na(time_to_surgery) & time_to_surgery <= grace_period
  fu_time  <- ifelse(deviates, time_to_surgery, followup)
  status   <- ifelse(deviates, 0, death)
  arm      <- "Control"
})

cols <- c("id", "arm", "fu_time", "status")
rbind(surg_clone[cols], ctrl_clone[cols])

## ----censor-apply-------------------------------------------------------------
policies <- create_policy_A(
  arms,
  treatment         = "surgery",
  time_to_treatment = "timetosurgery",
  grace_period      = grace_period,
  outcome           = "death",
  followup          = "fup_obs",
  clone_outcome     = "outcome",
  clone_followup    = "fup"
)
clones_policy <- apply_logics(clones, policies)

censoring_logics <- create_censoring_logics_A(
  arms,
  treatment                 = "surgery",
  time_to_treatment         = "timetosurgery",
  grace_period              = grace_period,
  followup                  = "fup_obs",
  clone_censoring           = "censoring",
  clone_uncensored_followup = "fup_uncensored"
)
clones_censored <- apply_logics(clones_policy, censoring_logics)

setdiff(names(clones_censored$Surgery), names(lungcancer))

## ----censor-final-------------------------------------------------------------
clones_final <- create_final_data(
  clones_censored,
  clone_followup  = "fup",
  clone_outcome   = "outcome",
  clone_censoring = "censoring",
  col_ids         = "id"
)
head(clones_final$Surgery)
sapply(clones_final, nrow)

## ----weight-------------------------------------------------------------------
clones_estimated <- estimate_censoring(
  clones_final,
  predictors = c("age", "sex"),
  method = "pooled_logit"
)
clones_weighted <- weight_cases(clones_estimated)

## ----weight-diagnostics, fig.width = 6, fig.height = 4, fig.cap = "Distribution of IPC weights."----
weights_all <- unlist(
  lapply(clones_weighted, function(x) x[["weight_Cox"]]),
  use.names = FALSE
)
summary(weights_all)
hist(weights_all, breaks = 40, col = "grey80", border = "white",
     main = NULL, xlab = "IPC weight")

## ----cox----------------------------------------------------------------------
cox_fit <- emul_estimate(
  clones_weighted,
  method     = "Cox",
  weights    = "weight_Cox",
  predictors = c("age", "sex")
)
summary(cox_fit)$conf.int

## ----bootstrap----------------------------------------------------------------
boot <- emul_estimate_bootstrap(
  lungcancer,
  arms                   = arms,
  id                     = "id",
  treatment              = "surgery",
  time_to_treatment      = "timetosurgery",
  grace_period           = grace_period,
  outcome                = "death",
  followup               = "fup_obs",
  censoring_predictors   = c("age", "sex"),
  method                 = "Cox",
  predictors             = c("age", "sex"),
  n_bootstrap            = 10,
  seed                   = 1
)
c(
  HR = boot$estimate,
  HR_lower = boot$ci_lower,
  HR_upper = boot$ci_upper
)

## ----km, fig.width = 6, fig.height = 4, fig.cap = "Weighted survival curves by strategy."----
km_fit <- emul_estimate(clones_weighted, method = "KM", weights = "weight_Cox")
plot(km_fit, col = c("#1b9e77", "#d95f02"), lwd = 2,
     xlab = "Days since time zero", ylab = "Survival probability")
legend("bottomleft", legend = arms, col = c("#1b9e77", "#d95f02"),
       lwd = 2, bty = "n")