flexsurvcure/0000755000176200001440000000000014754051342013014 5ustar liggesusersflexsurvcure/tests/0000755000176200001440000000000014252754560014163 5ustar liggesusersflexsurvcure/tests/testthat/0000755000176200001440000000000014754051342016016 5ustar liggesusersflexsurvcure/tests/testthat/test_match_stata.R0000644000176200001440000003015514252754560021501 0ustar liggesuserstest_that("Weibull Mixture matches stata", { # Weibull, Logistic # ------------------------------------------------------------------------------ # _t | Coef. Std. Err. z P>|z| [95% Conf. Interval] # -------------+---------------------------------------------------------------- # pi | # _cons | -.4731367 .1641441 -2.88 0.004 -.7948533 -.1514202 # -------------+---------------------------------------------------------------- # ln_lambda | # _cons | -11.10519 .5901206 -18.82 0.000 -12.2618 -9.948572 # -------------+---------------------------------------------------------------- # ln_gamma | # _cons | .448163 .0576425 7.77 0.000 .3351858 .5611403 # ------------------------------------------------------------------------------ logistic_params <- c( -.4731367, .448163, -11.10519) logistic_lower <- c( -.7948533, .3351858, -12.2618) logistic_upper <- c(-.1514202, .5611403, -9.948572) logistic_se <- c(.1641441 , .0576425 , .5901206) # Suppress unimportant NaN warnings from WeibullPH functions. logistic_null <- suppressWarnings(flexsurvcure(Surv(rectime, censrec)~1,data=bc,link="logistic", dist="weibullPH")) # Tolerance here is very permissive expect_equal(logistic_params, unname(logistic_null$res.t[ ,1]), tolerance=1e-2) expect_equal(logistic_lower, unname(logistic_null$res.t[ ,2]), tolerance=1e-2) expect_equal(logistic_upper, unname(logistic_null$res.t[ ,3]), tolerance=1e-2) expect_equal(logistic_se, unname(logistic_null$res.t[ ,4]), tolerance=1e-2) # Weibull, Identity Link # _t | Coef. Std. Err. z P>|z| [95% Conf. Interval] # -------------+---------------------------------------------------------------- # pi | # _cons | .3838745 .0388224 9.89 0.000 .3077839 .4599651 # -------------+---------------------------------------------------------------- # ln_lambda | # _cons | -11.10519 .5901226 -18.82 0.000 -12.26181 -9.948572 # -------------+---------------------------------------------------------------- # ln_gamma | # _cons | .4481635 .0576427 7.77 0.000 .3351859 .561141 # ------------------------------------------------------------------------------ ident_params <- c(.3838745, .4481635, -11.10519) ident_lower <- c(.3077839, .3351859, -12.26181) ident_upper <- c(.4599651, .561141, -9.948572) ident_se <- c(.0388224, .0576427, .5901226) ident_null <- flexsurvcure(Surv(rectime, censrec)~1,data=bc,link="identity", dist="weibullPH") # Tolerance here is very permissive expect_equal(ident_params, unname(ident_null$res.t[ ,1]), tolerance=1e-2) expect_equal(ident_lower, unname(ident_null$res.t[ ,2]), tolerance=1e-2) expect_equal(ident_upper, unname(ident_null$res.t[ ,3]), tolerance=1e-2) expect_equal(ident_se, unname(ident_null$res.t[ ,4]), tolerance=1e-2) }) test_that("Lognormal Mixture matches stata", { # Lognormal, Loglog # ------------------------------------------------------------------------------ # _t | Coef. Std. Err. z P>|z| [95% Conf. Interval] # -------------+---------------------------------------------------------------- # pi | # _cons | .2484884 .1977661 1.26 0.209 -.1391261 .6361029 # -------------+---------------------------------------------------------------- # mu | # _cons | 6.982434 .1304159 53.54 0.000 6.726824 7.238045 # -------------+---------------------------------------------------------------- # ln_sigma | # _cons | -.0933944 .0800745 -1.17 0.243 -.2503376 .0635487 # ------------------------------------------------------------------------------ loglog_params <- c(.2484884, 6.982434, -.0933944) loglog_lower <- c( -.1391261, 6.726824, -.2503376) loglog_upper <- c(.6361029, 7.238045, .0635487) loglog_se <- c(.1977661, .1304159, .0800745) loglog_null <- flexsurvcure(Surv(rectime, censrec)~1,data=bc,link="loglog", dist="lnorm") # Tolerance here is very permissive expect_equal(loglog_params, unname(loglog_null$res.t[ ,1]), tolerance=1e-2) expect_equal(loglog_lower, unname(loglog_null$res.t[ ,2]), tolerance=1e-2) expect_equal(loglog_upper, unname(loglog_null$res.t[ ,3]), tolerance=1e-2) expect_equal(loglog_se, unname(loglog_null$res.t[ ,4]), tolerance=1e-2) # Lognormal, Identity Link # ------------------------------------------------------------------------------ # _t | Coef. Std. Err. z P>|z| [95% Conf. Interval] # -------------+---------------------------------------------------------------- # pi | # _cons | .2774585 .0703503 3.94 0.000 .1395744 .4153425 # -------------+---------------------------------------------------------------- # mu | # _cons | 6.982433 .1304159 53.54 0.000 6.726823 7.238044 # -------------+---------------------------------------------------------------- # ln_sigma | # _cons | -.093395 .0800746 -1.17 0.243 -.2503383 .0635482 # ------------------------------------------------------------------------------ ident_params <- c(.2774585, 6.982433, -.093395) ident_lower <- c(.1395744, 6.726823, -.2503383) ident_upper <- c(.4153425, 7.238044, .0635482) ident_se <- c(.0703503, .1304159, .0800746) ident_null <- flexsurvcure(Surv(rectime, censrec)~1,data=bc,link="identity", dist="lnorm") # Tolerance here is very permissive expect_equal(ident_params, unname(ident_null$res.t[ ,1]), tolerance=1e-2) expect_equal(ident_lower, unname(ident_null$res.t[ ,2]), tolerance=1e-2) expect_equal(ident_upper, unname(ident_null$res.t[ ,3]), tolerance=1e-2) expect_equal(ident_se, unname(ident_null$res.t[ ,4]), tolerance=1e-2) }) test_that("Weibull Non-Mixture matches stata", { # Weibull, Logistic # ------------------------------------------------------------------------------ # _t | Coef. Std. Err. z P>|z| [95% Conf. Interval] # -------------+---------------------------------------------------------------- # pi | # _cons | -.5151878 .1806544 -2.85 0.004 -.8692639 -.1611116 # -------------+---------------------------------------------------------------- # ln_lambda | # _cons | -12.16467 .6119361 -19.88 0.000 -13.36405 -10.9653 # -------------+---------------------------------------------------------------- # ln_gamma | # _cons | .5110451 .0585201 8.73 0.000 .3963477 .6257425 # ------------------------------------------------------------------------------ logistic_params <- c( -.5151878, .5110451, -12.16467) logistic_lower <- c( -.8692639, .3963477, -13.36405) logistic_upper <- c(-.1611116, .6257425, -10.9653) logistic_se <- c(.1806544 , .0585201 , .6119361) # Suppress Nan Warnings logistic_null <- suppressWarnings(flexsurvcure(Surv(rectime, censrec)~1,data=bc,link="logistic", dist="weibullPH", mixture=F)) # Tolerance here is very permissive expect_equal(logistic_params, unname(logistic_null$res.t[ ,1]), tolerance=1e-2) expect_equal(logistic_lower, unname(logistic_null$res.t[ ,2]), tolerance=1e-2) expect_equal(logistic_upper, unname(logistic_null$res.t[ ,3]), tolerance=1e-2) expect_equal(logistic_se, unname(logistic_null$res.t[ ,4]), tolerance=1e-2) # Weibull, Loglog # ------------------------------------------------------------------------------ # _t | Coef. Std. Err. z P>|z| [95% Conf. Interval] # -------------+---------------------------------------------------------------- # pi | # _cons | -.0165781 .1149836 -0.14 0.885 -.2419419 .2087857 # -------------+---------------------------------------------------------------- # ln_lambda | # _cons | -12.16465 .6119389 -19.88 0.000 -13.36402 -10.96527 # -------------+---------------------------------------------------------------- # ln_gamma | # _cons | .5110431 .0585205 8.73 0.000 .3963451 .6257412 # ------------------------------------------------------------------------------ loglog_params <- c(-.0165781, .5110431, -12.16465) loglog_lower <- c( -.2419419, .3963451, -13.36402) loglog_upper <- c(.2087857, .6257412, -10.96527) loglog_se <- c(.1149836, .0585205, .6119389) # Supress NaN Warnings loglog_null <- suppressWarnings(flexsurvcure(Surv(rectime, censrec)~1,data=bc,link="loglog", dist="weibullPH", mixture=F)) # Tolerance here is very permissive expect_equal(loglog_params, unname(loglog_null$res.t[ ,1]), tolerance=1e-2) expect_equal(loglog_lower, unname(loglog_null$res.t[ ,2]), tolerance=1e-2) expect_equal(loglog_upper, unname(loglog_null$res.t[ ,3]), tolerance=1e-2) expect_equal(loglog_se, unname(loglog_null$res.t[ ,4]), tolerance=1e-2) }) test_that("Weibull Mixture w/ covariate matches stata", { good_data <- bc good_data$good <- ifelse(good_data$group == "Good", 1, 0) # Weibull, loglog # ------------------------------------------------------------------------------ # _t | Coef. Std. Err. z P>|z| [95% Conf. Interval] # -------------+---------------------------------------------------------------- # pi | # good | -1.304919 .1775218 -7.35 0.000 -1.652856 -.9569831 # _cons | .360375 .1384624 2.60 0.009 .0889936 .6317564 # -------------+---------------------------------------------------------------- # ln_lambda | # _cons | -11.05986 .5894734 -18.76 0.000 -12.2152 -9.90451 # -------------+---------------------------------------------------------------- # ln_gamma | # _cons | .4434316 .0580233 7.64 0.000 .329708 .5571553 # ------------------------------------------------------------------------------ loglog_params <- c(.360375, .4434316, -11.05986, -1.304919) loglog_lower <- c(.0889936, .329708, -12.2152, -1.652856) loglog_upper <- c(.6317564, .5571553,-9.90451, -.9569831) loglog_se <- c(.1384624, .0580233, .5894734, .1775218) # Suppress NaN Warnings loglog_cov <- suppressWarnings(flexsurvcure(Surv(rectime, censrec)~good,data=good_data,link="loglog", dist="weibullPH")) # Tolerance here is very permissive expect_equal(loglog_params, unname(loglog_cov$res.t[ ,1]), tolerance=1e-2) expect_equal(loglog_lower, unname(loglog_cov$res.t[ ,2]), tolerance=1e-2) expect_equal(loglog_upper, unname(loglog_cov$res.t[ ,3]), tolerance=1e-2) expect_equal(loglog_se, unname(loglog_cov$res.t[ ,4]), tolerance=1e-2) }) test_that("Weibull Mixture w/ baseline hazard", { # Weibull, Logistic # ------------------------------------------------------------------------------ # _t | Coef. Std. Err. z P>|z| [95% Conf. Interval] # -------------+---------------------------------------------------------------- # pi | # _cons | -.4589729 .1644206 -2.79 0.005 -.7812314 -.1367144 # -------------+---------------------------------------------------------------- # ln_lambda | # _cons | -1.871874 .1175981 -15.92 0.000 -2.102362 -1.641386 # -------------+---------------------------------------------------------------- # ln_gamma | # _cons | .4501334 .0579905 7.76 0.000 .3364742 .5637926 # ------------------------------------------------------------------------------ # logistic_params <- c( -.4589729, .4501334, -1.871874) logistic_lower <- c( -.7812314, .3364742, -2.102362) logistic_upper <- c(-.1367144, .5637926, -1.641386) logistic_se <- c(.1644206 , .0579905 , .1175981) # Suppress NaN Warnings logistic_null <- suppressWarnings(flexsurvcure(Surv(recyrs, censrec)~1,data=bc,link="logistic", dist="weibullPH", bhazard=rep(0.001,686))) # Tolerance here is very permissive expect_equal(logistic_params, unname(logistic_null$res.t[ ,1]), tolerance=1e-2) expect_equal(logistic_lower, unname(logistic_null$res.t[ ,2]), tolerance=1e-2) expect_equal(logistic_upper, unname(logistic_null$res.t[ ,3]), tolerance=1e-2) expect_equal(logistic_se, unname(logistic_null$res.t[ ,4]), tolerance=1e-2) }) flexsurvcure/tests/testthat/test_surv_funcs.R0000644000176200001440000002157414253004475021405 0ustar liggesuserstest_that("Mean survival works", { # MIXTURE MODELS # Mean should be infinite for models with positive cure fraction mix_some_cured <- flexsurvcure(Surv(rectime, censrec)~1,data=bc,link="logistic", dist="llogis") mix_some_cured_res <- summary(mix_some_cured, type = "mean", tidy=T) expect_equal(as.numeric(mix_some_cured_res), c(Inf, Inf, Inf)) # For cure fraction = 0, mean should equal that of base distribution mix_none_cured <- flexsurvcure(Surv(rectime, censrec)~1,data=bc,link="identity", dist="exp") mix_none_cured_res <- summary(mix_none_cured, type = "mean", tidy=T) mix_none_cured_base_res <- mean_exp(mix_none_cured$res[2,1]) expect_equal(mix_none_cured_res[1,1], mix_none_cured_base_res) # NON-MIXTURE MODELS # Mean should be infinite for models with positive cure fraction nmix_some_cured <- flexsurvcure(Surv(rectime, censrec)~1,data=bc,link="logistic", dist="llogis", mixture = F) nmix_some_cured_res <- summary(nmix_some_cured, type = "mean", tidy=T) expect_equal(as.numeric(nmix_some_cured_res), c(Inf, Inf, Inf)) # Test case where theta is zero expect_equal( mean_nmixsurv(pgenf, 0, mu = 1.2, sigma = 0.8, Q = 0.2, P = 0.3), 0 ) expect_equal( mean_mixsurv(pgenf, 0, mu = 1.2, sigma = 0.8, Q = 0.2, P = 0.3), mean_genf(1.2, 0.8, 0.2, 0.3) ) # Test with vector arguments # expect_equal( # mean_nmixsurv(pweibull, c(0.1, 0.1, 0.1), shape=c(1.2, 1.3, 1.5), scale=c(20, 21, 50)), # c(Inf, Inf, Inf) # ) # expect_equal( # mean_nmixsurv(pweibull, c(0.1), shape=c(1.2, 1.3, 1.5), scale=c(20, 21, 50)), # c(Inf, Inf, Inf) # ) # expect_equal( # mean_nmixsurv(pweibull, c(0), shape=c(1.2, 1.3, 1.5), scale=c(20, 21, 50)), # c(0, 0, 0) # ) # expect_equal( # mean_nmixsurv(pweibull, c(0, 1, 1), shape=c(1.2), scale=c(20)), # c(0, Inf, Inf) # ) # expect_error( # mean_nmixsurv(pweibull, c(0, 1, 1), shape=c(1.2, 1.3), scale=c(20, 21)), # 'Parameter values provided were of incompatible length' # ) # expect_equal( # mean_mixsurv(pweibull, c(0.1, 0.1, 0.1), shape=c(1.2, 1.3, 1.5), scale=c(20, 21, 50)), # c(Inf, Inf, Inf) # ) # expect_equal( # mean_mixsurv(pweibull, c(0.1), shape=c(1.2, 1.3, 1.5), scale=c(20, 21, 50)), # c(Inf, Inf, Inf) # ) # expect_equal( # mean_mixsurv(pweibull, c(0, 0, 0), shape=c(1.2, 1.3, 1.5), scale=c(20, 21, 50)), # c(18.81311716, 19.39511074, 45.13726464) # ) # expect_equal( # mean_mixsurv(pweibull, c(0), shape=c(1.2, 1.3, 1.5), scale=c(20, 21, 50)), # c(18.81311716, 19.39511074, 45.13726464) # ) # expect_equal( # mean_mixsurv(pweibull, c(0, 1, 1), shape=c(1.2), scale=c(20)), # c(18.81311716, Inf, Inf) # ) # expect_error( # mean_mixsurv(pweibull, c(0, 1, 1), shape=c(1.2, 1.3), scale=c(20, 21)), # 'Parameter values provided were of incompatible length' # ) }) test_that("RMST Works", { # MIXTURE MODELS # RMST should be equal to duration * theta + (1-theta) * uncured_rmst t_rmst <- 10000 mix_some_cured <- flexsurvcure(Surv(rectime, censrec)~1,data=bc,link="logistic", dist="gompertz") mix_some_cured_res <- summary(mix_some_cured, t=t_rmst, type = "rmst", tidy=T) mix_some_cured_res_u <- rmst_gompertz( t = t_rmst, shape=mix_some_cured$res[2,1], rate=mix_some_cured$res[3,1] ) expect_equal( mix_some_cured_res$est, (1 - mix_some_cured$res[1,1]) * mix_some_cured_res_u + mix_some_cured$res[1,1] * t_rmst ) nmix_some_cured <- flexsurvcure(Surv(rectime, censrec)~1,data=bc,link="logistic", dist="gompertz", mix = F) nmix_some_cured_res <- summary(nmix_some_cured, t=t_rmst, type = "rmst", tidy=T) expect_equal( nmix_some_cured_res$est, integrate(function(x) pnmixsurv( pgompertz, x, nmix_some_cured$res[1,1], shape = nmix_some_cured$res[2,1], rate = nmix_some_cured$res[3,1], lower.tail = F), 0, t_rmst )$value ) }) test_that("Survival projections", { # MIXTURE MODELS # Survival should be equal to cure fraction for large values of t mix_some_cured <- flexsurvcure(Surv(rectime, censrec)~1,data=bc,link="loglog", dist="lnorm") mix_some_cured_res <- summary(mix_some_cured, t=1e99, type = "survival", tidy=T) expect_equal(as.numeric(mix_some_cured_res)[2], as.numeric(mix_some_cured$res[1])) # NON-MIXTURE MODELS # Survival should be equal to cure fraction for large values of t nmix_some_cured <- flexsurvcure(Surv(rectime, censrec)~1,data=bc,link="loglog", dist="lnorm", mixture=F) nmix_some_cured_res <- summary(nmix_some_cured, t=1e99, type = "survival", tidy=T) expect_equal(as.numeric(nmix_some_cured_res)[2], as.numeric(nmix_some_cured$res[1])) }) test_that("Cumulative hazard projections", { # MIXTURE MODELS # Cumulative hazard should equal -log(cure fraction) for large values of t mix_some_cured <- flexsurvcure(Surv(rectime, censrec)~1,data=bc,link="identity", dist="weibull") mix_some_cured_res <- summary(mix_some_cured, t=1e99, type = "cumhaz", tidy=T) expect_equal(as.numeric(mix_some_cured_res)[2], -log(as.numeric(mix_some_cured$res[1]))) # NON-MIXTURE MODELS # Cumulative hazard should equal -log(cure fraction) for large values of t nmix_some_cured <- flexsurvcure(Surv(rectime, censrec)~1,data=bc,link="identity", dist="weibull", mixture=F) nmix_some_cured_res <- summary(nmix_some_cured, t=1e99, type = "cumhaz", tidy=T) expect_equal(as.numeric(nmix_some_cured_res)[2], -log(as.numeric(nmix_some_cured$res[1]))) # MIXTURE MODELS # Cumulative hazard should flatten mix_some_cured <- flexsurvcure(Surv(rectime, censrec)~1,data=bc,link="logistic", dist="exp") mix_some_cured_res <- summary(mix_some_cured, t=c(9999999, 1e99), type = "cumhaz", tidy=T) expect_equal(mix_some_cured_res$est[1], mix_some_cured_res$est[2]) # NON-MIXTURE MODELS # Cumulative hazard should flatten nmix_some_cured <- flexsurvcure(Surv(rectime, censrec)~1,data=bc,link="logistic", dist="exp", mixture=F) nmix_some_cured_res <- summary(nmix_some_cured, t=c(9999999, 1e99), type = "cumhaz", tidy=T) expect_equal(nmix_some_cured_res$est[1], nmix_some_cured_res$est[2]) }) test_that("Hazard rate projections", { # MIXTURE MODELS # Hazard at t = Inf should be zero mix_some_cured <- flexsurvcure(Surv(rectime, censrec)~1,data=bc,link="logistic", dist="exp") mix_some_cured_res <- summary(mix_some_cured, t=Inf, type = "hazard", tidy=T) expect_equal(as.numeric(mix_some_cured_res)[2], 0) # NON-MIXTURE MODELS # Hazard at t = Inf should be zero nmix_some_cured <- flexsurvcure(Surv(rectime, censrec)~1,data=bc,link="logistic", dist="exp", mixture=F) nmix_some_cured_res <- summary(nmix_some_cured, t=Inf, type = "hazard", tidy=T) expect_equal(as.numeric(nmix_some_cured_res)[2], 0) }) test_that("Random sampling", { # MIXTURE MODELS expect_equal(mean(rmixsurv(qexp, n = 1000000, theta = 0.0, rate = 1/50)), 50, tolerance = 1e-2) expect_equal(median(rmixsurv(qexp, n = 10000000, theta = 0.20, rate = 1/50)), qexp(0.625, rate = 1/50), tolerance = 1e-1) # NON-MIXTURE MODELS expect_equal(mean(rnmixsurv(qexp, n = 1000000, theta = 0.0, rate = 1/50)), 50, tolerance = 1e-2) }) test_that("P function works with infinite input", { # MIXTURE MODELS # Hazard at t = Inf should be zero mix_some_cured <- flexsurvcure(Surv(rectime, censrec)~1,data=bc,link="logistic", dist="exp") mix_some_cured_res <- summary(mix_some_cured, t=Inf, type = "survival", tidy=T) expect_equal(as.numeric(mix_some_cured_res)[2], 0) # NON-MIXTURE MODELS # Hazard at t = Inf should be zero nmix_some_cured <- flexsurvcure(Surv(rectime, censrec)~1,data=bc,link="logistic", dist="exp", mixture=F) nmix_some_cured_res <- summary(nmix_some_cured, t=Inf, type = "survival", tidy=T) expect_equal(as.numeric(nmix_some_cured_res)[2], 0) }) test_that("Quantile functions", { # MIXTURE MODELS expect_equal( qmixsurv(qexp, c(0.25, 0.5, 0.75), theta = 0.2, rate = 1/50), qgeneric(function(...) pmixsurv(pexp, ...), c(0.25, 0.5, 0.75), theta = 0.2, rate = 1/50), tolerance = 1e-4 ) expect_equal( qmixsurv(qweibull, c(0.25, 0.5, 0.75), theta = 0.15, shape = 1.2, scale = 50), qgeneric(function(...) pmixsurv(pweibull, ...), c(0.25, 0.5, 0.75), theta = 0.15, shape = 1.2, scale = 50), tolerance = 1e-4 ) # NON-MIXTURE MODELS expect_equal( qnmixsurv(qexp, c(0.25, 0.5, 0.75), theta = 0.2, rate = 1/50), qgeneric(function(...) pnmixsurv(pexp, ...), c(0.25, 0.5, 0.75), theta = 0.2, rate = 1/50), tolerance = 1e-4 ) expect_equal( qnmixsurv(qweibull, c(0.25, 0.5, 0.75), theta = 0.15, shape = 1.2, scale = 50), qgeneric(function(...) pnmixsurv(pweibull, ...), c(0.25, 0.5, 0.75), theta = 0.15, shape = 1.2, scale = 50), tolerance = 1e-4 ) }) test_that("Probit link works", { probit_model <- flexsurvcure(Surv(rectime, censrec)~1,data=bc,link="probit", dist="llogis") expect_equal(probit_model$res.t[1,1], qnorm(probit_model$res[1,1])) expect_equal(probit_model$res[1,1], pnorm(probit_model$res.t[1,1])) }) flexsurvcure/tests/testthat/testthat-problems.rds0000644000176200001440000010056714252775146022232 0ustar liggesusers]|U{-7H2MwFnӖhMn۔&BوLQT ,A2Q#* {n'7-'y{{7nXr]aѕ!rEK<vSSC>injU6rQB8wcMms};//oԨOSKUcǺ?w?㦸=uݰɍ͞^mnk1̎fw׷e$iŊM3(&"é1M՛jcbkj;jBdrfoSsVO}gK]z9ƛλi{uk7,~-[<-y(SgUUnb61k;o>A?RLw_rՊKg^TLZW蕒nնxݛx]{GmwcCsmK4/F;UqOVM^{ǺfeIck<-Jc]װYFLm q=٣@sBT%Ӵ+=;ݲήfJЖښ]W"Z(IUyzr=y>YSmunǣs6uF 9CHǵ#9|Xw=hnSD37z6nlNV_o;Famˮ@JC{4x[.ztFhui$UrÅ^?~lNuBXc֥˒Kiv<7z{9aCkѴ(stc^LO]m-^iHo]mjd<D&ӧfJ ˉvs̺ĻCѨX^M%g 2!rJQB X$\ )aXf.>Lŭ0Æe, _BÊ|q~e9$p˽܍݆~6?2܍h"bĶwmꃏ}?&i LObAOmsg`>5j8^:yhͫ-!YYzֳC Dok:bE5ذ:_zTMCk\w]CxenXGFڱ.;=u./91}u_זnfunSƺ q)VZZi빶0õS8N:]GuZkus[}\nukCm|;׳w oбe8_լrW3ǮYٔygj{fe~ж< 2GA&,,9!6{}׳܍[ƷG?i Y9{:4zEF{RᄱwmkV/؝a{-O$m퇡RY'R8X_h,D԰mV 6BW_uu-ӫ{CG4y-R6s3Х4T5[}_}ծ|ƴ5/pF6i{4mOř^mn#e/7uf-/ƚ_}zoHcƔʌ`ݱvLT[Ļv)f,^mzB6׆a{b|sEo-mš?np!8Ag m|ut=\,'>E(%uŘgҸQao# (3?o4s-zK|OG"Qg='>GqA#D}:)DhҾ?ҾInKM4g M~Qڇ,<"BhKX?3&|g~ R2B""zWD|oȯdj B7ARho&k_)kʨBr=pu 0?_ׯh f]$D}b=/!"\r ,bѻH >K1_u3|BԿA+/T,v뿆ZK_'vg"zw q"D~g6ը!gX7xÅQ`+8~ԟBc߶TQI.8lZ?GVڗGBߜNV!!U,zd+bS-<~!zؙ$B?i3(yb߰ $D}ϷL_D)%bW]JoS ίfpLuŮV"_ E_M|E+8NY_׊=o#ug+b׫$!Hg=_O|"_oIy?7:& yS[?AZWݭB_NdB_iNO!De&~"_#~&!o"T=rB=H|"_&~.!{y}Tq D~9įT_C~OZc)ĞQBϧWxÅ/̿Wy+?}j#+W^U_>Uy'D_w#*M'o_׷U BK|"_'~!' ;!z~?5\aS'K Wp|~.8ȢG=QifXG 3`k| 9?X?mG('*Ph3}?_bB篰8PI?PwX_ER-<⧒~:/dX9C߇3PwX_K}ijA:~7H_ae?-6͢G,S'lBwXEÉFu$~$9ď D1bc-<%HB}#I_HC?J#ӿ2J_J3AX[J4?)7-W>Uyt=liʧ!-pbgZo}1](XلߋN1GR%bԟC&Ʊ=/#>Wa T>! =W_8^2lK1~8}9Q M|> @B̿*,<G~H4E/6l"P/a/S7El+_m%~\GP~爝~G)osŮ<(]bT!ֿ~h#7V,/HzĿ"E\BOQ`Ƨ}/%D~9ė+ΦGBws Z1>G~W[7ZP ?oS1~n{ޢGH~"v"O~a#-TaݮڗOu'h=bcҏ D~8+R~{u5? 50 5('j~ė(.c(<#XO%D~qO'D~I$D~ė)VP~2S-Kυ\ f4'D~Ӊ8+#~,!+'>O>#Y/$D~/"D~@?Iφ/[d"O!D~F? T[iJWb}Xe_;[`LrwGɄljq|)oW>ؗo_K~)O#~"~#CE#~+1>[EZ;Cw797|t9O!:[dq=ٮ;?O|W!E9?}SB$D}/p#&D}[CnU_R,< =,<_EB>PkŮb|cI#g!|E>bBn!~!H&Eo'~"gBi~`bK$D{/SbXxQ-> #U\H-Q'_L?){/!D'EOReO=m gT\I{# _E/'W,H|b2?&} !B|b7_>93 Q= 篏9wE>"*d8PW~aDKX􈟢HWiH"qE#"" /?g#p:˱"Y?F !}6!?rl #D '~(WKhB=D"~ !O>1V?lL%~b>",Mb- Gk]gtB7g^3yp7?;A ~0!Pb!D]n#%DR w߲M˩}Y+O珫%ď"D@E!~"V: u#DH|xMo"}!LI[-!?JBE '-͑3I?? ?# uFH"?7E'M#'Dgr_@c[?B"?-1\}ORJWL4B&!O9ӢG%Kd/9C?e迩pB_jYI? BlUD-[j{){*_D| !OK,65 !AM&Dv!!vE;JKl~7݄h g"WN2")ď Dnt=t3,s>9\G)qbH=BE>^"vR"~b ſ\ W~2!]K7iT/#D}~H|9!#_A\/s@,7d᡿s8"vG[IҾ9BBaY/"DQH3F=j88C!? 7'~B'尋-z]MJ{FiZ ]۳bϩ!zAb/0!I=LE+8$g}&~"^{#I%>Wq4Km o~ !;ۆ ԇO|+c"B"@G =x>C)'%~tG/7Byo~Ə #T<?XGhWjb,GϷ ,BHGPF"BQ_L=sTE3_X_ }_/#DB^?jGA_I_x4ŗ(*#~6,G.PZ~uh8'ZUhB_֒=_L|"=$j~" $)i>Hd/Un_1kb!C'_jZ.VBWLC=W*?E7JWj]h%s&&>]?Q2W֩!AD7ȿJlE?D F FgՖg~3/xn֞:GQOhBOQc b_#cq}noXh3tClG/&D]OTOԉb'Yx? QZ ;iT3/#D"?[\W}ϢG?KCOǿE?,c IOB|"n#O!D;Os )vGHIm??ܧ1s;]H?~O!D}rϷqghS)bS!?)\G|"~/~O9i"s&Dϋc# !yQ?~(!YgXx U"_foAwK3KR>!c,zcܿߤ/"DCEz0_#g/!D?EqZ0~`t j#,Gw K|"G'?PDBuѩK2zESHhY -<_@gH'Ď"~).F?+Q[AaTJB[tpJBo3UDeLF? ¢ QLkO'DEg*%ZztG%Dg)2WgXxğALK%}֧նB?;d)Sd̅O!D}e.Do#R5_Bt_zU=WHhѫ?[G"DĎQ`B^ڢGcBs %D,JjjSC|+8?CG-迭buE;^=#~"7|z +Rf -gԈJ|DKlGݤD`?.PBw2A?׉/%DO;Seb[Lagm?s |oZx&"/P\H/#_Dp,& h}_B}_ Q~hBbw[8qF9z,<7>H|"?G~(!B|"G~,!sKwnjB 9~?VA?<$SQ߈~E+?G7J{\i-ztE?VI Dp#"DʳLE?bYx#PBy%-=2\}ń迏 >@}FTBF\_7=X< ЇP/&rRP_eO 1IU=P/F֬LGjdX8~&1t#Cߗȿȳ/(6# #DWHe-ɶMA0Km8}̞0Q!GЏ|o\? _L&?eǜf#$#"1x8G)"D2cJ?\!?2Wc-<JUE2bYxğGlBğOpB7,#1~Zο g$![I|"c?P1k#D׉|BXE!|Gw UOP1b5kH_Bx-3 Ʉo+Sq4_J4_F45׾@gW-zD|"kkз~6!J\yn I?9>za@Ae]@h}_H}]_jsS u煜pOhDᾥ=x腋R2(~8ԟ)ogwu'V>E]~Ϗ= ތ7G,~7/c~ %+7 oC 1i#;Oro_?ߩT`*K{՟A#EG W!ϯ>~GP~S=E_MgV!o0;oSE?ТGψRoQ>!_H ~x's5X M~dN_1Q =1\,&4_/$!Vւ'~(! nBė$vG"4⡟E&D~_7S WGc(B_֪e=_B|ŁEO AQ&D}d/[iCѿ+JRصגM#>x7h}s <5!g(I7HckŎW !ϭb[`"b Gf#~G)oMz ڿCGb|eq|bW,/qWy؉?Z8WyES?dN;#B|ؙ$,㉇[bQBo]n#w__f/&p׫ !/%ؕ$2B#5_Ay-ӈ^؟%! įV\O{؏ws G?,OhDY_p|8L3qn/ԢG_WQx}&^-zĿa#)P!/; >WcCbA_8?*K1~s##\LhsB&TB3Y)ٟ@|)!/_XNG_A^r#&?J|E]G^{Cu={Uh{-)VS~oBK&-o%D~$@#b|G~Y֟z?Gy}(Q?E?0f#(]\ƅ?P׿8,^mV,'9EPG(qqj≟8KKRTBG~IOW,҈/'D~RS!t#>/R\J'~!@rB\ V B?qoe|da:6*oLr՟Bm>s7kR"]/n"4e'qy=%"]ƍpb|+_zI?2W&?#c>g=?E8k]~_BQFoo2 1?PqOq3?Ǘ9훡v??_Gr7)D|+W,!s#|7 _Z-nb+,z_F|?EߟrMWI@°e\kŭL'[o=rw 1Cg(!(EY6D{3)hUCQZ:o%~b?ޢ"pq՟M?5Xxo pBo##E#~+GۉO!TBwZxd2񉄨)'+SNS`Bkb[4()-z7酋XYg>ge,#DMpB'B'Tj R/#>LB +߇:!O@ߗ~Vy?^  OH1>ԏ?U8!T,ؿfLJPsk~F+hj~1SY?Z->^_BqLjBBъR~bX6Os#t@|_Q~(o'rNbFe=&^_%^n3/i#,Ez/a'D?BB?.EXdǛ8hO"Dc8'~!+ TK[BHO"~!+!~9!+m?Soe|Mu̗iU %6G)߳Ŷ[?T_@/>HӿREG]GEpkԟGןˉ'ZWZxį$}^Ư$>xPb%H9F>oq*g(.'Q%#Vc#F+.=S2BKrBof IB ⡯$%Q}WBd+I]ׇys;7H_U~Ө> EkbX4*~] gb.+ ~"!Dľe#*ԟO{#Pqſ@"b|\G,+!^+?P/MB̯]f2O%D\n ~"*K q~>eGĮQ!A!~"L~?"~!\ b79!An"R&4!5([nW!An'ޣ[ߝwR[ 1v#_Z֟ʲ17H{X߈c#Pt#b?ߣboYيbO bBi'(_{ϒ~2!SFė"?_?/IqO/Q\NJ B񕄨bUJB̟7ﯖ,wtAyO}b|Cn'>U?؇@}j#T[y9ߖBpb_ 1>GωO%^ xB +N'A0!N3> b-z?~| _B? b='Tq9Op }տP뗐B|%/AY =J)\DLOU`+8eOPt W` 缄]= _ sԟE-âG9g+'WHBė~jH燄bԟG.t#" U2DA+,O%W LKZx_K)u~=SiPELB?%G|b\$Tmt#j1OUf"-SǬrpW"zw<+_CG=6fo$lr#fH.]Az~`*~`#IW /)wb}9Y*O!>K_%H{NS>!5=F|!!& Q/RW gcqsH?KdEz~Mg" /U2B?ǿA/&~"&o}ebW!zwe|-#*f:NS ]%\+Cb|_'E?$>U~$v"bXUb7!&=l9>KSyJ|>!mb[xĿA|*I_HEamLWO/V7O~O"D~%E'D? k"bYk+xHa/'oaW(X|}&\S_E 1~GߒhB' b@|)_/S,obX+_?K%f?e?_Q/Q)u#~įR\C $~-!D:ō`&D~Co(^)a"#0}:G:_e?Ʋ1?N׳7H ƫQ(s:qEvֿD9$NPrJ\i# ( %GQiӉG;u}Or83I??U$"&\q+8SB#~Robr- B̟z2x}Zi̯s.Q֪O!5'HwLjmPBė=hעG TUbs#r|_.^?OD|!f-񷐾P牵ħ}=xBńz}$v'(bd,֪BԯE|?Yo۩ B!vE;NP%^%;ѢG_Ţ/%~]GbDBldү%9YCuu?[ zBϱ?12~Ye}:Kt;Wy[ʟyO P`*bW?]%@E]M|E+8?NY׊=o#ug+]#Y=9> v>G/Pc?U1~nq#%\/!ωL ;-x賩Fb#~"1 tBE R?ڢ/%_FK|9!̳G Bo>co!_e|"}Ο 7Hϗf(]$)ӨXIsԟHϗdL:͢G~s靖gj/{&8T?L/%ZH9PlEUAb'XG*$9$R !J=⯲.i'G:b~9tGcH?s~@4E\_e#8U_Hϗj6yoRV"W"z=qDϗ_K_kۮ*BG~ۉ(nv@|-!ԿD=;ɲl%Ti^AztYHϗۢGv׿U!ֿs\ (W!! =O|!ńO Do"!5=}[;~!2K+(b߳=">?\C7]K\E\\O"B(r׏nVjB&=5)[?J߷ݡ Nfn]?.U _++b|'E">U1؃FbY GR_[. bs 1{##Eħ 1~$~"?-g{΢%T7y"\+ D>O,B b/Zx ѿ$~,пB7ϖ=j̹ʟ q](o0[񄘿<ʢGӿG'A?›xk_fW(grU`+0~ OW_2Y>`'cĩ?P?9VlEqg+dcG"yrQ_Ib)#&';?Ez,}vO"G>ᒇP??Pןb,<"B`KX?+9HF|bdrB7AF_HϿG?!~rW`H69`\ D~/+y[h, DZ[@z Q2okLBrE\_$~=!꿋cv` bY=?Yߛ7ib?^tSP|s,%D3n,)gO,z?x0Wp5WpBo8|Gb\D|.!ďV,sإǿ /V,.'~ !i3)]iߕ/%D~#\q6w5s 5'D~_L#?RnTB?$~"/-<_Oń7XgYB??^o+]y_Eyؓ=7"ӿC"{?V8Wp|=@FB!D~{#?RS7oRL{##B?jɟY곅'b33ķ%~njĞ9ҟ@?o9@c WԟBWX8߈OU뛿LBSd=E|mw?}E?TL?!{z#1>$>#G)ؿ-'tB䷇R#EF?PK5m5?å&.1SwjXG8/ oɟ M' ̟j II{'KR ? +q~5J1 /K,#lo$D I-;Qqx!C{)oʜLxB]?S\i =O#>A@㛹's9u QzğI|y0Bx<t/u?Sp)s ̥EOWM+Z}N],B̙ԓ-z_J|LlG"R,z_A|"=_H[z>g' w ~Z#FO!DT[*p׿-$WK|b:"ȯ Ez6oGXW"f=k!~єN"]įUkSe/o Vj#~ي҆GS֧bc,¢G'(#>ۭ.=&>O^n{)?A_S$P}]߈E)&R3R!)vEgHWigtB9z?LBM ߇_ vEW룙]l᡿ѾK8G2 ~(!_N|p=,<_E߷=0\># u*9@|!7_}7lͤ/"D~?&~b w+SmO#D~aᑟpiw:Oci?#~Ls_XxK Q;-./%^Z_ѿ) #aoԟD+YzEdE\k;=%DG杻o?['?7^Ѿ' {Jw#SďQĞW!񟷴o/Q"-e+_{C ǢG7/RW3*7 H?;Rw޵."?CS tpT"_g/$?+.}.#=_FJ_*_z$Gj~Qį%ңb,gD#Cz,NOc YhY%> 4Q$߾ħiQb-Yߥ婿/!7AyEe-N/VB/kj\8/{BM"ޭMe-Nf"tG(R|Y-<◓~!oF~.g4!GXWp~."~I_C Bϫ7V:'b~/vEHzߗ}S}z?R}zXbXh_ #Ǻo#Dow# ) b's ߕWfֿ/W\IFZ %*BwG+n XBw#U&-< ߏQBJVBwX)1>~fY} h?zIԾ_BO|"{#U;W=j?JcN7{O!˕qgF?N'"OSœ?^{I}^U_B,z~h|&u$D ~P["&>[qOA[o$?"?JQ' _#L+G~e?P'~:!s2#k~ˈS °~Ȉ"~b)ŏC2BoF%YIjf$+ ?Cւ>O"!kqFE!>YdS_BG|?EgEB_)/kA` E1ڢG?RQ1Ḓфzw?V1>.G?ԗO5!Hl/V˘`ᡟ@Bo"SQ|eL? 3)~XG2W ,B7xaf]H"B_'K,<[Bo)񕊫)J"į#D~r#?2֫燣?FX/dQuY޲>o *BqAi%>4Eglb>ؿ[]{FvbiQ=oWE];v?wf#nSq}bNT?B+z?!?URF@Ez&4[xNhg)gc'Ds8S ~4!MK>c߷X ˉ/" xƴbWZxw%'"?Uq&w5e+XƵbYxw"?Oqw#KM/S\N,c ~L?O%!wTA)v1}EM|")"=S DG E/GޢG$~"kߨ?C|xo_D?GZG߆ _1!R_?CDB?'w-zEz&ܟzC}/?CEU _#Bq- ~*j߇bYxW"F7"O?Nq#_,<Մ{ke<N|/_93#-gPGfen } }ʿzL!>K%>ML/]2Oo ڗ?QE5@c<[`8~VC{Q`+>f^.s u}45Gq'(flȹ(@CQ|=&4zȔsE!W J_&e?U1My3\q3q`GS?7E΢GĻQ|9WdPpBğ.ТGďPC#{2%D}J_F|b1ŗp\O Gwe.SDB$? KH_BYj?YXVqӿr\RBw!`w ߱Qy3\y"*=;xԡ!~%!Jo&-?smoe >]^S &֬B&,zo&>Uq Dh:i?;(>elBs"~!n,<@_!~!,vGSH?0ΙJ."X )儈/'}!UTYXo,_Kg6!Ye8y}O՟B[SSy}E6"Uo#~PE?e>~7!ψ"/,<لw?#NwC g!59_?"b|<*E?F8E6{\ O&,z)>=i$\?ė~O=miҗ!{# xqC',B/Xk4~fBe>1s}q[ЛO?<٦_GԚ[%IX+qZG[.϶y3+.._jΪ%+/]RUQh菑ޝMs\UKT |ns9'StKVnAKX4{ʪsXE{!iCC?4=r>dvsk;*W#$UVw/t?Ν!Y=I_`t,2ݜs8{Wիw_]`^c{綯?+C=ceXߞx~ChUngt9q>qjtܗk1<ՈjmXaGҎ#w>[;KYzω&Y;1ͼ[{w.|)FTo {π_YG~ {g3K{Do {gmiYz#N6ΪYu،/mlDΉv|gkJwB!oJO.:ipieh9:>"gSt=\:=Z{w$_ɑw:睽8x,>cɈtE`-*Сz8^ 0tۜ8p[{C{*;A{p(5\wr0]{WC{ݢ=Uw޻b ?=Hbzh6zk*~H.LSA褐T{*8NG*~Ƚ}ğ79!Blw]ź{ X-햽9\+Wַw.fb'N ]}wjc9t:ΜŻw"}aR^f^!^!nW+W{w.fZV*{]goIX={Swv:̽xVv/^:kv`W*~- u5^woSo5wԶlq764׶n[mT64Nr}Ϊzoak>m\HB;McNm81M^9pש1^_|>5'P&4ddr:ڶuC?]װڱZ5‡bLo_&oc9b[=M:^֎j&]/#˹-5B5a+DQ2Z=uN{|ަj8ASFmrR Mc0{`fiq7lro4{f5nl Ǿ_} >Ft %'o4ٛezZvuȻpV4Fr^-UdRB;uOm_zTFʢq@s57=uh7Pi:;n?vӾsЍUWsgS.B:?Tvy8ȺugOVZ_w3:\m$X\+w(q8-V_zY~d/y|4AZ #vrv[˩?i+m) c;7tMrڡ:~ \Dnu6jzƮ*Il-kgDiLm{sIBؿGrI::&!W}|['n۾ݹ94|Dfn}y`g'ZUZ'ڮi0>eM k[VQwۉ~Mvb:gi-aT98udo Em3_ ߧ,ڟ3ۻۆ@?7s?ѰO_vE,#?k\;L[6kp`BsS:ouC#nƨˢBhHwS'"2LmHb&(&:L;ҴS>|)ƃ ;L6̼;e=})zj%cO;чE|{cu ? [DAo>[-W‡xܽ Rڪ:Fm !nh޶8$Ӵ2Ey{6z!#e|5Y24Tmԩiڅ{\ݺ,s5^>x{?:׮oX ͰH@g0mČ ]W&j65oxjnWȹ!n+^^ea64n׭nh#B[0-h)ҬQtOCהrN?{wtG ~kqp{B05>:Ld Lp['E(h|y}2]ČxPn1Uq3Lq3s)VfgKcj;ةztd/K,Gs#~}{q)@kL7<~J&;[dT&Ϛg֌rv%n d';効yo,ȔpO߃{Yg(.WpC;*|Ɔ/4"EşHzi2󆄈tU|Z^\H;noˍ8޻+DyjAipjҖUl7vL+vth]26ՙ[>Uq a†[rz6{=@m $vj.Y|JgE Y囼-[ڇ,rl9^xUmY'rjdr'5 Q|-yHqu>\R4q ^?>!o'u`V54[-u=>éw2ole_lq27}en6stguu> 秅G秇=񞖖ڍ-Ti[3<䈎=3gf- W=>pB92C\fڸ{Z\ij=r蕸od;-Kq)t$p{]m{N]Ie˹/9 VnϏp袨m -|J8nv^۞)![ρ>١qhGlx"9|>ש>پ7|xӁ1; ؖnLи :}ܩ'ȹgnRu+dtB>XW+޸|E(|wunk>޿s몕=h0d;]_gsuQt3jL1;msahv뙁Tۮ7JO[Б'?f}jnˮڼU?Wݩytcq?|}㠝8nd=B1:8x]JU㵵h-qzfضK{RsSs'sm)*3g(&FI.,S+lIaPݲtK)f4cǸ#;:C3tb}reղ6Yp!6Jm"؅da~2g'8 `3Ԧ> n&YY7lfu6*f!@ cj!ybK,sC [j{jel9VVXBz&jkߝ2ڿ&)Sd ʸrf'Qt?βZk͐{q 6o%zZޢl Cϕڣ_|nBn۴"^_fR_w%{\,6'$]ar=ミsd}|O?raV G?2a'ʶt BaT]_Z:U;ށN=mN[K4߂zW F/iڕyKj椘_7~~bq osCkS9N-oM5C߀ksoŋ:;]mZKmϙ-n{φI^e)Wb6zP\Mt6W/7Rk01|ÿsӍ"[0 qU397PzPEWm >Rjww7͇:K%\2Ka9kҐۍg χB{6=&u~MfbKonDLJeo˾_HjC 5k Zm%rEH-S-; ̑[ơZ0GVpmHΑ Y1BEn?.\v\"!ICn46f=+q7P=SH9uT}_gfT3ۑ_׫!@ ]:|Ӹa/tHej/Io[ƙ=`?@,]/]=ffsrDNo]嶅V20-6hoz?=mlp gS;lۭqa]q_QCTfxs8V}qK yku~6$Wp=OV.};jχ3"!?6~rΏl#zvc:~n7BeB_oo uuُ]!mcZ0<-#xQKa^RKP'DžzV M;b>->_p"ã+dzmӕ젟0tƶӖf D+gQy (T-LK[p^wҸLo"o{mj{dosJyJK}m_E;BGA1渻P!iFW4w#>tեOc-6)kM;<_߷2wwop=J~?SӐW |/2/mon_X | *'Wy6q.o"mhӜz%?H'xrC{j6pXRx7h`p^jEȞ0v͙ksx3ƚ}34Ѝs}|j qՆ x4o_ u\_"WpG h&E닡G5y|;Ԍ_bǯ<)s&>b)=):7팻Z2O'wmoXkk7f^ߴjE22v`Ud={|8c{۪ >Y"{)x&Yy"Z6m+_饳#=X~̐~FffKv g6^iC\Vy_M^K~P(5/flexsurvcure/tests/testthat.R0000644000176200001440000000010414252754560016141 0ustar liggesuserslibrary(testthat) library(flexsurvcure) test_check("flexsurvcure") flexsurvcure/MD50000644000176200001440000000205414754051342013325 0ustar liggesusers3beafa5d18eb3f797d63eea6c795cc5a *DESCRIPTION 117a925a35ee7f6442086aaac24ba580 *NAMESPACE 299c6862b51368f5b4845ae7584bc494 *NEWS.md 59126f1aa5408bb66a98aa8fee391157 *R/aaa.R 7f7163d75c2ca423eba4d80e2828325c *R/flexsurvcure.R 39c09de6f9e097e2ba04fd12050279b4 *R/helper.r e54a9ed2e63d62f0118453ccf35f64a6 *R/mixture.r cca6e171de76db4bc1f4962b584af3ad *R/nonmixture.R 6f92133b82534bce2ccf79a3722d30ef *build/vignette.rds 7dac09393c46d5aaabadc2aa67290d8a *inst/doc/flexsurvcure.R 1b75a46361c65e068fe7abc17705ee8d *inst/doc/flexsurvcure.Rmd a10e23aaa8abd10fcff9a89272a04027 *inst/doc/flexsurvcure.html 55de4273dcdc85ccefa3cd773d347f5f *man/flexsurvcure.Rd 02d0a0a6079652cd47fe683a8164c8f4 *man/mixsurv.Rd 201b6a15bc79206330c8d3dccf5627b0 *man/nmixsurv.Rd 38d4369acd0fad473813a393d85e4524 *tests/testthat.R 698cfbb1abcc6f0c41b75fdafe680ac6 *tests/testthat/test_match_stata.R be400e81aa1a51b958b4acfcafe388bd *tests/testthat/test_surv_funcs.R a6fe56ea4d1bd2082a0bec73042ff56d *tests/testthat/testthat-problems.rds 1b75a46361c65e068fe7abc17705ee8d *vignettes/flexsurvcure.Rmd flexsurvcure/R/0000755000176200001440000000000014330276314013213 5ustar liggesusersflexsurvcure/R/aaa.R0000644000176200001440000000030514252775673014075 0ustar liggesusers#' @import survival flexsurv #' @importFrom stats runif pnorm qnorm #' @importFrom boot logit inv.logit #' @importFrom survival Surv survfit #' @importFrom flexsurv flexsurvreg flexsurv.dists NULL flexsurvcure/R/flexsurvcure.R0000644000176200001440000002122414754033240016073 0ustar liggesusers# Taken from flexsurv, needed to wrap init functions of base distributions expand.inits.args <- function(inits) { inits2 <- inits formals(inits2) <- alist(t=,mf=,mml=,aux=) body(inits2) <- body(inits) inits2 } #' Mixture and Non-Mixture Parametric Cure Models ##' ##' Mixture and non-mixture cure models using flexible base distributions ##' from the flexsurv package. ##' ##' This function works as a wrapper around \code{\link[flexsurv:flexsurvreg]{flexsurv::flexsurvreg()}} by ##' dynamically constructing a custom distribution using wrappers to the ##' pdf and cdf functions. ##' ##' In a parametric mixture model, it is assumed that there exists a group of individuals ##' who experience no excess mortality, with the proportion of such individuals being given ##' by the cure fraction parameter, and a parametric distribution representing the excess ##' mortality for the remaining individuals. ##' ##' By contrast, a parametric non-mixture model simply rescales an existing parametric ##' distribution such that the probability of survival asymptotically approaches the ##' cure fraction parameter as time approaches infinity. ##' ##' @param formula A formula expression in conventional R linear modeling ##' syntax. The response must be a survival object as returned by the ##' \code{\link[survival:Surv]{survival::Surv()}} function, and any covariates are given on the right-hand ##' side. For example, ##' ##' \code{Surv(time, dead) ~ age + sex} ##' ##' \code{Surv} objects of \code{type="right"},\code{"counting"}, ##' \code{"interval1"} or \code{"interval2"} are supported, corresponding to ##' right-censored, left-truncated or interval-censored observations. ##' ##' If there are no covariates, specify \code{1} on the right hand side, for ##' example \code{Surv(time, dead) ~ 1}. ##' ##' By default, covariates are placed on the ``theta'' parameter of the ##' distribution, representing the cure fraction, through a linear ##' model with the selected link function. ##' ##' Covariates can be placed on parameters of the base distribution by using the ##' name of the parameter as a ``function'' in the formula. For example, in a ##' Weibull model, the following expresses the scale parameter in terms of age ##' and a treatment variable \code{treat}, and the shape parameter in terms of ##' sex and treatment. ##' ##' \code{Surv(time, dead) ~ age + treat + shape(sex) + shape(treat)} ##' ##' However, if the names of the ancillary parameters clash with any real ##' functions that might be used in formulae (such as \code{I()}, or ##' \code{factor()}), then those functions will not work in the formula. A ##' safer way to model covariates on ancillary parameters is through the ##' \code{anc} argument to \code{\link[flexsurv:flexsurvreg]{flexsurv::flexsurvreg}}. ##' ##' \code{\link[survival:survreg]{survival::survreg()}} users should also note that the function ##' \code{strata()} is ignored, so that any covariates surrounded by ##' \code{strata()} are applied to the location parameter. ##' @param data A data frame in which to find variables supplied in ##' \code{formula}. If not given, the variables should be in the working ##' environment. ##' @param weights Optional variable giving case weights. ##' @param bhazard Optional variable giving expected hazards for relative ##' survival models. ##' @param subset Vector of integers or logicals specifying the subset of the ##' observations to be used in the fit. ##' @param na.action a missing-data filter function, applied after any 'subset' ##' argument has been used. Default is \code{options()$na.action}. ##' @param dist A string representing one of the built-in distributions of flexsurv. ##' \code{Surv(time, dead) ~ age + treat, anc = list(shape = ~ sex + treat)} ##' @param link A string representing the link function to use for estimation of the ##' cure fraction. Defaults to "logistic", but also supports "loglog", "probit", and "identity". ##' @param mixture optional TRUE/FALSE to specify whether a mixture model should be fitted. Defaults to TRUE. ##' @param ... other arguments to be passed to \code{\link[flexsurv:flexsurvreg]{flexsurv::flexsurvreg}}. ##' @examples ##' flexsurvcure(Surv(rectime,censrec)~group, data=bc, dist="weibull", anc=list(scale=~group)) ##' flexsurvcure(Surv(rectime,censrec)~group, data=bc, dist="lnorm", mixture = FALSE) ##' flexsurvcure(Surv(rectime,censrec)~group, data=bc, dist="weibull", link="loglog") ##' @export flexsurvcure <- function(formula, data, weights, bhazard, subset, dist, na.action, link = "logistic", mixture = T, ...) { call <- match.call() indx <- match(c("formula", "data", "weights", "bhazard", "subset", "na.action"), names(call), nomatch = 0) if (indx[1] == 0) stop("A \"formula\" argument is required") temp <- call[c(1, indx)] temp[[1]] <- as.name("model.frame") if (missing(data)) temp[["data"]] <- environment(formula) if (missing(data)) data <- environment(formula) if (missing(dist)) stop("Must provide dist") optim = list() # Patch the transformations based on link argument if ("character" %in% class(dist)) { dist_list <- flexsurv.dists[[dist]] } else if("list" %in% class(dist)){ dist_list <- dist dist <- dist_list$name } else { stop("Argument 'dist' must be a string or list.") } dist_list$name <- paste0(dist_list$name, "_mix") n_base_par <- length(dist_list$pars) dist_list$pars <- c("theta", dist_list$pars) dist_list$location <- "theta" if(is.null(dist_list)) stop("Distribution not found") if (link == "logistic") { dist_list$transforms <- append(list(logit), dist_list$transforms) dist_list$inv.transforms <- append(list(inv.logit), dist_list$inv.transforms) } else if(link == "loglog") { dist_list$transforms <- append(list(function(x) log(-log(x))), dist_list$transforms) dist_list$inv.transforms <- append(list(function(x) exp(-exp(x))), dist_list$inv.transforms) } else if (link == "probit") { dist_list$transforms <- append(list(qnorm), dist_list$transforms) dist_list$inv.transforms <- append(list(pnorm), dist_list$inv.transforms) } else if(link == "identity") { dist_list$transforms <- append(list(identity), dist_list$transforms) dist_list$inv.transforms <- append(list(identity), dist_list$inv.transforms) optim$method <- "L-BFGS-B" optim$lower = c(0, rep(-Inf, n_base_par)) optim$upper = c(1, rep(Inf, n_base_par)) } else { stop("Link must be 'logistic', 'loglog', 'probit', or 'identity'") } base_init <- expand.inits.args(dist_list$inits) dist_list$inits <- function(t, mf, mml, aux) { # To estimate initial values: # -Cure fraction based on minimum KM survival # -Other parameters based on normal initial values # run only on events. surv <- as.matrix(mf[ ,1]) weights <- mf[ ,ncol(mf)] selector <- surv[ ,2] == 1 aux_sf <- list( formula = aux$forms[[1]], data = aux$data, weights = aux$weights ) sf <- do.call(survfit, aux_sf) # Can't allow value of 0 theta = max(min(sf$surv), 0.01) aux_events <- aux aux_events$data = aux$data[selector, ] out <- c(theta, base_init(t=t[selector], mf=mf[selector, ], mml=mml[selector, ], aux=aux_events)) return(out) } # Build function list pfun = get(paste0("p", dist)) dfun = get(paste0("d", dist)) qfun = get(paste0("q", dist)) if(mixture) { dfns_list = list( p = function(q, ...) pmixsurv(pfun, q, ...), d = function(x, ...) dmixsurv(dfun, pfun, x, ...), H = function(x, ...) Hmixsurv(pfun, x, ...), h = function(x, ...) hmixsurv(dfun, pfun, x, ...), q = function(p, ...) qmixsurv(qfun, p, ...), r = function(n, ...) rmixsurv(qfun, n, ...), mean = function(...) mean_mixsurv(pfun, ...), rmst = function(t, ...) rmst_mixsurv(pfun, t, ...) ) } else { dfns_list = list( p = function(q, ...) pnmixsurv(pfun, q, ...), d = function(x, ...) dnmixsurv(dfun, pfun, x, ...), H = function(x, ...) Hnmixsurv(pfun, x, ...), h = function(x, ...) hnmixsurv(dfun, x, ...), q = function(p, ...) qnmixsurv(qfun, p, ...), r = function(n, ...) rnmixsurv(qfun, n, ...), mean = function(...) mean_nmixsurv(pfun, ...), rmst = function(t, ...) rmst_nmixsurv(pfun, t, ...) ) } # Generate fit out <- do.call( "flexsurvreg", append( list( formula, data = data, weights = temp$weights, subset = temp$subset, bhazard = temp$bhazard, dist = dist_list, dfns = dfns_list, ... ), optim ) ) # Use top-level call and set additional properties/attributes out$call <- call class(out) <- c("flexsurvcure", class(out)) out$link <- link out$mixture <- mixture out } flexsurvcure/R/helper.r0000644000176200001440000000065114252757753014675 0ustar liggesusersget_param_length_and_check <- function(theta, args) { param_lengths <- c(length(theta), sapply(args, length)) max_length <- max(param_lengths) valid_lengths <- (param_lengths <= 1) | (param_lengths == max_length) # If any two parameters with length > 1 have different lengths # then throw an error. if (!all(valid_lengths)) { stop('Parameter values provided were of incompatible length') } max_length } flexsurvcure/R/nonmixture.R0000644000176200001440000001275514421575204015561 0ustar liggesusers##' Non-Mixture Cure Models ##' ##' Probability density, distribution, quantile, random generation, hazard ##' cumulative hazard, mean, and restricted mean functions for generic ##' non-mixture cure models. These distribution functions take as arguments ##' the corresponding functions of the base distribution used. ##' ##' es dnmixsurv pnmixsurv qnmixsurv rnmixsurv ##' hnmixsurv Hnmixsurv mean_nmixsurv rmst_nmixsurv ##' @param pfun The base distribution's cumulative distribution function. ##' @param dfun The base distribution's probability density function. ##' @param qfun The base distribution's quantile function. ##' @param x,q,t Vector of times. ##' @param p Vector of probabilities. ##' @param n Number of random numbers to simulate. ##' @param theta The estimated cure fraction. ##' @param ... Parameters to be passed to the pdf or cdf of the base ##' distribution. ##' @return \code{dnmixsurv} gives the density, \code{pnmixsurv} gives the ##' distribution function, \code{hnmixsurv} gives the hazard and ##' \code{Hnmixsurv} gives the cumulative hazard. ##' ##' \code{qnmixsurv} gives the quantile function, which is computed by crude ##' numerical inversion. ##' ##' \code{rnmixsurv} generates random survival times by using \code{qnmixsurv} ##' on a sample of uniform random numbers. Due to the numerical root-finding ##' involved in \code{qnmixsurv}, it is slow compared to typical random number ##' generation functions. ##' ##' \code{mean_nmixsurv} and \code{rmst_nmixsurv} give the mean and restricted ##' mean survival times, respectively. ##' @author Jordan Amdahl ##' @keywords distribution ##' @name nmixsurv NULL ##' @export ##' @rdname nmixsurv pnmixsurv = function(pfun, q, theta, ...) { dots <- list(...) args <- dots args$lower.tail <- T args$log.p <- F out <- theta ^ do.call(pfun, append(list(q), args)) if (is.null(dots$lower.tail) || dots$lower.tail) { pos_inf <- is.infinite(q) & (q > 0) out[pos_inf] <- 0 out <- 1 - out } if (!is.null(dots$log.p) && dots$log.p) { out <- log(out) } return(out) } ##' @export ##' @rdname nmixsurv hnmixsurv = function(dfun,x, theta, ...) { dots <- list(...) args <- dots args$log <- F out <- -log(theta) * do.call(dfun, append(list(x), args)) if (!is.null(dots$log) && dots$log) { out <- log(out) } return(out) } ##' @export ##' @rdname nmixsurv Hnmixsurv = function(pfun, x, theta, ...) { dots <- list(...) pargs <- dots pargs$lower.tail <- F pargs$log.p <- F pargs$log <- NULL surv <- do.call(pnmixsurv, append(list(pfun, x, theta), pargs)) out <- -log(surv) if (!is.null(dots$log) && dots$log) { out <- log(out) } return(out) } ##' @export ##' @rdname nmixsurv dnmixsurv = function(dfun, pfun, x, theta, ...) { dots <- list(...) pargs <- dots pargs$lower.tail <- F pargs$log.p <- F pargs$log <- NULL hargs <- dots hargs$log <- F u_surv <- do.call(pnmixsurv, append(list(pfun, x, theta), pargs)) u_haz <- do.call(hnmixsurv, append(list(dfun, x, theta), hargs)) out <- u_surv * u_haz if (!is.null(dots$log) && dots$log) { out <- log(out) } return(out) } ##' @export ##' @rdname nmixsurv qnmixsurv = function(qfun, p, theta, ...) { inv_p <- 1 - p dots <- list(...) args <- dots args$lower.tail <- F args$log.p <- F uncured <- inv_p > theta out <- rep(Inf, length(inv_p)) if (length(theta)==1) { theta <- rep(theta, length(out)) } zeroThetaInd = uncured & theta == 0 if (any(zeroThetaInd)) { # If no cure then just use base qfun out[zeroThetaInd] <- do.call(qfun, append(list(inv_p[zeroThetaInd]), args)) } else { # Calculations below are meant to map the quantile distribution of the base # distribution to the quantile distribution of the cure model using the # following algebra: # # S(t) = theta ^ (1 - Su(t)) # ln[S(t)] = ln[theta ^ (1 - Su(t))] # ln[S(t)] = (1 - Su(t)) * ln[theta] # ln[S(t)] / ln[theta] = 1 - Su(t) # Su(t) = 1 - ln[S(t)] / ln[theta] # # Where Su(t) is the baseline survival distribution p_surv_to_lookup <- 1 - (log(inv_p) / log(theta)) out[uncured] <- do.call(qfun, append(list(p_surv_to_lookup), args))[uncured] } return(out) } ##' @export ##' @rdname nmixsurv rnmixsurv = function(qfun, n, theta, ...) { # Plug random uniform into quantile function out <- qnmixsurv(qfun, runif(n = n), theta, ...) return(out) } ##' @export ##' @rdname nmixsurv rmst_nmixsurv = function(pfun, t, theta, ...) { args <- list(...) out <- do.call( rmst_generic, append( list( function(q, ...) pnmixsurv(pfun, q, ...), t = t, theta = theta ), args ) ) return(out) } ##' @export ##' @rdname nmixsurv mean_nmixsurv = function(pfun, theta, ...) { # This is a very silly function because if theta is greater # than zero then the mean is infinite and if theta is zero # then the mean is zero. Still need to have it since all # flexsurv models should support getting means through # summary.flexsurv. # Put together arguments for call to rmst_generic args <- append( list( pfun, t = Inf, start = 0 ), list(...) ) # Figure out what length the output should be and create # a vector to store result out_length <- get_param_length_and_check(theta, args) out <- numeric(length(out_length)) # Identify indices where mean survival will be infinite # cure fraction is > 0. inf_indices <- (theta > 0) & rep(T, out_length) out[inf_indices] <- Inf out[!inf_indices] <- 0 out } flexsurvcure/R/mixture.r0000644000176200001440000001207614753456173015115 0ustar liggesusers##' Mixture cure models ##' ##' Probability density, distribution, quantile, random generation, hazard ##' cumulative hazard, mean, and restricted mean functions for generic ##' mixture cure models. These distribution functions take as arguments ##' the corresponding functions of the base distribution used. ##' ##' @aliases dmixsurv pmixsurv qmixsurv rmixsurv ##' hmixsurv Hmixsurv mean_mixsurv rmst_mixsurv ##' @param pfun The base distribution's cumulative distribution function. ##' @param dfun The base distribution's probability density function. ##' @param qfun The base distribution's quantile function. ##' @param x,q,t Vector of times. ##' @param p Vector of probabilities. ##' @param n Number of random numbers to simulate. ##' @param theta The estimated cure fraction. ##' @param ... additional parameters to be passed to the pdf or cdf of the base ##' distribution. ##' @return \code{dmixsurv} gives the density, \code{pmixsurv} gives the ##' distribution function, \code{hmixsurv} gives the hazard and ##' \code{Hmixsurv} gives the cumulative hazard. ##' ##' \code{qmixsurv} gives the quantile function, which is computed by crude ##' numerical inversion. ##' ##' \code{rmixsurv} generates random survival times by using \code{qmixsurv} ##' on a sample of uniform random numbers. Due to the numerical root-finding ##' involved in \code{qmixsurv}, it is slow compared to typical random number ##' generation functions. ##' ##' \code{mean_mixsurv} and \code{rmst_mixsurv} give the mean and restricted ##' mean survival times, respectively. ##' @author Jordan Amdahl ##' @keywords distribution ##' @name mixsurv NULL ##' @export ##' @rdname mixsurv pmixsurv = function(pfun, q, theta, ...) { dots <- list(...) args <- dots args$lower.tail <- F args$log.p <- F out <- theta + (1 - theta) * do.call(pfun, append(list(q), args)) if (is.null(dots$lower.tail) || dots$lower.tail) { pos_inf <- is.infinite(q) & (q > 0) out[pos_inf] <- 0 out <- 1 - out } if (!is.null(dots$log.p) && dots$log.p) { out <- log(out) } return(out) } ##' @export ##' @rdname mixsurv hmixsurv = function(dfun, pfun, x, theta, ...) { dots <- list(...) pargs <- dots pargs$lower.tail <- F pargs$log.p <- F pargs$log <- NULL dargs <- dots dargs$log <- F u_surv <- do.call(pfun, append(list(x), pargs)) u_pdf <- do.call(dfun, append(list(x), dargs)) out <- ((1 - theta) * u_pdf) / (theta + (1 - theta) * u_surv) if (!is.null(dots$log) && dots$log) { out <- log(out) } return(out) } ##' @export ##' @rdname mixsurv Hmixsurv = function(pfun, x, theta, ...) { dots <- list(...) pargs <- dots pargs$lower.tail <- F pargs$log.p <- F pargs$log <- NULL surv <- do.call(pmixsurv, append(list(pfun, x, theta), pargs)) out <- -log(surv) if (!is.null(dots$log) && dots$log) { out <- log(out) } return(out) } ##' @export ##' @rdname mixsurv dmixsurv = function(dfun, pfun, x, theta, ...) { dots <- list(...) pargs <- dots pargs$lower.tail <- F pargs$log.p <- F pargs$log <- NULL hargs <- dots hargs$log <- F u_surv <- do.call(pmixsurv, append(list(pfun, x, theta), pargs)) u_haz <- do.call(hmixsurv, append(list(dfun, pfun, x, theta), hargs)) out <- u_surv * u_haz if (!is.null(dots$log) && dots$log) { out <- log(out) } return(out) } ##' @export ##' @rdname mixsurv qmixsurv = function(qfun, p, theta, ...) { inv_p <- 1 - p dots <- list(...) args <- dots args$lower.tail <- F args$log.p <- F uncured <- inv_p > theta out <- rep(Inf, length(inv_p)) out[uncured] <- do.call(qfun, append(list(pmax((inv_p - theta) / (1 - theta),0)), args))[uncured] return(out) } ##' @export ##' @rdname mixsurv rmixsurv = function(qfun, n, theta, ...) { # Plug random uniform into quantile function out <- qmixsurv(qfun, runif(n = n), theta, ...) return(out) } ##' @export ##' @rdname mixsurv rmst_mixsurv = function(pfun, t, theta, ...) { args <- list(...) out <- do.call( rmst_generic, append( list( function(q, ...) pmixsurv(pfun, q, ...), t = t, theta = theta ), args ) ) return(out) } ##' @export ##' @rdname mixsurv mean_mixsurv = function(pfun, theta, ...) { # Put together arguments for call to rmst_generic args <- append( list( pfun, t = Inf, start = 0 ), list(...) ) # Figure out what length the output should be and create # a vector to store result out_length <- get_param_length_and_check(theta, args) out <- numeric(length(out_length)) # Identify indices where mean survival will be infinite # cure fraction is > 0. inf_indices <- (theta > 0) & rep(T, out_length) out[inf_indices] <- Inf # Create arguments to call rmst_generic to estimate mean # for indices where cure fraction is zero. non_inf_args <- lapply(args, function(x) { # Handle x is length 1 and shouldn't be indexed on if (length(x) == 1) { return(x) } return(x[!inf_indices]) }) # Set output for indices where theta is zero non_inf_res <- do.call(rmst_generic, non_inf_args) out[!inf_indices] <- non_inf_res out } flexsurvcure/vignettes/0000755000176200001440000000000014754045551015031 5ustar liggesusersflexsurvcure/vignettes/flexsurvcure.Rmd0000644000176200001440000000437514252754560020243 0ustar liggesusers--- title: "Parametric Cure Models" author: "Jordan Amdahl" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Parametric Cure Models} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- # Introduction Parametric cure models are a type of parametric survival model model in which it is assumed that there are a proportion of subjects who will not experience the event. In a mixture cure model, these 'cured' and 'uncured' subjects are modeled separately, with the cured individuals subject to no excess risk and the uncured individuals subject to excess risk modeled using a parametric survival distribution. In a non-mixture model, a parametric survival distribution is scaled such that survival asymptotically approaches the cure fraction. # Mixture Cure Model The following code fits a mixture cure model to the `bc` dataset from `flexsurv` using a Weibull distribution and a logistic link function for the cure fraction: ```{r, warning=FALSE, message=FALSE} library(flexsurvcure) cure_model <- flexsurvcure(Surv(rectime, censrec)~group, data=bc, link="logistic", dist="weibullPH", mixture=T) print(cure_model) ``` Model results can be displayed graphically using the `plot` S3 method: ```{r, warning=FALSE, message=FALSE} plot(cure_model) ``` Predicted survival probabilities can also be generated using the `summary` S3 method: ```{r, warning=FALSE, message=FALSE} summary(cure_model, t=seq(from=0,to=3000,by=1000), type="survival", tidy=T) ``` More complex models may be fitted by adding covariates to the parametric distribution used to model the uncured individuals. This is done by passing a list of formula, named according to the parameters affected, through the anc argument: ```{r, warning=FALSE, message=FALSE} cure_model_complex <- flexsurvcure(Surv(rectime, censrec)~group, data=bc, link="logistic", dist="weibullPH", mixture=T, anc=list(scale=~group)) print(cure_model_complex) plot(cure_model_complex) ``` # Non-Mixture Cure Model Non-mixture cure models can be fit by passing `mixture=FALSE` to `flexsurvcure`: ```{r, warning=FALSE, message=FALSE} library(flexsurvcure) cure_model_nmix <- flexsurvcure(Surv(rectime, censrec)~group, data=bc, link="loglog", dist="weibullPH", mixture=F) print(cure_model_nmix) ``` flexsurvcure/NAMESPACE0000644000176200001440000000120314252775725014242 0ustar liggesusers# Generated by roxygen2: do not edit by hand export(Hmixsurv) export(Hnmixsurv) export(dmixsurv) export(dnmixsurv) export(flexsurvcure) export(hmixsurv) export(hnmixsurv) export(mean_mixsurv) export(mean_nmixsurv) export(pmixsurv) export(pnmixsurv) export(qmixsurv) export(qnmixsurv) export(rmixsurv) export(rmst_mixsurv) export(rmst_nmixsurv) export(rnmixsurv) import(flexsurv) import(survival) importFrom(boot,inv.logit) importFrom(boot,logit) importFrom(flexsurv,flexsurv.dists) importFrom(flexsurv,flexsurvreg) importFrom(stats,pnorm) importFrom(stats,qnorm) importFrom(stats,runif) importFrom(survival,Surv) importFrom(survival,survfit) flexsurvcure/NEWS.md0000644000176200001440000000171414753456437014132 0ustar liggesusers# flexsurvcure 1.3.3 - Fixes issue with quantile function generation that led to incorrect results when generating quantiles through summary.flexsurvreg # flexsurvcure 1.3.2 - Fixes issue with incompatible vector length in quantile functions # flexsurvcure 1.3.1 - Fixes bug where wrong function was used in quantile calculations for summary.flexsurvreg - Fixes issue with vectorization of quantile functions # flexsurvcure 1.3.0 - Updated to include vectorized versions of mean_mixsurv and mean_nmixsurv # flexsurvcure 1.2.0 - Changed p function to satisfy convention that p function is P[X <= x] when lower.tail=TRUE, rather than P[X < x] - Adds random sampling function to object returned by flexsurvcure # flexsurvcure 1.1.0 - Added probit link option # flexsurvcure 1.0.0 - Fixes and performance improvements to quantile & random generation functions # flexsurvcure 0.0.2 - Fixes to cumulative hazard and RMST functions # flexsurvcure 0.0.1 - Initial release flexsurvcure/inst/0000755000176200001440000000000014754045551013776 5ustar liggesusersflexsurvcure/inst/doc/0000755000176200001440000000000014754045551014543 5ustar liggesusersflexsurvcure/inst/doc/flexsurvcure.R0000644000176200001440000000176214754045551017431 0ustar liggesusers## ----warning=FALSE, message=FALSE--------------------------------------------- library(flexsurvcure) cure_model <- flexsurvcure(Surv(rectime, censrec)~group, data=bc, link="logistic", dist="weibullPH", mixture=T) print(cure_model) ## ----warning=FALSE, message=FALSE--------------------------------------------- plot(cure_model) ## ----warning=FALSE, message=FALSE--------------------------------------------- summary(cure_model, t=seq(from=0,to=3000,by=1000), type="survival", tidy=T) ## ----warning=FALSE, message=FALSE--------------------------------------------- cure_model_complex <- flexsurvcure(Surv(rectime, censrec)~group, data=bc, link="logistic", dist="weibullPH", mixture=T, anc=list(scale=~group)) print(cure_model_complex) plot(cure_model_complex) ## ----warning=FALSE, message=FALSE--------------------------------------------- library(flexsurvcure) cure_model_nmix <- flexsurvcure(Surv(rectime, censrec)~group, data=bc, link="loglog", dist="weibullPH", mixture=F) print(cure_model_nmix) flexsurvcure/inst/doc/flexsurvcure.html0000644000176200001440000016055614754045551020203 0ustar liggesusers Parametric Cure Models

Parametric Cure Models

Jordan Amdahl

2025-02-15

Introduction

Parametric cure models are a type of parametric survival model model in which it is assumed that there are a proportion of subjects who will not experience the event. In a mixture cure model, these ‘cured’ and ‘uncured’ subjects are modeled separately, with the cured individuals subject to no excess risk and the uncured individuals subject to excess risk modeled using a parametric survival distribution. In a non-mixture model, a parametric survival distribution is scaled such that survival asymptotically approaches the cure fraction.

Mixture Cure Model

The following code fits a mixture cure model to the bc dataset from flexsurv using a Weibull distribution and a logistic link function for the cure fraction:

library(flexsurvcure)
cure_model <- flexsurvcure(Surv(rectime, censrec)~group, data=bc, link="logistic", dist="weibullPH", mixture=T)
print(cure_model)
## Call:
## flexsurvcure(formula = Surv(rectime, censrec) ~ group, data = bc, 
##     dist = "weibullPH", link = "logistic", mixture = T)
## 
## Estimates: 
##              data mean  est        L95%       U95%       se         exp(est) 
## theta               NA   6.73e-01   5.84e-01   7.52e-01         NA         NA
## shape               NA   1.55e+00   1.38e+00   1.74e+00   9.07e-02         NA
## scale               NA   1.61e-05   5.10e-06   5.11e-05   9.50e-06         NA
## groupMedium   3.34e-01  -1.23e+00  -1.74e+00  -7.09e-01   2.64e-01   2.93e-01
## groupPoor     3.32e-01  -3.48e+00  -5.56e+00  -1.40e+00   1.06e+00   3.08e-02
##              L95%       U95%     
## theta               NA         NA
## shape               NA         NA
## scale               NA         NA
## groupMedium   1.75e-01   4.92e-01
## groupPoor     3.85e-03   2.47e-01
## 
## N = 686,  Events: 299,  Censored: 387
## Total time at risk: 771400
## Log-likelihood = -2580.012, df = 5
## AIC = 5170.025

Model results can be displayed graphically using the plot S3 method:

plot(cure_model)

Predicted survival probabilities can also be generated using the summary S3 method:

summary(cure_model, t=seq(from=0,to=3000,by=1000), type="survival", tidy=T)
##    time        est        lcl       ucl  group
## 1     0 1.00000000 1.00000000 1.0000000   Good
## 2  1000 0.83251996 0.78899137 0.8689163   Good
## 3  2000 0.71313032 0.64543914 0.7740272   Good
## 4  3000 0.67959584 0.59539163 0.7487667   Good
## 5     0 1.00000000 1.00000000 1.0000000 Medium
## 6  1000 0.68057306 0.62844495 0.7247046 Medium
## 7  2000 0.45286672 0.38363593 0.5287801 Medium
## 8  3000 0.38890796 0.30239122 0.4878845 Medium
## 9     0 1.00000000 1.00000000 1.0000000   Poor
## 10 1000 0.51803653 0.46475351 0.6308191   Poor
## 11 2000 0.17446456 0.12701669 0.4161586   Poor
## 12 3000 0.07796116 0.03824658 0.3797724   Poor

More complex models may be fitted by adding covariates to the parametric distribution used to model the uncured individuals. This is done by passing a list of formula, named according to the parameters affected, through the anc argument:

cure_model_complex <- flexsurvcure(Surv(rectime, censrec)~group, data=bc, link="logistic", dist="weibullPH", mixture=T, anc=list(scale=~group))
print(cure_model_complex)
## Call:
## flexsurvcure(formula = Surv(rectime, censrec) ~ group, data = bc, 
##     dist = "weibullPH", link = "logistic", mixture = T, anc = list(scale = ~group))
## 
## Estimates: 
##                     data mean  est        L95%       U95%       se       
## theta                      NA   2.62e-02   1.91e-02   3.59e-02         NA
## shape                      NA   1.49e+00   1.35e+00   1.65e+00   7.69e-02
## scale                      NA   4.65e-06   1.48e-06   1.46e-05   2.72e-06
## groupMedium          3.34e-01  -1.78e+00  -1.79e+00  -1.77e+00   4.39e-03
## groupPoor            3.32e-01   2.07e+00   1.76e+00   2.39e+00   1.61e-01
## scale(groupMedium)   3.34e-01   8.29e-01   4.92e-01   1.17e+00   1.72e-01
## scale(groupPoor)     3.32e-01   2.11e+00   1.71e+00   2.51e+00   2.03e-01
##                     exp(est)   L95%       U95%     
## theta                      NA         NA         NA
## shape                      NA         NA         NA
## scale                      NA         NA         NA
## groupMedium          1.69e-01   1.68e-01   1.71e-01
## groupPoor            7.96e+00   5.81e+00   1.09e+01
## scale(groupMedium)   2.29e+00   1.64e+00   3.21e+00
## scale(groupPoor)     8.22e+00   5.52e+00   1.22e+01
## 
## N = 686,  Events: 299,  Censored: 387
## Total time at risk: 771400
## Log-likelihood = -2571.857, df = 7
## AIC = 5157.713
plot(cure_model_complex)

Non-Mixture Cure Model

Non-mixture cure models can be fit by passing mixture=FALSE to flexsurvcure:

library(flexsurvcure)
cure_model_nmix <- flexsurvcure(Surv(rectime, censrec)~group, data=bc, link="loglog", dist="weibullPH", mixture=F)
print(cure_model_nmix)
## Call:
## flexsurvcure(formula = Surv(rectime, censrec) ~ group, data = bc, 
##     dist = "weibullPH", link = "loglog", mixture = F)
## 
## Estimates: 
##              data mean  est       L95%      U95%      se        exp(est)
## theta              NA   6.35e-01  7.31e-01  5.17e-01        NA        NA
## shape              NA   1.72e+00  1.53e+00  1.92e+00  1.01e-01        NA
## scale              NA   3.07e-06  9.19e-07  1.03e-05  1.89e-06        NA
## groupMedium  3.34e-01   8.35e-01  4.99e-01  1.17e+00  1.71e-01  2.31e+00
## groupPoor    3.32e-01   1.63e+00  1.31e+00  1.95e+00  1.64e-01  5.09e+00
##              L95%      U95%    
## theta              NA        NA
## shape              NA        NA
## scale              NA        NA
## groupMedium  1.65e+00  3.22e+00
## groupPoor    3.69e+00  7.02e+00
## 
## N = 686,  Events: 299,  Censored: 387
## Total time at risk: 771400
## Log-likelihood = -2567.8, df = 5
## AIC = 5145.6
flexsurvcure/inst/doc/flexsurvcure.Rmd0000644000176200001440000000437514252754560017755 0ustar liggesusers--- title: "Parametric Cure Models" author: "Jordan Amdahl" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Parametric Cure Models} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- # Introduction Parametric cure models are a type of parametric survival model model in which it is assumed that there are a proportion of subjects who will not experience the event. In a mixture cure model, these 'cured' and 'uncured' subjects are modeled separately, with the cured individuals subject to no excess risk and the uncured individuals subject to excess risk modeled using a parametric survival distribution. In a non-mixture model, a parametric survival distribution is scaled such that survival asymptotically approaches the cure fraction. # Mixture Cure Model The following code fits a mixture cure model to the `bc` dataset from `flexsurv` using a Weibull distribution and a logistic link function for the cure fraction: ```{r, warning=FALSE, message=FALSE} library(flexsurvcure) cure_model <- flexsurvcure(Surv(rectime, censrec)~group, data=bc, link="logistic", dist="weibullPH", mixture=T) print(cure_model) ``` Model results can be displayed graphically using the `plot` S3 method: ```{r, warning=FALSE, message=FALSE} plot(cure_model) ``` Predicted survival probabilities can also be generated using the `summary` S3 method: ```{r, warning=FALSE, message=FALSE} summary(cure_model, t=seq(from=0,to=3000,by=1000), type="survival", tidy=T) ``` More complex models may be fitted by adding covariates to the parametric distribution used to model the uncured individuals. This is done by passing a list of formula, named according to the parameters affected, through the anc argument: ```{r, warning=FALSE, message=FALSE} cure_model_complex <- flexsurvcure(Surv(rectime, censrec)~group, data=bc, link="logistic", dist="weibullPH", mixture=T, anc=list(scale=~group)) print(cure_model_complex) plot(cure_model_complex) ``` # Non-Mixture Cure Model Non-mixture cure models can be fit by passing `mixture=FALSE` to `flexsurvcure`: ```{r, warning=FALSE, message=FALSE} library(flexsurvcure) cure_model_nmix <- flexsurvcure(Surv(rectime, censrec)~group, data=bc, link="loglog", dist="weibullPH", mixture=F) print(cure_model_nmix) ``` flexsurvcure/build/0000755000176200001440000000000014754045551014120 5ustar liggesusersflexsurvcure/build/vignette.rds0000644000176200001440000000033114754045551016454 0ustar liggesusersb```b`aab`b2 1# 'ZQ\ZT\Z&/XZR TSJŔ4|% #YVZ]?4-ީE0=(jؠjX2sRad9.nP&c0Gq?gQ~Xhݣ9JI,IK; flexsurvcure/man/0000755000176200001440000000000014252754560013574 5ustar liggesusersflexsurvcure/man/flexsurvcure.Rd0000644000176200001440000001027714754042507016625 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flexsurvcure.R \name{flexsurvcure} \alias{flexsurvcure} \title{Mixture and Non-Mixture Parametric Cure Models} \usage{ flexsurvcure( formula, data, weights, bhazard, subset, dist, na.action, link = "logistic", mixture = T, ... ) } \arguments{ \item{formula}{A formula expression in conventional R linear modeling syntax. The response must be a survival object as returned by the \code{\link[survival:Surv]{survival::Surv()}} function, and any covariates are given on the right-hand side. For example, \code{Surv(time, dead) ~ age + sex} \code{Surv} objects of \code{type="right"},\code{"counting"}, \code{"interval1"} or \code{"interval2"} are supported, corresponding to right-censored, left-truncated or interval-censored observations. If there are no covariates, specify \code{1} on the right hand side, for example \code{Surv(time, dead) ~ 1}. By default, covariates are placed on the ``theta'' parameter of the distribution, representing the cure fraction, through a linear model with the selected link function. Covariates can be placed on parameters of the base distribution by using the name of the parameter as a ``function'' in the formula. For example, in a Weibull model, the following expresses the scale parameter in terms of age and a treatment variable \code{treat}, and the shape parameter in terms of sex and treatment. \code{Surv(time, dead) ~ age + treat + shape(sex) + shape(treat)} However, if the names of the ancillary parameters clash with any real functions that might be used in formulae (such as \code{I()}, or \code{factor()}), then those functions will not work in the formula. A safer way to model covariates on ancillary parameters is through the \code{anc} argument to \code{\link[flexsurv:flexsurvreg]{flexsurv::flexsurvreg}}. \code{\link[survival:survreg]{survival::survreg()}} users should also note that the function \code{strata()} is ignored, so that any covariates surrounded by \code{strata()} are applied to the location parameter.} \item{data}{A data frame in which to find variables supplied in \code{formula}. If not given, the variables should be in the working environment.} \item{weights}{Optional variable giving case weights.} \item{bhazard}{Optional variable giving expected hazards for relative survival models.} \item{subset}{Vector of integers or logicals specifying the subset of the observations to be used in the fit.} \item{dist}{A string representing one of the built-in distributions of flexsurv. \code{Surv(time, dead) ~ age + treat, anc = list(shape = ~ sex + treat)}} \item{na.action}{a missing-data filter function, applied after any 'subset' argument has been used. Default is \code{options()$na.action}.} \item{link}{A string representing the link function to use for estimation of the cure fraction. Defaults to "logistic", but also supports "loglog", "probit", and "identity".} \item{mixture}{optional TRUE/FALSE to specify whether a mixture model should be fitted. Defaults to TRUE.} \item{...}{other arguments to be passed to \code{\link[flexsurv:flexsurvreg]{flexsurv::flexsurvreg}}.} } \description{ Mixture and non-mixture cure models using flexible base distributions from the flexsurv package. } \details{ This function works as a wrapper around \code{\link[flexsurv:flexsurvreg]{flexsurv::flexsurvreg()}} by dynamically constructing a custom distribution using wrappers to the pdf and cdf functions. In a parametric mixture model, it is assumed that there exists a group of individuals who experience no excess mortality, with the proportion of such individuals being given by the cure fraction parameter, and a parametric distribution representing the excess mortality for the remaining individuals. By contrast, a parametric non-mixture model simply rescales an existing parametric distribution such that the probability of survival asymptotically approaches the cure fraction parameter as time approaches infinity. } \examples{ flexsurvcure(Surv(rectime,censrec)~group, data=bc, dist="weibull", anc=list(scale=~group)) flexsurvcure(Surv(rectime,censrec)~group, data=bc, dist="lnorm", mixture = FALSE) flexsurvcure(Surv(rectime,censrec)~group, data=bc, dist="weibull", link="loglog") } flexsurvcure/man/mixsurv.Rd0000644000176200001440000000372414252754560015606 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mixture.r \name{mixsurv} \alias{mixsurv} \alias{dmixsurv} \alias{pmixsurv} \alias{qmixsurv} \alias{rmixsurv} \alias{hmixsurv} \alias{Hmixsurv} \alias{mean_mixsurv} \alias{rmst_mixsurv} \title{Mixture cure models} \usage{ pmixsurv(pfun, q, theta, ...) hmixsurv(dfun, pfun, x, theta, ...) Hmixsurv(pfun, x, theta, ...) dmixsurv(dfun, pfun, x, theta, ...) qmixsurv(qfun, p, theta, ...) rmixsurv(qfun, n, theta, ...) rmst_mixsurv(pfun, t, theta, ...) mean_mixsurv(pfun, theta, ...) } \arguments{ \item{pfun}{The base distribution's cumulative distribution function.} \item{theta}{The estimated cure fraction.} \item{...}{additional parameters to be passed to the pdf or cdf of the base distribution.} \item{dfun}{The base distribution's probability density function.} \item{x, q, t}{Vector of times.} \item{qfun}{The base distribution's quantile function.} \item{p}{Vector of probabilities.} \item{n}{Number of random numbers to simulate.} } \value{ \code{dmixsurv} gives the density, \code{pmixsurv} gives the distribution function, \code{hmixsurv} gives the hazard and \code{Hmixsurv} gives the cumulative hazard. \code{qmixsurv} gives the quantile function, which is computed by crude numerical inversion. \code{rmixsurv} generates random survival times by using \code{qmixsurv} on a sample of uniform random numbers. Due to the numerical root-finding involved in \code{qmixsurv}, it is slow compared to typical random number generation functions. \code{mean_mixsurv} and \code{rmst_mixsurv} give the mean and restricted mean survival times, respectively. } \description{ Probability density, distribution, quantile, random generation, hazard cumulative hazard, mean, and restricted mean functions for generic mixture cure models. These distribution functions take as arguments the corresponding functions of the base distribution used. } \author{ Jordan Amdahl } \keyword{distribution} flexsurvcure/man/nmixsurv.Rd0000644000176200001440000000412114252754560015754 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/nonmixture.R \name{nmixsurv} \alias{nmixsurv} \alias{pnmixsurv} \alias{hnmixsurv} \alias{Hnmixsurv} \alias{dnmixsurv} \alias{qnmixsurv} \alias{rnmixsurv} \alias{rmst_nmixsurv} \alias{mean_nmixsurv} \title{Non-Mixture Cure Models} \usage{ pnmixsurv(pfun, q, theta, ...) hnmixsurv(dfun, x, theta, ...) Hnmixsurv(pfun, x, theta, ...) dnmixsurv(dfun, pfun, x, theta, ...) qnmixsurv(qfun, p, theta, ...) rnmixsurv(qfun, n, theta, ...) rmst_nmixsurv(pfun, t, theta, ...) mean_nmixsurv(pfun, theta, ...) } \arguments{ \item{pfun}{The base distribution's cumulative distribution function.} \item{theta}{The estimated cure fraction.} \item{...}{Parameters to be passed to the pdf or cdf of the base distribution.} \item{dfun}{The base distribution's probability density function.} \item{x, q, t}{Vector of times.} \item{qfun}{The base distribution's quantile function.} \item{p}{Vector of probabilities.} \item{n}{Number of random numbers to simulate.} } \value{ \code{dnmixsurv} gives the density, \code{pnmixsurv} gives the distribution function, \code{hnmixsurv} gives the hazard and \code{Hnmixsurv} gives the cumulative hazard. \code{qnmixsurv} gives the quantile function, which is computed by crude numerical inversion. \code{rnmixsurv} generates random survival times by using \code{qnmixsurv} on a sample of uniform random numbers. Due to the numerical root-finding involved in \code{qnmixsurv}, it is slow compared to typical random number generation functions. \code{mean_nmixsurv} and \code{rmst_nmixsurv} give the mean and restricted mean survival times, respectively. } \description{ Probability density, distribution, quantile, random generation, hazard cumulative hazard, mean, and restricted mean functions for generic non-mixture cure models. These distribution functions take as arguments the corresponding functions of the base distribution used. } \details{ es dnmixsurv pnmixsurv qnmixsurv rnmixsurv hnmixsurv Hnmixsurv mean_nmixsurv rmst_nmixsurv } \author{ Jordan Amdahl } \keyword{distribution} flexsurvcure/DESCRIPTION0000644000176200001440000000136014754051342014522 0ustar liggesusersPackage: flexsurvcure Title: Flexible Parametric Cure Models Version: 1.3.3 Date: 2025-02-013 Authors@R: person("Jordan", "Amdahl", email = "jrdnmdhl@gmail.com", role = c("aut", "cre")) Maintainer: Jordan Amdahl Description: Flexible parametric mixture and non-mixture cure models for time-to-event data. Depends: survival , flexsurv Suggests: testthat, knitr, rmarkdown, covr URL: https://github.com/jrdnmdhl/flexsurvcure BugReports: https://github.com/jrdnmdhl/flexsurvcure/issues Imports: boot License: GPL (>= 2) Encoding: UTF-8 RoxygenNote: 7.3.1 VignetteBuilder: knitr NeedsCompilation: no Packaged: 2025-02-15 08:08:09 UTC; jamdahl Author: Jordan Amdahl [aut, cre] Repository: CRAN Date/Publication: 2025-02-15 08:40:02 UTC