tests/testthat/test_eval_rank_importance.R

test_that("numeric", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  pu <- data.frame(
    id = seq_len(4), cost = c(10, 2, NA, 3),
    spp1 = c(1, 0, 0, 1), spp2 = c(10, 5, 10, 6)
  )
  budgets <- c(2.5, 5)
  # create problem
  p <-
    problem(
      pu$cost,
      data.frame(id = seq_len(2), name = c("spp1", "spp2")),
      as.matrix(t(pu[, 3:4]))
    ) %>%
    add_min_set_objective() %>%
    add_absolute_targets(c(2, 10)) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # create a solution
  s <- c(0, 1, NA, 1)
  # calculate scores
  r1 <- eval_rank_importance(p, s, budgets = budgets, rescale = FALSE)
  r2 <- eval_rank_importance(p, s, n = 2, rescale = FALSE)
  # create correct total scores
  r3 <- c(0, 2, NA_real_, 1)
  attr(r3, "budgets") <- budgets
  attr(r3, "status") <- c("OPTIMAL", "OPTIMAL")
  attr(r3, "objective") <- c(1.5, 0.5)
  attr(r3, "runtime") <- c(1, 1)
  attr(r3, "gap") <- c(0, 0)
  # run tests
  ## objects
  expect_inherits(r1, "numeric")
  expect_inherits(r2, "numeric")
  expect_equal(r1, r3, ignore_attr = TRUE)
  expect_equal(r2, r3, ignore_attr = TRUE)
  ## attributes
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r3)[c("budgets", "objective")]
  )
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r2)[c("budgets", "objective")]
  )
  expect_inherits(attr(r1, "runtime"), "numeric")
  expect_inherits(attr(r2, "runtime"), "numeric")
  expect_inherits(attr(r1, "gap"), "numeric")
  expect_inherits(attr(r2, "gap"), "numeric")
  expect_inherits(attr(r1, "status"), "character")
  expect_inherits(attr(r2, "status"), "character")
  expect_length(attr(r1, "runtime"), 2)
  expect_length(attr(r2, "runtime"), 2)
  expect_length(attr(r1, "gap"), 2)
  expect_length(attr(r2, "gap"), 2)
  expect_length(attr(r1, "status"), 2)
  expect_length(attr(r2, "status"), 2)
})

test_that("matrix (single zone)", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  pu <- data.frame(
    id = seq_len(4), cost = c(10, 2, NA, 3),
    spp1 = c(1, 0, 0, 1), spp2 = c(10, 5, 10, 6)
  )
  budgets <- c(2.5, 5)
  # create problem
  p <-
    problem(
      matrix(pu$cost, ncol = 1),
      data.frame(id = seq_len(2), name = c("spp1", "spp2")),
      as.matrix(t(pu[, 3:4]))
    ) %>%
    add_min_set_objective() %>%
    add_absolute_targets(c(2, 10)) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # create a solution
  s <- c(0, 1, NA, 1)
  # calculate scores
  r1 <- eval_rank_importance(p, s, budgets = budgets, rescale = FALSE)
  r2 <- eval_rank_importance(p, s, n = 2, rescale = FALSE)
  # create correct total scores
  r3 <- matrix(c(0, 2, NA_real_, 1), ncol = 1)
  attr(r3, "budgets") <- budgets
  attr(r3, "status") <- c("OPTIMAL", "OPTIMAL")
  attr(r3, "objective") <- c(1.5, 0.5)
  attr(r3, "runtime") <- c(1, 1)
  attr(r3, "gap") <- c(0, 0)
  # run tests
  ## objects
  expect_inherits(r1, "numeric")
  expect_inherits(r2, "numeric")
  expect_equal(r1, r3, ignore_attr = TRUE)
  expect_equal(r2, r3, ignore_attr = TRUE)
  ## attributes
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r3)[c("budgets", "objective")]
  )
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r2)[c("budgets", "objective")]
  )
  expect_inherits(attr(r1, "runtime"), "numeric")
  expect_inherits(attr(r2, "runtime"), "numeric")
  expect_inherits(attr(r1, "gap"), "numeric")
  expect_inherits(attr(r2, "gap"), "numeric")
  expect_inherits(attr(r1, "status"), "character")
  expect_inherits(attr(r2, "status"), "character")
  expect_length(attr(r1, "runtime"), 2)
  expect_length(attr(r2, "runtime"), 2)
  expect_length(attr(r1, "gap"), 2)
  expect_length(attr(r2, "gap"), 2)
  expect_length(attr(r1, "status"), 2)
  expect_length(attr(r2, "status"), 2)
})

test_that("matrix (multiple zones, by_zone = FALSE)", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  pu <- data.frame(
    id = seq_len(8),
    cost_1 = c(1,  2,  NA, 3, 100, 100, NA, 100),
    cost_2 = c(10, 10, 10, 10,  4,   1, NA, 10),
    spp1_1 = c(1,  2, 0, 0, 0, 0,  0, 0),
    spp2_1 = c(NA, 0, 1, 1, 0, 0,  0, 0),
    spp1_2 = c(1,  0, 0, 0, 1, 0,  0, 1),
    spp2_2 = c(0,  0, 0, 0, 0, 10, 0, 0)
  )
  targets <- matrix(c(1, 1, 1, 0), nrow = 2, ncol = 2)
  budgets <- matrix(c(4, 8), ncol = 1)
  # create problem
  p <-
    problem(
      as.matrix(pu[, c(2, 3)]),
      data.frame(id = seq_len(2), name = c("spp1", "spp2")),
      list(as.matrix(t(pu[, 4:5])), as.matrix(t(pu[, 6:7])))
    ) %>%
    add_min_set_objective() %>%
    add_absolute_targets(targets) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # create a solution
  s <- matrix(c(1, 0, NA, 1, 0, 0, NA, 0, 0, 0, 0, 0, 1, 0, NA, 0), ncol = 2)
  # calculate scores
  r1 <- eval_rank_importance(p, s, budgets = budgets, rescale = FALSE)
  r2 <- eval_rank_importance(p, s, n = 2, rescale = FALSE, by_zone = FALSE)
  # create correct total scores
  r3 <- matrix(c(2, 0, NA, 2, 0, 0, NA, 0, 0, 0, 0, 0, 1, 0, NA, 0), ncol = 2)
  attr(r3, "budgets") <- budgets
  attr(r3, "status") <- c("OPTIMAL", "OPTIMAL")
  attr(r3, "objective") <- c(1.0, 0)
  attr(r3, "runtime") <- c(1, 1)
  attr(r3, "gap") <- c(0, 0)
  # run tests
  ## objects
  expect_inherits(r1, "matrix")
  expect_inherits(r2, "matrix")
  expect_equal(r1, r3, ignore_attr = TRUE)
  expect_equal(r2, r3, ignore_attr = TRUE)
  ## attributes
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r3)[c("budgets", "objective")]
  )
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r2)[c("budgets", "objective")]
  )
  expect_inherits(attr(r1, "runtime"), "numeric")
  expect_inherits(attr(r2, "runtime"), "numeric")
  expect_inherits(attr(r1, "gap"), "numeric")
  expect_inherits(attr(r2, "gap"), "numeric")
  expect_inherits(attr(r1, "status"), "character")
  expect_inherits(attr(r2, "status"), "character")
  expect_length(attr(r1, "runtime"), 2)
  expect_length(attr(r2, "runtime"), 2)
  expect_length(attr(r1, "gap"), 2)
  expect_length(attr(r2, "gap"), 2)
  expect_length(attr(r1, "status"), 2)
  expect_length(attr(r2, "status"), 2)
})

