diff --git a/R/getNodeRanking.R b/R/getNodeRanking.R index e4c6cf48d5b3e2763c6cc67422422587405e126b..792c081cf807583e2faff49cb3b3b4718e60dd8a 100644 --- a/R/getNodeRanking.R +++ b/R/getNodeRanking.R @@ -40,7 +40,10 @@ getNodeRanking <- function(griwrm) { # Check if upstream nodes have already been processed immediate_upstream_nodes <- g$id[!is.na(g$down) & g$down %in% g2$id] immediate_upstream_nodes <- immediate_upstream_nodes[!immediate_upstream_nodes %in% g2$id] - if (all(immediate_upstream_nodes %in% r)) { + if (all(immediate_upstream_nodes %in% r) && + (upDonor %in% r || isNodeDownstream(g2, upId, upDonor))) { + areNodesUpstreamDonor <- sapply(g2$id, function(id) isNodeDownstream(g2, id, upDonor)) + g2 <- g2[upDonor %in% r | g2$id == upDonor | areNodesUpstreamDonor, ] g2$donor <- g2$id ungaugedIds <- getNodeRanking(g2) r <- c(r, ungaugedIds) diff --git a/tests/testthat/test-getNodeRanking.R b/tests/testthat/test-getNodeRanking.R index 5019347120471bf8705144c7db812fd0c809b29f..18ace829d7e04c0a3de79252c9b4a8e38eeea5aa 100644 --- a/tests/testthat/test-getNodeRanking.R +++ b/tests/testthat/test-getNodeRanking.R @@ -55,3 +55,14 @@ test_that("Impossible case detected: ungauged node with diversion to an upstream area = NA)) expect_error(CreateGRiwrm(nodes_div)) }) + +test_that("donor of ungauged cluster is processed before sibling ungauged nodes (#155)", { + n155 <- data.frame(id = c("UngSib", "UngUp", "Donor", "Down"), + down = c("Down", "Donor", "Down", NA), + length = c(rep(1, 3), NA), + model = c("Ungauged", "Ungauged", "RunModel_GR4J", "RunModel_GR4J"), + area = rep(1,4), + donor = c("Donor", NA, NA, NA)) + g155 <- CreateGRiwrm(n155) + expect_equal(getNodeRanking(g155), c("UngUp", "Donor", "UngSib", "Down")) +})