Improve existing tests and add new ones

NEWS.md

@@ -11,6 +11,8 @@
 
 ## Improvements
 
+* Update existing tests and added new ones.
+
 * Add type check for `method` argument of `validate()` to ensure that only
   instances of `Method` class (i.e., produced by `powerly()` are passed).
 

tests/testthat/helpers.R

@@ -1,10 +1,9 @@
-# Get the number of cores allowed for parallelization.
-# TODO: figure how to allow more cores if the test is not ran by CRAN.
+# Get the number of cores allowed for parallelization for tests.
 get_number_cores <- function() {
     return(2)
 }
 
-# Helper based on 'quadprog' for testing the 'Solver' class.
+# Helper based on `quadprog` for testing the `Solver` class.
 solve_qp <- function(basis_matrix, y, a_mat, b_vec, meq = 0) {
     # Create matrices for `solve.QP`.
     d_mat <- crossprod(basis_matrix, basis_matrix)
@@ -14,7 +13,7 @@ solve_qp <- function(basis_matrix, y, a_mat, b_vec, meq = 0) {
     return(quadprog::solve.QP(Dmat = d_mat, dvec = d_vec, Amat = t(a_mat), bvec = b_vec, meq = meq)$solution)
 }
 
-# Helper based on 'osqp' for testing the 'Solver' class.
+# Helper based on `osqp` for testing the `Solver` class.
 solve_osqp <- function(basis_matrix, y, lower, upper) {
     # Set settings.
     settings <- osqp::osqpSettings(
@@ -46,7 +45,7 @@ solve_osqp <- function(basis_matrix, y, lower, upper) {
     return(model$Solve()$x)
 }
 
-# Helper for testing private methods of 'StepTwo' class.
+# Helper for testing private methods of `StepTwo` class.
 StepTwoTester <- R6::R6Class("StepTwoTester",
     inherit = StepTwo,
 
@@ -63,7 +62,7 @@ StepTwoTester <- R6::R6Class("StepTwoTester",
     )
 )
 
-# Helper for testing private methods of 'StepThree' class.
+# Helper for testing private methods of `StepThree` class.
 StepThreeTester <- R6::R6Class("StepThreeTester",
     inherit = StepThree,
 
@@ -88,3 +87,35 @@ StepThreeTester <- R6::R6Class("StepThreeTester",
         }
     )
 )
+
+# Helper for testing private methods of `Backend` class.
+BackendTester <- R6::R6Class("BackendTester",
+    inherit = Backend,
+
+    public = list(
+        # Mock the number of cores detected during instantiation.
+        mock_machine_available_cores = function(cores) {
+            # Predetermine the number of cores on the machine.
+            private$.available_cores <- cores
+        },
+
+        # Expose the private method for testing.
+        set_cores = function(cores) {
+            # Set the cores.
+            private$.set_cores(cores)
+        }
+    )
+)
+
+# Helper for testing private methods of `Range` class.
+RangeTester <- R6::R6Class("RangeTester",
+    inherit = Range,
+
+    public = list(
+        # Expose `.convergence_test()` for testing.
+        convergence_test = function(lower, upper) {
+            # Perform the test.
+            return(private$.convergence_test(lower, upper))
+        }
+    )
+)

tests/testthat/test-api-validate.R

@@ -0,0 +1,8 @@
+# Test 'validate()' public API.
+
+test_that("'validate()' fails on incorrect method object type", {
+    # Expect validate to fail on incorrect method object.
+    expect_error(validate(method = 1), .__ERRORS__$incorrect_type)
+    expect_error(validate(method = "method"), .__ERRORS__$incorrect_type)
+    expect_error(validate(method = StepOne$new()), .__ERRORS__$incorrect_type)
+})

tests/testthat/test-backend.R

@@ -0,0 +1,158 @@
+# Test 'Backend' class.
+
+test_that("'Backend' aborts on machines with only one core", {
+    # Create backend instance.
+    backend <- BackendTester$new()
+
+    # Suppose the machine has only one core.
+    backend$mock_machine_available_cores(cores = 1)
+
+    # The expected error message.
+    error_message <- "Not enough cores available on the machine."
+
+    # Expect to abort regardless of the requested cores.
+    expect_error(backend$set_cores(cores = 1), error_message)
+    expect_error(backend$set_cores(cores = 2), error_message)
+    expect_error(backend$set_cores(cores = 7), error_message)
+})
+
+
+test_that("'Backend' sets the number of cores correctly", {
+    # Create backend instance.
+    backend <- BackendTester$new()
+
+    # Suppose the machine has two cores.
+    backend$mock_machine_available_cores(cores = 2)
+
+    # Expectations based on the number of cores requested.
+
+    # When 1 core is requested.
+    expect_warning(backend$set_cores(cores = 1), "Argument `cores` must be greater than 1. Setting to 2.")
+    expect_equal(backend$cores, 2)
+
+    # When two cores are requested.
+    backend$set_cores(cores = 2)
+    expect_equal(backend$cores, 2)
+
+    # When more than two cores are requested.
+    expect_warning(backend$set_cores(cores = 7), "Argument `cores` cannot be larger than 2. Setting to 2.")
+    expect_equal(backend$cores, 2)
+
+    # Suppose the machine has 8 cores.
+    backend$mock_machine_available_cores(cores = 8)
+
+    # When 1 core is requested.
+    expect_warning(backend$set_cores(cores = 1), "Argument `cores` must be greater than 1. Setting to 2.")
+    expect_equal(backend$cores, 2)
+
+    # When two cores are requested.
+    backend$set_cores(cores = 2)
+    expect_equal(backend$cores, 2)
+
+    # When seven cores are requested.
+    backend$set_cores(cores = 7)
+    expect_equal(backend$cores, 7)
+
+    # When seven cores are requested.
+    expect_warning(backend$set_cores(cores = 8), "Argument `cores` cannot be larger than 7. Setting to 7.")
+    expect_equal(backend$cores, 7)
+})
+
+
+test_that("'Backend' performs operations on the cluster correctly", {
+    # Create a backend.
+    backend <- Backend$new()
+
+    # Start the cluster.
+    backend$start(2)
+
+    # Expect the cluster is empty upon creation.
+    expect_true(all(sapply(backend$inspect(), length) == 0))
+
+    # Create a variable in a new environment.
+    env <- new.env()
+    env$test_variable <- rnorm(1)
+
+    # Export variable to the cluster from an environment.
+    backend$export("test_variable", env)
+
+    # Expect the cluster to contain the exported variable.
+    expect_true(all(backend$inspect() == "test_variable"))
+
+    # Expect the cluster to hold the correct value for the exported variable.
+    expect_true(all(parallel::clusterEvalQ(backend$cluster, test_variable) == env$test_variable))
+
+    # Expect that clearing the cluster leaves it empty.
+    backend$clear()
+    expect_true(all(sapply(backend$inspect(), length) == 0))
+
+    # Create test data for the cluster `sapply` and `apply operations`.
+    data <- matrix(rnorm(100), 10, 10)
+    test_function <- function(x, add = 1) x + add
+
+    # Expect that the parallel `sapply` is executed correctly.
+    expect_equal(backend$sapply(data[, 1], test_function, add = 3), sapply(data[, 1], test_function, add = 3))
+
+    # Expect that the parallel `apply` is executed correctly.
+    expect_equal(backend$apply(data, 1, test_function, add = 10), apply(data, 1, test_function, add = 10))
+
+    # Expect that the cluster is empty after performing operations on it.
+     expect_true(all(sapply(backend$inspect(), length) == 0))
+
+    # Stop the cluster.
+    backend$stop()
+})
+
+
+test_that("'Backend' manages the cluster correctly", {
+    # Create a backend.
+    backend <- Backend$new()
+
+    # Start the cluster.
+    backend$start(2)
+
+    # Expect the correct type.
+    if (.Platform$OS.type == "unix") {
+       expect_equal(backend$type, c(unix = "FORK"))
+    } else {
+       expect_equal(backend$type, c(windows = "PSOCK"))
+    }
+
+    # Expect the correct number of cores.
+    expect_equal(backend$cores, 2)
+    expect_equal(length(backend$cluster), 2)
+
+    # Expect an error if an attempt is made to start a cluster while one is already active.
+    expect_error(backend$start(2), "A cluster is already active. Please stop it before starting a new one.")
+
+    # Expect stopping the cluster works.
+    backend$stop()
+    expect_false(backend$active)
+    expect_equal(backend$cluster, NULL)
+
+    # Expect the cluster can be started again after being stop.
+    backend$start(2)
+    expect_equal(length(backend$cluster), 2)
+
+    # Expect an error if an attempt is made to adopt a cluster while one is already active.
+    expect_error(backend$adopt(backend$cluster), "Cannot adopt external cluster while there is another active cluster.")
+
+    # Stop the current cluster.
+    backend$stop()
+
+    # Create a cluster manually.
+    cluster <- parallel::makePSOCKcluster(2)
+
+    # Expect the backend correctly adopts a cluster object.
+    backend$adopt(cluster)
+    expect_equal(backend$type, "adopted")
+    expect_equal(length(backend$cluster), 2)
+    expect_equal(backend$cores, 2)
+    expect_equal(backend$.__enclos_env__$private$.available_cores, NULL)
+    expect_equal(backend$.__enclos_env__$private$.allowed_cores, NULL)
+
+    # Expect that the backend can stop the adopted cluster.
+    backend$stop()
+    # If the backend `stop()` worked, then attempting to close again will throw an error.
+    expect_error(parallel::stopCluster(cluster))
+})

tests/testthat/test-model.R

@@ -0,0 +1,12 @@
+# Testing 'Model' class.
+
+test_that("'Model' base class throws errors for abstract methods", {
+    # Create `Model` base class.
+    model <- Model$new()
+
+    # Expect error because the methods are abstract.
+    expect_error(model$create(), .__ERRORS__$not_implemented)
+    expect_error(model$generate(NULL, NULL), .__ERRORS__$not_implemented)
+    expect_error(model$estimate(NULL), .__ERRORS__$not_implemented)
+    expect_error(model$evaluate(NULL, NULL, NULL), .__ERRORS__$not_implemented)
+})

tests/testthat/test-range.R

@@ -78,3 +78,22 @@ test_that("'Range' updates bounds correctly based on 'StepThree' confidence inte
         "The lower bound cannot be greater that the upper bound."
     )
 })