test_that("matrix (multiple zones, by_zone = TRUE)", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  pu <- data.frame(
    id = seq_len(8),
    cost_1 = c(1,  2,  NA, 3, 100, 100, NA, 100),
    cost_2 = c(10, 10, 10, 10,  4,   1, NA, 10),
    spp1_1 = c(1,  2, 0, 0, 0, 0,  0, 0),
    spp2_1 = c(NA, 0, 1, 1, 0, 0,  0, 0),
    spp1_2 = c(1,  0, 0, 0, 1, 0,  0, 1),
    spp2_2 = c(0,  0, 0, 0, 0, 10, 0, 0)
  )
  targets <- matrix(c(1, 1, 1, 0), nrow = 2, ncol = 2)
  budgets <- matrix(c(2, 4, 2, 4), ncol = 2)
  # create problem
  p <-
    problem(
      as.matrix(pu[, c(2, 3)]),
      data.frame(id = seq_len(2), name = c("spp1", "spp2")),
      list(as.matrix(t(pu[, 4:5])), as.matrix(t(pu[, 6:7])))
    ) %>%
    add_min_set_objective() %>%
    add_absolute_targets(targets) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # create a solution
  s <- matrix(c(1, 0, NA, 1, 0, 0, NA, 0, 0, 0, 0, 0, 1, 0, NA, 0), ncol = 2)
  # calculate scores
  r1 <- eval_rank_importance(p, s, budgets = budgets, rescale = FALSE)
  r2 <- eval_rank_importance(p, s, n = 2, rescale = FALSE, by_zone = TRUE)
  # create correct total scores
  r3 <- matrix(c(2, 0, NA, 1, 0, 0, NA, 0, 0, 0, 0, 0, 1, 0, NA, 0), ncol = 2)
  attr(r3, "budgets") <- budgets
  attr(r3, "status") <- c("OPTIMAL", "OPTIMAL")
  attr(r3, "objective") <- c(2, 0)
  attr(r3, "runtime") <- c(1, 1)
  attr(r3, "gap") <- c(0, 0)
  # run tests
  ## objects
  expect_inherits(r1, "matrix")
  expect_inherits(r2, "matrix")
  expect_equal(r1, r3, ignore_attr = TRUE)
  expect_equal(r2, r3, ignore_attr = TRUE)
  ## attributes
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r3)[c("budgets", "objective")]
  )
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r2)[c("budgets", "objective")]
  )
  expect_inherits(attr(r1, "runtime"), "numeric")
  expect_inherits(attr(r2, "runtime"), "numeric")
  expect_inherits(attr(r1, "gap"), "numeric")
  expect_inherits(attr(r2, "gap"), "numeric")
  expect_inherits(attr(r1, "status"), "character")
  expect_inherits(attr(r2, "status"), "character")
  expect_length(attr(r1, "runtime"), 2)
  expect_length(attr(r2, "runtime"), 2)
  expect_length(attr(r1, "gap"), 2)
  expect_length(attr(r2, "gap"), 2)
  expect_length(attr(r1, "status"), 2)
  expect_length(attr(r2, "status"), 2)
})

test_that("data.frame (single zone)", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  pu <- data.frame(
    id = seq_len(4), cost = c(10, 2, NA, 3),
    spp1 = c(1, 0, 0, 1), spp2 = c(10, 5, 10, 6)
  )
  budgets <- c(2.5, 5)
  # create problem
  p <-
    problem(pu, c("spp1", "spp2"), cost_column = "cost") %>%
    add_min_set_objective() %>%
    add_absolute_targets(c(2, 10)) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # create a solution
  s <- tibble::tibble(solution = c(0, 1, NA, 1))
  # calculate scores
  r1 <- eval_rank_importance(p, s, budgets = budgets, rescale = FALSE)
  r2 <- eval_rank_importance(p, s, n = 2, rescale = FALSE)
  # create correct total scores
  r3 <- tibble::tibble(rs = c(0, 2, NA_real_, 1))
  attr(r3, "budgets") <- budgets
  attr(r3, "status") <- c("OPTIMAL", "OPTIMAL")
  attr(r3, "objective") <- c(1.5, 0.5)
  attr(r3, "runtime") <- c(1, 1)
  attr(r3, "gap") <- c(0, 0)
  # run tests
  ## objects
  expect_inherits(r1, "data.frame")
  expect_inherits(r2, "data.frame")
  expect_equal(r1, r3, ignore_attr = TRUE)
  expect_equal(r2, r3, ignore_attr = TRUE)
  ## attributes
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r3)[c("budgets", "objective")]
  )
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r2)[c("budgets", "objective")]
  )
  expect_inherits(attr(r1, "runtime"), "numeric")
  expect_inherits(attr(r2, "runtime"), "numeric")
  expect_inherits(attr(r1, "gap"), "numeric")
  expect_inherits(attr(r2, "gap"), "numeric")
  expect_inherits(attr(r1, "status"), "character")
  expect_inherits(attr(r2, "status"), "character")
  expect_length(attr(r1, "runtime"), 2)
  expect_length(attr(r2, "runtime"), 2)
  expect_length(attr(r1, "gap"), 2)
  expect_length(attr(r2, "gap"), 2)
  expect_length(attr(r1, "status"), 2)
  expect_length(attr(r2, "status"), 2)
})

test_that("data.frame (multiple zones, by_zone = FALSE)", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  pu <- data.frame(
    id = seq_len(8),
    cost_1 = c(1,  2,  NA, 3, 100, 100, NA, 100),
    cost_2 = c(10, 10, 10, 10,  4,   1, NA, 10),
    spp1_1 = c(1,  2, 0, 0, 0, 0,  0, 0),
    spp2_1 = c(NA, 0, 1, 1, 0, 0,  0, 0),
    spp1_2 = c(1,  0, 0, 0, 1, 0,  0, 1),
    spp2_2 = c(0,  0, 0, 0, 0, 10, 0, 0)
  )
  targets <- matrix(c(1, 1, 1, 0), nrow = 2, ncol = 2)
  budgets <- matrix(c(4, 8), ncol = 1)
  # create problem
  p <-
    problem(
      pu,
      zones(c("spp1_1", "spp2_1"), c("spp1_2", "spp2_2")),
      c("cost_1", "cost_2")
    ) %>%
    add_min_set_objective() %>%
    add_absolute_targets(targets) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # create a solution
  s <- data.frame(
    cost_1 = c(1, 0, NA, 1, 0, 0, NA, 0),
    cost_2 = c(0, 0, 0, 0, 1, 0, NA, 0)
  )
  # calculate scores
  r1 <- eval_rank_importance(p, s, budgets = budgets, rescale = FALSE)
  r2 <- eval_rank_importance(p, s, n = 2, rescale = FALSE, by_zone = FALSE)
  # create correct total scores
  r3 <- tibble::tibble(
    rc_1 = c(2, 0, NA, 2, 0, 0, NA, 0),
    rc_2 = c(0, 0, 0, 0, 1, 0, NA, 0)
  )
  attr(r3, "budgets") <- budgets
  attr(r3, "status") <- c("OPTIMAL", "OPTIMAL")
  attr(r3, "objective") <- c(1.0, 0)
  attr(r3, "runtime") <- c(1, 1)
  attr(r3, "gap") <- c(0, 0)
  # run tests
  ## objects
  expect_inherits(r1, "data.frame")
  expect_inherits(r2, "data.frame")
  expect_equal(r1, r3, ignore_attr = TRUE)
  expect_equal(r2, r3, ignore_attr = TRUE)
  ## attributes
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r3)[c("budgets", "objective")]
  )
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r2)[c("budgets", "objective")]
  )
  expect_inherits(attr(r1, "runtime"), "numeric")
  expect_inherits(attr(r2, "runtime"), "numeric")
  expect_inherits(attr(r1, "gap"), "numeric")
  expect_inherits(attr(r2, "gap"), "numeric")
  expect_inherits(attr(r1, "status"), "character")
  expect_inherits(attr(r2, "status"), "character")
  expect_length(attr(r1, "runtime"), 2)
  expect_length(attr(r2, "runtime"), 2)
  expect_length(attr(r1, "gap"), 2)
  expect_length(attr(r2, "gap"), 2)
  expect_length(attr(r1, "status"), 2)
  expect_length(attr(r2, "status"), 2)
})

