if (FALSE) {
# set seed for reproducibility
set.seed(500)
# load data
sim_pu_polygons <- get_sim_pu_polygons()
sim_features <- get_sim_features()
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 locked in constraints using add_locked_constraints
p2 <- p1 %>% add_locked_in_constraints("locked_in")
# create identical problem using add_manual_locked_constraints
locked_data <- data.frame(
pu = which(sim_pu_polygons$locked_in),
status = 1
)
p3 <- p1 %>% add_manual_locked_constraints(locked_data)
# solve problems
s1 <- solve(p1)
s2 <- solve(p2)
s3 <- solve(p3)
# create object with all solutions
s4 <- sf::st_sf(
tibble::tibble(
s1 = s1$solution_1,
s2 = s2$solution_1,
s3 = s3$solution_1
),
geometry = sf::st_geometry(s1)
)
# plot solutions
## s1 = none locked in
## s2 = locked in constraints
## s3 = manual locked constraints
plot(s4)
# create minimal problem with multiple zones
p5 <-
problem(
sim_zones_pu_polygons, sim_zones_features,
c("cost_1", "cost_2", "cost_3")
) %>%
add_min_set_objective() %>%
add_relative_targets(matrix(runif(15, 0.1, 0.2), nrow = 5, ncol = 3)) %>%
add_binary_decisions() %>%
add_default_solver(verbose = FALSE)
# create data.frame with the following constraints:
# planning units 1, 2, and 3 must be allocated to zone 1 in the solution
# planning units 4, and 5 must be allocated to zone 2 in the solution
# planning units 8 and 9 must not be allocated to zone 3 in the solution
locked_data2 <- data.frame(
pu = c(1, 2, 3, 4, 5, 8, 9),
zone = c(rep("zone_1", 3), rep("zone_2", 2),rep("zone_3", 2)),
status = c(rep(1, 5), rep(0, 2))
)
# print locked constraint data
print(locked_data2)
# create problem with added constraints
p6 <- p5 %>% add_manual_locked_constraints(locked_data2)
# solve problem
s5 <- solve(p5)
s6 <- solve(p6)
# create two new columns representing the zone id that each planning unit
# was allocated to in the two solutions
s5$solution <- category_vector(sf::st_drop_geometry(
s5[, c("solution_1_zone_1", "solution_1_zone_2", "solution_1_zone_3")]
))
s5$solution <- factor(s5$solution)
s5$solution_locked <- category_vector(sf::st_drop_geometry(
s6[, c("solution_1_zone_1", "solution_1_zone_2", "solution_1_zone_3")]
))
s5$solution_locked <- factor(s5$solution_locked)
# plot solutions
plot(s5[, c("solution", "solution_locked")], axes = FALSE)
}
Run the code above in your browser using DataLab