+
+
+test_that("'Range' convergence test works correctly", {
+    # Expect error if the initial range is smaller than the tolerance.
+    expect_error(Range$new(100, 130, samples = 10, tolerance = 50), "Please provide a range wider than the tolerance.")
+
+    # Create `Range` instance.
+    range <- RangeTester$new(100, 500, samples = 20, tolerance = 50)
+
+    # Expect the convergence test triggers correctly.
+    expect_equal(range$convergence_test(100, 160), FALSE)
+    expect_equal(range$convergence_test(100, 150), TRUE)
+    expect_equal(range$convergence_test(100, 140), TRUE)
+
+    # Expect the convergence test triggers correctly even in absurd cases.
+    expect_equal(range$convergence_test(160, 100), TRUE)
+    expect_equal(range$convergence_test(150, 100), TRUE)
+    expect_equal(range$convergence_test(140, 100), TRUE)
+})

tests/testthat/test-solver.R

@@ -276,3 +276,14 @@ test_that("'Solver' implementations still give original solution after solving w
     expect_equal(osqp_first_alpha, osqp$solve())
     expect_equal(qp_first_alpha, qp$solve())
 })
+
+
+test_that("'Solver' base class throws errors for abstract methods", {
+    # Create `Solver` base class.
+    solver <- Solver$new()
+
+    # Expect error because the methods are abstract.
+    expect_error(solver$setup(NULL, NULL, NULL), .__ERRORS__$not_implemented)
+    expect_error(solver$solve(), .__ERRORS__$not_implemented)
+    expect_error(solver$solve_update(NULL), .__ERRORS__$not_implemented)
+})