test_that("data.frame (multiple zones, by_zone = TRUE)", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  pu <- data.frame(
    id = seq_len(8),
    cost_1 = c(1,  2,  NA, 3, 100, 100, NA, 100),
    cost_2 = c(10, 10, 10, 10,  4,   1, NA, 10),
    spp1_1 = c(1,  2, 0, 0, 0, 0,  0, 0),
    spp2_1 = c(NA, 0, 1, 1, 0, 0,  0, 0),
    spp1_2 = c(1,  0, 0, 0, 1, 0,  0, 1),
    spp2_2 = c(0,  0, 0, 0, 0, 10, 0, 0)
  )
  targets <- matrix(c(1, 1, 1, 0), nrow = 2, ncol = 2)
  budgets <- matrix(c(2, 4, 2, 4), ncol = 2)
  # create problem
  p <-
    problem(
      pu,
      zones(c("spp1_1", "spp2_1"), c("spp1_2", "spp2_2")),
      c("cost_1", "cost_2")
    ) %>%
    add_min_set_objective() %>%
    add_absolute_targets(targets) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # create a solution
  s <- data.frame(
    cost_1 = c(1, 0, NA, 1, 0, 0, NA, 0),
    cost_2 = c(0, 0, 0, 0, 1, 0, NA, 0)
  )  # calculate scores
  r1 <- eval_rank_importance(p, s, budgets = budgets, rescale = FALSE)
  r2 <- eval_rank_importance(p, s, n = 2, rescale = FALSE, by_zone = TRUE)
  # create correct total scores
  r3 <- tibble::tibble(
    rc_1 = c(2, 0, NA, 1, 0, 0, NA, 0),
    rc_2 = c(0, 0, 0, 0, 1, 0, NA, 0)
  )
  attr(r3, "budgets") <- budgets
  attr(r3, "status") <- c("OPTIMAL", "OPTIMAL")
  attr(r3, "objective") <- c(2, 0)
  attr(r3, "runtime") <- c(1, 1)
  attr(r3, "gap") <- c(0, 0)
  # run tests
  ## objects
  expect_inherits(r1, "data.frame")
  expect_inherits(r2, "data.frame")
  expect_equal(r1, r3, ignore_attr = TRUE)
  expect_equal(r2, r3, ignore_attr = TRUE)
  ## attributes
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r3)[c("budgets", "objective")]
  )
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r2)[c("budgets", "objective")]
  )
  expect_inherits(attr(r1, "runtime"), "numeric")
  expect_inherits(attr(r2, "runtime"), "numeric")
  expect_inherits(attr(r1, "gap"), "numeric")
  expect_inherits(attr(r2, "gap"), "numeric")
  expect_inherits(attr(r1, "status"), "character")
  expect_inherits(attr(r2, "status"), "character")
  expect_length(attr(r1, "runtime"), 2)
  expect_length(attr(r2, "runtime"), 2)
  expect_length(attr(r1, "gap"), 2)
  expect_length(attr(r2, "gap"), 2)
  expect_length(attr(r1, "status"), 2)
  expect_length(attr(r2, "status"), 2)
})

test_that("sf (single zone)", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  pu <- get_sim_pu_polygons()[1:4, ]
  pu$id <- seq_len(4)
  pu$cost <- c(10, 2, NA, 3)
  pu$spp1 <- c(1, 0, 0, 1)
  pu$spp2 <- c(10, 5, 10, 6)
  pu$solution <- c(0, 1, NA, 1)
  pu$geometry <- sf::st_geometry(pu)
  pu <- sf::st_set_geometry(pu, "geometry")
  budgets <- c(2.5, 5)
  # create problem
  p <-
    problem(pu, c("spp1", "spp2"), cost_column = "cost") %>%
    add_min_set_objective() %>%
    add_absolute_targets(c(2, 10)) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # calculate ranks
  r1 <- eval_rank_importance(p, pu[, "solution"], n = 2, rescale = FALSE)
  r2 <- eval_rank_importance(
    p, pu[, "solution"], budgets = budgets, rescale = FALSE
  )
  # create correct result
  pu$rs <- c(0, 2, NA_real_, 1)
  r3 <- pu[, "rs"]
  attr(r3, "budgets") <- budgets
  attr(r3, "status") <- c("OPTIMAL", "OPTIMAL")
  attr(r3, "objective") <- c(1.5, 0.5)
  attr(r3, "runtime") <- c(1, 1)
  attr(r3, "gap") <- c(0, 0)
  # run tests
  ## objects
  expect_inherits(r1, "sf")
  expect_inherits(r2, "sf")
  expect_equal(r1, r3, ignore_attr = TRUE)
  expect_equal(r2, r3, ignore_attr = TRUE)
  ## attributes
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r3)[c("budgets", "objective")]
  )
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r2)[c("budgets", "objective")]
  )
  expect_inherits(attr(r1, "runtime"), "numeric")
  expect_inherits(attr(r2, "runtime"), "numeric")
  expect_inherits(attr(r1, "gap"), "numeric")
  expect_inherits(attr(r2, "gap"), "numeric")
  expect_inherits(attr(r1, "status"), "character")
  expect_inherits(attr(r2, "status"), "character")
  expect_length(attr(r1, "runtime"), 2)
  expect_length(attr(r2, "runtime"), 2)
  expect_length(attr(r1, "gap"), 2)
  expect_length(attr(r2, "gap"), 2)
  expect_length(attr(r1, "status"), 2)
  expect_length(attr(r2, "status"), 2)
})

test_that("sf (multiple zones, by_zone = FALSE)", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  pu <- sf::st_as_sf(tibble::tibble(
    id = seq_len(8),
    cost_1 = c(1,  2,  NA, 3, 100, 100, NA, 100),
    cost_2 = c(10, 10, 10, 10,  4,   1, NA, 10),
    spp1_1 = c(1,  2, 0, 0, 0, 0,  0, 0),
    spp2_1 = c(NA, 0, 1, 1, 0, 0,  0, 0),
    spp1_2 = c(1,  0, 0, 0, 1, 0,  0, 1),
    spp2_2 = c(0,  0, 0, 0, 0, 10, 0, 0),
    geometry = sf::st_geometry(get_sim_pu_polygons()[seq_len(8), ])
  ))
  targets <- matrix(c(1, 1, 1, 0), nrow = 2, ncol = 2)
  budgets <- matrix(c(4, 8), ncol = 1)
  # create problem
  p <-
    problem(
      pu,
      zones(c("spp1_1", "spp2_1"), c("spp1_2", "spp2_2")),
      c("cost_1", "cost_2")
    ) %>%
    add_min_set_objective() %>%
    add_absolute_targets(targets) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # create a solution
  s <- sf::st_as_sf(tibble::tibble(
    cost_1 = c(1, 0, NA, 1, 0, 0, NA, 0),
    cost_2 = c(0, 0, 0, 0, 1, 0, NA, 0),
    geometry = sf::st_geometry(pu)
  ))
  # calculate scores
  r1 <- eval_rank_importance(p, s, budgets = budgets, rescale = FALSE)
  r2 <- eval_rank_importance(p, s, n = 2, rescale = FALSE, by_zone = FALSE)
  # create correct total scores
  r3 <-  sf::st_as_sf(tibble::tibble(
    rc_1 = c(2, 0, NA, 2, 0, 0, NA, 0),
    rc_2 = c(0, 0, 0, 0, 1, 0, NA, 0),
    geometry = sf::st_geometry(pu)
  ))
  attr(r3, "budgets") <- budgets
  attr(r3, "status") <- c("OPTIMAL", "OPTIMAL")
  attr(r3, "objective") <- c(1.0, 0)
  attr(r3, "runtime") <- c(1, 1)
  attr(r3, "gap") <- c(0, 0)
  # run tests
  ## objects
  expect_inherits(r1, "data.frame")
  expect_inherits(r2, "data.frame")
  expect_equal(r1, r3, ignore_attr = TRUE)
  expect_equal(r2, r3, ignore_attr = TRUE)
  ## attributes
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r3)[c("budgets", "objective")]
  )
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r2)[c("budgets", "objective")]
  )
  expect_inherits(attr(r1, "runtime"), "numeric")
  expect_inherits(attr(r2, "runtime"), "numeric")
  expect_inherits(attr(r1, "gap"), "numeric")
  expect_inherits(attr(r2, "gap"), "numeric")
  expect_inherits(attr(r1, "status"), "character")
  expect_inherits(attr(r2, "status"), "character")
  expect_length(attr(r1, "runtime"), 2)
  expect_length(attr(r2, "runtime"), 2)
  expect_length(attr(r1, "gap"), 2)
  expect_length(attr(r2, "gap"), 2)
  expect_length(attr(r1, "status"), 2)
  expect_length(attr(r2, "status"), 2)
})

