if (FALSE) {
# set seed for reproducibility
set.seed(500)
# load data
sim_pu_polygons <- get_sim_pu_polygons()
sim_features <- get_sim_features()
sim_locked_out_raster <- get_sim_locked_out_raster()
sim_zones_pu_raster <- get_sim_zones_pu_raster()
sim_zones_pu_polygons <- get_sim_zones_pu_polygons()
sim_zones_features <- get_sim_zones_features()
# create minimal problem
p1 <-
problem(sim_pu_polygons, sim_features, "cost") %>%
add_min_set_objective() %>%
add_relative_targets(0.2) %>%
add_binary_decisions() %>%
add_default_solver(verbose = FALSE)
# create problem with added locked out constraints using integers
p2 <- p1 %>% add_locked_out_constraints(which(sim_pu_polygons$locked_out))
# create problem with added locked out constraints using a column name
p3 <- p1 %>% add_locked_out_constraints("locked_out")
# create problem with added locked out constraints using raster data
p4 <- p1 %>% add_locked_out_constraints(sim_locked_out_raster)
# create problem with added locked out constraints using spatial polygon data
locked_out <- sim_pu_polygons[sim_pu_polygons$locked_out == 1, ]
p5 <- p1 %>% add_locked_out_constraints(locked_out)
# solve problems
s1 <- solve(p1)
s2 <- solve(p2)
s3 <- solve(p3)
s4 <- solve(p4)
s5 <- solve(p5)
# create single object with all solutions
s6 <- sf::st_sf(
tibble::tibble(
s1 = s1$solution_1,
s2 = s2$solution_1,
s3 = s3$solution_1,
s4 = s4$solution_1,
s5 = s5$solution_1
),
geometry = sf::st_geometry(s1)
)
# plot solutions
plot(
s6,
main = c(
"none locked out", "locked out (integer input)",
"locked out (character input)", "locked out (raster input)",
"locked out (polygon input)"
)
)
# reset plot
par(mfrow = c(1, 1))
# create minimal multi-zone problem with spatial data
p7 <-
problem(
sim_zones_pu_polygons, sim_zones_features,
cost_column = c("cost_1", "cost_2", "cost_3")
) %>%
add_min_set_objective() %>%
add_absolute_targets(matrix(rpois(15, 1), nrow = 5, ncol = 3)) %>%
add_binary_decisions() %>%
add_default_solver(verbose = FALSE)
# create multi-zone problem with locked out constraints using matrix data
locked_matrix <- as.matrix(sf::st_drop_geometry(
sim_zones_pu_polygons[, c("locked_1", "locked_2", "locked_3")]
))
p8 <- p7 %>% add_locked_out_constraints(locked_matrix)
# solve problem
s8 <- solve(p8)
# create new column representing the zone id that each planning unit
# was allocated to in the solution
s8$solution <- category_vector(sf::st_drop_geometry(
s8[, c("solution_1_zone_1", "solution_1_zone_2", "solution_1_zone_3")]
))
s8$solution <- factor(s8$solution)
# plot solution
plot(s8[, "solution"], main = "solution", axes = FALSE)
# create multi-zone problem with locked out constraints using column names
p9 <-
p7 %>%
add_locked_out_constraints(c("locked_1", "locked_2", "locked_3"))
# solve problem
s9 <- solve(p9)
# create new column in s8 representing the zone id that each planning unit
# was allocated to in the solution
s9$solution <- category_vector(sf::st_drop_geometry(
s9[, c("solution_1_zone_1", "solution_1_zone_2", "solution_1_zone_3")]
))
s9$solution[s9$solution == 1 & s9$solution_1_zone_1 == 0] <- 0
s9$solution <- factor(s9$solution)
# plot solution
plot(s9[, "solution"], main = "solution", axes = FALSE)
# create multi-zone problem with raster planning units
p10 <-
problem(sim_zones_pu_raster, sim_zones_features) %>%
add_min_set_objective() %>%
add_absolute_targets(matrix(rpois(15, 1), nrow = 5, ncol = 3)) %>%
add_binary_decisions() %>%
add_default_solver(verbose = FALSE)
# create multi-layer raster with locked out units
locked_out_raster <- sim_zones_pu_raster[[1]]
locked_out_raster[!is.na(locked_out_raster)] <- 0
locked_out_raster <- locked_out_raster[[c(1, 1, 1)]]
names(locked_out_raster) <- c("zones_1", "zones_2", "zones_3")
locked_out_raster[[1]][1] <- 1
locked_out_raster[[2]][2] <- 1
locked_out_raster[[3]][3] <- 1
# plot locked out raster
plot(locked_out_raster)
# add locked out raster units to problem
p10 <- p10 %>% add_locked_out_constraints(locked_out_raster)
# solve problem
s10 <- solve(p10)
# plot solution
plot(category_layer(s10), main = "solution", axes = FALSE)
}
Run the code above in your browser using DataLab