diff --git a/R/StrategusModule.R b/R/StrategusModule.R index 6c87867..093a38c 100644 --- a/R/StrategusModule.R +++ b/R/StrategusModule.R @@ -317,7 +317,7 @@ StrategusModule <- R6::R6Class( checkmate::assertClass(executionSettings, "ExecutionSettings", add = errorMessages) checkmate::reportAssertions(collection = errorMessages) - .replaceAttributes <- function(s) { + .replaceProperties <- function(s) { if (inherits(s, "covariateSettings") && "fun" %in% names(attributes(s))) { if (attr(s, "fun") == "getDbCohortBasedCovariatesData") { # Set the covariateCohortDatabaseSchema & covariateCohortTable values @@ -329,10 +329,10 @@ StrategusModule <- R6::R6Class( } if (is.null(names(covariateSettings))) { # List of lists - modifiedCovariateSettings <- lapply(covariateSettings, .replaceAttributes) + modifiedCovariateSettings <- lapply(covariateSettings, .replaceProperties) } else { # Plain list - modifiedCovariateSettings <- .replaceAttributes(covariateSettings) + modifiedCovariateSettings <- .replaceProperties(covariateSettings) } return(modifiedCovariateSettings) } @@ -351,7 +351,12 @@ StrategusModule <- R6::R6Class( return(.replaceCovariateSettingsCohortTableNames(x, executionSettings)) } else if (is.list(x)) { # If the element is a list, recurse on each element - return(lapply(x, replaceHelper)) + # Keep the original attributes by saving them before modification + attrs <- attributes(x) + newList <- lapply(x, replaceHelper) + # Restore attributes to the new list + attributes(newList) <- attrs + return(newList) } else { # If the element is not a list or "covariateSettings", return it as is return(x) diff --git a/tests/testthat/test-Settings.R b/tests/testthat/test-Settings.R index 8a5168d..e3f4d18 100644 --- a/tests/testthat/test-Settings.R +++ b/tests/testthat/test-Settings.R @@ -414,6 +414,13 @@ test_that("Test internal function for modifying covariate settings", { # 1) covariate settings that do not contain cohort table settings # 2) covariate settings that contain cohort table settings # 3) a list of covariate setting that has 1 & 2 above + # 4) Something other than a covariate setting object + esModuleSettingsCreator <- EvidenceSynthesisModule$new() + evidenceSynthesisSourceCmGrid <- esModuleSettingsCreator$createEvidenceSynthesisSource( + sourceMethod = "CohortMethod", + likelihoodApproximation = "adaptive grid" + ) + cov1 <- FeatureExtraction::createDefaultCovariateSettings() cov2 <- FeatureExtraction::createCohortBasedCovariateSettings( analysisId = 999, @@ -430,7 +437,8 @@ test_that("Test internal function for modifying covariate settings", { nested1 = cov1, nested2 = cov2, nested3 = covariateSettings - ) + ), + esSettings = evidenceSynthesisSourceCmGrid ) ) workDatabaseSchema <- "foo" @@ -444,6 +452,9 @@ test_that("Test internal function for modifying covariate settings", { ) testReplacedModuleSettings <- .replaceCovariateSettings(moduleSettings, executionSettings) + # For visual inspection + #ParallelLogger::saveSettingsToJson(moduleSettings, "before_unit_test.json") + #ParallelLogger::saveSettingsToJson(testReplacedModuleSettings, "after_unit_test.json") expect_equal(testReplacedModuleSettings$analysis$something[[1]]$covariateCohortDatabaseSchema, NULL) expect_equal(testReplacedModuleSettings$analysis$something[[1]]$covariateCohortTable, NULL) expect_equal(testReplacedModuleSettings$analysis$something[[2]]$covariateCohortDatabaseSchema, workDatabaseSchema) @@ -459,4 +470,5 @@ test_that("Test internal function for modifying covariate settings", { expect_equal(testReplacedModuleSettings$analysis$somethingElse$nested3[[1]]$covariateCohortTable, NULL) expect_equal(testReplacedModuleSettings$analysis$somethingElse$nested3[[2]]$covariateCohortDatabaseSchema, workDatabaseSchema) expect_equal(testReplacedModuleSettings$analysis$somethingElse$nested3[[2]]$covariateCohortTable, cohortTableNames$cohortTable) + expect_equal(class(testReplacedModuleSettings$analysis$esSettings), class(moduleSettings$analysis$esSettings)) })