test_that("sf (multiple zones, by_zone = TRUE)", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  pu <- sf::st_as_sf(tibble::tibble(
    id = seq_len(8),
    cost_1 = c(1,  2,  NA, 3, 100, 100, NA, 100),
    cost_2 = c(10, 10, 10, 10,  4,   1, NA, 10),
    spp1_1 = c(1,  2, 0, 0, 0, 0,  0, 0),
    spp2_1 = c(NA, 0, 1, 1, 0, 0,  0, 0),
    spp1_2 = c(1,  0, 0, 0, 1, 0,  0, 1),
    spp2_2 = c(0,  0, 0, 0, 0, 10, 0, 0),
    geometry = sf::st_geometry(get_sim_pu_polygons()[seq_len(8), ])
  ))
  targets <- matrix(c(1, 1, 1, 0), nrow = 2, ncol = 2)
  budgets <- matrix(c(2, 4, 2, 4), ncol = 2)
  # create problem
  p <-
    problem(
      pu,
      zones(c("spp1_1", "spp2_1"), c("spp1_2", "spp2_2")),
      c("cost_1", "cost_2")
    ) %>%
    add_min_set_objective() %>%
    add_absolute_targets(targets) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # create a solution
  s <- sf::st_as_sf(tibble::tibble(
    cost_1 = c(1, 0, NA, 1, 0, 0, NA, 0),
    cost_2 = c(0, 0, 0, 0, 1, 0, NA, 0),
    geometry = sf::st_geometry(pu)
  ))
  # calculate scores
  r1 <- eval_rank_importance(p, s, budgets = budgets, rescale = FALSE)
  r2 <- eval_rank_importance(p, s, n = 2, rescale = FALSE, by_zone = TRUE)
  # create correct total scores
  r3 <- sf::st_as_sf(tibble::tibble(
    rs_1 = c(2, 0, NA, 1, 0, 0, NA, 0),
    rs_2 = c(0, 0, 0, 0, 1, 0, NA, 0),
    geometry = sf::st_geometry(pu)
  ))
  attr(r3, "budgets") <- budgets
  attr(r3, "status") <- c("OPTIMAL", "OPTIMAL")
  attr(r3, "objective") <- c(2, 0)
  attr(r3, "runtime") <- c(1, 1)
  attr(r3, "gap") <- c(0, 0)
  # run tests
  ## objects
  expect_inherits(r1, "sf")
  expect_inherits(r2, "sf")
  expect_equal(r1, r3, ignore_attr = TRUE)
  expect_equal(r2, r3, ignore_attr = TRUE)
  ## attributes
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r3)[c("budgets", "objective")]
  )
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r2)[c("budgets", "objective")]
  )
  expect_inherits(attr(r1, "runtime"), "numeric")
  expect_inherits(attr(r2, "runtime"), "numeric")
  expect_inherits(attr(r1, "gap"), "numeric")
  expect_inherits(attr(r2, "gap"), "numeric")
  expect_inherits(attr(r1, "status"), "character")
  expect_inherits(attr(r2, "status"), "character")
  expect_length(attr(r1, "runtime"), 2)
  expect_length(attr(r2, "runtime"), 2)
  expect_length(attr(r1, "gap"), 2)
  expect_length(attr(r2, "gap"), 2)
  expect_length(attr(r1, "status"), 2)
  expect_length(attr(r2, "status"), 2)
})

test_that("SpatRaster (single zone)", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  pu <- terra::rast(matrix(c(10, 2, NA, 3), nrow = 1))
  features <- c(
    terra::rast(matrix(c(1, 0, 0, 1), nrow = 1)),
    terra::rast(matrix(c(10, 5, 10, 6), nrow = 1))
  )
  names(features) <- make.unique(names(features))
  budgets <- c(2.5, 5)
  # create problem
  p <-
    problem(pu, features) %>%
    add_min_set_objective() %>%
    add_absolute_targets(c(2, 10)) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # create a solution
  s <- terra::rast(matrix(c(0, 1, NA, 1), nrow = 1))
  # calculate ranks
  r1 <- eval_rank_importance(p, s, n = 2, rescale = FALSE)
  r2 <- eval_rank_importance(p, s, budgets = budgets, rescale = FALSE)
  # create correct result
  r3 <- terra::rast(matrix(c(0, 2, NA, 1), nrow = 1))
  names(r3) <- "rs"
  attr(r3, "budgets") <- budgets
  attr(r3, "status") <- c("OPTIMAL", "OPTIMAL")
  attr(r3, "objective") <- c(1.5, 0.5)
  attr(r3, "runtime") <- c(1, 1)
  attr(r3, "gap") <- c(0, 0)
  # run tests
  ## objects
  expect_inherits(r1, "SpatRaster")
  expect_inherits(r2, "SpatRaster")
  expect_equal(terra::values(r1), terra::values(r3), ignore_attr = TRUE)
  expect_equal(terra::values(r2), terra::values(r3), ignore_attr = TRUE)
  ## attributes
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r3)[c("budgets", "objective")]
  )
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r2)[c("budgets", "objective")]
  )
  expect_inherits(attr(r1, "runtime"), "numeric")
  expect_inherits(attr(r2, "runtime"), "numeric")
  expect_inherits(attr(r1, "gap"), "numeric")
  expect_inherits(attr(r2, "gap"), "numeric")
  expect_inherits(attr(r1, "status"), "character")
  expect_inherits(attr(r2, "status"), "character")
  expect_length(attr(r1, "runtime"), 2)
  expect_length(attr(r2, "runtime"), 2)
  expect_length(attr(r1, "gap"), 2)
  expect_length(attr(r2, "gap"), 2)
  expect_length(attr(r1, "status"), 2)
  expect_length(attr(r2, "status"), 2)
})

