diff --git a/R/plot.GRiwrm.R b/R/plot.GRiwrm.R index 1c2f2f8daeac1ee06bfa3d73bf8f001fac1d3806..8ac8eabc375dd56ce803e11fb2c3086a2eead03a 100644 --- a/R/plot.GRiwrm.R +++ b/R/plot.GRiwrm.R @@ -49,13 +49,17 @@ plot.GRiwrm <- function(x, x <- sortGRiwrm4plot(x) nodes <- unlist(sapply(unique(x$donor), plotGriwrmCluster, x = x, with_donors = with_donors)) g2 <- x[!is.na(x$down),] - links <- paste( - sprintf("id_%1$s", g2$id), - "-->|", - round(g2$length, digits = 0), - "km|", - sprintf("id_%1$s", g2$down) - ) + if (nrow(g2) > 0) { + links <- paste( + sprintf("id_%1$s", g2$id), + "-->|", + round(g2$length, digits = 0), + "km|", + sprintf("id_%1$s", g2$down) + ) + } else { + links <- "" + } x$nodeclass <- sapply(x$id, getNodeClass, griwrm = x) node_class <- lapply(unique(x$nodeclass), function(nc) { x$id[x$nodeclass == nc] diff --git a/tests/testthat/test-plot.GRiwrm.R b/tests/testthat/test-plot.GRiwrm.R index 0622d3924d0c817d84b106015e9195a59cf9c4c6..5a96a96b459ccca7657daab6c23247fcd316eb51 100644 --- a/tests/testthat/test-plot.GRiwrm.R +++ b/tests/testthat/test-plot.GRiwrm.R @@ -11,7 +11,7 @@ test_that("Diverted ungauged nodes have correct color", { expect_true(any(grepl("id_54029 UpstreamUngaugedDiversion", strsplit(mmd, "\n\n")[[1]]))) }) -test_that("Unguaged nodes and donors are in a box!", { +test_that("Ungauged nodes and donors are in a box!", { nds <- loadSevernNodes() nds$donor <- as.character(NA) nds$model[nds$id %in% c("54001", "54032", "54029")] <- "Ungauged" @@ -23,3 +23,10 @@ test_that("Unguaged nodes and donors are in a box!", { s <- plot(g, display = FALSE) expect_equal(strsplit(s, "\n")[[1]][c(5,13)], c("subgraph donor_54095 [54095]", "end")) }) + +test_that("Single node plot does not crash", { + sgl_node <- loadSevernNodes()[1,] + g <- CreateGRiwrm(sgl_node) + mmd <- plot(g, display = FALSE) + expect_false(grepl("-->", mmd, fixed = TRUE)) +})