#' @srrstats {G5.5} *Correctness tests should be run with a fixed random seed* #' @srrstats {G5.6a} *Parameter recovery tests should generally be expected to succeed within a defined tolerance rather than recovering exact values.* #' @srrstats {G5.6} **Parameter recovery tests** *to test that the implementation produce expected results given data with known properties. For instance, a linear regression algorithm should return expected coefficient values for a simulated data set generated from a linear model.* #' @srrstats {G5.9} **Noise susceptibility tests** *Packages should test for expected stochastic behaviour, such as through the following conditions:* #' @srrstats {G5.9a} *Adding trivial noise (for example, at the scale of `.Machine$double.eps`) to data does not meaningfully change results* test_that("cv_cureem function works correctly", { library(survival) withr::local_seed(1234) temp <- generate_cure_data(n = 200, j = 25, n_true = 5, a = 1.8) training <- temp$training fit.cv <- cv_cureem(Surv(Time, Censor) ~ ., data = training, x_latency = training, fdr_control = FALSE, grid_tuning = FALSE, nlambda_inc = 10, nlambda_lat = 10, n_folds = 2, seed = 23, verbose = FALSE ) fit.cv %>% expect_s3_class("mixturecure") expect_setequal(names(fit.cv), c("b0", "b", "beta", "logLik.inc", "logLik.lat", "selected_lambda_inc", "selected_lambda_lat", "max_c", "method", "model", "penalty", "cv", "y", "x_incidence", "x_latency", "scale", "call", "fdr_control")) fit.cv$b0 %>% expect_type("double") fit.cv$b %>% expect_type("double") fit.cv$beta %>% expect_type("double") fit.cv$logLik.inc %>% expect_type("double") fit.cv$logLik.lat %>% expect_type("double") fit.cv$selected_lambda_inc %>% expect_type("double") fit.cv$selected_lambda_lat %>% expect_type("double") fit.cv$max_c %>% expect_type("double") fit.cv$x_incidence %>% expect_type("double") fit.cv$x_latency %>% expect_type("double") fit.cv$y %>% expect_type("double") fit.cv$model %>% expect_type("character") fit.cv$scale %>% expect_type("logical") fit.cv$method %>% expect_type("character") fit.cv$penalty %>% expect_type("character") fit.cv$cv %>% expect_type("logical") fit.cv$fdr_control %>% expect_type("logical") fit.cv$call %>% expect_type("language") fit.cv$b %>% expect_length(dim(fit.cv$x_incidence)[2]) fit.cv$beta %>% expect_length(dim(fit.cv$x_latency)[2]) fit.cv$b0 %>% expect_length(1) fit.cv.exp <- cv_cureem(Surv(Time, Censor) ~ ., data = training, model = "exponential", x_latency = training, fdr_control = FALSE, grid_tuning = FALSE, nlambda_inc = 10, nlambda_lat = 10, n_folds = 2, seed = 23, verbose = FALSE ) fit.cv.exp %>% expect_s3_class("mixturecure") expect_setequal(names(fit.cv.exp), c("b0", "b", "beta", "rate", "logLik.inc", "logLik.lat", "selected_lambda_inc", "selected_lambda_lat", "max_c", "method", "model", "penalty", "cv", "y", "x_incidence", "x_latency", "scale", "call", "fdr_control")) fit.cv.exp$b0 %>% expect_type("double") fit.cv.exp$b %>% expect_type("double") fit.cv.exp$beta %>% expect_type("double") fit.cv.exp$rate %>% expect_type("double") fit.cv.exp$logLik.inc %>% expect_type("double") fit.cv.exp$logLik.lat %>% expect_type("double") fit.cv.exp$selected_lambda_inc %>% expect_type("double") fit.cv.exp$selected_lambda_lat %>% expect_type("double") fit.cv.exp$max_c %>% expect_type("double") fit.cv.exp$x_incidence %>% expect_type("double") fit.cv.exp$x_latency %>% expect_type("double") fit.cv.exp$y %>% expect_type("double") fit.cv.exp$model %>% expect_type("character") fit.cv.exp$scale %>% expect_type("logical") fit.cv.exp$method %>% expect_type("character") fit.cv.exp$penalty %>% expect_type("character") fit.cv.exp$cv %>% expect_type("logical") fit.cv.exp$fdr_control %>% expect_type("logical") fit.cv.exp$call %>% expect_type("language") fit.cv.exp$b %>% expect_length(dim(fit.cv$x_incidence)[2]) fit.cv.exp$beta %>% expect_length(dim(fit.cv$x_latency)[2]) fit.cv.exp$b0 %>% expect_length(1) fit.cv.exp$rate %>% expect_length(1) fit.cv.wei <- cv_cureem(Surv(Time, Censor) ~ ., data = training, model = "weibull", measure_inc = "auc", x_latency = training, fdr_control = FALSE, grid_tuning = FALSE, nlambda_inc = 10, nlambda_lat = 10, n_folds = 2, seed = 23, verbose = FALSE ) fit.cv.wei %>% expect_s3_class("mixturecure") expect_setequal(names(fit.cv.wei), c("b0", "b", "beta", "rate", "alpha", "logLik.inc", "logLik.lat", "selected_lambda_inc", "selected_lambda_lat", "max_c", "max.auc", "method", "model", "penalty", "cv", "y", "x_incidence", "x_latency", "scale", "call", "fdr_control")) fit.cv.wei$b0 %>% expect_type("double") fit.cv.wei$b %>% expect_type("double") fit.cv.wei$beta %>% expect_type("double") fit.cv.wei$rate %>% expect_type("double") fit.cv.wei$alpha %>% expect_type("double") fit.cv.wei$logLik.inc %>% expect_type("double") fit.cv.wei$logLik.lat %>% expect_type("double") fit.cv.wei$selected_lambda_inc %>% expect_type("double") fit.cv.wei$selected_lambda_lat %>% expect_type("double") fit.cv.wei$max_c %>% expect_type("double") fit.cv.wei$max.auc %>% expect_type("double") fit.cv.wei$x_incidence %>% expect_type("double") fit.cv.wei$x_latency %>% expect_type("double") fit.cv.wei$y %>% expect_type("double") fit.cv.wei$model %>% expect_type("character") fit.cv.wei$scale %>% expect_type("logical") fit.cv.wei$method %>% expect_type("character") fit.cv.wei$penalty %>% expect_type("character") fit.cv.wei$cv %>% expect_type("logical") fit.cv.wei$fdr_control %>% expect_type("logical") fit.cv.wei$call %>% expect_type("language") fit.cv.wei$b %>% expect_length(dim(fit.cv$x_incidence)[2]) fit.cv.wei$beta %>% expect_length(dim(fit.cv$x_latency)[2]) fit.cv.wei$b0 %>% expect_length(1) fit.cv.wei$rate %>% expect_length(1) fit.cv.wei$alpha %>% expect_length(1) fit.cv.wei$max.auc %>% expect_length(1) fit.cv.wei <- cv_cureem(Surv(Time, Censor) ~ ., data = training, model = "weibull", x_latency = training, fdr_control = FALSE, grid_tuning = FALSE, nlambda_inc = 10, nlambda_lat = 10, n_folds = 2, seed = 23, verbose = FALSE ) fit.cv.wei %>% expect_s3_class("mixturecure") expect_setequal(names(fit.cv.wei), c("b0", "b", "beta", "rate", "alpha", "logLik.inc", "logLik.lat", "selected_lambda_inc", "selected_lambda_lat", "max_c", "method", "model", "penalty", "cv", "y", "x_incidence", "x_latency", "scale", "call", "fdr_control")) fit.cv.wei$b0 %>% expect_type("double") fit.cv.wei$b %>% expect_type("double") fit.cv.wei$beta %>% expect_type("double") fit.cv.wei$rate %>% expect_type("double") fit.cv.wei$alpha %>% expect_type("double") fit.cv.wei$logLik.inc %>% expect_type("double") fit.cv.wei$logLik.lat %>% expect_type("double") fit.cv.wei$selected_lambda_inc %>% expect_type("double") fit.cv.wei$selected_lambda_lat %>% expect_type("double") fit.cv.wei$max_c %>% expect_type("double") fit.cv.wei$x_incidence %>% expect_type("double") fit.cv.wei$x_latency %>% expect_type("double") fit.cv.wei$y %>% expect_type("double") fit.cv.wei$model %>% expect_type("character") fit.cv.wei$scale %>% expect_type("logical") fit.cv.wei$method %>% expect_type("character") fit.cv.wei$penalty %>% expect_type("character") fit.cv.wei$cv %>% expect_type("logical") fit.cv.wei$fdr_control %>% expect_type("logical") fit.cv.wei$call %>% expect_type("language") fit.cv.wei$b %>% expect_length(dim(fit.cv$x_incidence)[2]) fit.cv.wei$beta %>% expect_length(dim(fit.cv$x_latency)[2]) fit.cv.wei$b0 %>% expect_length(1) fit.cv.wei$rate %>% expect_length(1) fit.cv.wei$alpha %>% expect_length(1) fit.cv.fdr <- cv_cureem(Surv(Time, Censor) ~ ., data = training, x_latency = training, model = "weibull", penalty = "lasso", fdr_control = TRUE, grid_tuning = FALSE, nlambda_inc = 10, nlambda_lat = 10, n_folds = 2, seed = 23, verbose = TRUE ) fit.cv.fdr %>% expect_s3_class("mixturecure") expect_setequal(names(fit.cv.fdr), c("b0", "b", "beta", "rate", "alpha", "selected_index_inc", "selected_index_lat", "method", "model", "penalty", "cv", "y", "x_incidence", "x_latency", "scale", "call", "fdr_control")) fit.cv.fdr$b0 %>% expect_type("double") fit.cv.fdr$b %>% expect_type("double") fit.cv.fdr$beta %>% expect_type("double") fit.cv.fdr$rate %>% expect_type("double") fit.cv.fdr$alpha %>% expect_type("double") fit.cv$selected_lambda_inc %>% expect_type("double") fit.cv$selected_lambda_lat %>% expect_type("double") fit.cv$x_incidence %>% expect_type("double") fit.cv$x_latency %>% expect_type("double") fit.cv$y %>% expect_type("double") fit.cv$model %>% expect_type("character") fit.cv$scale %>% expect_type("logical") fit.cv$method %>% expect_type("character") fit.cv$penalty %>% expect_type("character") fit.cv$cv %>% expect_type("logical") fit.cv$fdr_control %>% expect_type("logical") fit.cv$call %>% expect_type("language") fit.cv.fdr$b %>% expect_length(dim(fit.cv.fdr$x_incidence)[2]) fit.cv.fdr$beta %>% expect_length(dim(fit.cv.fdr$x_latency)[2]) fit.cv.fdr$b0 %>% expect_length(1) fit.cv.fdr$alpha %>% expect_length(1) fit.cv.fdr$rate %>% expect_length(1) expect_equal(round(fit.cv.fdr$b0, 5), 0.32659) expect_equal(round(fit.cv.fdr$rate, 5), 1.71472) expect_equal(round(fit.cv.fdr$alpha, 6), 0.752908) fit.scad <- cv_cureem(Surv(Time, Censor) ~ ., data = training, x_latency = training, model = "cox", penalty = "SCAD", fdr_control = FALSE, grid_tuning = FALSE, nlambda_inc = 10, nlambda_lat = 10, n_folds = 2, seed = 23, verbose = TRUE ) fit.cv %>% expect_s3_class("mixturecure") expect_setequal(names(fit.cv), c("b0", "b", "beta", "logLik.inc", "logLik.lat", "selected_lambda_inc", "selected_lambda_lat", "max_c", "method", "model", "penalty", "cv", "y", "x_incidence", "x_latency", "scale", "call", "fdr_control")) fit.scad$b0 %>% expect_type("double") fit.scad$b %>% expect_type("double") fit.scad$beta %>% expect_type("double") fit.scad$logLik.inc %>% expect_type("double") fit.scad$logLik.lat %>% expect_type("double") fit.scad$selected_lambda_inc %>% expect_type("double") fit.scad$selected_lambda_lat %>% expect_type("double") fit.scad$max_c %>% expect_type("double") fit.scad$x_incidence %>% expect_type("double") fit.scad$x_latency %>% expect_type("double") fit.scad$y %>% expect_type("double") fit.scad$model %>% expect_type("character") fit.scad$scale %>% expect_type("logical") fit.scad$method %>% expect_type("character") fit.scad$penalty %>% expect_type("character") fit.scad$cv %>% expect_type("logical") fit.scad$fdr_control %>% expect_type("logical") fit.scad$call %>% expect_type("language") fit.scad$b %>% expect_length(dim(fit.cv$x_incidence)[2]) fit.scad$beta %>% expect_length(dim(fit.cv$x_latency)[2]) fit.scad$b0 %>% expect_length(1) expect_error(cv_cureem(Time ~ ., data = training, x_latency = training, model = "cox", penalty = "SCAD")) expect_error(cv_cureem(Censor ~ ., data = training, x_latency = training, model = "cox", penalty = "SCAD")) expect_error(cv_cureem(training$Time)) training$subset_group <- gl(2, 75) training$penalty <- rnorm(dim(training)[1]) expect_error(cv_cureem(Surv(Time, Censor) ~ ., data = training, x_latency = training, subset = subset_group)) expect_error(cv_cureem(Surv(Time, Censor) ~ ., data = training, x_latency = testing)) expect_error(cv_cureem(Surv(Time, Censor) ~ ., data = training, x_latency = training, subset = subset_group)) expect_error(cv_cureem(Surv(Time, Censor) ~ ., data = training, x_latency = training, penalty_factor_inc = penalty)) expect_error(cv_cureem(Surv(Time, Censor) ~ ., data = training, x_latency = training, lambda_inc_list = -1)) expect_error(cv_cureem(Surv(Time, Censor) ~ ., data = training, x_latency = training, lambda_lat_list = -1)) expect_error(cv_cureem(Surv(Time, Censor) ~ ., penalty = "MCP", data = training, x_latency = training, gamma_inc = -1)) expect_error(cv_cureem(Surv(Time, Censor) ~ ., penalty = "MCP", data = training, x_latency = training, gamma_lat = -1)) expect_error(cv_cureem(Surv(Time, Censor) ~ ., data = training, x_latency = training, fdr.control = TRUE, fdr = 1.2)) expect_error(cv_cureem(Surv(Time, Censor) ~ ., data = training, x_latency = training, lambda_min_ratio_inc = 1.3)) expect_error(cv_cureem(Surv(Time, Censor) ~ ., data = training, x_latency = training, lambda_min_ratio_lat = -0.2)) withr::local_seed(26) temp <- generate_cure_data(n = 200, j = 25, n_true = 5, a = 1.8) training <- temp$training fit.cv <- cv_cureem(Surv(Time, Censor) ~ ., data = training, x_latency = training, fdr_control = FALSE, grid_tuning = FALSE, nlambda_inc = 10, nlambda_lat = 10, n_folds = 2, seed = 23, verbose = FALSE ) expect_equal(round(fit.cv$b0, 7), 0.3495074) })