tests/testthat/test_add_cost_penalties.R

In prioritizr: Systematic Conservation Prioritization in R

test_that("compile (single zone)", {
  # import data
  sim_pu_raster <- get_sim_pu_raster()
  sim_features <- get_sim_features()
  # create problems
  p1 <-
    problem(sim_pu_raster, sim_features) %>%
    add_min_set_objective() %>%
    add_relative_targets(0.1) %>%
    add_binary_decisions()
  p2 <-
    p1 %>%
    add_cost_penalties(3)
  # compile problems
  o1 <- compile(p1)
  o2 <- compile(p2)
  # calculations for tests
  pen <- 3 * c(p2$planning_unit_costs())
  # tests
  expect_equal(o2$obj(), o1$obj() + pen)
  expect_equal(o2$A(), o1$A())
  expect_equal(o2$ub(), o1$ub())
  expect_equal(o2$lb(), o1$lb())
  expect_equal(o2$rhs(), o1$rhs())
  expect_equal(o2$sense(), o1$sense())
  expect_equal(o2$modelsense(), o1$modelsense())
})

test_that("solve (single zone)", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  costs <- terra::rast(matrix(c(1,  2,  NA, 3, 100, 100, NA), ncol = 7))
  spp <- c(
    terra::rast(matrix(c(1,  2, 0, 0, 0, 0,  0), ncol = 7)),
    terra::rast(matrix(c(NA, 0, 1, 1, 0, 0,  0), ncol = 7)),
    terra::rast(matrix(c(1,  0, 0, 0, 1, 0,  0), ncol = 7)),
    terra::rast(matrix(c(0,  0, 0, 0, 0, 10, 0), ncol = 7))
  )
  names(spp) <- paste("F", seq_len(terra::nlyr(spp)))
  # create problem
  p <-
    problem(costs, spp) %>%
    add_max_wtd_sum_objective(budget = 1000) %>%
    add_cost_penalties(1000) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # solve problem
  s <- solve(p, run_checks = FALSE)
  # tests
  expect_inherits(s, "SpatRaster")
  expect_equal(c(terra::values(s)), c(0, 0, NA, 0, 0, 0, NA))
})

test_that("compile (multiple zones)", {
  # import data
  sim_zones_pu_raster <- get_sim_zones_pu_raster()
  sim_zones_features <- get_sim_zones_features()
  # create penalty data
  pd <- sim_zones_features[[1]][[seq_len(3)]]
  # create targets data
  targ <- matrix(
    runif(
      number_of_features(sim_zones_features) *
      number_of_zones(sim_zones_features)
    ) * 10,
    nrow = number_of_features(sim_zones_features),
    ncol = number_of_zones(sim_zones_features)
  )
  # create problems
  p1 <-
    problem(sim_zones_pu_raster, sim_zones_features) %>%
    add_min_set_objective() %>%
    add_absolute_targets(targ) %>%
    add_binary_decisions()
  p2 <-
    p1 %>%
    add_cost_penalties(c(3, 5, 7))
  # compile problems
  o1 <- compile(p1)
  o2 <- compile(p2)
  # calculations for tests
  pen <- matrix(
    c(3, 5, 7),
    nrow = p1$number_of_planning_units(),
    ncol = p1$number_of_zones(),
    byrow = TRUE
  ) * p2$planning_unit_costs()
  # tests
  expect_equal(o2$obj(), o1$obj() + c(pen))
  expect_equal(o2$A(), o1$A())
  expect_equal(o2$ub(), o1$ub())
  expect_equal(o2$lb(), o1$lb())
  expect_equal(o2$rhs(), o1$rhs())
  expect_equal(o2$sense(), o1$sense())
  expect_equal(o2$modelsense(), o1$modelsense())
})

test_that("solve (multiple zones)", {
  skip_on_cran()
  skip_if_no_fast_solvers_installed()
  # create data
  costs <- c(
    terra::rast(matrix(c(1,  2,  NA, 3, 100, 100, NA), ncol = 7)),
    terra::rast(matrix(c(10, 10, 10, 10,  4,   1, NA), ncol = 7))
  )
  spp <- c(
    terra::rast(matrix(c(1,  2, 0, 0, 0, 0,  0), ncol = 7)),
    terra::rast(matrix(c(NA, 0, 1, 1, 0, 0,  0), ncol = 7)),
    terra::rast(matrix(c(1,  0, 0, 0, 1, 0,  0), ncol = 7)),
    terra::rast(matrix(c(0,  0, 0, 0, 0, 10, 0), ncol = 7))
  )
  # create problem
  p <-
    problem(costs, zones(spp[[1:2]], spp[[3:4]])) %>%
    add_max_wtd_sum_objective(budget = 1000) %>%
    add_cost_penalties(c(1000, 2000)) %>%
    add_binary_decisions() %>%
    add_default_solver(gap = 0, verbose = FALSE)
  # solve problem
  s <- solve(p, run_checks = FALSE)
  # tests
  expect_inherits(s, "SpatRaster")
  expect_equal(c(terra::values(s[[1]])), c(0, 0, NA, 0, 0, 0, NA))
  expect_equal(c(terra::values(s[[2]])), c(0, 0, 0,  0, 0, 0, NA))
})

test_that("invalid inputs", {
  # import data
  sim_pu_raster <- get_sim_pu_raster()
  sim_features <- get_sim_features()
  # tests
  expect_tidy_error({
    problem(sim_pu_raster, sim_features) %>%
    add_cost_penalties(NA_real_)
  })
  expect_tidy_error({
    problem(sim_pu_raster, sim_features) %>%
    add_cost_penalties(c(3, 3))
  })
  expect_tidy_error({
    problem(sim_pu_raster, sim_features) %>%
    add_cost_penalties("a")
  })
})