Refactor status (#25)

.Rbuildignore

@@ -9,3 +9,5 @@
 ^\.travis\.yml$
 ^_pkgdown\.yml$
 ^windows$
+^packrat/
+^\.Rprofile$

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rcbc
 Type: Package
 Title: COIN CBC MILP Solver Bindings
-Version: 0.1.0.9000
+Version: 0.1.0.9001
 Description: An R interface to the CBC solver for mixed-integer linear programs.
 Authors@R: c(
   person("Dirk", "Schumacher", email = "mail@dirk-schumacher.net", role = c("aut", "cre")),

R/cbc_solve.R

@@ -167,5 +167,23 @@ solution_status <- function(result) {
 
 #' @export
 solution_status.rcbc_milp_result <- function(result) {
-  result$status
+
+  status_map <- list(
+    is_proven_optimal = "optimal",
+    is_proven_dual_infeasible = "unbounded",
+    is_proven_infeasible = "infeasible",
+    is_node_limit_reached = "nodelimit",
+    is_solution_limit_reached = "solutionlimit",
+    is_abandoned = "abandoned",
+    is_iteration_limit_reached = "iterationlimit",
+    is_seconds_limit_reached = "timelimit"
+    )
+
+  result <- Filter(function(x) is.logical(x) && x == TRUE, result)
+  if (length(result) > 0L) {
+    status_map[names(result)][[1L]]
+  }
+  else {
+    "unknown"
+  }
 }

src/cpp_cbc_solve.cpp

@@ -56,41 +56,23 @@ List cpp_cbc_solve(NumericVector obj,
   for(int i = 0; i < nCols; i++) {
     solution[i] = solverSolution[i];
   }
-  std::string status = "unknown";
-  bool isOptimal = model.isProvenOptimal();
-  bool isInfeasible = model.isProvenInfeasible();
-  bool isUnbounded = model.isProvenDualInfeasible();
-  bool isNodeLimitedReached = model.isNodeLimitReached();
-  bool isSolutionLimitReached = model.isSolutionLimitReached();
+
   bool isIterationLimitReached = model.solver()->isIterationLimitReached();
-  bool isAbandoned = model.isAbandoned();
-  if (isOptimal) {
-    status = "optimal";
-  } else if (isUnbounded) {
-    status = "unbounded";
-  } else if (isInfeasible) {
-    status = "infeasible";
-  } else if (isNodeLimitedReached) {
-    status = "nodelimit";
-  } else if (isSolutionLimitReached) {
-    status = "solutionlimit";
-  } else if (isAbandoned) {
-    status = "abandoned";
-  } else if (isIterationLimitReached) {
-    status = "iterationlimit";
-  }
+
   const double objValue = model.solver()->getObjValue();
   return List::create(
     Named("column_solution", solution),
-    Named("status", status),
     Named("objective_value", objValue),
-    Named("is_proven_optimal", isOptimal),
-    Named("is_proven_infeasible", isInfeasible),
-    Named("is_proven_dual_infeasible", isUnbounded),
-    Named("is_node_limit_reached", isNodeLimitedReached),
-    Named("is_solution_limit_reached", isSolutionLimitReached),
-    Named("is_abandoned", isAbandoned),
-    Named("is_iteration_limit_reached", isIterationLimitReached));
+    Named("is_proven_optimal", model.isProvenOptimal()),
+    Named("is_proven_dual_infeasible", model.isProvenDualInfeasible()),
+    Named("is_proven_infeasible", model.isProvenInfeasible()),
+    Named("is_node_limit_reached", model.isNodeLimitReached()),
+    Named("is_solution_limit_reached", model.isSolutionLimitReached()),
+    Named("is_abandoned", model.isAbandoned()),
+
+    Named("is_iteration_limit_reached", isIterationLimitReached),
+    Named("is_seconds_limit_reached", model.isSecondsLimitReached())
+  );
 }
 
 /*** R

tests/testthat/test-cbc-solver.R

@@ -158,3 +158,39 @@ describe("prepare_cbc_args", {
                  label = "all parameter names should contain word characters")
   })
 })
+
+test_that("status is assigned correct value", {
+  result <- list(
+    is_proven_optimal = FALSE,
+    is_proven_infeasible = FALSE,
+    is_proven_dual_infeasible = FALSE,
+    is_node_limit_reached = TRUE,
+    is_solution_limit_reached = FALSE,
+    is_abandoned = FALSE,
+    is_iteration_limit_reached = TRUE
+  )
+  result <- structure(result, class = "rcbc_milp_result")
+  expect_equal(solution_status(result), "nodelimit",
+               label = "status corresponding to the first true value is returned")
+
+  result <- list(
+    is_proven_optimal = FALSE,
+    is_proven_infeasible = FALSE,
+    is_abandoned = FALSE,
+    is_iteration_limit_reached = TRUE
+  )
+  result <- structure(result, class = "rcbc_milp_result")
+  expect_equal(solution_status(result), "iterationlimit",
+               label = "corresponding status returned")
+
+  result <- list(
+    is_proven_optimal = FALSE,
+    is_proven_infeasible = FALSE,
+    is_abandoned = FALSE,
+    is_iteration_limit_reached = FALSE
+  )
+  result <- structure(result, class = "rcbc_milp_result")
+  expect_equal(solution_status(result), "unknown",
+               lable = "unknown is returned if non of values is set to TRUE")
+
+})