From e250c767389a26e7b579216c8e93812b78cfa68e Mon Sep 17 00:00:00 2001
From: Gustav Delius <gustav.delius@gmail.com>
Date: Wed, 6 Nov 2024 11:53:48 +0100
Subject: [PATCH] Additional error messages in `matchBiomasses()` and
 `matchNumbers()`

---
 R/match.R                   | 25 +++++++++++++++++++++++++
 tests/testthat/test-match.R |  7 +++++++
 2 files changed, 32 insertions(+)

diff --git a/R/match.R b/R/match.R
index e9a7b43e..2216db7f 100644
--- a/R/match.R
+++ b/R/match.R
@@ -48,6 +48,8 @@ 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)) {
@@ -55,9 +57,18 @@ matchBiomasses <- function(params, species = NULL) {
         }
         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,6 +123,11 @@ 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)) {
@@ -119,9 +135,18 @@ matchNumbers <- function(params, species = NULL) {
         }
         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)
 }
diff --git a/tests/testthat/test-match.R b/tests/testthat/test-match.R
index 699936bf..2cd3ddb2 100644
--- a/tests/testthat/test-match.R
+++ b/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", {