data("exampleData1") Data <- exampleData1[-c(83:138), ] markers <- Data[, -1] status <- factor(Data$group, levels = c("not_needed", "needed")) load("result_data/mayo.rda") Data2 <- mayo[-c(42:119), ] markers2 <- Data2[, 3:4] status2 <- factor(Data2[, 2], levels = c(1, 0)) Data3 <- read.csv( "result_data/wdbc.data.txt", header = FALSE ) Data3 <- Data3[-c(121:262), ] markers3 <- Data3[, 4:5] status3 <- factor(Data3[, 2], levels = c("B", "M")) ############################################################################### load("result_data/test_nonlinComb.rda") for (method in c( "polyreg", "ridgereg" )) { set.seed(14042022) res <- nonlinComb( markers = markers, status = status, event = "needed", method = method, resample = "none", direction = "<", cutoff.method = "Youden" ) test_that("nonlinComb functions ...", { expect_length(res, 15) expect_equal(as.numeric(res$AUC_table$AUC[[3]]), r$AUC[r$Method == method][1], tolerance = 0.01 ) expect_equal(as.numeric(res$DiagStatCombined$detail[4, 2]), r$SPE[r$Method == method][1], tolerance = 0.01 ) expect_equal(as.numeric(res$DiagStatCombined$detail[3, 2]), r$SENS[r$Method == method][1], tolerance = 0.01 ) expect_equal(as.numeric(res$ThresholdCombined), r$Cutoff[r$Method == method][1], tolerance = 0.01 ) }) } ############################################################################### for (method in c( "lassoreg", "elasticreg" )) { set.seed(14042022) res <- nonlinComb( markers = markers2, status = status2, event = "1", method = method, resample = "none", direction = "<", cutoff.method = "Youden" ) test_that("nonlinComb functions ...", { expect_length(res, 15) expect_equal(as.numeric(res$AUC_table$AUC[[3]]), r$AUC[r$Method == method][1], tolerance = 0.01 ) expect_equal(as.numeric(res$DiagStatCombined$detail[4, 2]), r$SPE[r$Method == method][1], tolerance = 0.01 ) expect_equal(as.numeric(res$DiagStatCombined$detail[3, 2]), r$SENS[r$Method == method][1], tolerance = 0.01 ) expect_equal(as.numeric(res$ThresholdCombined), r$Cutoff[r$Method == method][1], tolerance = 0.01 ) }) } ############################################################################### for (method in c( "splines", "sgam", "nsgam" )) { set.seed(14042022) res <- nonlinComb( markers = markers3, status = status3, event = "M", method = method, resample = "none", direction = "<", cutoff.method = "Youden" ) test_that("nonlinComb functions ...", { expect_length(res, 15) expect_equal(as.numeric(res$AUC_table$AUC[[3]]), r$AUC[r$Method == method][1], tolerance = 0.01 ) expect_equal(as.numeric(res$DiagStatCombined$detail[4, 2]), r$SPE[r$Method == method][1], tolerance = 0.01 ) expect_equal(as.numeric(res$DiagStatCombined$detail[3, 2]), r$SENS[r$Method == method][1], tolerance = 0.01 ) expect_equal(as.numeric(res$ThresholdCombined), r$Cutoff[r$Method == method][1], tolerance = 0.01 ) }) } ############################################################################### status4 <- factor(Data3[, 2], levels = c("B", "M", "C")) status4[[9]] <- "C" test_that("nonlinComb functions ...", { expect_error( nonlinComb( markers = Data3[, 4:5], status = status4, event = "M", method = "polyreg", direction = direction, standardize = "zScore", cutoff.method = cutoff.method ), "the number of status levels should be 2" ) expect_error( nonlinComb( markers = Data3[, 4:6], status = status3, event = "M", method = "ridgereg", direction = direction, standardize = "zScore", cutoff.method = cutoff.method ), "the number of markers should be 2" ) }) test_that("nonlinComb functions ...", { expect_error( nonlinComb( markers = markers3, status = status3, event = "M", direction = "<", standardize = "none", cutoff.method = "Youden" ), "method should be one of 'polyreg', 'ridgereg', 'lassoreg', 'elasticreg', 'splines', 'sgam', 'nsgam'" ) expect_error( nonlinComb( markers = markers3, status = status3, event = "M", method = "asaddsa", direction = "auto", standardize = "none", cutoff.method = "Youden" ), "method should be one of 'polyreg', 'ridgereg', 'lassoreg', 'elasticreg', 'splines', 'sgam', 'nsgam'" ) expect_error( nonlinComb( markers = markers3, status = status3, event = "M", method = "ridgereg", direction = "auto", resample = "cv", standardize = "asdada", cutoff.method = "Youden" ), "standardize should be one of 'range', 'zScore', 'tScore', 'mean', 'deviance'" ) expect_error( nonlinComb( markers = markers2, status = status2, event = "1", method = "ridgereg", direction = "asdada", standardize = "none", cutoff.method = "Youden" ), "direction should be one of 'auto', '<', '>'" ) expect_error( nonlinComb( markers = markers2, status = status2, event = "1", method = "lassoreg", direction = "auto", standardize = "tScore", cutoff.method = "sadda" ), "The entered cutoff.method is invalid" ) expect_error( nonlinComb( markers = markers2, status = status2, event = "1", method = "splines", resample = "sada", standardize = "range", direction = "<", cutoff.method = "Youden" ), "resample should be one of 'none', 'cv', 'repeatedcv', 'boot'" ) }) ############################################################################### markers3[44, 1:2] <- "assay" test_that("nonlinComb functions ...", { expect_error( nonlinComb( markers = markers3, status = status3, event = "M", method = "ridgereg", direction = "<", standardize = "zScore", cutoff.method = "Youden" ), "at least one variable is not numeric" ) expect_error( nonlinComb( markers = markers, status = status, event = "C", method = "ridgereg", direction = "<", standardize = "zScore", cutoff.method = "Youden" ), "status does not include event" ) }) ############################################################################### markers3 <- Data3[, 4:5] status3[[12]] <- NA test_that("nonlinComb functions ...", { expect_warning( nonlinComb( markers = markers3, status = status3, event = "M", method = "ridgereg", direction = "<", standardize = "zScore", cutoff.method = "Youden" ), "Rows with NA removed from the dataset since status include NA" ) }) markers3[44, 1:2] <- NA status3 <- factor(Data3[, 2], levels = c("B", "M")) test_that("nonlinComb functions ...", { expect_warning( nonlinComb( markers = markers3, status = status3, event = "M", method = "ridgereg", direction = "<", standardize = "zScore", cutoff.method = "Youden" ), "Rows with NA removed from the dataset since markers include NA" ) })