Nothing
#' Functions to extract raw simulated samples
#'
#' @name extractrawsim
NULL
#' @rdname extractrawsim
#' @export
#' @param sim A `survparamsim` class object generated by [surv_param_sim()] function.
#' @details
#' [extract_sim()] extracts raw survival time & event status for all simulated subjects.
extract_sim <- function(sim) {
time.var <- as.character(attributes(stats::formula(sim$survreg))$variables[[2]][[2]])
status.var <- as.character(attributes(stats::formula(sim$survreg))$variables[[2]][[3]])
if(status.var[[1]] == "!") status.var <- status.var[[2]]
if(methods::is(sim, "survparamsim_resample")){
sim.merged.with.cov <-
sim$newdata.nona.sim %>%
dplyr::select(-time.var, -status.var, -n.resample) %>%
dplyr::left_join(sim$sim, ., by = c("rep", "subj.sim")) %>%
dplyr::select(rep, subj.sim, time, event, dplyr::everything())
} else if(methods::is(sim, "survparamsim_pre_resampled")){
sim.merged.with.cov <-
sim$newdata.nona.sim %>%
dplyr::select(-time.var, -status.var) %>%
dplyr::left_join(sim$sim, ., by = c("rep", "subj.sim")) %>%
dplyr::select(rep, subj.sim, time, event, dplyr::everything())
} else {
sim.merged.with.cov <-
sim$newdata.nona.sim %>%
dplyr::select(-time.var, -status.var) %>%
dplyr::left_join(sim$sim, ., by = c("subj.sim")) %>%
dplyr::select(rep, subj.sim, time, event, dplyr::everything())
}
return(sim.merged.with.cov)
}
#' @rdname extractrawsim
#' @export
#' @param hr.pi a return object from [calc_hr_pi()] function.
#' @details
#' [extract_hr()] extracts simulated HRs for all repeated simulations.
#' It also returns p values for Cox regression fits, one for each group
#' based on Wald test and another for the overall significance of the
#' coefficient based on logrank test. The latter has the same values
#' across treatment groups when >2 levels in treatment
extract_hr <- function(hr.pi) {
return(dplyr::select(hr.pi$sim.hr, -description))
}
#' @rdname extractrawsim
#' @export
#' @param km.pi A return object from [calc_km_pi()] function.
#' @details
#' [extract_km_obs()] extracts observed Kaplan-Meier curves.
extract_km_obs <- function(km.pi) {
return(km.pi$obs.km)
}
#' @rdname extractrawsim
#' @export
#' @param km.pi A return object from [calc_km_pi()] function.
#' @details
#' [extract_medsurv()] extracts simulated median survival times for all repeated simulations
extract_medsurv <- function(km.pi) {
return(km.pi$sim.median.time)
}
#' @rdname extractrawsim
#' @export
#' @param km.pi A return object from [calc_km_pi()] function.
#' @details
#' [extract_medsurv_delta()] extracts delta of median survival times between treatment groups
extract_medsurv_delta <- function(km.pi) {
pi.range <- km.pi$pi.range
trt.assign <- km.pi$trt.assign
sim.median.time <- km.pi$sim.median.time
if(length(km.pi$trt.syms) == 0) stop("`trt` needs to be specified in `calc_km_pi()`")
if(length(km.pi$trt.syms) > 1) stop("`trt` can only take one string in `calc_km_pi()")
group.syms <- km.pi$group.syms
trt.sym <- km.pi$trt.syms[[1]]
# Check trt values
check_trt(km.pi$median.pi, trt.sym, group.syms)
# Convert trt to factor
sim.median.time <-
sim.median.time %>%
dplyr::mutate(!!trt.sym := factor(!!trt.sym))
# Reverse control vs trt
if(trt.assign == "reverse"){
sim.median.time <-
sim.median.time %>%
dplyr::mutate(!!trt.sym := forcats::fct_rev(!!trt.sym))
}
sim.median.time <-
sim.median.time %>%
dplyr::mutate(.trt.group.index = as.integer(!!trt.sym),
.trt.group.index = paste0(".trt.group.", .trt.group.index))
trt.group.index.map <-
sim.median.time %>%
dplyr::select(!!trt.sym, .trt.group.index) %>%
dplyr::distinct()
# Calculate delta
sim.median.time.delta <-
sim.median.time %>%
# Change to wide data
dplyr::select(!(!!trt.sym)) %>%
dplyr::select(!n) %>%
tidyr::pivot_wider(names_from = .trt.group.index,
values_from = median) %>%
# Calc delta for all the non-control groups
dplyr::rename(.trt.control.group = .trt.group.1) %>%
dplyr::mutate(dplyr::across(dplyr::starts_with(".trt.group."), ~.x-.trt.control.group)) %>%
dplyr::select(!.trt.control.group) %>%
# Convert back to long data and recover the original trt variables
tidyr::pivot_longer(dplyr::starts_with(".trt.group."),
names_to = ".trt.group.index",
values_to = "median_delta") %>%
dplyr::left_join(trt.group.index.map, by = ".trt.group.index") %>%
dplyr::select(!.trt.group.index)
# Reverse back control vs trt
if(trt.assign == "reverse"){
sim.median.time.delta <-
sim.median.time.delta %>%
dplyr::mutate(!!trt.sym := forcats::fct_rev(!!trt.sym))
}
sim.median.time.delta %>%
dplyr::select(rep, !!!group.syms, !!trt.sym, dplyr::everything()) %>%
dplyr::arrange(rep, !!!group.syms, !!trt.sym) %>%
return()
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.