tests/testthat/test_add_divergence.R

In hydroloom: Utilities to Weave Hydrologic Fabrics

test_that("add_return_diversion", {
  x <- sf::read_sf(system.file("extdata/new_hope.gpkg", package = "hydroloom"))

  x <- hy(x)

  x <- add_return_divergence(x)

  expect_equal(sum(x$return_divergence == x$RtnDiv), 745)
})

test_that("complex split", {
  # these test if junctions with more than on upstream are handled.
  # base case
  x <- data.frame(id = c(1, 2, 3, 4, 5, 6, 7),
            fromnode = c(1, 2, 3, 3, 4, 5, 6),
              tonode = c(3, 3, 4, 5, 6, 6, 7),
            name = c("", "", "", "", "", "", ""),
            type = c(1, 1, 1, 1, 1, 1, 1))

  x <- add_divergence(x, 7, c(), name_attr = "name", type_attr = "type", major_types = 1)

  expect_equal(x$divergence[c(3,4)], c(1,2))

  # the rest of these switch from the base case
  # one matching name use it.
  x <- data.frame(id = c(1, 2, 3, 4, 5, 6, 7),
                  fromnode = c(1, 2, 3, 3, 4, 5, 6),
                  tonode = c(3, 3, 4, 5, 6, 6, 7),
                  name = c("test", "test2", "bbb", "test2", "", "", ""),
                  type = c(1, 1, 1, 1, 1, 1, 1))

  x <- add_divergence(x, 7, c(), name_attr = "name", type_attr = "type", major_types = 1)

  expect_equal(x$divergence[c(3,4)], c(2, 1))

  # one name at all
  x <- data.frame(id = c(1, 2, 3, 4, 5, 6, 7),
                  fromnode = c(1, 2, 3, 3, 4, 5, 6),
                  tonode = c(3, 3, 4, 5, 6, 6, 7),
                  name = c("test2", "", "", "test2", "", "", ""),
                  type = c(1, 1, 1, 1, 1, 1, 1))

  x <- add_divergence(x, 7, c(), name_attr = "name", type_attr = "type", major_types = 1)

  expect_equal(x$divergence[c(3,4)], c(2, 1))

  # major type name override
  x <- data.frame(id = c(1, 2, 3, 4, 5, 6, 7),
                  fromnode = c(1, 2, 3, 3, 4, 5, 6),
                  tonode = c(3, 3, 4, 5, 6, 6, 7),
                  name = c("test1", "test2", "test1", "test2", "", "", ""),
                  type = c(1, 2, 2, 1, 1, 1, 1))

  x <- add_divergence(x, 7, c(), name_attr = "name", type_attr = "type", major_types = 1)

  expect_equal(x$divergence[c(3,4)], c(1, 2))

  # major type
  x <- data.frame(id = c(1, 2, 3, 4, 5, 6, 7),
                  fromnode = c(1, 2, 3, 3, 4, 5, 6),
                  tonode = c(3, 3, 4, 5, 6, 6, 7),
                  name = c("test1", "test2", "test3", "test4", "", "", ""),
                  type = c(1, 2, 2, 1, 1, 1, 1))

  x <- add_divergence(x, 7, c(), name_attr = "name", type_attr = "type", major_types = 1)

  expect_equal(x$divergence[c(3,4)], c(2, 1))
})

test_that("add down main", {

  f <- system.file("extdata/coastal_example.gpkg", package = "hydroloom")

  g <- sf::read_sf(f)
  g <- g[g$FTYPE != "Coastline", ]

  outlets <- g$COMID[!g$ToNode %in% g$FromNode]

  d <- dplyr::select(g, COMID, gnis_id, FTYPE,
                     FromNode, ToNode)

  d <- add_divergence(d,
                      coastal_outlet_ids = outlets,
                      inland_outlet_ids = c(),
                      name_attr = "gnis_id",
                      type_attr = "FTYPE",
                      major_types = c("StreamRiver", "ArtificialPath", "Connector"))

  expect_equal(d$COMID, g$COMID)
  expect_equal(d$divergence, g$Divergence)

  expect_equal(d$divergence[d$COMID == 2544459], 2)
  expect_equal(d$divergence[d$COMID == 2544461], 1)

})

