subgroup.CFsurvfit: Compute subgroup counterfactual survival functions

In tedwestling/CFsurvival: Counterfactual Survival Analysis

Compute subgroup counterfactual survival functions

Description

This function estimates subgroup-specific counterfactual survival functions and contrasts from right-censored data subject to potential confounding using the output from the CFsurvfit function.

Usage

subgroup.CFsurvfit(
  fit,
  subgroup.inds,
  conf.band = TRUE,
  conf.level = 0.95,
  surv.diffs = TRUE,
  surv.ratios = TRUE,
  risk.ratios = FALSE,
  nnt = FALSE,
  verbose = FALSE
)

Arguments

fit	Previously fitted CF survival curves from the CFsurvfit
subgroup.inds	Indices of the original data set corresponding to the subgroup for which the counterfactual survivals and contrasts are desired.
conf.band	Logical indicating whether to compute simultaneous confidence bands.
conf.level	Desired coverage of confidence intervals/bands.
surv.diffs	Logical indicating whether to return an estimate of the difference in the survival functions, along with confidence intervals and tests.
surv.ratios	Logical indicating whether to return an estimate of the ratio in the survival functions, along with confidence intervals and tests.
risk.ratios	Logical indicating whether to return an estimate of the difference in the survival functions, along with confidence intervals and tests.
nnt	Logical indicating whether to return an estimate of the number needed to treat (nnt), along with confidence intervals.
verbose	Logical indicating whether progress should be printed.

Details

See the documentation for CFsurvfit for an explanation of counterfactual survival functions and how they are estimated.

Value

subgroup.CFsurvfit returns a list with the same structure as the output from CFsurvfit – see the documentation of that function for additional details.

Examples

# Define parameters
n <- 300
expit <- function(x) 1/(1 + exp(-x))
betaT <- 2; lambdaT <- 20; betaC <- 2; lambdaC <- 15

# Simulate data
covar <- runif(n, min=-1, max=1)
g0s <- expit(.2 - covar)
rx <- rbinom(n, size=1, prob=g0s)
event.time <- rweibull(n, shape = betaT, scale = lambdaT * exp(-covar - 1 + rx))
cens.time <- rweibull(n, shape = betaC, scale = lambdaC * exp(-covar/5 - rx/5))
cens.time[cens.time > 15] <- 15
obs.time <- pmin(event.time, cens.time)
obs.event <- as.numeric(event.time <= cens.time)

# Estimate the CF survivals
fit <- CFsurvfit(time=obs.time, event=obs.event, treat=rx, cond.surv.method = "coxph", confounders = data.frame(covar), propensity.method = "glm", surv.diffs=TRUE, surv.ratios=TRUE, risk.ratios=TRUE, nnt=TRUE, verbose=TRUE)

# Suppose we want the counterfactual survivals & contrasts among patients with covariate
#     values > 0
subgp <- which(covar > 0)
sub.fit <- subgroup.CFsurvfit(fit, subgp, verbose=TRUE)

# Define the true conditional survival functions of the control (S0) and treatment (S1) groups among units with covar > 0
S0 <- function(t) sapply(t, function(t0) integrate(function(w) pweibull(t0, shape=betaT, scale=lambdaT * exp(-w-1), lower.tail = FALSE), lower=0, upper=1)$value)
S1 <- function(t) sapply(t, function(t0) integrate(function(w) pweibull(t0, shape=betaT, scale=lambdaT * exp(-w), lower.tail = FALSE), lower=0, upper=1)$value)


# Plot the output
## Not run: 
library(ggplot2)

# First plot the survival curves + conf intervals + conf bands
sub.fit$surv.df$true.surv <- c(S1(c(0, sub.fit$fit.times)), S0(c(0, sub.fit$fit.times)))
ggplot(sub.fit$surv.df) +
    geom_line(aes(time, true.surv, group=trt), color='black') +
    geom_line(aes(time, surv, color=as.factor(trt), group=trt)) +
    geom_line(aes(time, ptwise.lower, color=as.factor(trt), group=trt), linetype=2) +
    geom_line(aes(time, ptwise.upper, color=as.factor(trt), group=trt), linetype=2) +
    geom_line(aes(time, unif.logit.lower, color=as.factor(trt), group=trt), linetype=3) +
    geom_line(aes(time, unif.logit.upper, color=as.factor(trt), group=trt), linetype=3) +
    scale_color_discrete("Treatment") +
    xlab("Time") +
    ylab("Survival") +
    coord_cartesian(xlim=c(0,15), ylim=c(0,1))

# Next plot the survival difference
sub.fit$surv.diff.df$true.surv.diff <- c(S1(sub.fit$surv.diff.df$time) - S0(sub.fit$surv.diff.df$time))
ggplot(sub.fit$surv.diff.df) +
    geom_line(aes(time, true.surv.diff), color='red') +
    geom_line(aes(time, surv.diff)) +
    geom_line(aes(time, ptwise.lower), linetype=2) +
    geom_line(aes(time, ptwise.upper), linetype=2) +
    geom_line(aes(time, unif.lower), linetype=3) +
    geom_line(aes(time, unif.upper), linetype=3) +
    xlab("Time") +
    ylab("Survival difference (treatment - control)") +
    coord_cartesian(xlim=c(0,15), ylim=c(0,1))

sub.fit$surv.ratio.df$true.surv.ratio <- c(S1(sub.fit$surv.ratio.df$time) / S0(sub.fit$surv.ratio.df$time))
ggplot(sub.fit$surv.ratio.df) +
    geom_line(aes(time, true.surv.ratio), color='red') +
    geom_line(aes(time, surv.ratio)) +
    geom_line(aes(time, ptwise.lower), linetype=2) +
    geom_line(aes(time, ptwise.upper), linetype=2) +
    geom_line(aes(time, unif.lower), linetype=3) +
    geom_line(aes(time, unif.upper), linetype=3) +
    xlab("Time") +
    ylab("Survival ratio (treatment / control)") +
    coord_cartesian(xlim=c(0,15), ylim=c(0,10))
## End(Not run)

tedwestling/CFsurvival documentation built on July 27, 2023, 11:35 a.m.