source(system.file("extdata", "sample_flines.R", package = "nhdplusTools"))
pt_data <- sample_flines %>%
align_nhdplus_names()
cida <- sf::read_sf(list.files(pattern = "cida_flowlines.gpkg", full.names = TRUE, recursive = TRUE)) %>%
align_nhdplus_names()
test_that("get_DM works normal", {
result <- get_DM(pt_data, 11689050)
result2 <- get_DM(pt_data, 11689050, include = FALSE)
expect_equal(length(result), 26)
expect_equal(length(result2), 25)
})
test_that("get_DM works short", {
result <- get_DM(pt_data, 11690570)
result2 <- get_DM(pt_data, 11690570, include = FALSE)
expect_equal(length(result), 6)
expect_equal(length(result2), 5)
})
test_that("get_DM works for no divergence", {
result <- get_DM(pt_data, 11688810)
expect_true(!11688828 %in% result)
expect_equal(length(result), 35)
})
test_that("get_DM works upstream of diversion", {
result <- get_DM(pt_data, 11689280)
expect_true(!11689758 %in% result)
expect_true(11689286 %in% result)
expect_equal(length(result), 29)
})
test_that("get_DM with distance 0 returns 1 comid", {
result <- get_DM(pt_data, 11688810, distance = 0)
expect_equal(length(result), 1)
})
test_that("get_DM with distance 2 returns specific COMIDs", {
result <- get_DM(pt_data,
11688810, distance = 2)
expect_equal(length(result), 3)
expect_true(all(c(11688810, 11688826, 11688884) %in% result))
})
test_that("get_DM with distance big returns specific same as no distance", {
result <- get_DM(pt_data,
11688810, distance = 100000)
result2 <- get_DM(pt_data, 11688810)
expect_equal(result, result2)
})
test_that("get_DM works upstream of diversion", {
result <- get_DM(pt_data, 11689280)
expect_true(!11689758 %in% result)
expect_true(11689286 %in% result)
expect_equal(length(result), 29)
})
test_that("get_DM sorts (eg returns different order)", {
result <- get_DM(pt_data, 11689280)
result2 <- get_DM(pt_data, 11689280, sort = TRUE)
expect_equal(length(result), length(result2))
expect_true(sum(result == result2) < length(result))
})
test_that("get_DM sorts correctly", {
comid = cida$COMID[33]
result <- get_DM(cida, comid, sort = TRUE)
sort_order = c(8585070, 8585080, 8585102, 8585124, 8585128, 8585130,
8585142, 8585160, 8585158, 8585178, 8585176, 8585910, 8585922,
8585966, 8585976, 8585978, 8585986, 8585980, 8585972, 8585908,
8585902, 8585836, 8585840, 8585810, 8585796, 8585800)
expect_true(sum(result == sort_order) == length(result))
})
test_that("get_DM sorts correctly with distance parameter", {
result <- get_DM(cida, 8585070, sort = TRUE, distance = 5)
sort_order = c(8585070, 8585080, 8585102, 8585124, 8585128, 8585130,
8585142, 8585160, 8585158, 8585178, 8585176, 8585910, 8585922,
8585966, 8585976, 8585978, 8585986, 8585980, 8585972, 8585908,
8585902, 8585836, 8585840, 8585810, 8585796, 8585800)
expect_true(sum(result == sort_order[1:length(result)]) == length(result))
})
test_that("get_UM works short", {
result <- get_UM(pt_data, 11689050)
result2 <- get_UM(pt_data, 11689050, include = FALSE)
expect_equal(length(result), 18)
expect_equal(length(result2), 17)
})
test_that("get_UM works long", {
result <- get_UM(pt_data, 11690570)
result2 <- get_UM(pt_data, 11690570, include = FALSE)
expect_equal(length(result), 80)
expect_equal(length(result2), 79)
})
test_that("get_UM returns 1 for distance 0", {
result <- get_UM(pt_data,
11690570, distance = 0)
expect_equal(length(result), 1)
})
test_that("get_UM returns a certain length for given distance", {
result <- get_UM(pt_data,
11690570, distance = 10)
expect_equal(length(result), 12)
})
test_that("get_UM sorts (eg returns different order)", {
result <- get_UM(pt_data, 11689280)
result2 <- get_UM(pt_data, 11689280, sort = TRUE)
expect_equal(length(result), length(result2))
expect_true(sum(result == result2) < length(result))
})
test_that("get_UM sorts correctly", {
result <- get_UM(cida, 8585070, sort = TRUE)
correct_order = c(8585070, 8585022, 8585002, 8584996, 8584888)
expect_true(sum(result == correct_order) == length(result))
})
test_that("get_UM sorts correctly with distance parameter", {
comid = cida$COMID[33]
result <- get_DM(cida, comid, sort = TRUE, distance = 1)
correct_order = c(8585070, 8585022, 8585002, 8584996, 8584888)
expect_true(sum(result == correct_order[1:length(result)]) == length(result))
})
test_that("get_UT works", {
result <- get_UT(pt_data, 11687180)
expect_equal(length(result), 5)
result <- get_UT(pt_data, 11687224)
expect_equal(length(result), 7)
test_error <- rbind(pt_data, pt_data)
expect_error(get_UT(test_error, 11687180),
"Found duplicate id for starting catchment. Duplicate rows in network?")
})
test_that("get_UT works with distance", {
result <- get_UT(pt_data,
11689276, distance = 0)
expect_equal(result, 11689276)
result <- get_UT(pt_data,
11689276, distance = 3)
expect_equal(length(result), 6)
})
test_that("get_UT works with distance specific", {
result <- get_UT(pt_data, 11687180, 2)
expect_equal(length(result), 3)
})
test_that("get_UT returns diverted paths.", {
result <- get_UT(pt_data, 11690184)
expect_true(all(c(11689276, 11690200) %in% result),
"missing a diverted or main path")
})
test_that("get_DD works with two divergences", {
result <- get_DD(pt_data, 11689316)
expect_true(all(c(11689294, 11690224, 11689268, 11689758, 11689276) %in% result))
})
test_that("get_DD works", {
result <- get_DD(pt_data, 11688810)
expect_true(11688810 %in% result)
expect_true(11688828 %in% result)
expect_equal(length(result), 36)
})
test_that("get_DD works upstream of diversion", {
result <- get_DD(pt_data, 11689280)
expect_true(11689758 %in% result)
expect_true(11689286 %in% result)
expect_equal(length(result), 33)
})
test_that("get_DD with distance 0.2 returns 3", {
result <- get_DD(pt_data,
11688810, distance = 0.5)
expect_equal(length(result), 3)
})
test_that("get_DD with distance 2 returns 4 specific", {
result <- get_DD(pt_data,
11688810, distance = 2)
expect_equal(length(result), 4)
expect_true(all(c(11688810, 11688826, 11688828, 11688884) %in% result))
})
test_that("get_DM works if missing the outlet", {
pt_data_borkd <- dplyr::filter(pt_data, TerminalFl == 0)
result <- get_DM(pt_data_borkd, 11688810)
expect_equal(length(result), 34)
})
test_that("get_DM sorts (eg returns different order)", {
result <- get_DM(pt_data, 11689280)
result2 <- get_DM(pt_data, 11689280, sort = TRUE)
expect_equal(length(result), length(result2))
expect_true(sum(result == result2) < length(result))
})
test_that("get_DM sorts correctly", {
comid = pt_data$COMID[33]
result <- get_DM(pt_data, comid, sort = TRUE)
correct_order = c(c(11690560, 11690226, 11690556, 11690558, 11690604, 11690566,
11690602, 11690246, 11690538, 11690564, 11690570, 11690256,
11690258, 11690568, 11690262, 11690260))
expect_true(sum(result == correct_order) == length(result))
})
test_that("get_DM sorts correctly with distance parameter", {
comid = pt_data$COMID[33]
result <- get_DM(pt_data, comid, sort = TRUE, distance = 5)
correct_order = c(c(11690560, 11690226, 11690556, 11690558, 11690604, 11690566,
11690602, 11690246, 11690538, 11690564, 11690570, 11690256,
11690258, 11690568, 11690262, 11690260))
expect_true(sum(result == correct_order[1:length(result)]) == length(result))
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.