[Backfill corrections] Force modeling to use GLPK if gurobi license info isn't provided

backfill_corrections/delphiBackfillCorrection/DESCRIPTION

@@ -30,6 +30,7 @@ Suggests:
     knitr (>= 1.15),
     rmarkdown (>= 1.4),
     testthat (>= 1.0.1),
-    covr (>= 2.2.2)
+    covr (>= 2.2.2),
+    mockr
 RoxygenNote: 7.2.0
 Encoding: UTF-8

backfill_corrections/delphiBackfillCorrection/R/model.R

@@ -131,7 +131,10 @@ model_training_and_testing <- function(train_data, test_data, taus, covariates,
 
         success = success + 1
       },
-      error=function(e) {msg_ts("Training failed for ", model_path)}
+      error=function(e) {
+        msg_ts("Training failed for ", model_path, ". Check that your gurobi ",
+          "license is valid and being passed properly to the program.")
+      }
     )
   }
   if (success < length(taus)) {return (NULL)}

backfill_corrections/delphiBackfillCorrection/R/utils.R

@@ -67,9 +67,37 @@ read_params <- function(path = "params.json", template_path = "params.json.templ
   # Model parameters
   if (!("taus" %in% names(params))) {params$taus <- TAUS}
   if (!("lambda" %in% names(params))) {params$lambda <- LAMBDA}
-  if (!("lp_solver" %in% names(params))) {params$lp_solver <- LP_SOLVER}
   if (!("lag_pad" %in% names(params))) {params$lag_pad <- LAG_PAD}
 
+  if ("lp_solver" %in% names(params)) {
+    params$lp_solver <- match.arg(params$lp_solver, c("gurobi", "glpk"))
+  } else {
+    params$lp_solver <- LP_SOLVER
+  }
+  if (params$lp_solver == "gurobi") {
+    # Make call to gurobi CLI to check license. Returns a status of `0` if
+    # license can be found and is valid.
+    tryCatch(
+      expr = {
+        license_status <- run_cli("gurobi_cl")
+      },
+      error=function(e) {
+        if (grepl("Error 10032: License has expired", e$message, fixed=TRUE)) {
+          stop("The gurobi license has expired. Please renew or switch to ",
+            "using glpk. lp_solver can be specified in params.json.")
+        }
+        msg_ts(e$message)
+        license_status <- 1
+      }
+    )
+
+    if (license_status != 0) {
+      warning("gurobi solver was requested but license information was ",
+        "not available or not valid; using glpk instead")
+      params$lp_solver <- "glpk"
+    }
+  }
+
   # Data parameters
   if (!("num_col" %in% names(params))) {params$num_col <- "num"}
   if (!("denom_col" %in% names(params))) {params$denom_col <- "denom"}
@@ -109,6 +137,13 @@ read_params <- function(path = "params.json", template_path = "params.json.templ
   return(params)
 }
 
+#' Wrapper for `base::system2` for testing convenience
+#'
+#' @param command string to run as command
+run_cli <- function(command) {
+  system2(command)
+}
+
 #' Create directory if not already existing
 #'
 #' @param path string specifying a directory to create

backfill_corrections/delphiBackfillCorrection/unit-tests/testthat/params-glpk.json.template

@@ -0,0 +1,4 @@
+{
+  "input_dir": "./test.temp",
+  "lp_solver": "glpk"
+}

backfill_corrections/delphiBackfillCorrection/unit-tests/testthat/params-gurobi.json.template

@@ -0,0 +1,4 @@
+{
+  "input_dir": "./test.temp",
+  "lp_solver": "gurobi"
+}

backfill_corrections/delphiBackfillCorrection/unit-tests/testthat/params-run.json.template

@@ -4,5 +4,6 @@
   "ref_lag": 3,
   "input_dir": "./input",
   "export_dir": "./output",
-  "cache_dir": "./cache"
+  "cache_dir": "./cache",
+  "lp_solver": "glpk"
 }

backfill_corrections/delphiBackfillCorrection/unit-tests/testthat/params-test.json.template

@@ -1,3 +1,4 @@
 {
-  "input_dir": "./test.temp"
+  "input_dir": "./test.temp",
+  "lp_solver": "gurobi"
 }

backfill_corrections/delphiBackfillCorrection/unit-tests/testthat/test-beta_prior_estimation.R

