r-opt · dirkschumacher · Mar 14, 2020
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -10,7 +10,7 @@ Description: Model real world mixed integer programs in R.
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 6.1.1
+RoxygenNote: 7.0.2
 Suggests: 
     covr,
     knitr,
@@ -27,6 +27,7 @@ Imports:
     methods,
     rlang
 Collate: 
+    'cache-solver.R'
     'helper.R'
     'linear-expression-class.R'
     'variable-class.R'
@@ -36,6 +37,7 @@ Collate:
     'solver-interface.R'
     'roi-solver.R'
     'mip-model.R'
+    'pipe-api.R'
     'quadratic-expression-class.R'
     'quadratic-expression-methods.R'
     'rmpk-package.R'

diff --git a/NAMESPACE b/NAMESPACE
@@ -1,9 +1,12 @@
 # Generated by roxygen2: do not edit by hand
 
 export(MIPModel)
+export(Model)
 export(RMPSolverInterface)
 export(ROI_solver)
 export(TERMINATION_STATUS)
+export(add_variable)
+export(cache_solver)
 export(sum_expr)
 exportClasses(RMPKLinearExpression)
 exportClasses(RMPKQuadraticExpression)

diff --git a/R/cache-solver.R b/R/cache-solver.R
@@ -0,0 +1,25 @@
+#' A solver that caches all operations
+#'
+#' It cannot solve anything.
+#'
+#' @export
+cache_solver <- function() {
+  CachedMipSolver$new(NULL)
+}
+
+CachedMipSolver <- R6::R6Class(
+  "CachedMipSolver",
+  inherit = ROIMipSolver,
+  public = list(
+    format = function(...) {
+      "No solver (caching)"
+    },
+    set_solver = function(solver) {
+      stopifnot(inherts(solver, "RMPSolverInterface"))
+      private$solver <- solver
+    }
+  ),
+  private = list(
+    solver = NULL
+  )
+)
diff --git a/R/mip-model-methods.R b/R/mip-model-methods.R
@@ -34,6 +34,7 @@ mip_model_impl_set_objective <- function(obj_variables, sense = "min") {
     obj_variables <- ensure_linear_expression(obj_variables)
     private$solver$set_linear_objective(obj_variables, sense)
   }
+
   invisible()
 }
 
@@ -109,7 +110,7 @@ mip_model_impl_get_value <- function(variable_selector) {
   )
 }
 