test_that("SpatRaster (multiple zones, by_zone = FALSE)", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  pu <- c(
    terra::rast(matrix(c(1,  2,  NA, 3, 100, 100, NA, 100), nrow = 1)),
    terra::rast(matrix(c(10, 10, 10, 10,  4,   1, NA, 10), nrow = 1))
  )
  names(pu) <- make.unique(names(pu))
  features <- c(
    terra::rast(matrix(c(1,  2, 0, 0, 0, 0,  0, 0), nrow = 1)),
    terra::rast(matrix(c(NA, 0, 1, 1, 0, 0,  0, 0), nrow = 1)),
    terra::rast(matrix(c(1,  0, 0, 0, 1, 0,  0, 1), nrow = 1)),
    terra::rast(matrix(c(0,  0, 0, 0, 0, 10, 0, 0), nrow = 1))
  )
  targets <- matrix(c(1, 1, 1, 0), nrow = 2, ncol = 2)
  budgets <- matrix(c(4, 8), ncol = 1)
  # create problem
  p <-
    problem(pu, zones(features[[c(1, 2)]], features[[c(3, 4)]])) %>%
    add_min_set_objective() %>%
    add_absolute_targets(targets) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # create a solution
  s <- c(
    terra::rast(matrix(c(1, 0, NA, 1, 0, 0, NA, 0), nrow = 1)),
    terra::rast(matrix(c(0, 0, 0, 0, 1, 0, NA, 0), nrow = 1))
  )
  # calculate ranks
  r1 <- eval_rank_importance(p, s, budgets = budgets, rescale = FALSE)
  r2 <- eval_rank_importance(p, s, n = 2, rescale = FALSE, by_zone = FALSE)
  # create correct result
  r3 <- c(
    terra::rast(matrix(c(2, 0, NA, 2, 0, 0, NA, 0), nrow = 1)),
    terra::rast(matrix(c(0, 0, 0,  0, 1, 0, NA, 0), nrow = 1))
  )
  attr(r3, "budgets") <- budgets
  attr(r3, "status") <- c("OPTIMAL", "OPTIMAL")
  attr(r3, "objective") <- c(1.0, 0)
  attr(r3, "runtime") <- c(1, 1)
  attr(r3, "gap") <- c(0, 0)
  # run tests
  ## objects
  expect_inherits(r1, "SpatRaster")
  expect_inherits(r2, "SpatRaster")
  expect_equal(terra::values(r1), terra::values(r3), ignore_attr = TRUE)
  expect_equal(terra::values(r2), terra::values(r3), ignore_attr = TRUE)
  ## attributes
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r3)[c("budgets", "objective")]
  )
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r2)[c("budgets", "objective")]
  )
  expect_inherits(attr(r1, "runtime"), "numeric")
  expect_inherits(attr(r2, "runtime"), "numeric")
  expect_inherits(attr(r1, "gap"), "numeric")
  expect_inherits(attr(r2, "gap"), "numeric")
  expect_inherits(attr(r1, "status"), "character")
  expect_inherits(attr(r2, "status"), "character")
  expect_length(attr(r1, "runtime"), 2)
  expect_length(attr(r2, "runtime"), 2)
  expect_length(attr(r1, "gap"), 2)
  expect_length(attr(r2, "gap"), 2)
  expect_length(attr(r1, "status"), 2)
  expect_length(attr(r2, "status"), 2)
})

test_that("SpatRaster (multiple zones, by_zone = TRUE)", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  pu <- c(
    terra::rast(matrix(c(1,  2,  NA, 3, 100, 100, NA, 100), nrow = 1)),
    terra::rast(matrix(c(10, 10, 10, 10,  4,   1, NA, 10), nrow = 1))
  )
  names(pu) <- make.unique(names(pu))
  features <- c(
    terra::rast(matrix(c(1,  2, 0, 0, 0, 0,  0, 0), nrow = 1)),
    terra::rast(matrix(c(NA, 0, 1, 1, 0, 0,  0, 0), nrow = 1)),
    terra::rast(matrix(c(1,  0, 0, 0, 1, 0,  0, 1), nrow = 1)),
    terra::rast(matrix(c(0,  0, 0, 0, 0, 10, 0, 0), nrow = 1))
  )
  targets <- matrix(c(1, 1, 1, 0), nrow = 2, ncol = 2)
  budgets <- matrix(c(2, 4, 2, 4), ncol = 2)
  # create problem
  p <-
    problem(pu, zones(features[[c(1, 2)]], features[[c(3, 4)]])) %>%
    add_min_set_objective() %>%
    add_absolute_targets(targets) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # create a solution
  s <- c(
    terra::rast(matrix(c(1, 0, NA, 1, 0, 0, NA, 0), nrow = 1)),
    terra::rast(matrix(c(0, 0, 0, 0, 1, 0, NA, 0), nrow = 1))
  )
  # calculate ranks
  r1 <- eval_rank_importance(p, s, budgets = budgets, rescale = FALSE)
  r2 <- eval_rank_importance(p, s, n = 2, rescale = FALSE, by_zone = TRUE)
  # create correct result
  r3 <- c(
    terra::rast(matrix(c(2, 0, NA, 1, 0, 0, NA, 0), nrow = 1)),
    terra::rast(matrix(c(0, 0, 0,  0, 1, 0, NA, 0), nrow = 1))
  )
  attr(r3, "budgets") <- budgets
  attr(r3, "status") <- c("OPTIMAL", "OPTIMAL")
  attr(r3, "objective") <- c(2, 0)
  attr(r3, "runtime") <- c(1, 1)
  attr(r3, "gap") <- c(0, 0)
  # run tests
  ## objects
  expect_inherits(r1, "SpatRaster")
  expect_inherits(r2, "SpatRaster")
  expect_equal(terra::values(r1), terra::values(r3), ignore_attr = TRUE)
  expect_equal(terra::values(r2), terra::values(r3), ignore_attr = TRUE)
  ## attributes
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r3)[c("budgets", "objective")]
  )
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r2)[c("budgets", "objective")]
  )
  expect_inherits(attr(r1, "runtime"), "numeric")
  expect_inherits(attr(r2, "runtime"), "numeric")
  expect_inherits(attr(r1, "gap"), "numeric")
  expect_inherits(attr(r2, "gap"), "numeric")
  expect_inherits(attr(r1, "status"), "character")
  expect_inherits(attr(r2, "status"), "character")
  expect_length(attr(r1, "runtime"), 2)
  expect_length(attr(r2, "runtime"), 2)
  expect_length(attr(r1, "gap"), 2)
  expect_length(attr(r2, "gap"), 2)
  expect_length(attr(r1, "status"), 2)
  expect_length(attr(r2, "status"), 2)
})

test_that("Spatial (single zone)", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  pu <- get_sim_pu_polygons()[1:4, ]
  pu$id <- seq_len(4)
  pu$cost <- c(10, 2, NA, 3)
  pu$spp1 <- c(1, 0, 0, 1)
  pu$spp2 <- c(10, 5, 10, 6)
  pu$solution <- c(0, 1, NA, 1)
  pu$geometry <- sf::st_geometry(pu)
  pu <- sf::st_set_geometry(pu, "geometry")
  budgets <- c(2.5, 5)
  # create problems
  expect_warning(
    p1 <-
      problem(sf::as_Spatial(pu), c("spp1", "spp2"), cost_column = "cost") %>%
      add_min_set_objective() %>%
      add_absolute_targets(c(2, 10)) %>%
      add_binary_decisions() %>%
      add_default_solver(gap = 0, verbose = FALSE),
    "deprecated"
  )
  p2 <-
    problem(pu, c("spp1", "spp2"), cost_column = "cost") %>%
    add_min_set_objective() %>%
    add_absolute_targets(c(2, 10)) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # calculate ranks
  expect_warning(
    r1 <- eval_rank_importance(
      p1, sf::as_Spatial(pu[, "solution"]), n = 2, rescale = FALSE
    ),
    "deprecated"
  )
  expect_warning(
    r2 <- eval_rank_importance(
      p1, sf::as_Spatial(pu[, "solution"]), budgets = budgets, rescale = FALSE
    ),
    "deprecated"
  )
  # correct result
  r3 <- eval_rank_importance(
    p2, pu[, "solution"], budgets = budgets, rescale = FALSE
  )
  # tests
  expect_inherits(r1, "Spatial")
  expect_inherits(r2, "Spatial")
  expect_equal(sf::st_as_sf(r1), r3, ignore_attr = TRUE)
  expect_equal(sf::st_as_sf(r2), r3, ignore_attr = TRUE)
  ## attributes
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r3)[c("budgets", "objective")]
  )
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r2)[c("budgets", "objective")]
  )
  expect_inherits(attr(r1, "runtime"), "numeric")
  expect_inherits(attr(r2, "runtime"), "numeric")
  expect_inherits(attr(r1, "gap"), "numeric")
  expect_inherits(attr(r2, "gap"), "numeric")
  expect_inherits(attr(r1, "status"), "character")
  expect_inherits(attr(r2, "status"), "character")
  expect_length(attr(r1, "runtime"), 2)
  expect_length(attr(r2, "runtime"), 2)
  expect_length(attr(r1, "gap"), 2)
  expect_length(attr(r2, "gap"), 2)
  expect_length(attr(r1, "status"), 2)
  expect_length(attr(r2, "status"), 2)
})

