if (FALSE) {
# set seed for reproducibility
set.seed(600)
# load data
sim_pu_polygons <- get_sim_pu_polygons()
sim_features <- get_sim_features()
sim_zones_pu_raster <- get_sim_zones_pu_raster()
sim_zones_features <- get_sim_zones_features()
# create basic problem
p1 <-
problem(sim_pu_polygons, sim_features, "cost") %>%
add_min_set_objective() %>%
add_relative_targets(0.2) %>%
add_default_solver(verbose = FALSE)
# create a symmetric connectivity matrix where the connectivity between
# two planning units corresponds to their shared boundary length
b_matrix <- boundary_matrix(sim_pu_polygons)
# rescale matrix values to have a maximum value of 1
b_matrix <- rescale_matrix(b_matrix, max = 1)
# visualize connectivity matrix
Matrix::image(b_matrix)
# create a symmetric connectivity matrix where the connectivity between
# two planning units corresponds to their spatial proximity
# i.e., planning units that are further apart share less connectivity
centroids <- sf::st_coordinates(
suppressWarnings(sf::st_centroid(sim_pu_polygons))
)
d_matrix <- (1 / (Matrix::Matrix(as.matrix(dist(centroids))) + 1))
# rescale matrix values to have a maximum value of 1
d_matrix <- rescale_matrix(d_matrix, max = 1)
# remove connections between planning units with values below a threshold to
# reduce run-time
d_matrix[d_matrix < 0.8] <- 0
# visualize connectivity matrix
Matrix::image(d_matrix)
# create a symmetric connectivity matrix where the connectivity
# between adjacent two planning units corresponds to their combined
# value in a column of the planning unit data
# for example, this column could describe the extent of native vegetation in
# each planning unit and we could use connectivity penalties to identify
# solutions that cluster planning units together that both contain large
# amounts of native vegetation
c_matrix <- connectivity_matrix(sim_pu_polygons, "cost")
# rescale matrix values to have a maximum value of 1
c_matrix <- rescale_matrix(c_matrix, max = 1)
# visualize connectivity matrix
Matrix::image(c_matrix)
# create penalties
penalties <- c(10, 25)
# create problems using the different connectivity matrices and penalties
p2 <- list(
p1,
p1 %>% add_connectivity_penalties(penalties[1], data = b_matrix),
p1 %>% add_connectivity_penalties(penalties[2], data = b_matrix),
p1 %>% add_connectivity_penalties(penalties[1], data = d_matrix),
p1 %>% add_connectivity_penalties(penalties[2], data = d_matrix),
p1 %>% add_connectivity_penalties(penalties[1], data = c_matrix),
p1 %>% add_connectivity_penalties(penalties[2], data = c_matrix)
)
# solve problems
s2 <- lapply(p2, solve)
# create single object with all solutions
s2 <- sf::st_sf(
tibble::tibble(
p2_1 = s2[[1]]$solution_1,
p2_2 = s2[[2]]$solution_1,
p2_3 = s2[[3]]$solution_1,
p2_4 = s2[[4]]$solution_1,
p2_5 = s2[[5]]$solution_1,
p2_6 = s2[[6]]$solution_1,
p2_7 = s2[[7]]$solution_1
),
geometry = sf::st_geometry(s2[[1]])
)
names(s2)[1:7] <- c(
"basic problem",
paste0("b_matrix (", penalties,")"),
paste0("d_matrix (", penalties,")"),
paste0("c_matrix (", penalties,")")
)
# plot solutions
plot(s2)
# create minimal multi-zone problem and limit solver to one minute
# to obtain solutions in a short period of time
p3 <-
problem(sim_zones_pu_raster, sim_zones_features) %>%
add_min_set_objective() %>%
add_relative_targets(matrix(0.15, nrow = 5, ncol = 3)) %>%
add_binary_decisions() %>%
add_default_solver(time_limit = 60, verbose = FALSE)
# create matrix showing which planning units are adjacent to other units
a_matrix <- adjacency_matrix(sim_zones_pu_raster)
# visualize matrix
Matrix::image(a_matrix)
# create a zone matrix where connectivities are only present between
# planning units that are allocated to the same zone
zm1 <- as(diag(3), "Matrix")
# print zone matrix
print(zm1)
# create a zone matrix where connectivities are strongest between
# planning units allocated to different zones
zm2 <- matrix(1, ncol = 3, nrow = 3)
diag(zm2) <- 0
zm2 <- as(zm2, "Matrix")
# print zone matrix
print(zm2)
# create a zone matrix that indicates that connectivities between planning
# units assigned to the same zone are much higher than connectivities
# assigned to different zones
zm3 <- matrix(0.1, ncol = 3, nrow = 3)
diag(zm3) <- 1
zm3 <- as(zm3, "Matrix")
# print zone matrix
print(zm3)
# create a zone matrix that indicates that connectivities between planning
# units allocated to zone 1 are very high, connectivities between planning
# units allocated to zones 1 and 2 are moderately high, and connectivities
# planning units allocated to other zones are low
zm4 <- matrix(0.1, ncol = 3, nrow = 3)
zm4[1, 1] <- 1
zm4[1, 2] <- 0.5
zm4[2, 1] <- 0.5
zm4 <- as(zm4, "Matrix")
# print zone matrix
print(zm4)
# create a zone matrix with strong connectivities between planning units
# allocated to the same zone, moderate connectivities between planning
# unit allocated to zone 1 and zone 2, and negative connectivities between
# planning units allocated to zone 3 and the other two zones
zm5 <- matrix(-1, ncol = 3, nrow = 3)
zm5[1, 2] <- 0.5
zm5[2, 1] <- 0.5
diag(zm5) <- 1
zm5 <- as(zm5, "Matrix")
# print zone matrix
print(zm5)
# create vector of penalties to use creating problems
penalties2 <- c(5, 15)
# create multi-zone problems using the adjacent connectivity matrix and
# different zone matrices
p4 <- list(
p3,
p3 %>% add_connectivity_penalties(penalties2[1], zm1, a_matrix),
p3 %>% add_connectivity_penalties(penalties2[2], zm1, a_matrix),
p3 %>% add_connectivity_penalties(penalties2[1], zm2, a_matrix),
p3 %>% add_connectivity_penalties(penalties2[2], zm2, a_matrix),
p3 %>% add_connectivity_penalties(penalties2[1], zm3, a_matrix),
p3 %>% add_connectivity_penalties(penalties2[2], zm3, a_matrix),
p3 %>% add_connectivity_penalties(penalties2[1], zm4, a_matrix),
p3 %>% add_connectivity_penalties(penalties2[2], zm4, a_matrix),
p3 %>% add_connectivity_penalties(penalties2[1], zm5, a_matrix),
p3 %>% add_connectivity_penalties(penalties2[2], zm5, a_matrix)
)
# solve problems
s4 <- lapply(p4, solve)
s4 <- lapply(s4, category_layer)
s4 <- terra::rast(s4)
names(s4) <- c(
"basic problem",
paste0("zm", rep(seq_len(5), each = 2), " (", rep(penalties2, 2), ")")
)
# plot solutions
plot(s4, axes = FALSE)
# create an array to manually specify the connectivities between
# each planning unit when they are allocated to each different zone
# for real-world problems, these connectivities would be generated using
# data - but here these connectivity values are assigned as random
# ones or zeros
c_array <- array(0, c(rep(ncell(sim_zones_pu_raster[[1]]), 2), 3, 3))
for (z1 in seq_len(3))
for (z2 in seq_len(3))
c_array[, , z1, z2] <- round(
runif(ncell(sim_zones_pu_raster[[1]]) ^ 2, 0, 0.505)
)
# create a problem with the manually specified connectivity array
# note that the zones argument is set to NULL because the connectivity
# data is an array
p5 <- list(
p3,
p3 %>% add_connectivity_penalties(15, zones = NULL, c_array)
)
# solve problems
s5 <- lapply(p5, solve)
s5 <- lapply(s5, category_layer)
s5 <- terra::rast(s5)
names(s5) <- c("basic problem", "connectivity array")
# plot solutions
plot(s5, axes = FALSE)
}
Run the code above in your browser using DataLab