-mip_model_impl_get_variable_dual <- function(variable_selector) {
+mip_model_impl_get_variable_dual <- function() {
   extract_solver_variable_value(
     private,
     rlang::enquo(variable_selector),

diff --git a/R/mip-model.R b/R/mip-model.R
@@ -2,11 +2,23 @@
 #'
 #' @param solver a solver object
 #' @include roi-solver.R
+#' @include cache-solver.R
 #' @export
-MIPModel <- function(solver) {
+MIPModel <- function(solver = cache_solver()) {
   RMPKMipModel$new(solver)
 }
 
+#' A new mixed-integer programming Model
+#'
+#' @param solver a solver object
+#' @include roi-solver.R
+#' @include cache-solver.R
+#' @export
+Model <- function(solver = cache_solver()) {
+  RMPKMipModel$new(solver)
+}
+
+
 #' @include mip-model-methods.R
 #' @noRd
 RMPKMipModel <- R6::R6Class("RMPKMipModel",
@@ -36,6 +48,7 @@ RMPKMipModel <- R6::R6Class("RMPKMipModel",
       cat("MIP Model: \n")
       cat("  Variables: ", private$solver$nvars(), "\n", sep = "")
       cat("  Constraints: ", private$solver$nconstraints(), "\n", sep = "")
+      cat("  Solver:", format(private$solver), "\n")
       invisible(self)
     }
   ),

diff --git a/R/pipe-api.R b/R/pipe-api.R
@@ -0,0 +1,157 @@
+#' @export
+add_variable <- function(model, variable_expr, ..., type = "continuous", lb = -Inf, ub = Inf) {
+  UseMethod("add_variable")
+}
+
+add_variable.RMPKMipModel <- function(model, variable_expr, ..., type = "continuous", lb = -Inf, ub = Inf) {
+  model <- as_pipe_mip_model(model)
+  add_variable(model, !!rlang::enquo(variable_expr), ..., type = type, lb = lb, ub = ub)
+}
+
+add_variable.PipeRMPKMipModel <- function(model, variable_expr, ..., type = "continuous", lb = -Inf, ub = Inf) {
+  model$assign_to_env(
+    extract_var_name(rlang::enquo(variable_expr)),
+    model$add_variable(..., type = type, lb = lb, ub = ub)
+  )
+  model
+}
+
+set_objective <- function(model, obj_variables, sense = "min") {
+  UseMethod("set_objective")
+}
+
+set_objective.RMPKMipModel <- function(model, obj_variables, sense = "min") {
+  model <- as_pipe_mip_model(model)
+  set_objective(model, rlang::enquo(obj_variables), sense)
+}
+
+set_objective.PipeRMPKMipModel <- function(model, obj_variables, sense = "min") {
+  model$with_variable_env(
+    rlang::quo(model$set_objective(!!rlang::get_expr(rlang::enquo(obj_variables)), !!sense))
+  )
+  model
+}
+
+add_constraint <- function(model, obj_variables, sense = "min") {
+  UseMethod("add_constraint")
+}
+
+add_constraint.RMPKMipModel <- function(model, expr, ...) {
+  model <- as_pipe_mip_model(model)
+  add_constraint(model, rlang::enquo(expr), ...)
+}
+
+add_constraint.PipeRMPKMipModel <- function(model, expr, ...) {
+  args <- rlang::enexprs(expr, ...)
+  model$with_variable_env(
+    rlang::quo(model$add_constraint(!!!lapply(args, rlang::get_expr)))
+  )
+  model
+}
+
+set_bounds <- function(model, expr, ..., lb = NULL, ub = NULL) {
+  UseMethod("set_bounds")
+}
+
+set_bounds.RMPKMipModel <- function(model, expr, ..., lb = NULL, ub = NULL) {
+  model <- as_pipe_mip_model(model)
+  set_bounds(model, rlang::enquo(expr), ..., lb = lb, ub = ub)
+}
+
+set_bounds.PipeRMPKMipModel <-
F438
 function(model, expr, ..., lb = NULL, ub = NULL) {
+  args <- rlang::enexprs(expr, ...)
+  model$with_variable_env(
+    rlang::quo(model$set_bounds(!!!lapply(args, rlang::get_expr), lb = !!lb, ub = !!ub))
+  )
+  model
+}
+
+get_solution <- function(model) {
+
+}
+
+solve_model <- function(model, solver) {
+  stopifnot(inherits(model, "PipeRMPKMipModel"))
+
+}
+
+extract_var_name <- function(expr) {
+  if (rlang::quo_is_symbol(expr)) {
+    return(vctrs::vec_cast(rlang::quo_get_expr(expr), "character"))
+  }
+  quo <- rlang::quo_get_expr(expr)
+  if (rlang::quo_is_call(expr) && length(quo) >= 2L &&
+      quo[[1L]] == "[" && rlang::is_symbol(quo[[2L]])) {
+    return(vctrs::vec_cast(as.character(quo[[2L]]), "character"))
+  }
+  stop("wat")
+}
+
+as_pipe_mip_model <- function(model) {
+  stopifnot(inherits(model, "RMPKMipModel"))
+  PipeRMPKMipModel$new(model)
+}
+
+PipeRMPKMipModel <- R6::R6Class(
+  "PipeRMPKMipModel",
+  public = list(
+    initialize = function(mip_model) {
+      private$mip_model <- mip_model
+      private$variable_env <- rlang::new_environment()
+    },
+    assign_to_env = function(var_name, value) {
+      assign(var_name, value, envir = private$variable_env)
+    },
+    with_variable_env = function(expr) {
+      parent <- rlang::quo_get_env(expr)
+      parent.env(private$variable_env) <- parent # TODO: this alters the parent
+      rlang::eval_tidy(rlang::quo_get_expr(expr), env = private$variable_env)
+    },
+    add_variable = function(..., type = "continuous", lb = -Inf, ub = Inf) {
+      private$mip_model$add_variable(..., type = type, lb = lb, ub = ub)
+    },
+    set_objective = function(obj_variables, sense = "min") {
+      private$mip_model$set_objective(obj_variables, sense)
+    },
+    add_constraint = function(expr, ...) {
+      args <- rlang::enquos(expr, ...)
+      rlang::eval_tidy(
+        rlang::quo(
+          private$mip_model$add_constraint(!!!args)
+        )
+      )
+    },
+    set_bounds = function(expr, ..., lb = NULL, ub = NULL) {
+      private$mip_model$set_bounds(expr, ..., lb = lb, ub = ub)
+    },
+
+    # optimize
+    optimize = function() private$mip_model$optimize(),
+    termination_status = function() {
+      private$mip_model$termination_status()
+    },
+    termination_solver_message = function() {
+      private$mip_model$termination_solver_message()
+    },
+    get_variable_value = function(variable_selector) {
+      private$mip_model$get_variable_value(variable_selector)
+    },
+    get_variable_dual = function(variable_selector) {
+      private$mip_model$get_variable_dual(variable_selector)
+    },
+    get_row_duals = function() {
+      private$mip_model$get_row_duals()
+    },
+    objective_value = function() {
+      private$mip_model$objective_value()
+    },
+
+    format = function(...) {
+      format(private$mip_model)
+    }
+  ),
+  private = list(
+    mip_model = NULL,
+    variable_env = NULL
+  )
+)
diff --git a/R/roi-solver.R b/R/roi-solver.R
@@ -148,11 +148,18 @@ ROIMipSolver <- R6::R6Class(
         bounds = var_bounds,
         maximum = private$obj_sense == "max"
       )
-      private$roi_result <- ROI::ROI_solve(
-        op,
-        private$roi_solver_name,
-        control = private$roi_control_list
-      )
+      private$roi_result <- if (is.null(private$roi_solver_name)) {
+        private$roi_result <- ROI::ROI_solve(
+          op,
+          control = private$roi_control_list
+        )
+      } else {
+        private$roi_result <- ROI::ROI_solve(
+          op,
+          private$roi_solver_name,
+          control = private$roi_control_list
+        )
+      }
     },
     get_variable_value = function(var_index) {
       private$roi_result$solution[[var_index]]
@@ -197,6 +204,13 @@ ROIMipSolver <- R6::R6Class(
     },
     constraint_direction = function() {
       private$row_dir
+    },
+    format = function(...) {
+      if (!is.null(private$roi_solver_name)) {
+        paste0("ROI solver bound to ", private$roi_solver_name)
+      } else {
+        "ROI solver"
+      }
     }
   ),
   private = list(

diff --git a/R/solver-interface.R b/R/solver-interface.R
@@ -57,6 +57,9 @@ RMPSolverInterface <- R6::R6Class(
     },
     get_termination_message = function() {
       not_implemented()
+    },
+    format = function(...) {
+      "unknown solver"
     }
   )
 )

diff --git a/man/MIPModel.Rd b/man/MIPModel.Rd
diff --git a/man/Model.Rd b/man/Model.Rd