tests/testthat/test_eval_asym_connectivity_summary.R

In prioritizr: Systematic Conservation Prioritization in R

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),
      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()
  )
  # simulate 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")
  # calculate connectivity (dgCMatrix)
  r1 <- eval_asym_connectivity_summary(p, pu[, "solution"], zm, cm)
  # calculate connectivity (matrix)
  r2 <- eval_asym_connectivity_summary(p, pu[, "solution"], zm, as.matrix(cm))
  # calculate connectivity (array)
  r3 <- eval_asym_connectivity_summary(
    p, pu[, "solution"], NULL, as_connectivity_array(zm, cm)
  )
  # correct connectivity result
  r4 <- tibble::tibble(
    summary = "overall",
    asym_connectivity = r_asym_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()
  )
  # simulate 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")
  # calculate connectivity (dgCMatrix)
  r1 <- eval_asym_connectivity_summary(p, pu[, "solution"], zm, cm)
  # calculate connectivity (matrix)
  r2 <- eval_asym_connectivity_summary(p, pu[, "solution"], zm, as.matrix(cm))
  # calculate connectivity (array)
  r3 <- eval_asym_connectivity_summary(
    p, pu[, "solution"], NULL, as_connectivity_array(zm, cm)
  )
  # correct connectivity result
  r4 <- tibble::tibble(
    summary = "overall",
    asym_connectivity = r_asym_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 data
  zm <- matrix(1, ncol = 2, nrow = 2)
  # create planning unit
  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()
  )
  # simulate connectivity matrix
  cm <- matrix(runif(nrow(pu)^2), nrow = nrow(pu), ncol = nrow(pu))
  # 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_asym_connectivity_summary(p, pu[, c("sol_1", "sol_2")], zm, cm)
  # calculate connectivity (matrix)
  r2 <- eval_asym_connectivity_summary(
    p, pu[, c("sol_1", "sol_2")], zm, as.matrix(cm)
  )
  # calculate connectivity (array)
  r3 <- eval_asym_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"),
    asym_connectivity = c(
      r_asym_connectivity_given_matrix(pu[, c("sol_1", "sol_2")], zm, cm),
      r_asym_connectivity_given_matrix(pu[, c("sol_1")], diag(1), cm),
      r_asym_connectivity_given_matrix(pu[, c("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 data
  zm <- diag(2)
  # create planning unit
  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()
  )
  # simulate connectivity matrix
  cm <- matrix(runif(nrow(pu)^2), nrow = nrow(pu), ncol = nrow(pu))
  # 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_asym_connectivity_summary(p, pu[, c("sol_1", "sol_2")], zm, cm)
  # calculate connectivity (matrix)
  r2 <- eval_asym_connectivity_summary(
    p, pu[, c("sol_1", "sol_2")], zm, as.matrix(cm)
  )
  # calculate connectivity (array)
  r3 <- eval_asym_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"),
    asym_connectivity = c(
      r_asym_connectivity_given_matrix(pu[, c("sol_1", "sol_2")], zm, cm),
      r_asym_connectivity_given_matrix(pu[, c("sol_1")], diag(1), cm),
      r_asym_connectivity_given_matrix(pu[, c("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 data
  zm <- matrix(c(0.9, 0.2, 0.2, 0.4), ncol = 2, nrow = 2)
  # create planning unit
  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()
  )
  # simulate connectivity matrix
  cm <- matrix(runif(nrow(pu)^2), nrow = nrow(pu), ncol = nrow(pu))
  # 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_asym_connectivity_summary(p, pu[, c("sol_1", "sol_2")], zm, cm)
  # calculate connectivity (matrix)
  r2 <- eval_asym_connectivity_summary(
    p, pu[, c("sol_1", "sol_2")], zm, as.matrix(cm)
  )
  # calculate connectivity (array)
  ## calculate metrics
  r3 <- eval_asym_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"),
    asym_connectivity = c(
      r_asym_connectivity_given_matrix(pu[, c("sol_1", "sol_2")], zm, cm),
      r_asym_connectivity_given_matrix(pu[, "sol_1"], diag(1), cm),
      r_asym_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 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),
      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()
  )
  # simulate connectivity matrix
  cm <- boundary_matrix(pu)
  # create problem
  p <- problem(pu, features = c("spp1", "spp2"), cost_column = "cost")
  # tests
  expect_warning(
    eval_asym_connectivity_summary(p, pu[, "solution"], data = cm),
    "symmetric"
  )
})