tests/testthat/test-integration.R

In dirkschumacher/rmpk.glpk: GLPK Bindings For RMPK

test_that("a first example works", {
  set.seed(42)
  solver <- GLPK()
  v <- rnorm(10)
  w <- rnorm(10)
  model <- rmpk::MIPModel(solver)
  model$add_variable(x[i], type = "integer", lb = 0, ub = 1, i = 1:10)
  model$set_objective(rmpk::sum_expr(v[i] * x[i], i = 1:10), sense = "max")
  model$add_constraint(rmpk::sum_expr(w[i] * x[i], i = 1:10) <= 5)
  model$optimize()
  res <- model$get_variable_value(x[i])
  expect_true(all(res$value %in% c(0, 1)))
  expect_true(any(res$value == 1))
  expect_true(model$objective_value() > 0)
})

test_that("register a callback", {
  solver <- GLPK()
  model <- rmpk::MIPModel(solver)
  model$add_variable(x[i], type = "binary", i = 1:10)
  model$set_objective(rmpk::sum_expr(x[i], i = 1:10), sense = "max")
  model$add_constraint(rmpk::sum_expr(x[i], i = 1:10) <= 7.5)

  # When an integer solution is found, we dynamically add a constraint
  # further restricting the search space
  solver$set_irowgen_callback(function() {
    values <- vapply(1:10, function(i) {
      var <- x[i]
      # in GLPK you can only access the values of the relaxation
      solver$glpk_get_col_prim(x[i])
    }, numeric(1L))
    all_integral <- all(values %% 1 == 0)
    if (all_integral && sum(values) > 4) {
      model$add_constraint(rmpk::sum_expr(x[i], i = 1:10) <= 4)
    }
  })

  model$optimize()
  res <- model$get_variable_value(x[i])
  expect_equal(sum(res$value), 4)
})

test_that("bounds and equality constraints", {
  solver <- GLPK()
  model <- rmpk::MIPModel(solver)
  model$add_variable(x[i], type = "integer", lb = 0, ub = 1, i = 1:10)
  model$set_objective(rmpk::sum_expr(x[i], i = 1:10), sense = "max")
  model$add_constraint(x[i] == 0, i = 1:5)
  model$set_bounds(x[i], ub = 0, i = 6:9)
  model$optimize()
  res <- model$get_variable_value(x[i])
  res <- res[order(res$i), ]
  expect_equal(res$value, c(rep.int(0, 9), 1))
})