test_that("Spatial (multiple zones)", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  pu <- sf::st_as_sf(tibble::tibble(
    id = seq_len(8),
    cost_1 = c(1,  2,  NA, 3, 100, 100, NA, 100),
    cost_2 = c(10, 10, 10, 10,  4,   1, NA, 10),
    spp1_1 = c(1,  2, 0, 0, 0, 0,  0, 0),
    spp2_1 = c(NA, 0, 1, 1, 0, 0,  0, 0),
    spp1_2 = c(1,  0, 0, 0, 1, 0,  0, 1),
    spp2_2 = c(0,  0, 0, 0, 0, 10, 0, 0),
    geometry = sf::st_geometry(get_sim_pu_polygons()[seq_len(8), ])
  ))
  targets <- matrix(c(1, 1, 1, 0), nrow = 2, ncol = 2)
  budgets <- matrix(c(4, 8), ncol = 1)
  # create problems
  expect_warning(
    p1 <-
      problem(
        sf::as_Spatial(pu),
        zones(c("spp1_1", "spp2_1"), c("spp1_2", "spp2_2")),
        c("cost_1", "cost_2")
      ) %>%
      add_min_set_objective() %>%
      add_absolute_targets(targets) %>%
      add_binary_decisions() %>%
      add_default_solver(gap = 0, verbose = FALSE),
    "deprecated"
  )
  p2 <-
    problem(
      pu,
      zones(c("spp1_1", "spp2_1"), c("spp1_2", "spp2_2")),
      c("cost_1", "cost_2")
    ) %>%
    add_min_set_objective() %>%
    add_absolute_targets(targets) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # create a solution
  s <- sf::st_as_sf(tibble::tibble(
    cost_1 = c(1, 0, NA, 1, 0, 0, NA, 0),
    cost_2 = c(0, 0, 0, 0, 1, 0, NA, 0),
    geometry = sf::st_geometry(pu)
  ))
  # calculate correct result
  expect_warning(
    r1 <- eval_rank_importance(
      p1, sf::as_Spatial(s), n = 2, rescale = FALSE,
      by_zone = FALSE
    ),
    "deprecated"
  )
  expect_warning(
    r2 <- eval_rank_importance(
      p1, sf::as_Spatial(s), budgets = budgets, rescale = FALSE
    ),
    "deprecated"
  )
  # correct result
  r3 <- eval_rank_importance(
    p2, s, budgets = budgets, rescale = FALSE
  )
  # tests
  expect_inherits(r1, "Spatial")
  expect_inherits(r2, "Spatial")
  expect_equal(sf::st_as_sf(r1), r3, ignore_attr = TRUE)
  expect_equal(sf::st_as_sf(r2), r3, ignore_attr = TRUE)
  ## attributes
  ## attributes
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r3)[c("budgets", "objective")]
  )
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r2)[c("budgets", "objective")]
  )
  expect_inherits(attr(r1, "runtime"), "numeric")
  expect_inherits(attr(r2, "runtime"), "numeric")
  expect_inherits(attr(r1, "gap"), "numeric")
  expect_inherits(attr(r2, "gap"), "numeric")
  expect_inherits(attr(r1, "status"), "character")
  expect_inherits(attr(r2, "status"), "character")
  expect_length(attr(r1, "runtime"), 2)
  expect_length(attr(r2, "runtime"), 2)
  expect_length(attr(r1, "gap"), 2)
  expect_length(attr(r2, "gap"), 2)
  expect_length(attr(r1, "status"), 2)
  expect_length(attr(r2, "status"), 2)
})

test_that("raster (single zone)", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  pu <- terra::rast(matrix(c(10, 2, NA, 3), nrow = 1))
  features <- c(
    terra::rast(matrix(c(1, 0, 0, 1), nrow = 1)),
    terra::rast(matrix(c(10, 5, 10, 6), nrow = 1))
  )
  names(features) <- make.unique(names(features))
  budgets <- c(2.5, 5)
  # create problem
  expect_warning(
    p1 <-
      problem(raster::raster(pu), raster::stack(features)) %>%
      add_min_set_objective() %>%
      add_absolute_targets(c(2, 10)) %>%
      add_binary_decisions() %>%
      add_default_solver(gap = 0, verbose = FALSE),
    "deprecated"
  )
  p2 <-
    problem(pu, features) %>%
    add_min_set_objective() %>%
    add_absolute_targets(c(2, 10)) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # create a solution
  s <- terra::rast(matrix(c(0, 1, NA, 1), nrow = 1))
  # calculate ranks
  expect_warning(
    r1 <- eval_rank_importance(
      p1, raster::raster(s), n = 2, rescale = FALSE
    ),
    "deprecated"
  )
  expect_warning(
    r2 <- eval_rank_importance(
      p1, raster::raster(s), budgets = budgets, rescale = FALSE
    ),
    "deprecated"
  )
  # create correct result
  r3 <- eval_rank_importance(p2, s, budgets = budgets, rescale = FALSE)
  # run tests
  ## objects
  expect_inherits(r1, "Raster")
  expect_inherits(r2, "Raster")
  expect_equal(
    terra::values(terra::rast(r1)),
    terra::values(r3),
    ignore_attr = TRUE
  )
  expect_equal(
    terra::values(terra::rast(r2)),
    terra::values(r3),
    ignore_attr = TRUE
  )
  ## attributes
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r3)[c("budgets", "objective")]
  )
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r2)[c("budgets", "objective")]
  )
  expect_inherits(attr(r1, "runtime"), "numeric")
  expect_inherits(attr(r2, "runtime"), "numeric")
  expect_inherits(attr(r1, "gap"), "numeric")
  expect_inherits(attr(r2, "gap"), "numeric")
  expect_inherits(attr(r1, "status"), "character")
  expect_inherits(attr(r2, "status"), "character")
  expect_length(attr(r1, "runtime"), 2)
  expect_length(attr(r2, "runtime"), 2)
  expect_length(attr(r1, "gap"), 2)
  expect_length(attr(r2, "gap"), 2)
  expect_length(attr(r1, "status"), 2)
  expect_length(attr(r2, "status"), 2)
})

