Nothing
test_that("single zone (zone matrix = 1)", {
set.seed(500)
# create zones data
zm <- diag(1)
# create problem data
pu <- sf::st_as_sf(
tibble::tibble(
id = seq_len(10), cost = c(0.2, NA_real_, runif(8)),
spp1 = runif(10), spp2 = c(rpois(9, 4), NA),
con = runif(10),
solution = c(0, NA, 1, 1, 1, 0, 0, 0, 1, 0)
),
geometry =
terra::rast(
matrix(seq_len(10), ncol = 2, byrow = TRUE),
extent = terra::ext(0, 2, 0, 5)
) %>%
terra::as.polygons() %>%
sf::st_as_sf() %>%
{.[order(.[[1]]), ]} %>%
sf::st_geometry()
)
# create connectivity matrix
cm <- connectivity_matrix(pu, "con")
# create problem
p <- problem(pu, features = c("spp1", "spp2"), cost_column = "cost")
# calculate connectivity (dgCMatrix)
r1 <- eval_connectivity_summary(p, pu[, "solution"], zm, cm)
# calculate connectivity (matrix)
r2 <- eval_connectivity_summary(p, pu[, "solution"], zm, as.matrix(cm))
# calculate connectivity (array)
r3 <- eval_connectivity_summary(
p, pu[, "solution"], NULL, as_connectivity_array(zm, cm)
)
# correct connectivity result
r4 <- tibble::tibble(
summary = "overall",
connectivity = r_connectivity_given_matrix(pu$solution, zm, cm)
)
# run tests
expect_equal(r1, r2)
expect_equal(r1, r3)
expect_equal(r1, r4)
expect_equal(nrow(na.omit(r1)), nrow(r1))
})
test_that("single zone (variable zone matrix)", {
set.seed(500)
# create zones data
zm <- matrix(0.4, ncol = 1, nrow = 1)
# create problem data
pu <- sf::st_as_sf(
tibble::tibble(
id = seq_len(10), cost = c(0.2, NA_real_, runif(8)),
spp1 = runif(10), spp2 = c(rpois(9, 4), NA),
con = runif(10),
solution = c(0, NA, 1, 1, 1, 0, 0, 0, 1, 0)
),
geometry =
terra::rast(
matrix(seq_len(10), ncol = 2, byrow = TRUE),
extent = terra::ext(0, 2, 0, 5)
) %>%
terra::as.polygons() %>%
sf::st_as_sf() %>%
{.[order(.[[1]]), ]} %>%
sf::st_geometry()
)
# create connectivity matrix
cm <- connectivity_matrix(pu, "con")
# create problem
p <- problem(pu, features = c("spp1", "spp2"), cost_column = "cost")
# calculate connectivity (dgCMatrix)
r1 <- eval_connectivity_summary(p, pu[, "solution"], zm, cm)
# calculate connectivity (matrix)
r2 <- eval_connectivity_summary(p, pu[, "solution"], zm, as.matrix(cm))
# calculate connectivity (array)
r3 <- eval_connectivity_summary(
p, pu[, "solution"], NULL, as_connectivity_array(zm, cm)
)
# correct connectivity result
r4 <- tibble::tibble(
summary = "overall",
connectivity = r_connectivity_given_matrix(pu$solution, zm, cm)
)
# run tests
expect_equal(r1, r2)
expect_equal(r1, r3)
expect_equal(r1, r4)
expect_equal(nrow(na.omit(r1)), nrow(r1))
})
test_that("multiple zones (zone matrix = 1)", {
set.seed(500)
# create zones matrix
zm <- matrix(1, ncol = 2, nrow = 2)
# create problem data
pu <- sf::st_as_sf(
tibble::tibble(
id = seq_len(10),
con = runif(10),
cost_1 = c(NA, NA, runif(8)),
cost_2 = c(0.3, NA, runif(8)),
spp1_1 = runif(10), spp2_1 = c(rpois(9, 4), NA),
spp1_2 = runif(10), spp2_2 = runif(10),
sol_1 = c(NA, NA, rep(c(0, 1), 4)),
sol_2 = c(1, NA, rep(c(1, 0), 4))
),
geometry =
terra::rast(
matrix(seq_len(10), ncol = 2, byrow = TRUE),
extent = terra::ext(0, 2, 0, 5)
) %>%
terra::as.polygons() %>%
sf::st_as_sf() %>%
{.[order(.[[1]]), ]} %>%
sf::st_geometry()
)
# create connectivity matrix
cm <- connectivity_matrix(pu, "con")
# create problem
p <- problem(
pu,
features = zones(c("spp1_1", "spp2_1"), c("spp1_2", "spp2_2")),
cost_column = c("cost_1", "cost_2")
)
# calculate connectivity (dgCMatrix)
r1 <- eval_connectivity_summary(p, pu[, c("sol_1", "sol_2")], zm, cm)
# calculate connectivity (matrix)
r2 <- eval_connectivity_summary(
p, pu[, c("sol_1", "sol_2")], zm, as.matrix(cm)
)
# calculate connectivity (array)
r3 <- eval_connectivity_summary(
p, pu[, c("sol_1", "sol_2")], NULL, as_connectivity_array(zm, cm)
)
# correct connectivity result
r4 <- tibble::tibble(
summary = c("overall", "1", "2"),
connectivity = c(
r_connectivity_given_matrix(pu[, c("sol_1", "sol_2")], zm, cm),
r_connectivity_given_matrix(pu[, "sol_1"], diag(1), cm),
r_connectivity_given_matrix(pu[, "sol_2"], diag(1), cm)
)
)
# run tests
expect_equal(r1, r2)
expect_equal(r1, r3)
expect_equal(r1, r4)
expect_equal(nrow(na.omit(r1)), nrow(r1))
})
test_that("multiple zones (zone matrix = identity matrix)", {
set.seed(500)
# create zones matrix
zm <- diag(2)
# create problem data
pu <- sf::st_as_sf(
tibble::tibble(
id = seq_len(10),
con = runif(10),
cost_1 = c(NA, NA, runif(8)),
cost_2 = c(0.3, NA, runif(8)),
spp1_1 = runif(10), spp2_1 = c(rpois(9, 4), NA),
spp1_2 = runif(10), spp2_2 = runif(10),
sol_1 = c(NA, NA, rep(c(0, 1), 4)),
sol_2 = c(1, NA, rep(c(1, 0), 4))
),
geometry =
terra::rast(
matrix(seq_len(10), ncol = 2, byrow = TRUE),
extent = terra::ext(0, 2, 0, 5)
) %>%
terra::as.polygons() %>%
sf::st_as_sf() %>%
{.[order(.[[1]]), ]} %>%
sf::st_geometry()
)
# create connectivity matrix
cm <- connectivity_matrix(pu, "con")
# create problem
p <- problem(
pu,
features = zones(c("spp1_1", "spp2_1"), c("spp1_2", "spp2_2")),
cost_column = c("cost_1", "cost_2")
)
# calculate connectivity (dgCMatrix)
r1 <- eval_connectivity_summary(p, pu[, c("sol_1", "sol_2")], zm, cm)
# calculate connectivity (matrix)
r2 <- eval_connectivity_summary(
p, pu[, c("sol_1", "sol_2")], zm, as.matrix(cm)
)
# calculate connectivity (array)
r3 <- eval_connectivity_summary(
p, pu[, c("sol_1", "sol_2")], NULL, as_connectivity_array(zm, cm)
)
# correct connectivity result
r4 <- tibble::tibble(
summary = c("overall", "1", "2"),
connectivity = c(
r_connectivity_given_matrix(pu[, c("sol_1", "sol_2")], zm, cm),
r_connectivity_given_matrix(pu[, "sol_1"], diag(1), cm),
r_connectivity_given_matrix(pu[, "sol_2"], diag(1), cm)
)
)
# run tests
expect_equal(r1, r2)
expect_equal(r1, r3)
expect_equal(r1, r4)
expect_equal(nrow(na.omit(r1)), nrow(r1))
})
test_that("multiple zones (variable zone matrix)", {
set.seed(500)
# create zones matrix
zm <- matrix(c(0.9, 0.2, 0.2, 0.4), ncol = 2, nrow = 2)
# create problem data
pu <- sf::st_as_sf(
tibble::tibble(
id = seq_len(10),
con = runif(10),
cost_1 = c(NA, NA, runif(8)),
cost_2 = c(0.3, NA, runif(8)),
spp1_1 = runif(10), spp2_1 = c(rpois(9, 4), NA),
spp1_2 = runif(10), spp2_2 = runif(10),
sol_1 = c(NA, NA, rep(c(0, 1), 4)),
sol_2 = c(1, NA, rep(c(1, 0), 4))
),
geometry =
terra::rast(
matrix(seq_len(10), ncol = 2, byrow = TRUE),
extent = terra::ext(0, 2, 0, 5)
) %>%
terra::as.polygons() %>%
sf::st_as_sf() %>%
{.[order(.[[1]]), ]} %>%
sf::st_geometry()
)
# create connectivity matrix
cm <- connectivity_matrix(pu, "con")
# create problem
p <- problem(
pu,
features = zones(c("spp1_1", "spp2_1"), c("spp1_2", "spp2_2")),
cost_column = c("cost_1", "cost_2")
)
# calculate connectivity (dgCMatrix)
r1 <- eval_connectivity_summary(p, pu[, c("sol_1", "sol_2")], zm, cm)
# calculate connectivity (matrix)
r2 <- eval_connectivity_summary(
p, pu[, c("sol_1", "sol_2")], zm, as.matrix(cm)
)
# calculate connectivity (array)
## calculate metrics
r3 <- eval_connectivity_summary(
p, pu[, c("sol_1", "sol_2")], NULL, as_connectivity_array(zm, cm)
)
## rescale metrics to account for diagonal values != 1
r3[[2]][[2]] <- r3[[2]][[2]] * (1 / zm[1, 1])
r3[[2]][[3]] <- r3[[2]][[3]] * (1 / zm[2, 2])
# correct connectivity result
r4 <- tibble::tibble(
summary = c("overall", "1", "2"),
connectivity = c(
r_connectivity_given_matrix(pu[, c("sol_1", "sol_2")], zm, cm),
r_connectivity_given_matrix(pu[, "sol_1"], diag(1), cm),
r_connectivity_given_matrix(pu[, "sol_2"], diag(1), cm)
)
)
# run tests
expect_equal(r1, r2)
expect_equal(r1, r3)
expect_equal(r1, r4)
expect_equal(nrow(na.omit(r1)), nrow(r1))
})
test_that("expected warnings", {
set.seed(500)
# create zones matrix
zm <- diag(1)
# create problem data
pu <- sf::st_as_sf(
tibble::tibble(
id = seq_len(10), cost = c(0.2, NA_real_, runif(8)),
spp1 = runif(10), spp2 = c(rpois(9, 4), NA),
con = runif(10),
solution = c(0, NA, 1, 1, 1, 0, 0, 0, 1, 0)
),
geometry =
terra::rast(
matrix(seq_len(10), ncol = 2, byrow = TRUE),
extent = terra::ext(0, 2, 0, 5)
) %>%
terra::as.polygons() %>%
sf::st_as_sf() %>%
{.[order(.[[1]]), ]} %>%
sf::st_geometry()
)
# create asymmetric connectivity matrix
cm <- matrix(runif(nrow(pu)^2), nrow = nrow(pu), ncol = nrow(pu))
# create problem
p <- problem(pu, features = c("spp1", "spp2"), cost_column = "cost")
# tests
expect_warning(
eval_connectivity_summary(p, pu[, "solution"], data = cm),
"asymmetric"
)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.