@@ -70,7 +70,7 @@ test_that("testing the squared error objection function given the beta prior", {
 test_that("testing the prior estimation", {
   dw <- "Sat_ref"
   priors <- est_priors(train_data, prior_test_data, geo, value_type, dw, TAUS, 
-                       covariates, response, LP_SOLVER, lambda, 
+                       covariates, response, "glpk", lambda,
                        indicator, signal, geo_level, signal_suffix, 
                        training_end_date, training_start_date, model_save_dir)
   alpha <- priors[2]
@@ -110,7 +110,7 @@ test_that("testing the main beta prior adjustment function", {
                            indicator, signal, geo_level, signal_suffix,
                            lambda, value_type, geo, 
                            training_end_date, training_start_date, model_save_dir,
-                           taus = TAUS, lp_solver = LP_SOLVER)
+                           taus = TAUS, lp_solver = "glpk")
   updated_train_data <- updated_data[[1]]
   updated_test_data <- updated_data[[2]]
 

backfill_corrections/delphiBackfillCorrection/unit-tests/testthat/test-model.R

@@ -113,21 +113,21 @@ test_that("testing generating or loading the model", {
 
   # Generate the model and check again
   obj <- get_model(model_path, train_data, covariates, tau,
-                        lambda, LP_SOLVER, train_models=TRUE) 
+                        lambda, "glpk", train_models=TRUE)
   expect_true(file.exists(model_path))
   created <- file.info(model_path)$ctime
 
   # Check that the model was not generated again.
   obj <- get_model(model_path, train_data, covariates, tau,
-                        lambda, LP_SOLVER, train_models=FALSE)   
+                        lambda, "glpk", train_models=FALSE)
   expect_equal(file.info(model_path)$ctime, created)
 
   expect_silent(file.remove(model_path))
 })
 
 test_that("testing model training and testing", {
   result <- model_training_and_testing(train_data, test_data, taus=TAUS, covariates=covariates,
-                                       lp_solver=LP_SOLVER, lambda=lambda, test_lag=test_lag,
+                                       lp_solver="glpk", lambda=lambda, test_lag=test_lag,
                                        geo=geo, value_type=value_type, model_save_dir=model_save_dir,
                                        indicator=indicator, signal=signal,
                                        geo_level=geo_level, signal_suffix=signal_suffix,

backfill_corrections/delphiBackfillCorrection/unit-tests/testthat/test-utils.R

@@ -1,7 +1,13 @@
 library(stringr)
+library(mockr)
 
 context("Testing utils helper functions")
 
+# Make it look like we have a valid gurobi license for testing purposes.
+mock_system2 <- function(...) {
+  return(0)
+}
+
 test_that("testing create directory if not exist", {
   # If not exists
   path = "test.test"
@@ -55,14 +61,9 @@ test_that("testing read parameters", {
   expect_true(!("parallel_max_cores" %in% names(params)))
 
 
-  expect_true(!("taus" %in% names(params)))
-  expect_true(!("lambda" %in% names(params)))
-  expect_true(!("lp_solver" %in% names(params)))
   expect_true(!("lag_pad" %in% names(params)))
-
   expect_true(!("taus" %in% names(params)))
   expect_true(!("lambda" %in% names(params)))
-  expect_true(!("lp_solver" %in% names(params)))
 
   expect_true(!("num_col" %in% names(params)))
   expect_true(!("denom_col" %in% names(params)))
@@ -81,9 +82,11 @@ test_that("testing read parameters", {
   # Create input file
   path = "test.temp"
   create_dir_not_exist(path)
-  expect_silent(params <- read_params(path = "params-test.json",
+  expect_warning(params <- read_params(path = "params-test.json",
                                       template_path = "params-test.json.template",
-                                      train_models = TRUE, make_predictions = TRUE))
+                                      train_models = TRUE, make_predictions = TRUE),
+                 "gurobi solver was requested but license information was not available"
+  )
   unlink(path, recursive = TRUE)
 
 
@@ -92,12 +95,7 @@ test_that("testing read parameters", {
 
   expect_true("parallel" %in% names(params))
   expect_true("parallel_max_cores" %in% names(params))
-
-
-  expect_true("taus" %in% names(params))
-  expect_true("lambda" %in% names(params))
-  expect_true("lp_solver" %in% names(params))
-
+
   expect_true("taus" %in% names(params))
   expect_true("lambda" %in% names(params))
   expect_true("lp_solver" %in% names(params))
@@ -125,7 +123,7 @@ test_that("testing read parameters", {
 
   expect_true(all(params$taus == TAUS))
   expect_true(params$lambda == LAMBDA)
-  expect_true(params$lp_solver == LP_SOLVER)
+  expect_true(params$lp_solver == "glpk")
   expect_true(params$lag_pad == LAG_PAD)
 
   expect_true(params$num_col == "num")
@@ -148,6 +146,36 @@ test_that("testing read parameters", {
   expect_silent(file.remove("params-test.json"))
 })
 
+test_that("lp_solver selection works", {
+  # GLPK selected explicitly.
+  path = "test.temp"
+  create_dir_not_exist(path)
+  expect_silent(params <- read_params(path = "params-glpk.json",
+                                      template_path = "params-glpk.json.template",
+                                      train_models = TRUE, make_predictions = TRUE))
+  expect_true(params$lp_solver == "glpk")
+  expect_silent(file.remove("params-glpk.json"))
+
+  # gurobi selected explicitly, but without gurobi license file
+  expect_warning(params <- read_params(path = "params-gurobi.json",
+                                      template_path = "params-gurobi.json.template",
+                                      train_models = TRUE, make_predictions = TRUE),
+                 "gurobi solver was requested but license information was not available"
+  )
+  expect_true(params$lp_solver == "glpk")
+  expect_silent(file.remove("params-gurobi.json"))
+
+  # gurobi selected explicitly, with gurobi license file mocked to appear available and valid
+  local_mock("delphiBackfillCorrection::run_cli" = mock_system2)
+  expect_silent(params <- read_params(path = "params-gurobi.json",
+                                      template_path = "params-gurobi.json.template",
+                                      train_models = TRUE, make_predictions = TRUE))
+  expect_true(params$lp_solver == "gurobi")
+  expect_silent(file.remove("params-gurobi.json"))
+
+  unlink(path, recursive = TRUE)
+})
+
 test_that("validity_checks alerts appropriately", {
   time_value = as.Date(c("2022-01-01", "2022-01-02", "2022-01-03"))
   issue_date = as.Date(c("2022-01-05", "2022-01-05", "2022-01-05"))