test_that("Raster (multiple zones)", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  pu <- c(
    terra::rast(matrix(c(1,  2,  NA, 3, 100, 100, NA, 100), nrow = 1)),
    terra::rast(matrix(c(10, 10, 10, 10,  4,   1, NA, 10), nrow = 1))
  )
  names(pu) <- make.unique(names(pu))
  features <- c(
    terra::rast(matrix(c(1,  2, 0, 0, 0, 0,  0, 0), nrow = 1)),
    terra::rast(matrix(c(NA, 0, 1, 1, 0, 0,  0, 0), nrow = 1)),
    terra::rast(matrix(c(1,  0, 0, 0, 1, 0,  0, 1), nrow = 1)),
    terra::rast(matrix(c(0,  0, 0, 0, 0, 10, 0, 0), nrow = 1))
  )
  targets <- matrix(c(1, 1, 1, 0), nrow = 2, ncol = 2)
  budgets <- matrix(c(4, 8), ncol = 1)
  # create problems
  expect_warning(
    p1 <-
      problem(
        raster::stack(pu),
        suppressWarnings(zones(
          raster::stack(features[[c(1, 2)]]),
          raster::stack(features[[c(3, 4)]])
        ))
      ) %>%
      add_min_set_objective() %>%
      add_absolute_targets(targets) %>%
      add_binary_decisions() %>%
      add_default_solver(gap = 0, verbose = FALSE),
      "deprecated"
  )
  p2 <-
    problem(pu, zones(features[[c(1, 2)]], features[[c(3, 4)]])) %>%
    add_min_set_objective() %>%
    add_absolute_targets(targets) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # create a solution
  s <- c(
    terra::rast(matrix(c(1, 0, NA, 1, 0, 0, NA, 0), nrow = 1)),
    terra::rast(matrix(c(0, 0, 0, 0, 1, 0, NA, 0), nrow = 1))
  )
  # calculate ranks
  expect_warning(
    r1 <- eval_rank_importance(
      p1, raster::stack(s), budgets = budgets, rescale = FALSE
    ),
    "deprecated"
  )
  expect_warning(
    r2 <- eval_rank_importance(
      p1, raster::stack(s), n = 2, rescale = FALSE, by_zone = FALSE
    ),
    "deprecated"
  )
  # create correct result
  r3 <- eval_rank_importance(p2, s, budgets = budgets, rescale = FALSE)
  # run tests
  ## objects
  expect_inherits(r1, "Raster")
  expect_inherits(r2, "Raster")
  expect_equal(
    terra::values(terra::rast(r1)),
    terra::values(r3),
    ignore_attr = TRUE
  )
  expect_equal(
    terra::values(terra::rast(r2)),
    terra::values(r3),
    ignore_attr = TRUE
  )
  ## attributes
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r3)[c("budgets", "objective")]
  )
  expect_equal(
    attributes(r1)[c("budgets", "objective")],
    attributes(r2)[c("budgets", "objective")]
  )
  expect_inherits(attr(r1, "runtime"), "numeric")
  expect_inherits(attr(r2, "runtime"), "numeric")
  expect_inherits(attr(r1, "gap"), "numeric")
  expect_inherits(attr(r2, "gap"), "numeric")
  expect_inherits(attr(r1, "status"), "character")
  expect_inherits(attr(r2, "status"), "character")
  expect_length(attr(r1, "runtime"), 2)
  expect_length(attr(r2, "runtime"), 2)
  expect_length(attr(r1, "gap"), 2)
  expect_length(attr(r2, "gap"), 2)
  expect_length(attr(r1, "status"), 2)
  expect_length(attr(r2, "status"), 2)
})

test_that("rescale = TRUE", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  pu <- data.frame(
    id = seq_len(4), cost = c(10, 2, NA, 3),
    spp1 = c(1, 0, 0, 1), spp2 = c(10, 5, 10, 6)
  )
  budgets <- c(2.5, 5)
  # create problem
  p <-
    problem(
      pu$cost,
      data.frame(id = seq_len(2), name = c("spp1", "spp2")),
      as.matrix(t(pu[, 3:4]))
    ) %>%
    add_min_set_objective() %>%
    add_absolute_targets(c(2, 10)) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # create a solution
  s <- c(0, 1, NA, 1)
  # calculate scores
  r1 <- eval_rank_importance(
    p, s, budgets = budgets, rescale = TRUE, run_checks = FALSE
  )
  r2 <- eval_rank_importance(
    p, s, n = 2, rescale = TRUE, force = TRUE
  )
  # create correct total scores
  r3 <- c(0, 1, NA_real_, 0.01)
  # run tests
  ## objects
  expect_inherits(r1, "numeric")
  expect_inherits(r2, "numeric")
  expect_equal(r1, r3, ignore_attr = TRUE)
  expect_equal(r2, r3, ignore_attr = TRUE)
  ## attributes
  expect_equal(attr(r1, "budgets"), budgets)
  expect_equal(attr(r2, "budgets"), budgets)
})

test_that("custom objective", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # import data
  sim_pu_raster <- get_sim_pu_raster()
  sim_features <- get_sim_features()
  sim_phylogeny <- get_sim_phylogeny()
  # set targets
  ## note that we set targets such that we are likely to have some
  ## features that can have their targets entirely met when
  ## setting a budget that is 50% the cost of the min set solution
  targ <- c(rep(1, terra::nlyr(sim_features) - 1), 4)
  # create problem
  p <-
    problem(sim_pu_raster, sim_features) %>%
    add_min_set_objective() %>%
    add_absolute_targets(targ) %>%
    add_binary_decisions() %>%
    add_default_solver(verbose = FALSE)
  # create a solution
  s <- solve(p)
  # calculate ranks
  r1 <- eval_rank_importance(
    p, s, n = 2, rescale = FALSE,
    objective = "add_max_phylo_div_objective",
    extra_args = list(tree = sim_phylogeny)
  )
  # tests
  expect_inherits(r1, "SpatRaster")
  expect_true(terra::global(r1 == 0, "sum", na.rm = TRUE)[[1]] > 0)
  expect_true(terra::global(r1 == 1, "sum", na.rm = TRUE)[[1]] > 0)
  expect_true(terra::global(r1 == 2, "sum", na.rm = TRUE)[[1]] > 0)
})

test_that("default budget-limited objective", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  pu <- terra::rast(matrix(c(10, 2, NA, 3), nrow = 1))
  features <- c(
    terra::rast(matrix(c(1, 0, 0, 1), nrow = 1)),
    terra::rast(matrix(c(10, 5, 10, 6), nrow = 1))
  )
  names(features) <- make.unique(names(features))
  budgets <- c(2.5, 5)
  # create problem
  p <-
    problem(pu, features) %>%
    add_min_shortfall_objective(budget = max(budgets)) %>%
    add_absolute_targets(c(2, 10)) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # create a solution
  s <- terra::rast(matrix(c(0, 1, NA, 1), nrow = 1))
  # calculate ranks
  r1 <- eval_rank_importance(p, s, n = 2, rescale = FALSE)
  r2 <- eval_rank_importance(p, s, budgets = budgets, rescale = FALSE)
  # create correct result
  r3 <- terra::rast(matrix(c(0, 2, NA, 1), nrow = 1))
  # run tests
  ## objects
  expect_inherits(r1, "SpatRaster")
  expect_inherits(r2, "SpatRaster")
  expect_equal(terra::values(r1), terra::values(r3), ignore_attr = TRUE)
  expect_equal(terra::values(r2), terra::values(r3), ignore_attr = TRUE)
  ## attributes
  expect_equal(attr(r1, "budgets"), budgets)
  expect_equal(attr(r2, "budgets"), budgets)
})

test_that("default budget-limited and explicit objectives give same result", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  pu <- terra::rast(matrix(c(10, 2, NA, 3), nrow = 1))
  features <- c(
    terra::rast(matrix(c(1, 0, 0, 1), nrow = 1)),
    terra::rast(matrix(c(10, 5, 10, 6), nrow = 1))
  )
  names(features) <- make.unique(names(features))
  budgets <- c(2.5, 5)
  # create problem
  p <-
    problem(pu, features) %>%
    add_min_shortfall_objective(budget = max(budgets)) %>%
    add_absolute_targets(c(2, 10)) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # create a solution
  s <- terra::rast(matrix(c(0, 1, NA, 1), nrow = 1))
  # calculate ranks
  r1 <- eval_rank_importance(p, s, n = 2, rescale = FALSE)
  r2 <- eval_rank_importance(p, s, budgets = budgets, rescale = FALSE)
  r3 <- eval_rank_importance(
    p, s, budgets = budgets, rescale = FALSE,
    objective = "add_min_shortfall_objective"
  )
  r4 <- eval_rank_importance(
    p, s, n = 2, rescale = FALSE,
    objective = "add_min_shortfall_objective"
  )
  # create correct result
  r5 <- terra::rast(matrix(c(0, 2, NA, 1), nrow = 1))
  # run tests
  ## objects
  expect_inherits(r1, "SpatRaster")
  expect_inherits(r2, "SpatRaster")
  expect_inherits(r3, "SpatRaster")
  expect_inherits(r4, "SpatRaster")
  expect_equal(terra::values(r1), terra::values(r5), ignore_attr = TRUE)
  expect_equal(terra::values(r2), terra::values(r5), ignore_attr = TRUE)
  expect_equal(terra::values(r3), terra::values(r5), ignore_attr = TRUE)
  expect_equal(terra::values(r4), terra::values(r5), ignore_attr = TRUE)
  ## attributes
  expect_equal(attr(r1, "budgets"), budgets)
  expect_equal(attr(r2, "budgets"), budgets)
  expect_equal(attr(r3, "budgets"), budgets)
  expect_equal(attr(r4, "budgets"), budgets)
})

