# Copyright 2025 Observational Health Data Sciences and Informatics # # This file is part of PatientLevelPrediction # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # ================ SETTING TESTINGS test_that("set LR inputs", { # ===================================== # checking Logistic Regression # ===================================== model_set <- setLassoLogisticRegression() expect_s3_class(model_set, "modelSettings") expect_equal(model_set$fitFunction, "fitCyclopsModel") expect_type(model_set$param, "list") expect_equal(model_set$param$priorParams$priorType, "laplace") expect_equal(attr(model_set$param, "settings")$modelType, "logistic") expect_equal(attr(model_set$param, "settings")$priorfunction, "Cyclops::createPrior") expect_equal(attr(model_set$param, "settings")$addIntercept, TRUE) expect_equal(attr(model_set$param, "settings")$useControl, TRUE) expect_equal(attr(model_set$param, "settings")$name, "Lasso Logistic Regression") expect_equal(attr(model_set$param, "settings")$cvRepetitions, 1) variance <- runif(1) model_set <- setLassoLogisticRegression(variance = variance) expect_equal(model_set$param$priorParams$variance, variance) seed <- sample(10, 1) model_set <- setLassoLogisticRegression(seed = seed) expect_equal(attr(model_set$param, "settings")$seed, seed) model_set <- setLassoLogisticRegression(includeCovariateIds = c(1, 2)) expect_equal(model_set$param$includeCovariateIds, c(1, 2)) model_set <- setLassoLogisticRegression(noShrinkage = c(1, 3)) expect_equal(model_set$param$priorParams$exclude, c(1, 3)) threads <- sample(10, 1) model_set <- setLassoLogisticRegression(threads = threads) expect_equal(attr(model_set$param, "settings")$threads, threads) model_set <- setLassoLogisticRegression(forceIntercept = TRUE) expect_equal(model_set$param$priorParams$forceIntercept, TRUE) model_set <- setLassoLogisticRegression(upperLimit = 1) expect_equal(model_set$param$upperLimit, 1) model_set <- setLassoLogisticRegression(lowerLimit = 1) expect_equal(model_set$param$lowerLimit, 1) tolerance <- runif(1) model_set <- setLassoLogisticRegression(tolerance = tolerance) expect_equal(attr(model_set$param, "settings")$tolerance, tolerance) maxIterations <- sample(100, 1) model_set <- setLassoLogisticRegression(maxIterations = maxIterations) expect_equal(attr(model_set$param, "settings")$maxIterations, maxIterations) }) test_that("set LR incorrect inputs", { expect_error(setLassoLogisticRegression(variance = -0.01)) expect_error(setLassoLogisticRegression(variance = "variance")) expect_error(setLassoLogisticRegression(seed = "seed")) expect_error(setLassoLogisticRegression(threads = "threads")) expect_error(setLassoLogisticRegression(lowerLimit = "lowerLimit")) expect_error(setLassoLogisticRegression(upperLimit = "upperLimit")) expect_error(setLassoLogisticRegression(lowerLimit = 3, upperLimit = 1)) }) test_that("set cox regression inputs", { skip_if_not_installed("polspline") skip_on_cran() # ===================================== # checking Cox Regression # ===================================== modelSet <- setCoxModel() expect_s3_class(modelSet, "modelSettings") expect_equal(modelSet$fitFunction, "fitCyclopsModel") expect_type(modelSet$param, "list") expect_equal(modelSet$param$priorParams$priorType, "laplace") expect_equal(attr(modelSet$param, "settings")$modelType, "cox") expect_equal(attr(modelSet$param, "settings")$priorfunction, "Cyclops::createPrior") expect_equal(attr(modelSet$param, "settings")$addIntercept, FALSE) expect_equal(attr(modelSet$param, "settings")$useControl, TRUE) expect_equal(attr(modelSet$param, "settings")$name, "LASSO Cox Regression") expect_equal(attr(modelSet$param, "settings")$cvRepetitions, 1) variance <- runif(1) modelSet <- setCoxModel(variance = variance) expect_equal(modelSet$param$priorParams$variance, variance) seed <- sample(10, 1) modelSet <- setCoxModel(seed = seed) expect_equal(attr(modelSet$param, "settings")$seed, seed) modelSet <- setCoxModel(includeCovariateIds = c(1, 2)) expect_equal(modelSet$param$includeCovariateIds, c(1, 2)) modelSet <- setCoxModel(upperLimit = 1) expect_equal(modelSet$param$upperLimit, 1) modelSet <- setCoxModel(lowerLimit = 1) expect_equal(modelSet$param$lowerLimit, 1) modelSet <- setCoxModel(noShrinkage = c(1, 3)) expect_equal(modelSet$param$priorParams$exclude, c(1, 3)) threads <- sample(10, 1) modelSet <- setCoxModel(threads = threads) expect_equal(attr(modelSet$param, "settings")$threads, threads) tolerance <- runif(1) modelSet <- setCoxModel(tolerance = tolerance) expect_equal(attr(modelSet$param, "settings")$tolerance, tolerance) maxIterations <- sample(100, 1) modelSet <- setCoxModel(maxIterations = maxIterations) expect_equal(attr(modelSet$param, "settings")$maxIterations, maxIterations) }) test_that("set cox regression incorrect inputs", { skip_if_not_installed("polspline") skip_on_cran() expect_error(setCoxModel(variance = -0.01)) expect_error(setCoxModel(variance = "variance")) expect_error(setCoxModel(seed = "seed")) expect_error(setCoxModel(threads = "threads")) expect_error(setCoxModel(lowerLimit = "lowerLimit")) expect_error(setCoxModel(upperLimit = "upperLimit")) expect_error(setCoxModel(lowerLimit = 3, upperLimit = 1)) }) test_that("set IHT inputs", { skip_if_not_installed("IterativeHardThresholding") skip_on_cran() # ===================================== # checking IHT # ===================================== modelSet <- setIterativeHardThresholding() expect_s3_class(modelSet, "modelSettings") expect_equal(modelSet$fitFunction, "fitCyclopsModel") expect_type(modelSet$param, "list") expect_equal(attr(modelSet$param, "settings")$modelType, "logistic") expect_equal(attr(modelSet$param, "settings")$priorfunction, "IterativeHardThresholding::createIhtPrior") expect_equal(attr(modelSet$param, "settings")$addIntercept, FALSE) expect_equal(attr(modelSet$param, "settings")$useControl, FALSE) expect_equal(attr(modelSet$param, "settings")$name, "Iterative Hard Thresholding") expect_equal(attr(modelSet$param, "settings")$crossValidationInPrior, FALSE) k <- sample(100, 1) modelSet <- setIterativeHardThresholding(K = k) expect_equal(modelSet$param$priorParams$K, k) penalty <- sample(c("bic", "aic"), 1) modelSet <- setIterativeHardThresholding(penalty = penalty) expect_equal(modelSet$param$priorParams$penalty, penalty) modelSet <- setIterativeHardThresholding(exclude = c(1, 2)) expect_equal(modelSet$param$priorParams$exclude, c(1, 2)) modelSet <- setIterativeHardThresholding(forceIntercept = TRUE) expect_equal(modelSet$param$priorParams$forceIntercept, TRUE) modelSet <- setIterativeHardThresholding(fitBestSubset = TRUE) expect_equal(modelSet$param$priorParams$fitBestSubset, TRUE) # add other parameter checks ## initialRidgeVariance ## tolerance ## maxIterations ## threshold ## delta seed <- sample(10, 1) modelSet <- setIterativeHardThresholding(seed = seed) expect_equal(attr(modelSet$param, "settings")$seed, seed) }) test_that("test IHT incorrect inputs", { skip_if_not_installed("IterativeHardThresholding") skip_on_cran() expect_error(setIterativeHardThresholding(K = 0)) expect_error(setIterativeHardThresholding(penalty = "L1")) expect_error(setIterativeHardThresholding(fitBestSubset = "true")) expect_error(setIterativeHardThresholding(seed = "F")) }) # ================ FUNCTION TESTING test_that("test logistic regression runs", { skip_if_offline() modelSettings <- setLassoLogisticRegression() fitModel <- fitPlp( trainData = trainData, modelSettings = modelSettings, search = "grid", analysisId = "lrTest", analysisPath = tempdir() ) expect_equal(length(unique(fitModel$prediction$evaluationType)), 2) expect_equal(nrow(fitModel$prediction), nrow(trainData$labels) * 2) expect_true(length(fitModel$model$coefficients) < trainData$covariateData$covariateRef %>% dplyr::tally() %>% dplyr::pull() + 1) expect_true(!is.null(fitModel$trainDetails$trainingTime)) expect_equal(fitModel$trainDetails$trainingDate, Sys.Date()) expect_equal( nrow(fitModel$covariateImportance), trainData$covariateData$covariateRef %>% dplyr::tally() %>% dplyr::pull() ) expect_true("covariateValue" %in% colnames(fitModel$covariateImportance)) expect_equal(fitModel$modelDesign$outcomeId, attr(trainData, "metaData")$outcomeId) expect_equal(fitModel$modelDesign$targetId, attr(trainData, "metaData")$targetId) })