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_in_raster <- get_sim_locked_in_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 in constraints using integers
p2 <- p1 %>% add_locked_in_constraints(which(sim_pu_polygons$locked_in))
# create problem with added locked in constraints using a column name
p3 <- p1 %>% add_locked_in_constraints("locked_in")
# create problem with added locked in constraints using raster data
p4 <- p1 %>% add_locked_in_constraints(sim_locked_in_raster)
# create problem with added locked in constraints using spatial polygon data
locked_in <- sim_pu_polygons[sim_pu_polygons$locked_in == 1, ]
p5 <- p1 %>% add_locked_in_constraints(locked_in)
# 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 in", "locked in (integer input)",
"locked in (character input)", "locked in (raster input)",
"locked in (polygon input)"
)
)
# 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 in 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_in_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"], axes = FALSE)
# create multi-zone problem with locked in constraints using column names
p9 <- p7 %>% add_locked_in_constraints(c("locked_1", "locked_2", "locked_3"))
# solve problem
s9 <- solve(p9)
# create new column 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"], 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 in units
locked_in_raster <- sim_zones_pu_raster[[1]]
locked_in_raster[!is.na(locked_in_raster)] <- 0
locked_in_raster <- locked_in_raster[[c(1, 1, 1)]]
names(locked_in_raster) <- c("zone_1", "zone_2", "zone_3")
locked_in_raster[[1]][1] <- 1
locked_in_raster[[2]][2] <- 1
locked_in_raster[[3]][3] <- 1
# plot locked in raster
plot(locked_in_raster)
# add locked in raster units to problem
p10 <- p10 %>% add_locked_in_constraints(locked_in_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