Nothing
test_that("degenerate levelpath", {
x <- structure(list(ID = c(203071, 202863, 202883, 205509, 203069, 202875, 942110034),
toID = c(202863, 202883, 205509, 203069, 202875, 942110034, 0),
fcode = c(33600, 33600, 33600, 33600, 33600, 46006, 55800),
nameID = c(630020286, 630020286, 630020286, 630020286, 630020286, 630020286, 630020286),
lengthkm = c(14.962, 4.881, 13.204, 2.054, 9.601, 2.893, 10.988),
reachcode = c("12110208001272", "12110208000093", "12110208001144",
"12110208001144", "12110208001144", "12110208000099", "12110208017253"),
frommeas = c(0, 0, 46.98279, 38.69724, 0, 0, 0),
tomeas = c(99.35641, 100, 100, 46.98279, 38.69724, 100, 100),
areasqkm = c(21.7197, 1019.7891, 74.0889, 37.3122, 530.9604, 5.562, 17.8893),
weight = c(14.962, 19.843, 33.047, 35.101, 44.702, 47.595, 58.583),
terminalID = c(942110034, 942110034, 942110034, 942110034, 942110034, 942110034, 942110034
)), row.names = c(NA, 7L), class = "data.frame")
expect_warning(
y <- nhdplusTools::get_levelpaths(x)
)
expect_equal(nrow(y), nrow(x))
})
test_that("calculate level path", {
source(system.file("extdata", "walker_data.R", package = "nhdplusTools"))
test_flowline <- prepare_nhdplus(walker_flowline, 0, 0, FALSE, warn = FALSE)
test_flowline <- data.frame(
ID = test_flowline$COMID,
toID = test_flowline$toCOMID,
nameID = walker_flowline$GNIS_ID,
weight = walker_flowline$ArbolateSu,
stringsAsFactors = FALSE)
expect_warning(
test_flowline_out <- left_join(test_flowline,
get_levelpaths(test_flowline, status = TRUE), by = "ID")
)
nhdp_lp <- sort(unique(walker_flowline$LevelPathI))
nhdt_lp <- sort(unique(test_flowline_out$levelpath))
expect_true(length(nhdp_lp) == length(nhdt_lp))
for(lp in seq_along(nhdp_lp)) {
nhdp <- filter(walker_flowline, LevelPathI == nhdp_lp[lp])
outlet_comid <- filter(nhdp, Hydroseq == min(Hydroseq))$COMID
nhdt <- filter(test_flowline_out, outletID == outlet_comid)
expect(all(nhdp$COMID %in% nhdt$ID), paste("Mismatch in", nhdp_lp[lp],
"level path from NHDPlus."))
}
# break the data
test_flowline$nameID[test_flowline$ID == 5329293] <- " "
test_flowline$nameID[test_flowline$ID == 5329295] <- "255208"
expect_warning(
test_flowline_out2 <- left_join(test_flowline,
get_levelpaths(test_flowline, status = TRUE), by = "ID")
)
expect_equal(test_flowline_out2$levelpath[test_flowline_out2$ID == 5329295], 1)
expect_warning(
test_flowline_out2 <- left_join(test_flowline,
get_levelpaths(test_flowline, override_factor = 10,
status = TRUE), by = "ID")
)
expect_equal(test_flowline_out$levelpath, test_flowline_out2$levelpath)
})
test_that("hr levelpath", {
skip_on_cran()
suppressMessages(
source(system.file("extdata/nhdplushr_data.R", package = "nhdplusTools")))
hr_flowline <- align_nhdplus_names(hr_data$NHDFlowline)
suppressWarnings(
fl <- prepare_nhdplus(hr_flowline, 0, 0, purge_non_dendritic = FALSE, warn = FALSE))
fl <- select(hr_flowline, COMID, ArbolateSu, GNIS_Name) %>%
left_join(fl, by = "COMID") %>%
st_sf() %>%
select(ID = COMID, toID = toCOMID, weight = ArbolateSu, nameID = GNIS_Name)
expect_warning(expect_message(
lp <- get_levelpaths(sf::st_set_geometry(fl, NULL), cores = 2)
))
expect_warning(expect_warning(expect_message(
expect_error(get_levelpaths(sf::st_set_geometry(fl, NULL), cores = "char"))
)))
future::plan(future::sequential)
# Same number of total flowlines
expect_equal(length(unique(hr_flowline$LevelPathI)), length(unique(lp$levelpath)))
# follows a semi tricky mainstem the same as HI
expect_equal(lp[lp$ID == 15000500039693, ]$levelpath, lp[lp$ID == 15000500039696, ]$levelpath)
})
test_that("degenerate", {
net <- structure(list(ID = 11000020, toID = 0, nameID = "constant",
lengthkm = 12.2243026760847, areasqkm = 54.2851667150928,
weight = 12.2243026760847, terminalID = 11000020), row.names = 2938080L, class = "data.frame")
suppressWarnings(
er <- get_levelpaths(net, 5)
)
expect_equal(er$topo_sort, 1)
expect_equal(er$levelpath, 1)
})
test_that("from vignette works", {
source(system.file("extdata/new_hope_data.R", package = "nhdplusTools"))
suppressWarnings(fpath <- get_tocomid(
dplyr::select(new_hope_flowline, COMID, FromNode, ToNode, Divergence, FTYPE,
AreaSqKM, LENGTHKM, GNIS_ID)) %>%
sf::st_cast("LINESTRING") %>%
select(-tonode, -fromnode, -divergence, -ftype) %>%
get_sorted(split = TRUE))
fpath[["arbolatesum"]] <- calculate_arbolate_sum(
dplyr::select(fpath, ID = comid, toID = tocomid, length = lengthkm))
expect_warning(
lp <- get_levelpaths(
dplyr::select(fpath, ID = comid, toID = tocomid,
nameID = gnis_id, weight = arbolatesum),
status = FALSE)
)
fpath <- dplyr::left_join(fpath, lp, by = c("comid" = "ID"))
expect_true(all(names(fpath) %in%
c("comid", "tocomid", "areasqkm", "lengthkm",
"gnis_id", "terminalID",
"arbolatesum", "outletID",
"topo_sort", "levelpath", "geom")))
expect_equal(length(unique(fpath$levelpath)),
length(unique(new_hope_flowline$LevelPathI)))
expect_equal(length(unique(fpath$levelpath)),
length(unique(fpath$outletID)))
plus <- add_plus_network_attributes(dplyr::select(fpath, comid, tocomid,
lengthkm, areasqkm,
nameID = gnis_id),
status = FALSE)
expect_s3_class(plus, "sf")
})
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.