tests/testthat/test-statistic.R

@@ -0,0 +1,10 @@
+# Testing 'Statistic' class.
+
+test_that("'Statistic' base class throws errors for abstract methods", {
+    # Create `Statistic` base class.
+    statistic <- Statistic$new()
+
+    # Expect error because the methods are abstract.
+    expect_error(statistic$compute(NULL), .__ERRORS__$not_implemented)
+    expect_error(statistic$apply(NULL), .__ERRORS__$not_implemented)
+})

tests/testthat/test-step-one.R

@@ -60,3 +60,37 @@ test_that("'StepOne' Monte Carlo simulation runs correctly", {
     # Statistics computed via both methods should be equal.
     expect_equal(step_1$statistics, statistics)
 })
+
+
+test_that("'StepOne' sets the model type correctly", {
+    # Create `StepOne` instance.
+    step_1 <- StepOne$new()
+
+    # Set dummy `Range`.
+    step_1$set_range(Range$new(100, 500))
+
+    # Expect that attempting to set an unknown model type throws an error.
+    expect_error(step_1$set_model("unknown"), "Not supported.")
+
+    # Expect that setting a `ggm` type yields a `GgmModel` instance.
+    step_1$set_model("ggm")
+    expect_equal(step_1$model_type, "ggm")
+    expect_equal("GgmModel" %in% class(step_1$model), TRUE)
+})
+
+
+test_that("'StepOne' sets the statistic type correctly", {
+    # Create `StepOne` instance.
+    step_1 <- StepOne$new()
+
+    # Set dummy `Range`.
+    step_1$set_range(Range$new(100, 500))
+
+    # Expect that attempting to set an unknown statistic type throws an error.
+    expect_error(step_1$set_statistic("unknown", 0.8), "Not supported.")
+
+    # Expect that setting a `power` type yields a `PowerStatistic` instance.
+    step_1$set_statistic("power", 0.8)
+    expect_equal(step_1$statistic_type, "power")
+    expect_equal("PowerStatistic" %in% class(step_1$statistic), TRUE)
+})

tests/testthat/test-step-two.R

@@ -68,7 +68,7 @@ test_that("'StepTwo' correctly performs the LOOCV procedure", {
 })
 
 
-test_that("'StepTwo' fits a spline correctly", {
+test_that("'StepTwo' fits and interpolates a spline correctly", {
     # Create range.
     range <- Range$new(100, 1500, 10)