test_that("base down_level", {

  a <- dplyr::tibble(
    id = c("00BE2E87-F8A4-4D53-8CE6-E192469D86EE", "00BE2E87-F8A4-4D53-8CE6-E192469D86EE"),
    toid = c("2DAE89DC-2C4B-43A1-AB19-E4BAA997C9D2", "72498570-8338-400C-A167-EB3AA589F18B"),
    coastal = c(TRUE, TRUE),
    name_att = c("Stuhini Creek", "Stuhini Creek"),
    ftype = c(558L, 558L),
    dn_name_att = c(NA, "Stuhini Creek"),
    dn_ftype = c(558L, 558L),
    major_type = c(TRUE, TRUE),
  )

  testthat::expect_equal(hydroloom:::down_level(a), "72498570-8338-400C-A167-EB3AA589F18B")

  b <- dplyr::tibble(
    id = c("120497331", "120497331"),
    toid = c("120513267", "120497186"),
    coastal = c(TRUE, TRUE),
    name_att = c(NA_character_, NA_character_),
    ftype = c(460L, 460L),
    dn_name_att = c(NA, "Carroll Creek"),
    dn_ftype = c(460L, 460L),
    major_type = c(TRUE, TRUE),
  )

  testthat::expect_equal(hydroloom:::down_level(b), "120497186")

  c <- dplyr::tibble(
    id = c("67193536", "67193536"),
    toid = c("67194746", "67194750"),
    coastal = c(FALSE, FALSE),
    name_att = c("East Fork Tsivat River", "East Fork Tsivat River"),
    ftype = c(460L, 460L),
    dn_name_att = c(NA, "East Fork Tsivat River"),
    dn_ftype = c(460L, 460L),
    major_type = c(TRUE, TRUE),
  )

  testthat::expect_equal(hydroloom:::down_level(c), "67194750")

  d <- dplyr::tibble(
    id = c("{0691ff49-3167-4387-9d59-bd0e69f23ba0}", "{0691ff49-3167-4387-9d59-bd0e69f23ba0}"),
    toid = c("{6cc577b7-98b2-4352-9edc-5ec342e93078}", "{a1654838-6109-47b2-b5fd-07d329ff502b}"),
    coastal = c(TRUE, TRUE),
    name_att = c(NA_character_, NA_character_),
    ftype = c(336L, 336L),
    dn_name_att = c(NA_character_, NA_character_),
    dn_ftype = c(460L, 336L),
    major_type = c(TRUE, FALSE),
  )

  testthat::expect_equal(hydroloom:::down_level(d), "{6cc577b7-98b2-4352-9edc-5ec342e93078}")

  e <- dplyr::tibble(
    id = c("{3BBADBC2-10CD-42C4-963E-2CC3EBCAB96B}", "{3BBADBC2-10CD-42C4-963E-2CC3EBCAB96B}"),
    toid = c("00", "102984973"),
    coastal = c(TRUE, TRUE),
    name_att = c("South Fork Craig River", "South Fork Craig River"),
    ftype = c(460L, 460L),
    dn_name_att = c("South Fork Craig River", "South Fork Craig River"),
    dn_ftype = c(460L, 460L),
    major_type = c(TRUE, TRUE),
  )

  testthat::expect_equal(hydroloom:::down_level(e), "00")

  f <- dplyr::tibble(
    id = c("1", "1"),
    toid = c("5", "4"),
    coastal = c(TRUE, FALSE),
    name_att = c("South Fork Craig River", "South Fork Craig River"),
    ftype = c(460L, 460L),
    dn_name_att = c("South Fork Craig River", "South Fork Craig River"),
    dn_ftype = c(460L, 460L),
    major_type = c(TRUE, TRUE),
  )

  testthat::expect_equal(hydroloom:::down_level(f), "5")

  g <- dplyr::tibble(
    id = c("1", "1"),
    toid = c("5", "4"),
    coastal = c(TRUE, FALSE),
    name_att = c(NA_character_, NA_character_),
    ftype = c(460L, 460L),
    dn_name_att = c("South Fork Craig River", "check"),
    dn_ftype = c(460L, 460L),
    major_type = c(FALSE, FALSE),
  )

  testthat::expect_equal(hydroloom:::down_level(g), "5")

  h <- dplyr::tibble(
    id = c("1", "1"),
    toid = c("5", "4"),
    coastal = c(FALSE, FALSE),
    name_att = c(NA_character_, NA_character_),
    ftype = c(460L, 460L),
    dn_name_att = c("South Fork Craig River", NA_character_),
    dn_ftype = c(460L, 460L),
    major_type = c(TRUE, TRUE),
  )

  testthat::expect_equal(hydroloom:::down_level(h), "5")

  i <- dplyr::tibble(
    id = c("1", "1"),
    toid = c("5", "4"),
    coastal = c(FALSE, FALSE),
    name_att = c(NA_character_, NA_character_),
    ftype = c(460L, 460L),
    dn_name_att = c(NA_character_, NA_character_),
    dn_ftype = c(460L, 460L),
    major_type = c(TRUE, FALSE),
  )

  testthat::expect_equal(hydroloom:::down_level(i), "5")

  j <- dplyr::tibble(
    id = c("1", "1"),
    toid = c("5", "4"),
    coastal = c(FALSE, FALSE),
    name_att = c(NA_character_, NA_character_),
    ftype = c(460L, 460L),
    dn_name_att = c("test", NA_character_),
    dn_ftype = c(460L, 460L),
    major_type = c(FALSE, FALSE),
  )

  testthat::expect_equal(hydroloom:::down_level(j), "5")

  k <- dplyr::tibble(
    id = c("1", "1"),
    toid = c("5", "4"),
    coastal = c(FALSE, FALSE),
    name_att = c(NA_character_, NA_character_),
    ftype = c(460L, 460L),
    dn_name_att = c(NA_character_, NA_character_),
    dn_ftype = c(460L, 460L),
    major_type = c(FALSE, FALSE),
  )

  testthat::expect_equal(hydroloom:::down_level(k), "4")

  k <- dplyr::tibble(
    id = c("146073319", "146073319"),
    name_att = c("00246611", "00246611"),
    type_att = c(336L, 336L),
    toid = c("7ff2749a-869f-480f-a092-cbe3a4446ef0", "6f0fb7e8-b38c-4252-a9a2-3865d94987d5"),
    dn_name_att = c("00246611", "00249685"),
    dn_type_att = c(336L, 336L),
    coastal = c(FALSE, FALSE),
    major_type = c(FALSE, FALSE),
  )

  testthat::expect_equal(hydroloom:::down_level(k), "7ff2749a-869f-480f-a092-cbe3a4446ef0")

})

test_that("winnow works with name count", {
  x_orig <- dplyr::tibble(
    id = c("167280297", "167280300", "167280301", "167282662"),
    fromnode = c(41971, 43610, 41973, 41971),
    tonode = c(41968, 41971, 41971, 43712),
    name_att = c("00881819", "00875875", "00881819", "00875875"),
    type_att = c(558L, 558L, 558L, 558L),
    direction = c(709L, 709L, 709L, 709L),
  ) |>
    structure(
      class = c("hy", "tbl_df", "tbl", "data.frame"),
      orig_names = c(
        id = "id", fromnode = "fromnode", tonode = "tonode", gnis_id = "gnis_id",
        ftype = "feature_type", direction = "direction"
      )
    )

  n <- 41971

  major_types <- c(460, 558, 334)

  name_count <- c("00875875" = 38L, "00881819" = 68L) |>
    structure(
      dim = 2L,
      dimnames = list(c("00875875", "00881819")) |>
        structure(names = ""),
      class = "table"
    )

  expect_equal(hydroloom:::winnow_upstream(n, x_orig, major_types, name_count)$name_att[1],
               "00881819")

  unlink("divergence_checks.txt")
})