Additional error messages in matchBiomasses() and matchNumbers()

Author: gustavdelius

R/match.R

@@ -48,16 +48,27 @@ matchBiomasses <- function(params, species = NULL) {
     if (length(species) == 0) {
         return(params)
     }
+    
+    error_message <- ""
     for (sp in seq_len(nrow(params@species_params))[species]) {
         cutoff <- params@species_params$biomass_cutoff[[sp]]
         if (is.null(cutoff) || is.na(cutoff)) {
             cutoff <- 0
         }
         total <- sum((params@initial_n[sp, ] * params@w * params@dw)
                      [params@w >= cutoff])
+        if (!(total > 0)) {
+            error_message <- paste(
+                error_message, params@species_params$species[[sp]],
+                "does not grow up to the biomass_cutoff size of",
+                cutoff, "grams.\n")
+        }
         factor <- params@species_params$biomass_observed[[sp]] / total
         params@initial_n[sp, ] <- params@initial_n[sp, ] * factor
     }
+    if (error_message != "") {
+        stop(error_message)
+    }
 
     setBevertonHolt(params)
 }
@@ -112,16 +123,30 @@ matchNumbers <- function(params, species = NULL) {
                                  return.logical = TRUE) &
         !is.na(params@species_params$number_observed) &
         params@species_params$number_observed > 0
+    if (length(species) == 0) {
+        return(params)
+    }
+    
+    error_message <- ""
     for (sp in seq_len(nrow(params@species_params))[species]) {
         cutoff <- params@species_params$number_cutoff[[sp]]
         if (is.null(cutoff) || is.na(cutoff)) {
             cutoff <- 0
         }
         total <- sum((params@initial_n[sp, ] * params@dw)
                      [params@w >= cutoff])
+        if (!(total > 0)) {
+            error_message <- paste(
+                error_message, params@species_params$species[[sp]],
+                "does not grow up to the biomass_cutoff size of",
+                cutoff, "grams.\n")
+        }
         factor <- params@species_params$number_observed[[sp]] / total
         params@initial_n[sp, ] <- params@initial_n[sp, ] * factor
     }
+    if (error_message != "") {
+        stop(error_message)
+    }
 
     setBevertonHolt(params)
 }

tests/testthat/test-match.R

@@ -5,12 +5,14 @@ test_that("matchBiomasses works", {
     expect_identical(matchBiomasses(params), params)
     species_params(params)$biomass_observed <- NA
     expect_unchanged(matchBiomasses(params), params)
+    
     # Does nothing if observed already equals model
     species_params(params)$biomass_cutoff <- 1e-4
     biomass_actual <-
         rowSums(sweep(params@initial_n, 2, params@w * params@dw, "*"))
     species_params(params)$biomass_observed <- biomass_actual
     expect_unchanged(matchBiomasses(params), params)
+    
     # Even if only partially observed
     species_params(params)$biomass_observed[1:5] <- NA
     expect_unchanged(matchBiomasses(params), params)
@@ -25,6 +27,11 @@ test_that("matchBiomasses works", {
     expect_equal(params2@initial_n[1:5, ], params@initial_n[1:5, ])
     # and unselected species don't change
     expect_equal(params2@initial_n[10:12, ], params@initial_n[10:12, ])
+    
+    # Throws an error if biomass_cutoff > w_max
+    params@species_params$biomass_cutoff[6] <- 1e16
+    expect_error(matchBiomasses(params),
+                 "Whiting does not grow up to the biomass_cutoff")
 })
 
 test_that("matchNumbers works", {