fix compatibility issues with deps

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: surveyvoi
 Type: Package
-Version: 1.0.3.1
+Version: 1.0.3.2
 Title: Survey Value of Information
 Description: Decision support tool for prioritizing sites for ecological
     surveys based on their potential to improve plans for conserving
@@ -35,7 +35,7 @@ Imports:
     parallel,
     progress (>= 1.2.2),
     assertthat (>= 0.2.0),
-    xgboost (>= 1.2.0.1),
+    xgboost (>= 1.5.2.1),
     plyr (>= 1.8.4),
     withr (>= 2.1.2),
     tibble (>= 2.1.3),
@@ -49,7 +49,7 @@ Imports:
     Rcpp (>= 0.12.19),
     Rsymphony (>= 0.1-31),
 Suggests:
-    testthat (>= 2.0.0),
+    testthat (>= 3.1.2),
     knitr (>= 1.20),
     roxygen2 (>= 6.1.0),
     rmarkdown (>= 1.10),
@@ -82,7 +82,7 @@ SystemRequirements:
 URL: https://github.com/jeffreyhanson/surveyvoi
 BugReports: https://github.com/jeffreyhanson/surveyvoi/issues
 VignetteBuilder: knitr
-RoxygenNote: 7.1.1
+RoxygenNote: 7.1.2
 Encoding: UTF-8
 Biarch: true
 Collate:

NEWS.md

@@ -1,3 +1,11 @@
+# surveyvoi 1.0.3.2
+
+- Fix compatibility issues with updates to the xgboost package (version 1.5.0).
+- Fix parallel processing tests given updates to the testthat package
+  (version 3.1.2).
+- Fix tests for environmental and geographic survey schemes given updates to
+  the gurobi package (version 9.5.0).
+
 # surveyvoi 1.0.3.1
 
 - GMP dependencies on Windows systems are now handled using RWinLib

R/cluster.R

@@ -20,8 +20,7 @@ NULL
 #' @return `cluster` object.
 #'
 #' @noRd