test_that("locked in constraints", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  pu <- terra::rast(matrix(c(10, 2, NA, 3, 1), nrow = 1))
  locked <- terra::rast(matrix(c(0, 0, NA, 0, 1), nrow = 1))
  features <- c(
    terra::rast(matrix(c(1, 0, 0, 1, 0), nrow = 1)),
    terra::rast(matrix(c(10, 5, 10, 6, 0), nrow = 1))
  )
  names(features) <- make.unique(names(features))
  budgets <- c(3.5, 6)
  # create problem
  p <-
    problem(pu, features) %>%
    add_min_set_objective() %>%
    add_absolute_targets(c(2, 10)) %>%
    add_locked_in_constraints(locked) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # create a solution
  s <- terra::rast(matrix(c(0, 1, NA, 1, 1), nrow = 1))
  # calculate ranks
  r1 <- eval_rank_importance(p, s, n = 2, rescale = FALSE)
  r2 <- eval_rank_importance(p, s, budgets = budgets, rescale = FALSE)
  # create correct result
  r3 <- terra::rast(matrix(c(0, 2, NA, 1, 2), nrow = 1))
  names(r3) <- "rs"
  # run tests
  ## objects
  expect_inherits(r1, "SpatRaster")
  expect_inherits(r2, "SpatRaster")
  expect_inherits(r3, "SpatRaster")
  expect_equal(terra::values(r1), terra::values(r3), ignore_attr = TRUE)
  expect_equal(terra::values(r2), terra::values(r3), ignore_attr = TRUE)
  ## attributes
  expect_equal(attr(r1, "budgets"), budgets)
  expect_equal(attr(r2, "budgets"), budgets)
})

test_that("locked out constraints", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  pu <- terra::rast(matrix(c(10, 2, NA, 3, 1), nrow = 1))
  locked <- terra::rast(matrix(c(0, 0, NA, 0, 1), nrow = 1))
  features <- c(
    terra::rast(matrix(c(1, 0, 0, 1, 100), nrow = 1)),
    terra::rast(matrix(c(10, 5, 10, 6, 100), nrow = 1))
  )
  names(features) <- make.unique(names(features))
  budgets <- c(2.5, 5)
  # create problem
  p <-
    problem(pu, features) %>%
    add_min_set_objective() %>%
    add_absolute_targets(c(2, 10)) %>%
    add_locked_out_constraints(locked) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # create a solution
  s <- terra::rast(matrix(c(0, 1, NA, 1, 0), nrow = 1))
  # calculate ranks
  r1 <- eval_rank_importance(p, s, n = 2, rescale = FALSE)
  r2 <- eval_rank_importance(p, s, budgets = budgets, rescale = FALSE)
  # create correct result
  r3 <- terra::rast(matrix(c(0, 2, NA, 1, 0), nrow = 1))
  # run tests
  ## objects
  expect_inherits(r1, "SpatRaster")
  expect_inherits(r2, "SpatRaster")
  expect_inherits(r3, "SpatRaster")
  expect_equal(terra::values(r1), terra::values(r3), ignore_attr = TRUE)
  expect_equal(terra::values(r2), terra::values(r3), ignore_attr = TRUE)
  ## attributes
  expect_equal(attr(r1, "budgets"), budgets)
  expect_equal(attr(r2, "budgets"), budgets)
})

test_that("invalid inputs", {
  # import data
  pu <- terra::rast(matrix(c(10, 2, NA, 3), nrow = 1))
  features <- c(
    terra::rast(matrix(c(1, 0, 0, 1), nrow = 1)),
    terra::rast(matrix(c(10, 5, 10, 6), nrow = 1))
  )
  names(features) <- make.unique(names(features))
  budgets <- c(2.5, 5)
  # create problem
  p <-
    problem(pu, features) %>%
    add_min_set_objective() %>%
    add_absolute_targets(c(2, 10)) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # create a solution
  s <- terra::rast(matrix(c(0, 1, NA, 1), nrow = 1))
  # not specifying n explicitly
  expect_tidy_error(
    eval_rank_importance(p, s, 1),
    "explicitly named"
  )
  # not specifying n or budgets
  expect_tidy_error(
    eval_rank_importance(p, s),
    "Exactly one of"
  )
  # specifying both n and budgets
  expect_tidy_error(
    eval_rank_importance(p, s, n = 2, budgets = budgets),
    "not both"
  )
  # specifying both n < 2
  expect_tidy_error(
    eval_rank_importance(p, s, n = 1),
    "greater than or equal"
  )
  # specifying invalid objective
  expect_tidy_error(
    eval_rank_importance(p, s, n = 2, objective = "add_min_set_objective"),
    "budget"
  )
  expect_tidy_error(
    eval_rank_importance(p, s, n = 2, objective = "asdf"),
    "name of an objective function"
  )
  # specifying extra_args with unused parameter
  expect_tidy_error(
    eval_rank_importance(p, s, n = 2, extra_args = list(1)),
    "explicitly named"
  )
  expect_tidy_error(
    eval_rank_importance(p, s, n = 2, extra_args = list(asdf = 1)),
    "must be `NULL`"
  )
  expect_tidy_error(
    eval_rank_importance(
      p, s, n = 2, objective = "add_max_phylo_div_objective",
      extra_args = list(asdf = 1)
    ),
    "tree"
  )
  # specifying extra_args with budget parameter
  expect_tidy_error(
    eval_rank_importance(p, s, n = 2, extra_args = list(budget = 1)),
    "must not have an element named"
  )
  # specifying extra_args with x parameter
  expect_tidy_error(
    eval_rank_importance(p, s, n = 2, extra_args = list(x = 1)),
    "must not have an element named"
  )
  # specifying n as a number that is > number of planning units
  expect_tidy_error(
    eval_rank_importance(p, s, n = 1000),
    "selected planning units"
  )
  # specifying only 1 budget value
  expect_tidy_error(
    eval_rank_importance(p, s, budgets = 2.5),
    "budgets"
  )
  # specifying only 1 budget value
  expect_tidy_error(
    eval_rank_importance(p, s, budgets = matrix(2.5)),
    "budgets"
  )
  # specifying budgets with ncol() > 1 and not equal to number of zones
  expect_tidy_error(
    eval_rank_importance(p, s, budgets = matrix(c(2, 4, 2, 4), ncol = 2)),
    "budgets"
  )
  # specifying complex constraints throws error
  expect_tidy_error(
    p %>%
      add_linear_constraints(100, "<=", pu) %>%
      eval_rank_importance(s, n = 2),
    "pre-computed"
  )
  # warning if non-default by_zone value is used with budgets
  expect_warning(
    eval_rank_importance(p, s, by_zone = FALSE, budgets = budgets),
    "default parameter value"
  )
})

Try the prioritizr package in your browser

Any scripts or data that you put into this service are public.

prioritizr documentation built on April 3, 2025, 8:45 p.m.