# Legacy tests for backwards compatability w/ heRomod
fs1 = flexsurv::flexsurvreg(survival::Surv(rectime, censrec) ~ group,
data = flexsurv::bc,
dist = "weibull")
fs2 = flexsurv::flexsurvreg(survival::Surv(rectime, censrec) ~ group,
data = flexsurv::bc,
dist = "weibullPH")
fs3 = flexsurv::flexsurvspline(
survival::Surv(rectime, censrec) ~ group,
data = flexsurv::bc,
scale = "odds",
k = 2
)
fs4 = flexsurv::flexsurvreg(survival::Surv(rectime, censrec) ~ group,
data = flexsurv::bc,
dist = "exp")
fs5 = flexsurv::flexsurvreg(survival::Surv(rectime, censrec) ~ 1,
data = flexsurv::bc,
dist = "genf")
fs6 = flexsurv::flexsurvreg(survival::Surv(time, status == 1) ~ age + sex,
data = survival::cancer,
dist = "gompertz")
cox = survival::coxph(survival::Surv(rectime, censrec) ~ group,
data = flexsurv::bc)
cox_bl = survival::survfit(cox)
km = survival::survfit(survival::Surv(rectime, censrec) ~ group, data =
flexsurv::bc)
km_good = survival::survfit(survival::Surv(rectime, censrec) ~ group,
data = flexsurv::bc %>% dplyr::filter(group == "Good"))
test_that("Flexsurvreg",
{
heRomod_res = fs6 %>%
set_covariates(age = 50, sex = 1) %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
fs_res = summary(
fs6,
t = seq(from = 200, to = 2000, by = 200),
type = "survival",
ci = F,
newdata = data.frame(age = 50, sex = 1)
)[[1]]$est
expect_equal(heRomod_res, fs_res, tolerance=1e-8)
})
test_that("Applying treatment effects",
{
# Testing apply_hr, apply_af, apply_or against flexsurvreg output to see
# that it is consitent.
surv1_medium_surv = fs1 %>%
set_covariates(group = "Medium") %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
surv1_medium_aft_surv = fs1 %>%
set_covariates(group = "Good") %>%
apply_af(fs1$coefficients[3], log_af = T) %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
surv1_poor_surv = fs1 %>%
set_covariates(group = "Poor") %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
surv1_poor_aft_surv = fs1 %>%
set_covariates(group = "Good") %>%
apply_af(fs1$coefficients[4], log_af = T) %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
surv1_poor_shift_surv = fs1 %>%
set_covariates(group = "Poor") %>%
apply_shift(shift = 800) %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
surv1_medium_prob = fs1 %>%
set_covariates(group = "Medium") %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "prob")
surv1_medium_aft_prob = fs1 %>%
set_covariates(group = "Good") %>%
apply_af(fs1$coefficients[3], log_af = T) %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "prob")
surv1_poor_prob = fs1 %>%
set_covariates(group = "Poor") %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "prob")
surv1_poor_aft_prob = fs1 %>%
set_covariates(group = "Good") %>%
apply_af(fs1$coefficients[4], log_af = T) %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "prob")
surv2_medium_surv = fs2 %>%
set_covariates(group = "Medium") %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
surv2_medium_hr_surv = fs2 %>%
set_covariates(group = "Good") %>%
apply_hr(fs2$coefficients[3], log_hr = T) %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
surv2_poor_surv = fs2 %>%
set_covariates(group = "Poor") %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
surv2_poor_hr_surv = fs2 %>%
set_covariates(group = "Good") %>%
apply_hr(fs2$coefficients[4], log_hr = T) %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
surv2_medium_prob = fs2 %>%
set_covariates(group = "Medium") %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "prob")
surv2_medium_hr_prob = fs2 %>%
set_covariates(group = "Good") %>%
apply_hr(fs2$coefficients[3], log_hr = T) %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "prob")
surv2_poor_prob = fs2 %>%
set_covariates(group = "Poor") %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "prob")
surv2_poor_hr_prob = fs2 %>%
set_covariates(group = "Good") %>%
apply_hr(fs2$coefficients[4], log_hr = T) %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "prob")
surv3_medium_surv = fs3 %>%
set_covariates(group = "Medium") %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
surv3_medium_or_surv = fs3 %>%
set_covariates(group = "Good") %>%
apply_or(fs3$coefficients[5], log_or = T) %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
surv3_poor_surv = fs3 %>%
set_covariates(group = "Poor") %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
surv3_poor_or_surv = fs3 %>%
set_covariates(group = "Good") %>%
apply_or(fs3$coefficients[6], log_or = T) %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
surv3_medium_prob = fs3 %>%
set_covariates(group = "Medium") %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "prob")
surv3_medium_or_prob = fs3 %>%
set_covariates(group = "Good") %>%
apply_or(fs3$coefficients[5], log_or = T) %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "prob")
surv3_poor_prob = fs3 %>%
set_covariates(group = "Poor") %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "prob")
surv3_poor_or_prob = fs3 %>%
set_covariates(group = "Good") %>%
apply_or(fs3$coefficients[6], log_or = T) %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "prob")
# Test acceleration
expect_equal(surv1_medium_surv, surv1_medium_aft_surv)
expect_equal(surv1_poor_surv, surv1_poor_aft_surv)
expect_equal(surv1_medium_prob, surv1_medium_aft_prob)
expect_equal(surv1_poor_prob, surv1_poor_aft_prob)
# Test Proportional Hazards
expect_equal(surv2_medium_surv, surv2_medium_hr_surv)
expect_equal(surv2_poor_surv, surv2_poor_hr_surv)
expect_equal(surv2_medium_prob, surv2_medium_hr_prob)
expect_equal(surv2_poor_prob, surv2_poor_hr_prob)
# Test Proportional Odds
expect_equal(surv3_medium_surv, surv3_medium_or_surv)
expect_equal(surv3_poor_surv, surv3_poor_or_surv)
expect_equal(surv3_medium_prob, surv3_medium_or_prob)
expect_equal(surv3_poor_prob, surv3_poor_or_prob)
# Test shifts
expect_equal(surv1_poor_surv[1:6], surv1_poor_shift_surv[5:10])
expect_equal(length(surv1_poor_surv), length(surv1_poor_shift_surv))
expect_identical(apply_shift(fs1, 2),
apply_shift(apply_shift(fs1, 5),-3))
expect_identical(surv1_poor_shift_surv[1:3],
rep(1, 3))
## Test combinations
fsm = fs5 %>% set_covariates(group = "Medium")
fsm_changes = fsm %>%
apply_shift(5) %>% apply_hr(0.5) %>% apply_shift(-5) %>% apply_hr(2)
fsm_survs <- fsm %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
fsm_changes_survs = fsm_changes %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
expect_equal(fsm_survs, fsm_changes_survs)
fsm_changes = fsm %>%
apply_shift(5) %>% apply_hr(0.5) %>% apply_af(0.5) %>%
apply_af(2) %>% apply_shift(-5) %>% apply_hr(2)
fsm_changes_survs = fsm_changes %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
expect_equal(fsm_survs, fsm_changes_survs)
fsm_changes = fsm %>%
apply_shift(5) %>% apply_or(0.5) %>% apply_shift(-5) %>% apply_or(2)
fsm_changes_survs = fsm_changes %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
expect_equal(fsm_survs, fsm_changes_survs)
## misaligned shifts
surv1_poor_shift_surv_misaligned1 = fs1 %>%
set_covariates(group = "Poor") %>%
apply_shift(shift = 100) %>%
compute_surv(time = seq_len(10),
cycle_length = 300,
type = "surv")
surv1_poor_shift_surv_misaligned2 = fs1 %>%
set_covariates(group = "Poor") %>%
compute_surv(time = seq_len(30),
cycle_length = 100,
type = "surv") %>%
.[seq_len(10) * 3 - 1]
expect_equal(surv1_poor_shift_surv_misaligned1,
surv1_poor_shift_surv_misaligned2)
}
)
test_that(
"Applying treatment effects",
{
# Testing apply_hr, apply_af, apply_or and apply_shift
# against flexsurvreg output to see that it is consistent.
surv1_medium_surv = fs1 %>%
set_covariates(group="Medium") %>%
compute_surv(time=seq_len(10),cycle_length=200, type="surv")
surv1_medium_aft_surv = fs1 %>%
set_covariates(group="Good") %>%
apply_af(fs1$coefficients[3], log_af=T) %>%
compute_surv(time=seq_len(10),cycle_length=200, type="surv")
surv1_poor_surv = fs1 %>%
set_covariates(group="Poor") %>%
compute_surv(time=seq_len(10),cycle_length=200, type="surv")
surv1_poor_aft_surv = fs1 %>%
set_covariates(group="Good") %>%
apply_af(fs1$coefficients[4], log_af=T) %>%
compute_surv(time=seq_len(10),cycle_length=200, type="surv")
surv1_poor_shift_surv = fs1 %>%
set_covariates(group = "Poor") %>%
apply_shift(shift = 800) %>%
compute_surv(time = seq_len(10), cycle_length = 200, type = "surv")
surv1_medium_prob = fs1 %>%
set_covariates(group="Medium") %>%
compute_surv(time=seq_len(10),cycle_length=200, type="prob")
surv1_medium_aft_prob = fs1 %>%
set_covariates(group="Good") %>%
apply_af(fs1$coefficients[3], log_af=T) %>%
compute_surv(time=seq_len(10),cycle_length=200, type="prob")
surv1_poor_prob = fs1 %>%
set_covariates(group="Poor") %>%
compute_surv(time=seq_len(10),cycle_length=200, type="prob")
surv1_poor_aft_prob = fs1 %>%
set_covariates(group="Good") %>%
apply_af(fs1$coefficients[4], log_af=T) %>%
compute_surv(time=seq_len(10),cycle_length=200, type="prob")
surv2_medium_surv = fs2 %>%
set_covariates(group="Medium") %>%
compute_surv(time=seq_len(10),cycle_length=200, type="surv")
surv2_medium_hr_surv = fs2 %>%
set_covariates(group="Good") %>%
apply_hr(fs2$coefficients[3], log_hr=T) %>%
compute_surv(time=seq_len(10),cycle_length=200, type="surv")
surv2_poor_surv = fs2 %>%
set_covariates(group="Poor") %>%
compute_surv(time=seq_len(10),cycle_length=200, type="surv")
surv2_poor_hr_surv = fs2 %>%
set_covariates(group="Good") %>%
apply_hr(fs2$coefficients[4], log_hr=T) %>%
compute_surv(time=seq_len(10),cycle_length=200, type="surv")
surv2_medium_prob = fs2 %>%
set_covariates(group="Medium") %>%
compute_surv(time=seq_len(10),cycle_length=200, type="prob")
surv2_medium_hr_prob = fs2 %>%
set_covariates(group="Good") %>%
apply_hr(fs2$coefficients[3], log_hr=T) %>%
compute_surv(time=seq_len(10),cycle_length=200, type="prob")
surv2_poor_prob = fs2 %>%
set_covariates(group="Poor") %>%
compute_surv(time=seq_len(10),cycle_length=200, type="prob")
surv2_poor_hr_prob = fs2 %>%
set_covariates(group="Good") %>%
apply_hr(fs2$coefficients[4], log_hr=T) %>%
compute_surv(time=seq_len(10),cycle_length=200, type="prob")
surv3_medium_surv = fs3 %>%
set_covariates(group="Medium") %>%
compute_surv(time=seq_len(10),cycle_length=200, type="surv")
surv3_medium_or_surv = fs3 %>%
set_covariates(group="Good") %>%
apply_or(fs3$coefficients[5], log_or=T) %>%
compute_surv(time=seq_len(10),cycle_length=200, type="surv")
surv3_poor_surv = fs3 %>%
set_covariates(group="Poor") %>%
compute_surv(time=seq_len(10),cycle_length=200, type="surv")
surv3_poor_or_surv = fs3 %>%
set_covariates(group="Good") %>%
apply_or(fs3$coefficients[6], log_or=T) %>%
compute_surv(time=seq_len(10),cycle_length=200, type="surv")
surv3_medium_prob = fs3 %>%
set_covariates(group="Medium") %>%
compute_surv(time=seq_len(10),cycle_length=200, type="prob")
surv3_medium_or_prob = fs3 %>%
set_covariates(group="Good") %>%
apply_or(fs3$coefficients[5], log_or=T) %>%
compute_surv(time=seq_len(10),cycle_length=200, type="prob")
surv3_poor_prob = fs3 %>%
set_covariates(group="Poor") %>%
compute_surv(time=seq_len(10),cycle_length=200, type="prob")
surv3_poor_or_prob = fs3 %>%
set_covariates(group="Good") %>%
apply_or(fs3$coefficients[6], log_or=T) %>%
compute_surv(time=seq_len(10),cycle_length=200, type="prob")
# Test acceleration
expect_equal(surv1_medium_surv,surv1_medium_aft_surv)
expect_equal(surv1_poor_surv, surv1_poor_aft_surv)
expect_equal(surv1_medium_prob,surv1_medium_aft_prob)
expect_equal(surv1_poor_prob, surv1_poor_aft_prob)
# Test Proportional Hazards
expect_equal(surv2_medium_surv,surv2_medium_hr_surv)
expect_equal(surv2_poor_surv, surv2_poor_hr_surv)
expect_equal(surv2_medium_prob,surv2_medium_hr_prob)
expect_equal(surv2_poor_prob, surv2_poor_hr_prob)
# Test Proportional Odds
expect_equal(surv3_medium_surv,surv3_medium_or_surv)
expect_equal(surv3_poor_surv, surv3_poor_or_surv)
expect_equal(surv3_medium_prob,surv3_medium_or_prob)
expect_equal(surv3_poor_prob, surv3_poor_or_prob)
# Test shifts
expect_equal(surv1_poor_surv[1:6], surv1_poor_shift_surv[5:10])
expect_equal(length(surv1_poor_surv), length(surv1_poor_shift_surv))
## Test combinations
fsm = fs5 %>% set_covariates(group = "Medium")
fsm_changes = fsm %>%
apply_shift(5) %>% apply_hr(0.5) %>% apply_shift(-5) %>% apply_hr(2)
fsm_survs <- fsm %>%
compute_surv(time=seq_len(10),cycle_length=200, type="surv")
fsm_changes_survs = fsm_changes %>%
compute_surv(time=seq_len(10),cycle_length=200, type="surv")
expect_equal(fsm_survs, fsm_changes_survs)
fsm_changes = fsm %>%
apply_shift(5) %>% apply_hr(0.5) %>% apply_af(0.5) %>%
apply_af(2) %>% apply_shift(-5) %>% apply_hr(2)
fsm_changes_survs = fsm_changes %>%
compute_surv(time=seq_len(10),cycle_length=200, type="surv")
expect_equal(fsm_survs, fsm_changes_survs)
fsm_changes = fsm %>%
apply_shift(5) %>% apply_or(0.5) %>% apply_shift(-5) %>% apply_or(2)
fsm_changes_survs = fsm_changes %>%
compute_surv(time=seq_len(10),cycle_length=200, type="surv")
expect_equal(fsm_survs, fsm_changes_survs)
## misaligned shifts
surv1_poor_shift_surv_misaligned1 = fs1 %>%
set_covariates(group = "Poor") %>%
apply_shift(shift = 100) %>%
compute_surv(time = seq_len(10),
cycle_length = 300, type = "surv")
surv1_poor_shift_surv_misaligned2 = fs1 %>%
set_covariates(group = "Poor") %>%
compute_surv(time = seq_len(30),
cycle_length = 100, type = "surv") %>%
.[seq_len(10)*3 - 1]
expect_equal(surv1_poor_shift_surv_misaligned1,
surv1_poor_shift_surv_misaligned2)
# Test shifts
expect_equal(surv1_poor_surv[1:6], surv1_poor_shift_surv[5:10])
expect_equal(length(surv1_poor_surv), length(surv1_poor_shift_surv))
## Test combinations
fsm = fs5 %>% set_covariates(group = "Medium")
fsm_changes = fsm %>%
apply_shift(5) %>% apply_hr(0.5) %>% apply_shift(-5) %>% apply_hr(2)
fsm_survs <- fsm %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
fsm_changes_survs = fsm_changes %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
expect_equal(fsm_survs, fsm_changes_survs)
fsm_changes = fsm %>%
apply_shift(5) %>% apply_hr(0.5) %>% apply_af(0.5) %>%
apply_af(2) %>% apply_shift(-5) %>% apply_hr(2)
fsm_changes_survs = fsm_changes %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
expect_equal(fsm_survs, fsm_changes_survs)
fsm_changes = fsm %>%
apply_shift(5) %>% apply_or(0.5) %>% apply_shift(-5) %>% apply_or(2)
fsm_changes_survs = fsm_changes %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
expect_equal(fsm_survs, fsm_changes_survs)
## misaligned shifts
surv1_poor_shift_surv_misaligned1 = fs1 %>%
set_covariates(group = "Poor") %>%
apply_shift(shift = 100) %>%
compute_surv(time = seq_len(10),
cycle_length = 300,
type = "surv")
surv1_poor_shift_surv_misaligned2 = fs1 %>%
set_covariates(group = "Poor") %>%
compute_surv(time = seq_len(30),
cycle_length = 100,
type = "surv") %>%
.[seq_len(10) * 3 - 1]
expect_equal(surv1_poor_shift_surv_misaligned1,
surv1_poor_shift_surv_misaligned2)
}
)
test_that("Defining Survival Distributions",
{
surv1 = define_survival(dist = "weibull",
shape = 1.3797,
scale = 4169.3446)
surv2 = define_survival(dist = "weibullPH",
shape = 1.379652e+00,
scale = 1.012901e-05)
surv3 = define_spline_survival(
scale = "odds",
gamma1 = -23.5217273,
gamma2 = 3.4496006,
gamma3 = 0.4883449,
gamma4 = -0.3159025,
knots1 = 4.276666,
knots2 = 6.219263,
knots3 = 6.771924,
knots4 = 7.806289
)
surv5 = define_survival(
dist = "genf",
mu = 6.96387,
sigma = 1.17338,
Q = -1.08049,
P = 0.33090
)
surv1_surv = surv1 %>%
compute_surv(time = seq_len(10), cycle_length = 200)
fs1_surv = fs1 %>%
set_covariates(group = "Good") %>%
compute_surv(time = seq_len(10), cycle_length = 200)
surv1_prob = surv1 %>%
compute_surv(time = seq_len(10), cycle_length = 200)
fs1_prob = fs1 %>%
set_covariates(group = "Good") %>%
compute_surv(time = seq_len(10), cycle_length = 200)
surv2_surv = surv2 %>%
compute_surv(time = seq_len(10), cycle_length = 200)
fs2_surv = fs2 %>%
set_covariates(group = "Good") %>%
compute_surv(time = seq_len(10), cycle_length = 200)
surv2_prob = surv2 %>%
compute_surv(time = seq_len(10), cycle_length = 200)
fs2_prob = fs2 %>%
set_covariates(group = "Good") %>%
compute_surv(time = seq_len(10), cycle_length = 200)
surv3_surv = surv3 %>%
compute_surv(time = seq_len(10), cycle_length = 200)
fs3_surv = fs3 %>%
set_covariates(group = "Good") %>%
compute_surv(time = seq_len(10), cycle_length = 200)
surv3_prob = surv3 %>%
compute_surv(time = seq_len(10), cycle_length = 200)
fs3_prob = fs3 %>%
set_covariates(group = "Good") %>%
compute_surv(time = seq_len(10), cycle_length = 200)
surv5_surv = surv5 %>%
compute_surv(time = seq_len(10), cycle_length = 200)
fs5_surv = fs5 %>%
set_covariates(group = "Good") %>%
compute_surv(time = seq_len(10), cycle_length = 200)
surv5_prob = surv5 %>%
compute_surv(time = seq_len(10), cycle_length = 200)
fs5_prob = fs5 %>%
set_covariates(group = "Good") %>%
compute_surv(time = seq_len(10), cycle_length = 200)
# Survival from flexsurv should equal equivalent from
# define_survival
expect_equal(surv1_surv, fs1_surv, tolerance = 1E-4)
expect_equal(surv1_prob, fs1_prob, tolerance = 1E-4)
expect_equal(surv2_surv, fs2_surv, tolerance = 1E-4)
expect_equal(surv2_prob, fs2_prob, tolerance = 1E-4)
expect_equal(surv3_surv, fs3_surv, tolerance = 1E-4)
expect_equal(surv3_prob, fs3_prob, tolerance = 1E-4)
expect_equal(surv5_surv, fs5_surv, tolerance = 1E-4)
expect_equal(surv5_prob, fs5_prob, tolerance = 1E-4)
surv_table_df <- data.frame(time = c(0, 1, 5, 10),
survival = c(1, 0.9, 0.7, 0.4))
reg <- define_surv_table(surv_table_df)
expect_equal(eval_surv(reg, time = c(0.5, 1.5, 2.5, 5.5, 10, 11)),
c(1, 0.9, 0.9, 0.7, 0.4, NA))
surv_lifetable_df <- data.frame(
age = c(0, 1, 2, 3),
male = c(0.011, 0.004, 0.003, 0.002),
female = c(0.010, 0.005, 0.004, 0.002)
)
reg <- define_surv_lifetable(surv_lifetable_df, c(1,1,1), 0.5)
expect_equal(surv_prob(reg, time = c(0, 0.5, 1, 1.5, 2, 3, 10)),
c(1, 0.9977474, 0.9955000, 0.9937564, 0.9920160, 0.9900320, 0.9762544),
tolerance = 1e-7)
surv_lifetable_df2 <- data.frame(
the_age = c(4, 6, 8, 10),
men = c(0.011, 0.004, 0.003, 0.002),
women = c(0.010, 0.005, 0.004, 0.002)
)
reg2 <- define_surv_lifetable(surv_lifetable_df2, 6, 0.5, age_col = "the_age", male_col = "men", female_col = "women")
expect_equal(surv_prob(reg, time = c(0, 0.5, 1, 1.5, 2, 3, 10)),
surv_prob(reg2, time = c(0, 1, 2, 3, 4, 6, 20)),
tolerance = 1e-7)
surv_lifetable_df3 <- data.frame(
age = c(0, 1, 2, 3),
male = c(0.011, 0.004, 1, 1),
female = c(0.010, 0.005, 1, 1)
)
reg3 <- define_surv_lifetable(surv_lifetable_df3, 1, 0.5)
expect_equal(surv_prob(reg3, time = c(0, 0.5, 1, 1.5, 2, 3, 10)),
c(1, 0.9977474, 0.9955000, 0, 0, 0, 0),
tolerance = 1e-7)
surv_lifetable_df4 <- data.frame(
age = c(0, 1, 2, 3),
male = c(0.011, 0.004, 0.003, 0.002),
female = c(0.010, 0.005, 0.004, 0.002)
)
reg4 <- define_surv_lifetable(surv_lifetable_df4, 1, 0.5, output_unit = "months")
expect_equal(surv_prob(reg, time = c(0, 0.5, 1, 1.5, 2, 3, 10)),
surv_prob(reg4, time = c(0, 6, 12, 18, 24, 36, 120)),
tolerance = 1e-7)
})
test_that("Survfit",
{
# Survival for a KM fit only to one group should be the same
# as survival for all w/ covariates set to same group.
km_prob = km %>%
set_covariates(data.frame(group = "Good")) %>%
compute_surv(time = seq_len(10), cycle_length = 200)
km_good_prob = km_good %>%
compute_surv(time = seq_len(10), cycle_length = 200)
km_surv = km %>%
set_covariates(data.frame(group = "Good")) %>%
compute_surv(time = seq_len(10), cycle_length = 200)
km_good_surv = km_good %>%
compute_surv(time = seq_len(10), cycle_length = 200)
expect_equal(km_prob, km_good_prob)
expect_equal(km_surv, km_good_surv)
})
test_that("Combining Survival Distributions",
{
# Projecting a distribution w/ itself should not
# change survival
exp_surv = fs4 %>%
set_covariates(group = "Poor") %>%
compute_surv(time = seq_len(10), cycle_length = 200)
exp_surv2 = fs4 %>%
set_covariates(group = "Poor") %>%
join(543.343 , fs4 %>% set_covariates(group = "Poor")) %>%
compute_surv(time = seq_len(10), cycle_length = 200)
expect_equal(exp_surv, exp_surv2)
# Pooling a distribution w/ itself should not
# change survival
exp_sur3 = fs4 %>%
set_covariates(group = "Poor") %>%
compute_surv(time = seq_len(10), cycle_length = 200)
exp_surv4 = fs4 %>%
set_covariates(group = "Poor") %>%
mix(0.5, fs4 %>% set_covariates(group = "Poor"), 0.5) %>%
compute_surv(time = seq_len(10), cycle_length = 200)
# Projecting + Pooling w/ self, applying null
# treatment effects should not change survival
exp_sur5 = fs4 %>%
set_covariates(group = "Poor") %>%
compute_surv(time = seq_len(10), cycle_length = 200)
exp_surv6 = fs4 %>%
set_covariates(group = "Poor") %>%
mix(0.5, fs4 %>% set_covariates(group = "Poor"), 0.5) %>%
apply_hr(1) %>%
join(89.1, fs4 %>% set_covariates(group = "Poor")) %>%
apply_af(1) %>%
apply_or(1) %>%
compute_surv(time = seq_len(10), cycle_length = 200)
expect_equal(exp_sur5, exp_surv6)
# Should also work if cycle doesn't start at 1
exp_sur7 = fs4 %>%
set_covariates(group = "Poor") %>%
compute_surv(time = seq(from = 10, to = 20, by = 1),
cycle_length = 100)
exp_surv8 = fs4 %>%
set_covariates(group = "Poor") %>%
mix(0.5, fs4 %>% set_covariates(group = "Poor"), 0.5) %>%
apply_hr(1) %>%
join(89.1, fs4 %>% set_covariates(group = "Poor")) %>%
apply_af(1) %>%
apply_or(1) %>%
compute_surv(time = seq(from = 10, to = 20, by = 1),
cycle_length = 100)
expect_equal(exp_sur7, exp_surv8)
# Should also work for length 1 input
exp_sur9 = fs4 %>%
set_covariates(group = "Poor") %>%
compute_surv(time = 25, cycle_length = 365.25 / 7)
exp_surv10 = fs4 %>%
set_covariates(group = "Poor") %>%
mix(0.5, fs4 %>% set_covariates(group = "Poor"), 0.5) %>%
apply_hr(1) %>%
join(89.1, fs4 %>% set_covariates(group = "Poor")) %>%
apply_af(1) %>%
apply_or(1) %>%
compute_surv(time = 25, cycle_length = 365.25 / 7)
expect_equal(exp_sur9, exp_surv10)
# Adding exponential hazards to itself same as applying a HR of 2
exp_double1_prob = fs4 %>%
set_covariates(group = "Medium") %>%
add_hazards(., .) %>%
compute_surv(time = seq_len(10), cycle_length = 200)
exp_double2_prob = fs4 %>%
set_covariates(group = "Medium") %>%
apply_hr(hr = 2) %>%
compute_surv(time = seq_len(10), cycle_length = 200)
exp_double1_surv = fs4 %>%
set_covariates(group = "Medium") %>%
add_hazards(., .) %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
exp_double2_surv = fs4 %>%
set_covariates(group = "Medium") %>%
apply_hr(hr = 2) %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
expect_equal(exp_double1_prob, exp_double2_prob)
expect_equal(exp_double1_surv, exp_double2_surv)
# Running a flexsurvreg w/o specifying covariates should
# be the same as a wieghted average of the covariate levels
# based on distribution in original data
fs1_weighted1_surv = suppressWarnings(fs3 %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv"))
fs1_weighted2_surv = mix(
fs3 %>% set_covariates(group = "Good"), 229,
fs3 %>% set_covariates(group = "Medium"), 229,
fs3 %>% set_covariates(group = "Poor"), 228
) %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "surv")
fs2_weighted1_prob = suppressWarnings(fs3 %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "prob"))
fs2_weighted2_prob = mix(
fs3 %>% set_covariates(group = "Good"), 229,
fs3 %>% set_covariates(group = "Medium"), 229,
fs3 %>% set_covariates(group = "Poor"), 228
) %>%
compute_surv(time = seq_len(10),
cycle_length = 200,
type = "prob")
expect_equal(fs1_weighted1_surv, fs1_weighted2_surv)
expect_equal(fs2_weighted1_prob, fs2_weighted2_prob)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.