Avoid cryptic errors if functions are called with no valid species selected by their species argument. Closes #251.

gustavdelius · gustavdelius · commit aa996d9095a0 · 2022-11-03T19:47:13.000Z
diff --git a/R/match.R b/R/match.R
@@ -45,6 +45,9 @@ matchBiomasses <- function(params, species = NULL) {
                                  return.logical = TRUE) &
         !is.na(params@species_params$biomass_observed) &
         params@species_params$biomass_observed > 0
+    if (length(species) == 0) {
+        return(params)
+    }
     for (sp in (1:nrow(params@species_params))[species]) {
         cutoff <- params@species_params$biomass_cutoff[[sp]]
         if (is.null(cutoff) || is.na(cutoff)) {
diff --git a/R/plots.R b/R/plots.R
@@ -251,7 +251,7 @@ plotBiomass <- function(sim, species = NULL,
                 is.flag(return_data),
                 length(ylim) == 2)
     params <- sim@params
-    species <- valid_species_arg(sim, species)
+    species <- valid_species_arg(sim, species, error_on_empty = TRUE)
     if (missing(start_time)) start_time <- 
             as.numeric(dimnames(sim@n)[[1]][1])
     if (missing(end_time)) end_time <- 
@@ -364,7 +364,7 @@ plotYield <- function(sim, sim2,
                 is.flag(log),
                 is.flag(return_data))
     params <- sim@params
-    species <- valid_species_arg(sim, species)
+    species <- valid_species_arg(sim, species, error_on_empty = TRUE)
     if (missing(sim2)) {
         y <- getYield(sim, ...)
         y_total <- rowSums(y)
@@ -465,7 +465,7 @@ plotYieldGear <- function(sim,
                 is.flag(total),
                 is.flag(return_data))
     params <- sim@params
-    species <- valid_species_arg(sim, species)
+    species <- valid_species_arg(sim, species, error_on_empty = TRUE)
     
     y <- getYieldGear(sim, ...)
     y_total <- rowSums(y, dims = 2)
@@ -590,6 +590,9 @@ plotSpectra <- function(object, species = NULL,
                 length(wlim) == 2,
                 length(ylim) == 2)
     species <- valid_species_arg(object, species)
+    if (length(species) == 0 && !total && !resource) {
+        stop("There is nothing to plot as no valid species have been selected.")
+    }
     if (is(object, "MizerSim")) {
         if (missing(time_range)) {
             time_range  <- max(as.numeric(dimnames(object@n)$time))
@@ -787,7 +790,8 @@ plotFeedingLevel <- function(object, species = NULL,
     }
         
     # selector for desired species
-    sel_sp <- valid_species_arg(params, species, return.logical = TRUE)
+    sel_sp <- valid_species_arg(params, species, return.logical = TRUE,
+                                error_on_empty = TRUE)
     species <- dimnames(params@initial_n)$sp[sel_sp]
     feed <- feed[sel_sp, , drop = FALSE]
     
@@ -908,7 +912,7 @@ plotPredMort <- function(object, species = NULL,
         pred_mort <- apply(pred_mort, c(2, 3), mean)
     }
     
-    species <- valid_species_arg(params, species)
+    species <- valid_species_arg(params, species, error_on_empty = TRUE)
     pred_mort <- pred_mort[as.character(dimnames(pred_mort)[[1]]) %in% species, , drop = FALSE]
     plot_dat <- data.frame(
         w = rep(params@w, each = length(species)),
@@ -1000,7 +1004,7 @@ plotFMort <- function(object, species = NULL,
     if (length(dim(f)) == 3) {
         f <- apply(f, c(2, 3), mean)
     }
-    species <- valid_species_arg(params, species)
+    species <- valid_species_arg(params, species, error_on_empty = TRUE)
     f <- f[as.character(dimnames(f)[[1]]) %in% species, , drop = FALSE]
     plot_dat <- data.frame(w = rep(params@w, each = length(species)),
                            value = c(f),
@@ -1077,7 +1081,7 @@ plotGrowthCurves <- function(object, species = NULL,
     } else if (is(object, "MizerParams")) {
         params <- validParams(object)
     }
-    species <- valid_species_arg(params, species)
+    species <- valid_species_arg(params, species, error_on_empty = TRUE)
     sp_sel <- params@species_params$species %in% species
     ws <- getGrowthCurves(params, species, max_age, percentage)
     plot_dat <- reshape2::melt(ws)
@@ -1216,6 +1220,9 @@ plotDiet <- function(object, species = NULL, return_data = FALSE) {
     assert_that(is.flag(return_data))
     params <- validParams(object)
     species <- valid_species_arg(object, species, return.logical = TRUE)
+    if (sum(species) != 1) {
+        stop("You need to select a single species for which to plot the diet.")
+    }
     diet <- getDiet(params)[species, , ]
     prey <- dimnames(diet)$prey
     # the plot looks better upsided down
diff --git a/R/steady.R b/R/steady.R
@@ -313,38 +313,48 @@ constant_other <- function(params, n_other, component, ...) {
 #'   each species whether it is to be selected (TRUE) or not. 
 #' @param return.logical Whether the return value should be a logical vector.
 #'   Default FALSE.
+#' @param error_on_empty Whether to throw an error if there are zero valid
+#'   species. Default FALSE.
 #'   
 #' @return A vector of species names, in the same order as specified in the
 #'   'species' argument. If 'return.logical = TRUE' then a logical vector is
 #'   returned instead, with length equal to the number of species, with
 #'   TRUE entry for each selected species.
 #' @export
 #' @concept helper
-valid_species_arg <- function(object, species = NULL, return.logical = FALSE) {
+valid_species_arg <- function(object, species = NULL, return.logical = FALSE,
+                              error_on_empty = FALSE) {
     if (is(object, "MizerSim")) {
         params <- object@params
     } else if (is(object, "MizerParams")) {
         params <- object
     } else {
         stop("The first argument must be a MizerSim or MizerParams object.")
     }
-    assert_that(is.flag(return.logical))
+    assert_that(is.flag(return.logical),
+                is.flag(error_on_empty))
     all_species <- dimnames(params@initial_n)$sp
     no_sp <- nrow(params@species_params)
     # Set species if missing to list of all non-background species
     if (is.null(species)) {
         species <- dimnames(params@initial_n)$sp[!is.na(params@A)]
         if (length(species) == 0) {  # There are no non-background species.
+            if (error_on_empty) {
+                stop("No species have been selected.")
+            }
             if (return.logical) {
                 return(rep(FALSE, no_sp))
             } else {
-                return(NULL)
+                vector("character")
             }
         }
     }
     if (is.logical(species)) {
         if (length(species) != no_sp) {
-            stop("The boolean `species` argument has the wrong length")
+            stop("The boolean `species` argument has the wrong length.")
+        }
+        if (!any(species) && error_on_empty) {
+            stop("No species have been selected.")
         }
         if (return.logical) {
             return(species)
@@ -354,9 +364,12 @@ valid_species_arg <- function(object, species = NULL, return.logical = FALSE) {
     if (is.numeric(species)) {
         if (!all(species %in% (1:no_sp))) {
             warning("A numeric 'species' argument should only contain the ",
-                    "integers 1 to ", no_sp)
+                    "integers 1 to ", no_sp, ".")
         }
         species.logical <- 1:no_sp %in% species
+        if (!any(species.logical) && error_on_empty) {
+            stop("No species have been selected.")
+        }
         if (return.logical) {
             return(species.logical)
         }
@@ -365,9 +378,12 @@ valid_species_arg <- function(object, species = NULL, return.logical = FALSE) {
     invalid <- setdiff(species, all_species)
     if (length(invalid) > 0) {
         warning("The following species do not exist: ", 
-                toString(invalid))
+                toString(invalid), ".")
     }
     species <- intersect(species, all_species)
+    if (length(species) == 0 && error_on_empty) {
+        stop("No species have been selected.")
+    }
     if (return.logical) {
         return(all_species %in% species)
     }
diff --git a/man/valid_species_arg.Rd b/man/valid_species_arg.Rd
diff --git a/tests/testthat/test-steady.R b/tests/testthat/test-steady.R
@@ -91,6 +91,7 @@ test_that("steady() preserves R_max", {
 
 # valid_species_arg ----
 test_that("valid_species_arg works", {
+    # character species argument
     expect_warning(s <- valid_species_arg(NS_params, c("non", "sense")),
                    "The following species do not exist: non, sense")
     expect_identical(s, vector(mode = "character"))
@@ -100,6 +101,10 @@ test_that("valid_species_arg works", {
     expect_identical(valid_species_arg(NS_params, c("Sprat", "Sandeel"),
                                        return.logical = TRUE),
                      c(TRUE, TRUE, rep(FALSE, 10)))
+    expect_error(
+        valid_species_arg(NS_params, c("non", "sense"), error_on_empty = TRUE) |>
+            suppressWarnings(),
+        "No species have been selected.")
     # numeric species argument
     expect_warning(s <- valid_species_arg(NS_params, c(2.5, 13)),
                  "A numeric 'species' argument should only contain the integers 1 to 12")
@@ -111,6 +116,10 @@ test_that("valid_species_arg works", {
     expect_identical(valid_species_arg(NS_params, c(3, 1),
                                        return.logical = TRUE),
                      c(TRUE, FALSE, TRUE, rep(FALSE, 9)))
+    expect_error(
+        valid_species_arg(NS_params, 13, error_on_empty = TRUE) |>
+            suppressWarnings(),
+        "No species have been selected.")
     # logical species argument
     expect_error(valid_species_arg(NS_params, c(TRUE, FALSE)),
                  "The boolean `species` argument has the wrong length")
@@ -121,6 +130,10 @@ test_that("valid_species_arg works", {
                                        c(TRUE, FALSE, TRUE, rep(FALSE, 9)),
                                        return.logical = TRUE),
                      c(TRUE, FALSE, TRUE, rep(FALSE, 9)))
+    expect_error(
+        valid_species_arg(NS_params, rep(FALSE, 12), error_on_empty = TRUE) |>
+            suppressWarnings(),
+        "No species have been selected.")
     # called with MizerSim object
     sim <- project(NS_params, t_max = 1, dt = 1)
     expect_identical(valid_species_arg(sim, "Cod"),