-start_cluster <- function(
-  n, names, type = NULL) {
+start_cluster <- function(n, names, type = NULL) {
   # assert arguments are valid
   assertthat::assert_that(
     assertthat::is.count(n),
@@ -33,6 +32,10 @@ start_cluster <- function(
   if (is.null(type)) {
     type <- ifelse(.Platform$OS.type == "unix", "FORK", "PSOCK")
   }
+  if (nchar(Sys.getenv("TESTTHAT")) > 0) {
+    # this function only works with PSOCK clusters when tested in testthat v3+
+    type <- "PSOCK"
+  }
   # validate cluster type
   assertthat::assert_that(
     assertthat::is.string(type),

R/fit_xgb_occupancy_models.R

@@ -180,21 +180,22 @@ NULL
 #' }
 #'
 #' @examples
+#' \dontrun{
 #' # set seeds for reproducibility
 #' library(RandomFields)
 #' set.seed(123)
 #' RFoptions(seed = 123)
 #'
-#' # simulate data for 200 sites, 2 features, and 3 environmental variables
-#' site_data <- simulate_site_data(n_sites = 30, n_features = 2, prop = 0.1)
+#' # simulate data for 30 sites, 2 features, and 3 environmental variables
+#' site_data <- simulate_site_data(
+#'   n_sites = 30, n_features = 2, n_env_vars = 3, prop = 0.1)
 #' feature_data <- simulate_feature_data(n_features = 2, prop = 1)
 #'
 #' # create list of possible tuning parameters for modelling
 #' parameters <- list(eta = seq(0.1, 0.5, length.out = 3),
 #'                    lambda = 10 ^ seq(-1.0, 0.0, length.out = 3),
 #'                    objective = "binary:logistic")
 #'
-#' \donttest{
 #' # fit models
 #' # note that we use 10 random search iterations here so that the example
 #' # finishes quickly, you would probably want something like 1000+
@@ -391,9 +392,9 @@ fit_xgb_occupancy_models <- function(
       survey_spec <- feature_data[[feature_survey_specificity_column]][[i]]
       ## make predictions
       p_train_k <- c(withr::with_package("xgboost",
-        stats::predict(m_k, x_train_k, ntreelimit = nround_k)))
+        stats::predict(m_k, x_train_k, iterationrange = c(1, nround_k + 1))))
       p_test_k <- c(withr::with_package("xgboost",
-        stats::predict(m_k, x_test_k, ntreelimit = nround_k)))
+        stats::predict(m_k, x_test_k, iterationrange = c(1, nround_k + 1))))
       ## validate predictions
       assertthat::assert_that(all(p_train_k >= 0), all(p_train_k <= 1),
         msg = "xgboost predictions are not between zero and one")
@@ -439,7 +440,7 @@ fit_xgb_occupancy_models <- function(
              function(x) {
       ## generate predictions
       out <- c(withr::with_package("xgboost", stats::predict(
-        x, site_env_data, ntreelimit = x$best_iteration)))
+        x, site_env_data, iterationrange = c(1, x$best_iteration + 1))))
       ## validate predictions
       assertthat::assert_that(all(out >= 0), all(out <= 1),
         msg = "xgboost predictions are not between zero and one")
@@ -506,7 +507,8 @@ tune_model <- function(data, folds, survey_sensitivity, survey_specificity,
   ## fit models using all parameters combinations
   is_parallel <- (n_threads > 1) && (nrow(full_parameters) > 1)
   if (is_parallel) {
-    cl <- start_cluster(n_threads,
+    cl <- start_cluster(
+      n_threads,
       c("full_parameters", "data", "survey_sensitivity", "survey_specificity",
         "spw", "n_rounds", "early_stopping_rounds", "seed",
         "rcpp_model_performance", "make_feval_tss"))
@@ -540,7 +542,9 @@ tune_model <- function(data, folds, survey_sensitivity, survey_specificity,
       ### generate predictions
       yhat_test <- c(withr::with_package("xgboost",
           stats::predict(
-            model, data[[k]]$test$x, ntreelimit = model$best_iteration)))
+            model, data[[k]]$test$x,
+            iterationrange = c(1, model$best_iteration + 1)
+          )))
       ### validate predictions
       assertthat::assert_that(all(yhat_test >= 0), all(yhat_test <= 1),
         msg = "xgboost predictions are not between zero and one")

R/ilp.R

@@ -64,11 +64,13 @@ distance_based_prioritizations <- function(
     assertthat::noNA(solver))
   assertthat::assert_that(
     solver %in% c("auto", "Rsymphony", "gurobi"))
+
   # identify solver
   if (identical(solver, "auto")) {
     solver <- ifelse(
       requireNamespace("gurobi", quietly = TRUE), "gurobi", "Rsymphony")
   }
+
   # prepare data for optimization
   ## initialization
   n <- nrow(x)
@@ -101,6 +103,7 @@ distance_based_prioritizations <- function(
   } else {
     p <- list(gap_limit = -1, verbosity = ifelse(verbose, 1, -2))
   }
+
   # prepare output matrix
   out <- matrix(NA, ncol = nrow(x), nrow = length(budget))
   # iterate over each budget and obtain the solution
@@ -126,6 +129,7 @@ distance_based_prioritizations <- function(
     ## store solution
     out[b, ] <- as.logical(s)
   }
+
   # return matrix
   out
 }
@@ -314,9 +318,6 @@ rsymphony_solve <- function(model, parameters) {
   # assert arguments are valid
   assertthat::assert_that(is.list(model), is.list(parameters))
   # return solution
-  list(
-    x = do.call(
-      Rsymphony::Rsymphony_solve_LP,
-      append(model, parameters))$solution
-  )
+  s <- do.call(Rsymphony::Rsymphony_solve_LP, append(model, parameters))
+  list(x = s$solution, objval = s$objval)
 }

README.md

@@ -80,7 +80,7 @@ Please cite the *surveyvoi R* package when using it in publications. To
 cite the developmental version, please use:
 
 > Hanson JO, Chadès I, Hudgins EJ, Bennett J (2021). surveyvoi: Survey
-> Value of Information. R package version 1.0.3.1. Available at
+> Value of Information. R package version 1.0.3.2. Available at
 > <https://github.com/jeffreyhanson/surveyvoi>.
 
 ## Usage