ECOSolveR: Embedded Conic Solver in R

context("ECOS C source suite Tests")

data(ECOS_exitcodes)

ecos_code <- function(ecos_symbolic_name) ECOS_exitcodes[ecos_symbolic_name, ]$code

## log_ax test has an additional test on accuracy, in addition to one
## on exitFlag.  There is a problem on 32-Solaris and windows where
## this test fails (not on Win 64!).  I have checked the test directly
## with the C code and so the problem is not with anything in our
## calling it from R. The precision is not reached; instead of
## achieving something less than 1e-11, it only reaches 8e-11 or so on
## the 32-bit platforms, which is quite odd. Therefore, I'm modifying
## this test with a more generous tolerance.
test_log_ax_accuracy <- function(result) {
    true_x <- -log(0.3)/0.3
    ecos_x <- result$x[1]
    abs_err <- abs(true_x - ecos_x)
    ## Original test from C code
    ##    expect_true( abs_err < 1e-11)
    ## Our more generous test
    expect_true( abs_err < 1e-10)
}

ecos_control <- ecos.control(verbose = 1L)

ecos_test_info <- list(
    list(message = "MPC01: ECOS failed to produce outputflag OPTIMAL",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL") ),
         test_further = NULL),
    list(message = "MPC02: ECOS failed to produce outputflag OPTIMAL",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL") || exitflag == ecos_code("ECOS_OPTIMAL")+ecos_code("ECOS_INACC_OFFSET") ),
         test_further = NULL),
    list(message = "quadratics-norm-test: ECOS failed to produce output flag OPTIMAL",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL") ),
         test_further = NULL),
    list(message = "quadratics-quad-over-lin-test: ECOS failed to produce output flag OPTIMAL",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL") ),
         test_further = NULL),
    list(message = "quadratics-sq-norm-test: ECOS failed to produce output flag OPTIMAL",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL") ),
         test_further = NULL),
    list(message = "quadratics-sum-sq-test: ECOS failed to produce output flag OPTIMAL",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL") ),
         test_further = NULL),
    list(message = "inv-pos-test: ECOS failed to produce at least something close to OPTIMAL",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL")+ecos_code("ECOS_INACC_OFFSET") || exitflag == ecos_code("ECOS_OPTIMAL") ),
         test_further = NULL),
    list(message = "feas-test: ECOS failed to produce outputflag OPTIMAL",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL") ),
         test_further = NULL),
    list(message = "unboundedLP1: ECOS failed to produce outputflag UNBOUNDED",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_DINF") ),
         test_further = NULL),
    list(message = "infeasible1: ECOS failed to produce outputflag PRIMAL INFEASIBLE",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_PINF") ),
         test_further = NULL),
    list(message = "lp_25fv47: ECOS failed to produce outputflag OPTIMAL",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL") ),
         test_further = NULL),
    list(message = "lp_adlittle: ECOS failed to produce outputflag OPTIMAL",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL") ),
         test_further = NULL),
    list(message = "lp_afiro: ECOS failed to produce outputflag OPTIMAL",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL") ),
         test_further = NULL),
    list(message = "lp_agg: ECOS failed to produce outputflag OPTIMAL",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL") ),
         test_further = NULL),
    list(message = "lp_agg2: ECOS failed to produce outputflag OPTIMAL",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL") ),
         test_further = NULL),
    list(message = "lp_agg3: ECOS failed to produce outputflag OPTIMAL",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL") ),
         test_further = NULL),
    list(message = "lp_bandm: ECOS failed to produce outputflag OPTIMAL",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL") ),
         test_further = NULL),
    list(message = "lp_beaconfd: ECOS failed to produce outputflag OPTIMAL",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL") ),
         test_further = NULL),
    list(message = "lp_blend: ECOS failed to produce outputflag OPTIMAL",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL") ),
         test_further = NULL),
    list(message = "lp_bnl1: ECOS failed to produce outputflag OPTIMAL",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL") ),
         test_further = NULL),
    list(message = "githubIssue98-test: ECOS failed to produce outputflag OPTIMAL",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL") ),
         test_further = NULL),
    list(message = "emptyProblem: ECOS failed to produce outputflag OPTIMAL",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL") ),
         test_further = NULL),
    list(message = "update_data: ECOS failed to produce correct updated solution.",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL") || exitflag == ecos_code("ECOS_OPTIMAL")+ecos_code("ECOS_INACC_OFFSET"))),
    list(message = "random_feasible: ECOS failed to produce outputflag OPTIMAL",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL") ),
         test_further = NULL),
    list(message = "random_infeasible: ECOS failed to produce outputflag ECOS_PINF)",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_PINF") ),
         test_further = NULL),
    list(message = "random_unbounded: ECOS failed to produce outputflag ECOS_DINF)",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_DINF") ),
         test_further = NULL),
    list(message = "num_err: ECOS failed to produce outputflag UNBOUNDED",
         control = ecos_control,
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_DINF") ),
         test_further = NULL),
    list(message = "log_ax_x: ECOS failed to produce outputflag OPTIMAL or desired precision!",
         control = ecos.control(verbose = 1L, feastol = 1e-12),
         test = function(exitflag) expect_true(  exitflag == ecos_code("ECOS_OPTIMAL") ),
         test_further = test_log_ax_accuracy)
)

ecos_test_data = c(
    "MPC01_1.RDS",
    "MPC02_1.RDS",
    "generated_tests_1.RDS",
    "generated_tests_2.RDS",
    "generated_tests_3.RDS",
    "generated_tests_4.RDS",
    "generated_tests_5.RDS",
    "feas_1.RDS",
    "unboundedLP1_1.RDS",
    "infeasible1_1.RDS",
    "lp_25fv47_1.RDS",
    "lp_adlittle_1.RDS",
    "lp_afiro_1.RDS",
    "lp_agg_1.RDS",
    "lp_agg2_1.RDS",
    "lp_agg3_1.RDS",
    "lp_bandm_1.RDS",
    "lp_beaconfd_1.RDS",
    "lp_blend_1.RDS",
    "lp_bnl1_1.RDS",
    "githubIssue98_1.RDS",
    "emptyProblem_1.RDS",
    "update_data_1.RDS", ## only one
    "random_feasible_1.RDS",
    "random_infeasible_1.RDS",
    "random_unbounded_1.RDS",
    "num_err_1.RDS",
    "log_ax_x_1.RDS"
)

names(ecos_test_info) <- ecos_test_data

run_ecos_on_data <- function(data_file, control) {
    prob_data <- readRDS(system.file("testdata", data_file, package = "ECOSolveR"))
    if (prob_data$m == 0 || prob_data$n == 0) {
        G <- NULL
        h <- NULL
    } else {
        G <- Matrix::sparseMatrix(x = prob_data$Gpr, i = prob_data$Gir, p = prob_data$Gjc,
                                  dims = c(prob_data$m, prob_data$n), index1 = FALSE)
        h <- prob_data$h
    }
    if (prob_data$p == 0 || prob_data$n == 0) {
        A <- NULL
        b <- NULL
    } else {
        A <- Matrix::sparseMatrix(x = prob_data$Apr, i = prob_data$Air, p = prob_data$Ajc,
                                  dims = c(prob_data$p, prob_data$n), index1 = FALSE)
        b <- prob_data$b
    }
    dims <- lapply(list(l = prob_data$l, q=prob_data$q, e=prob_data$e), as.integer)

    ECOS_csolve(c = prob_data$c, G=G, h = h, dims = dims, A = A, b = b,
                control = control)
}


run_test <- function(data_file) {
    test_info <- ecos_test_info[[data_file]]
    test_that( test_info[["message"]], {
        result <- run_ecos_on_data(data_file, control = test_info$control)
        test_info[["test"]](result$retcodes["exitFlag"])
        if (!is.null(test_info$test_further)) {
            test_info$test_further(result)
        }
    })
}

## Run all the tests
for (d in ecos_test_data) {
    run_test(d)
}