From aaadda503348800c0d92da4d0dc92833b6af1853 Mon Sep 17 00:00:00 2001 From: Indrajeet Patil Date: Thu, 28 Jul 2022 09:23:08 +0200 Subject: [PATCH 1/6] Additional tests for utilities --- R/utilities-individual.R | 8 +++++-- man/applyIndividualParameters.Rd | 1 - tests/testthat/test-utilities-individual.R | 25 ++++++++++++++++++++++ tests/testthat/test-utilities-simulation.R | 8 +++++++ 4 files changed, 39 insertions(+), 3 deletions(-) create mode 100644 tests/testthat/test-utilities-simulation.R diff --git a/R/utilities-individual.R b/R/utilities-individual.R index 6566fd9b..3eef5f54 100644 --- a/R/utilities-individual.R +++ b/R/utilities-individual.R @@ -41,7 +41,12 @@ writeIndividualToXLS <- function(individualCharacteristics, outputXLSPath) { units[i] <- individual$distributedParameters$units[[i]] } - output <- data.frame(unlist(containerPaths, use.names = FALSE), unlist(paramNames, use.names = FALSE), unlist(as.numeric(values), use.names = FALSE), unlist(units, use.names = FALSE)) + output <- data.frame( + unlist(containerPaths, use.names = FALSE), + unlist(paramNames, use.names = FALSE), + unlist(as.numeric(values), use.names = FALSE), + unlist(units, use.names = FALSE) + ) colnames(output) <- columnNames writexl::write_xlsx(output, path = outputXLSPath, col_names = TRUE) @@ -118,7 +123,6 @@ readIndividualCharacteristicsFromXLS <- function(XLSpath, #' @export #' #' @examples -#' #' #' \dontrun{ #' simulation <- loadSimulation(filePath = modelPath) #' humanIndividualCharacteristics <- createIndividualCharacteristics( diff --git a/man/applyIndividualParameters.Rd b/man/applyIndividualParameters.Rd index 1b848d12..23de2283 100644 --- a/man/applyIndividualParameters.Rd +++ b/man/applyIndividualParameters.Rd @@ -19,7 +19,6 @@ For human species, only parameters that do not override formulas are applied. For other species, all parameters returned by \code{createIndividual} are applied. } \examples{ -#' \dontrun{ simulation <- loadSimulation(filePath = modelPath) humanIndividualCharacteristics <- createIndividualCharacteristics( diff --git a/tests/testthat/test-utilities-individual.R b/tests/testthat/test-utilities-individual.R index 95c76528..19c6d403 100644 --- a/tests/testthat/test-utilities-individual.R +++ b/tests/testthat/test-utilities-individual.R @@ -50,3 +50,28 @@ test_that("It create IndividualCharacteristics when numerical values are empty", expect_equal(individualCharacteristics$population, "European_ICRP_2002") expect_equal(individualCharacteristics$gender, "MALE") }) + +## context("writeIndividualToXLS") + +test_that("`writeIndividualToXLS()` writes correct data to a spreadsheet", { + withr::with_tempdir( + code = { + simulation <- loadSimulation(system.file("extdata", "simple.pkml", package = "ospsuite")) + humanIndividualCharacteristics <- createIndividualCharacteristics( + species = Species$Human, + population = HumanPopulation$European_ICRP_2002, + gender = Gender$Male, + weight = 70 + ) + tmp <- writeIndividualToXLS(humanIndividualCharacteristics, "ParameterSet.xlsx") + df <- readxl::read_xlsx(tmp) + + expect_equal(dim(df), c(96L, 4L)) + expect_equal(colnames(df), c("Container Path", "Parameter Name", "Value", "Units")) + expect_equal( + unique(df$Units), + c("year(s)", "week(s)", "dm", NA, "kg", "l", "l/min/kg organ", "l/min", "min") + ) + } + ) +}) diff --git a/tests/testthat/test-utilities-simulation.R b/tests/testthat/test-utilities-simulation.R new file mode 100644 index 00000000..c704a0fd --- /dev/null +++ b/tests/testthat/test-utilities-simulation.R @@ -0,0 +1,8 @@ +## context("initializeSimulation") + +test_that("`initializeSimulation()` loads a simulation at the minimum", { + simulation <- loadSimulation(system.file("extdata", "simple.pkml", package = "ospsuite")) + initializeSimulation(simulation, steadyStateTime = TRUE) + simulationResults <- runSimulation(simulation) + expect_s3_class(simulationResults, "SimulationResults") +}) From 09e978f7ffd12ecc11f183c816934cccd9a6fbee Mon Sep 17 00:00:00 2001 From: Indrajeet Patil Date: Thu, 28 Jul 2022 10:22:14 +0200 Subject: [PATCH 2/6] test for `compareSimulationParameters()` --- R/utilities-steady-state.R | 20 ++++++++++++++++---- tests/testthat/test-utilities-individual.R | 2 ++ tests/testthat/test-utilities-simulation.R | 14 ++++++++++++++ 3 files changed, 32 insertions(+), 4 deletions(-) diff --git a/R/utilities-steady-state.R b/R/utilities-steady-state.R index 88e01494..05f36074 100644 --- a/R/utilities-steady-state.R +++ b/R/utilities-steady-state.R @@ -94,8 +94,13 @@ exportSteadyStateToXLS <- function(simulation, } speciesInitVals <- data.frame( - unlist(moleculeContainerPath, use.names = FALSE), unlist(moleculeName, use.names = FALSE), unlist(moleculeIsPresent, use.names = FALSE), unlist(moleculeValue, use.names = FALSE), - unlist(moleculeUnits, use.names = FALSE), unlist(moleculeScaleDivisor, use.names = FALSE), unlist(moleculeNegValsAllowed, use.names = FALSE) + unlist(moleculeContainerPath, use.names = FALSE), + unlist(moleculeName, use.names = FALSE), + unlist(moleculeIsPresent, use.names = FALSE), + unlist(moleculeValue, use.names = FALSE), + unlist(moleculeUnits, use.names = FALSE), + unlist(moleculeScaleDivisor, use.names = FALSE), + unlist(moleculeNegValsAllowed, use.names = FALSE) ) if (length(speciesInitVals) > 0) { @@ -103,12 +108,19 @@ exportSteadyStateToXLS <- function(simulation, } parameterInitVals <- data.frame( - unlist(parameterContainerPath, use.names = FALSE), unlist(parameterName, use.names = FALSE), unlist(parameterValue, use.names = FALSE), unlist(parameterUnits, use.names = FALSE) + unlist(parameterContainerPath, use.names = FALSE), + unlist(parameterName, use.names = FALSE), + unlist(parameterValue, use.names = FALSE), + unlist(parameterUnits, use.names = FALSE) ) if (length(parameterInitVals) > 0) { colnames(parameterInitVals) <- c("Container Path", "Parameter Name", "Value", "Units") } # Write the results into an excel file. - writexl::write_xlsx(list("Molecules" = speciesInitVals, "Parameters" = parameterInitVals), path = resultsXLSPath, col_names = TRUE) + writexl::write_xlsx( + list("Molecules" = speciesInitVals, "Parameters" = parameterInitVals), + path = resultsXLSPath, + col_names = TRUE + ) } diff --git a/tests/testthat/test-utilities-individual.R b/tests/testthat/test-utilities-individual.R index 19c6d403..996f9960 100644 --- a/tests/testthat/test-utilities-individual.R +++ b/tests/testthat/test-utilities-individual.R @@ -54,6 +54,8 @@ test_that("It create IndividualCharacteristics when numerical values are empty", ## context("writeIndividualToXLS") test_that("`writeIndividualToXLS()` writes correct data to a spreadsheet", { + skip_if_not_installed("withr") + withr::with_tempdir( code = { simulation <- loadSimulation(system.file("extdata", "simple.pkml", package = "ospsuite")) diff --git a/tests/testthat/test-utilities-simulation.R b/tests/testthat/test-utilities-simulation.R index c704a0fd..3b302ed2 100644 --- a/tests/testthat/test-utilities-simulation.R +++ b/tests/testthat/test-utilities-simulation.R @@ -6,3 +6,17 @@ test_that("`initializeSimulation()` loads a simulation at the minimum", { simulationResults <- runSimulation(simulation) expect_s3_class(simulationResults, "SimulationResults") }) + +## context("compareSimulationParameters") + +test_that("`compareSimulationParameters()` produces no differences with identical simulations", { + simPath <- system.file("extdata", "simple.pkml", package = "ospsuite") + sim1 <- loadSimulation(simPath) + sim2 <- loadSimulation(simPath) + + res <- compareSimulationParameters(sim1, sim2) + expect_equal( + res, + list(In1NotIn2 = list(), In2NotIn1 = list(), Different = list()) + ) +}) From f03cd797e818fc6a17bfc8331d286bbece704ba5 Mon Sep 17 00:00:00 2001 From: Indrajeet Patil Date: Thu, 28 Jul 2022 10:29:47 +0200 Subject: [PATCH 3/6] tweak tests for settings --- R/esqlabs-env.R | 7 +------ tests/testthat/_snaps/esqlabsr-settings.md | 18 ------------------ tests/testthat/test-esqlabsr-settings.R | 11 ++++++++++- 3 files changed, 11 insertions(+), 25 deletions(-) delete mode 100644 tests/testthat/_snaps/esqlabsr-settings.md diff --git a/R/esqlabs-env.R b/R/esqlabs-env.R index 32d76c2c..40757db4 100644 --- a/R/esqlabs-env.R +++ b/R/esqlabs-env.R @@ -1,8 +1,3 @@ -.getPackageVersion <- function() { - version <- getNamespaceVersion("esqlabsR") - return(version) -} - # Environment that holds various global variables and settings for the esqlabsR, # It is not exported and should not be directly manipulated by other packages. esqlabsEnv <- new.env(parent = emptyenv()) @@ -11,7 +6,7 @@ esqlabsEnv <- new.env(parent = emptyenv()) esqlabsEnv$packageName <- "esqlabsR" # Version of the package -esqlabsEnv$packageVersion <- .getPackageVersion() +esqlabsEnv$packageVersion <- getNamespaceVersion("esqlabsR") # Default width of a plot of a single `PlotMapping` esqlabsEnv$widthPerPlotMapping <- 8 diff --git a/tests/testthat/_snaps/esqlabsr-settings.md b/tests/testthat/_snaps/esqlabsr-settings.md deleted file mode 100644 index ee80666a..00000000 --- a/tests/testthat/_snaps/esqlabsr-settings.md +++ /dev/null @@ -1,18 +0,0 @@ -# Names for settings are as expected - - Code - esqlabsRSettingNames - Output - $packageVersion - [1] "packageVersion" - - $packageName - [1] "packageName" - - $widthPerPlotMapping - [1] "widthPerPlotMapping" - - $heightPerPlotMapping - [1] "heightPerPlotMapping" - - diff --git a/tests/testthat/test-esqlabsr-settings.R b/tests/testthat/test-esqlabsr-settings.R index 3129712f..165c1c7e 100644 --- a/tests/testthat/test-esqlabsr-settings.R +++ b/tests/testthat/test-esqlabsr-settings.R @@ -1,5 +1,13 @@ test_that("Names for settings are as expected", { - expect_snapshot(esqlabsRSettingNames) + expect_equal( + esqlabsRSettingNames, + list( + packageVersion = "packageVersion", + packageName = "packageName", + widthPerPlotMapping = "widthPerPlotMapping", + heightPerPlotMapping = "heightPerPlotMapping" + ) + ) }) test_that("Check that values for package environment bindings are correct", { @@ -9,4 +17,5 @@ test_that("Check that values for package environment bindings are correct", { ) expect_equal(getEsqlabsRSetting("packageName"), "esqlabsR") + expect_type(getEsqlabsRSetting("packageVersion"), "character") }) From e7104b2f7917a2a822075f1f199e9a3cce9956c2 Mon Sep 17 00:00:00 2001 From: Indrajeet Patil Date: Thu, 28 Jul 2022 10:43:50 +0200 Subject: [PATCH 4/6] Test for `sampleRandomValue()` --- tests/testthat/test-utilities-population.R | 30 ++++++++++++++++++++++ 1 file changed, 30 insertions(+) create mode 100644 tests/testthat/test-utilities-population.R diff --git a/tests/testthat/test-utilities-population.R b/tests/testthat/test-utilities-population.R new file mode 100644 index 00000000..c402f495 --- /dev/null +++ b/tests/testthat/test-utilities-population.R @@ -0,0 +1,30 @@ +## context("sampleRandomValue") + +test_that("`sampleRandomValue()` generates needed distribution", { + expect_error( + sampleRandomValue("xyz", 5, 2, 10), + messages$errorDistributionNotSupported("xyz") + ) + + set.seed(123) + expect_equal( + sampleRandomValue(Distributions$Normal, 5, 2, 10), + c( + 3.87904870689558, 4.53964502103344, 8.11741662829825, 5.14101678284915, + 5.25857547032189, 8.43012997376656, 5.9218324119784, 2.46987753078693, + 3.62629429621295, 4.10867605980008 + ), + tolerance = 0.001 + ) + + set.seed(123) + expect_equal( + sampleRandomValue(Distributions$LogNormal, 5, 2, 10), + c( + 3.74081271106427, 4.24843764475839, 8.46318202896501, 4.77021554349172, + 4.87946908411847, 8.98864517081978, 5.54444951200875, 2.85153959957418, + 3.56304555191325, 3.90999158989997 + ), + tolerance = 0.001 + ) +}) From 3b0d1dc50fccf9585f5fb3af81187db91e61586d Mon Sep 17 00:00:00 2001 From: Indrajeet Patil Date: Thu, 28 Jul 2022 11:25:06 +0200 Subject: [PATCH 5/6] Address review comments --- tests/testthat/test-utilities-file.R | 4 ---- tests/testthat/test-utilities-individual.R | 3 --- 2 files changed, 7 deletions(-) diff --git a/tests/testthat/test-utilities-file.R b/tests/testthat/test-utilities-file.R index d3bd59b3..d132cd53 100644 --- a/tests/testthat/test-utilities-file.R +++ b/tests/testthat/test-utilities-file.R @@ -1,8 +1,6 @@ ## context("sourceAll") test_that("`sourceAll()` sources all files in the directory", { - skip_if_not_installed("withr") - withr::with_tempdir( code = { f1 <- file.create("f1.R") @@ -21,8 +19,6 @@ test_that("`sourceAll()` sources all files in the directory", { ## context("pathFromClipboard") test_that("`pathFromClipboard()` converts paths as expected", { - skip_if_not_installed("clipr") - # This will work only in interactive mode, i.e. with # `devtools::test_active_file()` or `devtools::test()`, but not during R CMD # Check on CRAN or AppVeyor where the system clipboard is not available diff --git a/tests/testthat/test-utilities-individual.R b/tests/testthat/test-utilities-individual.R index 996f9960..c7543066 100644 --- a/tests/testthat/test-utilities-individual.R +++ b/tests/testthat/test-utilities-individual.R @@ -54,11 +54,8 @@ test_that("It create IndividualCharacteristics when numerical values are empty", ## context("writeIndividualToXLS") test_that("`writeIndividualToXLS()` writes correct data to a spreadsheet", { - skip_if_not_installed("withr") - withr::with_tempdir( code = { - simulation <- loadSimulation(system.file("extdata", "simple.pkml", package = "ospsuite")) humanIndividualCharacteristics <- createIndividualCharacteristics( species = Species$Human, population = HumanPopulation$European_ICRP_2002, From f3e554195f2669482a5d9aac9ec4311166bddf68 Mon Sep 17 00:00:00 2001 From: Indrajeet Patil Date: Thu, 28 Jul 2022 11:30:31 +0200 Subject: [PATCH 6/6] remove `expect_s3_class()` for R6 --- tests/testthat/test-sensitivity-calculation.R | 2 +- tests/testthat/test-utilities-figures.R | 6 +++--- tests/testthat/test-utilities-simulation.R | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-sensitivity-calculation.R b/tests/testthat/test-sensitivity-calculation.R index c259c34a..3a4ab053 100644 --- a/tests/testthat/test-sensitivity-calculation.R +++ b/tests/testthat/test-sensitivity-calculation.R @@ -237,7 +237,7 @@ test_that("sensitivityCalculation errors if file extension is incorrect", { # checking `SensitivityCalculation` object ------------------ test_that("sensitivityCalculation returns the correct object", { - expect_s3_class(results, "SensitivityCalculation") + expect_true(isOfType(results, "SensitivityCalculation")) expect_equal( length(results$simulationResults), diff --git a/tests/testthat/test-utilities-figures.R b/tests/testthat/test-utilities-figures.R index 6df3463f..18460ca4 100644 --- a/tests/testthat/test-utilities-figures.R +++ b/tests/testthat/test-utilities-figures.R @@ -50,7 +50,7 @@ test_that("col2hsv returns expected HSV values for a given R color name", { test_that("createEsqlabsPlotConfiguration() creates object with chosen defaults", { myPC <- createEsqlabsPlotConfiguration() - expect_s3_class(myPC, "DefaultPlotConfiguration") + expect_true(isOfType(myPC, "DefaultPlotConfiguration")) expect_equal(myPC$titleSize, 8) }) @@ -58,7 +58,7 @@ test_that("createEsqlabsPlotConfiguration() creates object with chosen defaults" test_that("createEsqlabsPlotGridConfiguration() creates object with chosen defaults", { myPGC <- createEsqlabsPlotGridConfiguration() - expect_s3_class(myPGC, "PlotGridConfiguration") + expect_true(isOfType(myPGC, "PlotGridConfiguration")) expect_equal(myPGC$tagLevels, "a") }) @@ -67,6 +67,6 @@ test_that("createEsqlabsPlotGridConfiguration() creates object with chosen defau test_that("createEsqlabsExportConfiguration() creates object with chosen defaults", { myProjConfig <- ProjectConfiguration$new() myEC <- createEsqlabsExportConfiguration(myProjConfig) - expect_s3_class(myEC, "ExportConfiguration") + expect_true(isOfType(myEC, "ExportConfiguration")) expect_equal(myEC$units, "cm") }) diff --git a/tests/testthat/test-utilities-simulation.R b/tests/testthat/test-utilities-simulation.R index 3b302ed2..4928bffc 100644 --- a/tests/testthat/test-utilities-simulation.R +++ b/tests/testthat/test-utilities-simulation.R @@ -4,7 +4,7 @@ test_that("`initializeSimulation()` loads a simulation at the minimum", { simulation <- loadSimulation(system.file("extdata", "simple.pkml", package = "ospsuite")) initializeSimulation(simulation, steadyStateTime = TRUE) simulationResults <- runSimulation(simulation) - expect_s3_class(simulationResults, "SimulationResults") + expect_true(isOfType(simulationResults, "SimulationResults")) }) ## context("compareSimulationParameters")