diff --git a/tests/testthat/helpers.R b/tests/testthat/helpers.R index 7d428d7..38960a8 100644 --- a/tests/testthat/helpers.R +++ b/tests/testthat/helpers.R @@ -13,38 +13,6 @@ 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. -solve_osqp <- function(basis_matrix, y, lower, upper) { - # Set settings. - settings <- osqp::osqpSettings( - verbose = FALSE, - eps_abs = 1e-10, - eps_rel = 1e-10, - linsys_solver = 0L, - warm_start = FALSE - ) - - # Create matrices for `osqp`. - p_mat <- crossprod(basis_matrix, basis_matrix) - q_vec <- -crossprod(basis_matrix, y) - - # Create constraint matrix. - a_mat <- diag(1, ncol(basis_matrix)) - - # Create model. - model <- osqp::osqp( - P = p_mat, - q = q_vec, - A = a_mat, - l = lower, - u = upper, - pars = settings - ) - - # Optimize. - return(model$Solve()$x) -} - # Compute performance measures. compute_measure <- function(true_parameters, estimated_parameters, measure) { # Extract the true and estimated parameters from the weights matrices. diff --git a/tests/testthat/test-solver.R b/tests/testthat/test-solver.R index 2a18a06..7d86803 100644 --- a/tests/testthat/test-solver.R +++ b/tests/testthat/test-solver.R @@ -10,17 +10,11 @@ test_that("'Solver' implementations set correct constraints for monotone non-dec n <- ncol(ispline$matrix) # Create solvers. - osqp <- OsqpSolver$new() qp <- QuadprogSolver$new() # Setup solvers. - osqp$setup(ispline, y, increasing = TRUE) qp$setup(ispline, y, increasing = TRUE) - # Test bounds for 'OsqpSolver'. - expect_equal(osqp$.__enclos_env__$private$.lower, c(-Inf, rep(0, n - 1))) - expect_equal(osqp$.__enclos_env__$private$.upper, rep(Inf, n)) - # Constraints for 'QuadprogSolver'. b_vec <- rep(0, n) a_mat <- diag(1, n) @@ -42,17 +36,11 @@ test_that("'Solver' implementations set correct constraints for monotone non-inc n <- ncol(ispline$matrix) # Create solvers. - osqp <- OsqpSolver$new() qp <- QuadprogSolver$new() # Setup solvers. - osqp$setup(ispline, y, increasing = FALSE) qp$setup(ispline, y, increasing = FALSE) - # Test bounds for 'OsqpSolver'. - expect_equal(osqp$.__enclos_env__$private$.lower, rep(-Inf, n)) - expect_equal(osqp$.__enclos_env__$private$.upper, c(Inf, rep(0, n - 1))) - # Constraints for 'QuadprogSolver'. b_vec <- rep(0, n) a_mat <- diag(-1, n) @@ -74,17 +62,11 @@ test_that("'Solver' implementations set correct constraints for non-monotone spl n <- ncol(bspline$matrix) # Create solvers. - osqp <- OsqpSolver$new() qp <- QuadprogSolver$new() # Setup solvers. - osqp$setup(bspline, y) qp$setup(bspline, y) - # Test bounds for 'OsqpSolver'. - expect_equal(osqp$.__enclos_env__$private$.lower, rep(-Inf, n)) - expect_equal(osqp$.__enclos_env__$private$.upper, rep(Inf, n)) - # Constraints for 'QuadprogSolver'. b_vec <- rep(0, n) a_mat <- diag(0, n) @@ -105,15 +87,12 @@ test_that("'Solver' implementations give correct solution for monotone non-decre n <- ncol(ispline$matrix) # Create solvers. - osqp <- OsqpSolver$new() qp <- QuadprogSolver$new() # Setup solvers. - osqp$setup(ispline, y, increasing = TRUE) qp$setup(ispline, y, increasing = TRUE) # Solve using own implementations. - osqp_impl_alpha <- osqp$solve() qp_impl_alpha <- qp$solve() # Solve using 'quadprog'. @@ -122,15 +101,8 @@ test_that("'Solver' implementations give correct solution for monotone non-decre b_vec <- rep(0, n) qp_alpha <- solve_qp(ispline$matrix, y, a_mat, b_vec) - # Solve using 'osqp'. - osqp_alpha <- solve_osqp(ispline$matrix, y, c(-Inf, rep(0, n - 1)), rep(Inf, n)) - # Each implementation should be equal with its counterpart. - expect_equal(osqp_impl_alpha, osqp_alpha, tolerance = 1e-6) expect_equal(qp_impl_alpha, qp_alpha, tolerance = 1e-6) - - # The implementations should also give the same solution. - expect_equal(osqp_impl_alpha, qp_impl_alpha, tolerance = 1e-6) }) @@ -144,15 +116,12 @@ test_that("'Solver' implementations give correct solution for monotone non-incre n <- ncol(ispline$matrix) # Create solvers. - osqp <- OsqpSolver$new() qp <- QuadprogSolver$new() # Setup solvers. - osqp$setup(ispline, y, increasing = FALSE) qp$setup(ispline, y, increasing = FALSE) # Solve using own implementations. - osqp_impl_alpha <- osqp$solve() qp_impl_alpha <- qp$solve() # Solve using 'quadprog'. @@ -161,15 +130,8 @@ test_that("'Solver' implementations give correct solution for monotone non-incre b_vec <- rep(0, n) qp_alpha <- solve_qp(ispline$matrix, y, a_mat, b_vec) - # Solve using 'osqp'. - osqp_alpha <- solve_osqp(ispline$matrix, y, rep(-Inf, n), c(Inf, rep(0, n - 1))) - # Each implementation should be equal with its counterpart. - expect_equal(osqp_impl_alpha, osqp_alpha, tolerance = 1e-6) expect_equal(qp_impl_alpha, qp_alpha, tolerance = 1e-6) - - # The implementations should also give the same solution. - expect_equal(osqp_impl_alpha, qp_impl_alpha, tolerance = 1e-6) }) @@ -182,22 +144,18 @@ test_that("'Solver' implementations give correct solution for non-monotone splin bspline <- Basis$new(x, df = 0, monotone = FALSE) # Create solvers. - osqp <- OsqpSolver$new() qp <- QuadprogSolver$new() # Setup solvers. - osqp$setup(bspline, y) qp$setup(bspline, y) # Solve using own implementations. - osqp_impl_alpha <- osqp$solve() qp_impl_alpha <- qp$solve() # Solve using 'lm'. lm_alpha <- as.numeric(lm.fit(bspline$matrix, y)$coefficients) # Test. - expect_equal(osqp_impl_alpha, lm_alpha, tolerance = 1e-6) expect_equal(qp_impl_alpha, lm_alpha, tolerance = 1e-6) }) @@ -212,36 +170,25 @@ test_that("'Solver' implementations gives correct solution for updated statistic n <- ncol(ispline$matrix) # Create solvers. - osqp <- OsqpSolver$new() qp <- QuadprogSolver$new() # Setup solvers. - osqp$setup(ispline, y, increasing = TRUE) qp$setup(ispline, y, increasing = TRUE) # Solve first time with original data. - osqp$solve() qp$solve() # Create new data to update the solver. y_new <- sample(y, length(y), TRUE) # Update solvers and solve problem. - osqp_impl_alpha <- osqp$solve_update(y_new) qp_impl_alpha <- qp$solve_update(y_new) - # Solve problem with new data using 'osqp' helper. - osqp_alpha <- solve_osqp(ispline$matrix, y_new, osqp$.__enclos_env__$private$.lower, osqp$.__enclos_env__$private$.upper) - # Solve problem with new data using 'quadprog' helper. qp_alpha <- solve_qp(ispline$matrix, y_new, qp$.__enclos_env__$private$.a_mat, qp$.__enclos_env__$private$.b_vec) # The solver implementations should agree with their counterpart helpers. - expect_equal(osqp_impl_alpha, osqp_alpha, tolerance = 1e-6) expect_equal(qp_impl_alpha, qp_alpha, tolerance = 1e-6) - - # The solver implementations should give the same solution. - expect_equal(osqp_impl_alpha, qp_impl_alpha, tolerance = 1e-6) }) @@ -254,26 +201,21 @@ test_that("'Solver' implementations still give original solution after solving w ispline <- Basis$new(x, df = 0, monotone = TRUE) # Create solvers. - osqp <- OsqpSolver$new() qp <- QuadprogSolver$new() # Setup solvers. - osqp$setup(ispline, y, increasing = TRUE) qp$setup(ispline, y, increasing = TRUE) # Solve first time with original data. - osqp_first_alpha <- osqp$solve() qp_first_alpha <- qp$solve() # Create new data to update the solver. y_new <- sample(y, length(y), TRUE) # Solve with updated data. - osqp$solve_update(y_new) qp$solve_update(y_new) # Solve again and expect to recover the original solution. - expect_equal(osqp_first_alpha, osqp$solve()) expect_equal(qp_first_alpha, qp$solve()) }) diff --git a/tests/testthat/test-step-two.R b/tests/testthat/test-step-two.R index 4843d2c..91ccbbc 100644 --- a/tests/testthat/test-step-two.R +++ b/tests/testthat/test-step-two.R @@ -53,11 +53,8 @@ test_that("'StepTwo' correctly performs the LOOCV procedure", { # Create 'StepTwo' mock instance. step_2 <- StepTwoTester$new(step_1) - # Flip a coin to decide which solver to use. - solver_type <- ifelse(rbinom(1, 1, .5), "quadprog", "osqp") - # Perform LOOCV via the mock instance. - step_2$run_cv(monotone = TRUE, increasing = TRUE, df = NULL, solver_type = solver_type) + step_2$run_cv(monotone = TRUE, increasing = TRUE, df = NULL, solver_type = "quadprog") # The dimensions if the LOOCV result should match the number of sample sizes and DF tested. expect_equal(nrow(step_2$cv$se), range$available_samples) @@ -91,11 +88,8 @@ test_that("'StepTwo' fits and interpolates a spline correctly", { # Fit a spline via step two. step_2 <- StepTwo$new(step_1) - # Flip a coin to decide which solver to use. - solver_type <- ifelse(rbinom(1, 1, .5), "quadprog", "osqp") - # Fit the spline. - step_2$fit(monotone = TRUE, increasing = TRUE, df = NULL, solver_type = solver_type) + step_2$fit(monotone = TRUE, increasing = TRUE, df = NULL, solver_type = "quadprog") # Extract the DF selected. df <- step_2$cv$df[which.min(step_2$cv$mse)] @@ -105,12 +99,16 @@ test_that("'StepTwo' fits and interpolates a spline correctly", { knots <- attributes(basis)$knots basis <- cbind(1, basis) - # Create box constraints for 'osqp'. - lower <- c(-Inf, rep(0, ncol(basis) - 1)) - upper <- rep(Inf, ncol(basis)) + # Number of basis functions. + n <- ncol(basis) + + # Create box constraints. + a_mat <- diag(1, n) + a_mat[1, 1] <- 0 + b_vec <- rep(0, n) # Estimate alpha. - alpha <- solve_osqp(basis, step_1$statistics, lower, upper) + alpha <- solve_qp(basis, step_1$statistics, a_mat, b_vec) # Predict. fitted <- basis %*% alpha