From 018bdd59960661b2945cd19399c9a55d24527541 Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Fri, 11 Jul 2025 08:14:36 +0100 Subject: [PATCH 1/7] `getBiomass()` now has a `use_cutoff` argument to use the `biomass_cutoff` species parameter. --- R/summary_methods.R | 45 ++++++++++++-- man/getBiomass.Rd | 24 +++++++- tests/testthat/test-summary_methods.R | 89 ++++++++++++++++++++------- 3 files changed, 131 insertions(+), 27 deletions(-) diff --git a/R/summary_methods.R b/R/summary_methods.R index 6cdc22d3..ffd1fe1f 100644 --- a/R/summary_methods.R +++ b/R/summary_methods.R @@ -205,12 +205,25 @@ getSSB <- function(object) { #' step. #' #' Calculates the total biomass through time within user defined size limits. -#' The default option is to use the whole size range. You can specify minimum +#' The default option is to use the size range starting at the size specified +#' by the `biomass_cutoff` species parameter, if it is set, or else the full +#' size range of each species. You can specify minimum #' and maximum weight or length range for the species. Lengths take precedence #' over weights (i.e. if both min_l and min_w are supplied, only min_l will be #' used). #' +#' @details +#' When no size range arguments are provided, the function checks if the +#' `biomass_cutoff` column exists in the species parameters. If it does, +#' those values are used as the minimum weight for each species. For species +#' with NA values in `biomass_cutoff`, the default minimum weight (smallest +#' weight in the model) is used. +#' #' @param object An object of class `MizerParams` or `MizerSim`. +#' @param use_cutoff If TRUE, the `biomass_cutoff` column in the +#' species parameters is used as the minimum weight for each species (ignoring any +#' size range arguments in `...`). If FALSE (default), the specified size range +#' arguments are used, if provided, or the full size range of the species is used. #' @inheritDotParams get_size_range_array -params #' #' @return If called with a MizerParams object, a vector with the biomass in @@ -225,16 +238,40 @@ getSSB <- function(object) { #' biomass["1972", "Herring"] #' biomass <- getBiomass(NS_sim, min_w = 10, max_w = 1000) #' biomass["1972", "Herring"] -getBiomass <- function(object, ...) { +#' +#' # If species_params contains a biomass_cutoff column, it can be used +#' # as the minimum weight when use_cutoff = TRUE +#' species_params(params)$biomass_cutoff <- species_params(params)$w_mat +#' biomass <- getBiomass(NS_sim, use_cutoff = TRUE) # Uses biomass_cutoff as min_w +#' biomass["1972", "Herring"] +getBiomass <- function(object, use_cutoff = FALSE, ...) { if (is(object, "MizerSim")) { sim <- object - size_range <- get_size_range_array(sim@params, ...) + + if (use_cutoff && "biomass_cutoff" %in% names(sim@params@species_params)) { + # Use biomass_cutoff as min_w for each species + biomass_cutoff <- sim@params@species_params$biomass_cutoff + # Replace NA values with the default minimum weight + biomass_cutoff[is.na(biomass_cutoff)] <- min(sim@params@w) + size_range <- get_size_range_array(sim@params, min_w = biomass_cutoff) + } else { + size_range <- get_size_range_array(sim@params, ...) + } return(apply(sweep(sweep(sim@n, c(2, 3), size_range, "*"), 3, sim@params@w * sim@params@dw, "*"), c(1, 2), sum)) } if (is(object, "MizerParams")) { params <- object - size_range <- get_size_range_array(params, ...) + + if (use_cutoff && "biomass_cutoff" %in% names(params@species_params)) { + # Use biomass_cutoff as min_w for each species + biomass_cutoff <- params@species_params$biomass_cutoff + # Replace NA values with the default minimum weight + biomass_cutoff[is.na(biomass_cutoff)] <- min(params@w) + size_range <- get_size_range_array(params, min_w = biomass_cutoff) + } else { + size_range <- get_size_range_array(params, ...) + } return(((params@initial_n * size_range) %*% (params@w * params@dw))[, , drop = TRUE]) } diff --git a/man/getBiomass.Rd b/man/getBiomass.Rd index 64dbf0b7..b4aec16e 100644 --- a/man/getBiomass.Rd +++ b/man/getBiomass.Rd @@ -5,11 +5,16 @@ \title{Calculate the total biomass of each species within a size range at each time step.} \usage{ -getBiomass(object, ...) +getBiomass(object, use_cutoff = FALSE, ...) } \arguments{ \item{object}{An object of class \code{MizerParams} or \code{MizerSim}.} +\item{use_cutoff}{If TRUE, the \code{biomass_cutoff} column in the +species parameters is used as the minimum weight for each species (ignoring any +size range arguments in \code{...}). If FALSE (default), the specified size range +arguments are used, if provided, or the full size range of the species is used.} + \item{...}{ Arguments passed on to \code{\link[=get_size_range_array]{get_size_range_array}} \describe{ @@ -31,16 +36,31 @@ for all species. } \description{ Calculates the total biomass through time within user defined size limits. -The default option is to use the whole size range. You can specify minimum +The default option is to use the size range starting at the size specified +by the \code{biomass_cutoff} species parameter, if it is set, or else the full +size range of each species. You can specify minimum and maximum weight or length range for the species. Lengths take precedence over weights (i.e. if both min_l and min_w are supplied, only min_l will be used). } +\details{ +When no size range arguments are provided, the function checks if the +\code{biomass_cutoff} column exists in the species parameters. If it does, +those values are used as the minimum weight for each species. For species +with NA values in \code{biomass_cutoff}, the default minimum weight (smallest +weight in the model) is used. +} \examples{ biomass <- getBiomass(NS_sim) biomass["1972", "Herring"] biomass <- getBiomass(NS_sim, min_w = 10, max_w = 1000) biomass["1972", "Herring"] + +# If species_params contains a biomass_cutoff column, it can be used +# as the minimum weight when use_cutoff = TRUE +species_params(params)$biomass_cutoff <- species_params(params)$w_mat +biomass <- getBiomass(NS_sim, use_cutoff = TRUE) # Uses biomass_cutoff as min_w +biomass["1972", "Herring"] } \seealso{ Other summary functions: diff --git a/tests/testthat/test-summary_methods.R b/tests/testthat/test-summary_methods.R index 0092e906..6d11334a 100644 --- a/tests/testthat/test-summary_methods.R +++ b/tests/testthat/test-summary_methods.R @@ -15,17 +15,17 @@ n_pp <- abs(rnorm(length(params@w_full))) ## get_size_range_array ---- test_that("get_size_range_array works", { - params@species_params[["a"]] <- + params@species_params[["a"]] <- c(0.007, 0.001, 0.009, 0.002, 0.010, 0.006, 0.008, 0.004, 0.007, 0.005, 0.005, 0.007) - params@species_params[["b"]] <- + params@species_params[["b"]] <- c(3.014, 3.320, 2.941, 3.429, 2.986, 3.080, 3.019, 3.198, 3.101, 3.160, 3.173, 3.075) - + # no limits size_n <- get_size_range_array(params) expect_true(all(size_n)) - + # specifying weights size_n <- get_size_range_array(params, min_w = 1) expect_true(!all(size_n[, which(params@w < 1)])) @@ -37,50 +37,50 @@ test_that("get_size_range_array works", { expect_true(!all(size_n[, which(params@w > 100)])) expect_true(!all(size_n[, which(params@w < 1)])) expect_true(all(size_n[, which((params@w >= 1) & (params@w <= 100))])) - + # specifying lengths min_l <- 2 size_n <- get_size_range_array(params, min_l = min_l) min_w <- params@species_params$a * min_l ^ params@species_params$b - for (sp in seq_len(nrow(params@species_params))) { + for (sp in seq_len(nrow(params@species_params))) { expect_true(all(size_n[sp, which(params@w >= min_w[sp])])) expect_true(!all(size_n[sp, which(params@w < min_w[sp])])) } max_l <- 100 size_n <- get_size_range_array(params, max_l = max_l) max_w <- params@species_params$a * max_l ^ params@species_params$b - for (sp in seq_len(nrow(params@species_params))) { + for (sp in seq_len(nrow(params@species_params))) { expect_true(all(size_n[sp, which(params@w <= max_w[sp])])) expect_true(!all(size_n[sp, which(params@w > max_w[sp])])) } size_n <- get_size_range_array(params, min_l = min_l, max_l = max_l) min_w <- params@species_params$a * min_l ^ params@species_params$b max_w <- params@species_params$a * max_l ^ params@species_params$b - for (sp in seq_len(nrow(params@species_params))) { - expect_true(all(size_n[sp, which((params@w <= max_w[sp]) & + for (sp in seq_len(nrow(params@species_params))) { + expect_true(all(size_n[sp, which((params@w <= max_w[sp]) & (params@w >= min_w[sp]))])) expect_true(!all(size_n[sp, which(params@w < min_w[sp])])) expect_true(!all(size_n[sp, which(params@w > max_w[sp])])) } - + # mixed weights and lengths size_n <- get_size_range_array(params, min_w = 1, max_l = max_l) min_w <- rep(1, nrow(params@species_params)) - for (sp in seq_len(nrow(params@species_params))) { - expect_true(all(size_n[sp, which((params@w <= max_w[sp]) & + for (sp in seq_len(nrow(params@species_params))) { + expect_true(all(size_n[sp, which((params@w <= max_w[sp]) & (params@w >= min_w[sp]))])) expect_true(!all(size_n[sp, which(params@w < min_w[sp])])) expect_true(!all(size_n[sp, which(params@w > max_w[sp])])) } size_n <- get_size_range_array(params, min_l = min_l, max_w = 100) max_w <- rep(100, nrow(params@species_params)) - for (sp in seq_len(nrow(params@species_params))) { - expect_true(all(size_n[sp, which((params@w <= max_w[sp]) & + for (sp in seq_len(nrow(params@species_params))) { + expect_true(all(size_n[sp, which((params@w <= max_w[sp]) & (params@w >= min_w[sp]))])) expect_true(!all(size_n[sp, which(params@w < min_w[sp])])) expect_true(!all(size_n[sp, which(params@w > max_w[sp])])) } - + # Gives expected error messages expect_error(get_size_range_array(params, min_w = 1000, max_w = 1), "min_w must be less than max_w") @@ -101,7 +101,7 @@ test_that("get_size_range_array works", { no_ab_params@species_params$a[1] <- NA expect_error(get_size_range_array(no_ab_params, min_l = 1, max_w = 100), "There must be no NAs in the species_params columns 'a' and 'b'") - no_ab_params@species_params <- + no_ab_params@species_params <- params@species_params[, !(names(params@species_params) %in% c("a", "b"))] expect_error(get_size_range_array(no_ab_params, min_l = 1, max_w = 100), "pecies_params slot must have columns 'a' and 'b'") @@ -178,7 +178,7 @@ test_that("getMeanMaxWeight works", { # expect_known_value(getMeanMaxWeight(sim, measure = "both"), # "values/getMeanMaxWeight") expect_snapshot(getMeanMaxWeight(sim, measure = "both")) - + }) @@ -194,7 +194,7 @@ test_that("getYieldGear works",{ # numeric test # expect_known_value(y, "values/getYieldGear") expect_snapshot(y) - expect_equal(getYieldGear(sim)[1, , ], + expect_equal(getYieldGear(sim)[1, , ], getYieldGear(sim@params)) }) @@ -266,7 +266,7 @@ test_that("getDiet works with proportion = FALSE", { diet <- getDiet(params, n, n_pp, proportion = FALSE) # expect_known_value(diet, "values/getDiet") expect_snapshot(diet) - # Check that summing over all species and resource gives + # Check that summing over all species and resource gives # total consumption consumption <- rowSums(diet, dims = 2) encounter <- getEncounter(params, n, n_pp) @@ -293,10 +293,10 @@ test_that("getDiet works with additional components", { } # switch off satiation for easier test of result species_params(params)$h <- Inf - p <- setComponent(params, "test", 1, + p <- setComponent(params, "test", 1, dynamics_fun = "test_dyn", encounter_fun = "test_dyn") - + diet1 <- getDiet(params, proportion = FALSE) diet2 <- getDiet(p, proportion = FALSE) expect_identical(diet1[, , 1:14], diet2[, , 1:14]) @@ -320,6 +320,53 @@ test_that("getBiomass works", { expect_equal(getBiomass(sim)[1, ], getBiomass(sim@params)) }) +# getBiomass with biomass_cutoff ---- +test_that("getBiomass works with biomass_cutoff", { + # Add biomass_cutoff to species_params + params_with_cutoff <- params + params_with_cutoff@species_params$biomass_cutoff <- c(10, 20, 15, 5, 25, 8, 12, 18, 7, 9, 11, 14) + + # Create simulation with biomass_cutoff + sim_with_cutoff <- project(params_with_cutoff, t_max = 10) + + # Test that biomass_cutoff is used when use_cutoff = TRUE + biomass_with_cutoff <- getBiomass(sim_with_cutoff, use_cutoff = TRUE) + + # Test that use_cutoff = FALSE (default) ignores biomass_cutoff + biomass_no_cutoff <- getBiomass(sim_with_cutoff, use_cutoff = FALSE) + biomass_default <- getBiomass(sim_with_cutoff) + expect_equal(biomass_no_cutoff, biomass_default) + + # Test that explicit size range arguments are ignored when use_cutoff = TRUE + biomass_explicit <- getBiomass(sim_with_cutoff, use_cutoff = TRUE, min_w = 5, max_w = 1000) + biomass_cutoff_used <- getBiomass(sim_with_cutoff, use_cutoff = TRUE) + + # These should be the same because explicit arguments are ignored when use_cutoff = TRUE + expect_equal(biomass_explicit, biomass_cutoff_used) + + # Test that explicit size range arguments work when use_cutoff = FALSE + biomass_explicit_no_cutoff <- getBiomass(sim_with_cutoff, use_cutoff = FALSE, min_w = 5, max_w = 1000) + # This should be different from the biomass_cutoff result + expect_false(all(biomass_explicit_no_cutoff == biomass_cutoff_used)) + + # Test with some NA values in biomass_cutoff + params_partial_cutoff <- params + params_partial_cutoff@species_params$biomass_cutoff <- c(10, NA, 15, 5, NA, 8, 12, 18, 7, 9, 11, 14) + sim_partial_cutoff <- project(params_partial_cutoff, t_max = 10) + + # Should work without error + expect_no_error(getBiomass(sim_partial_cutoff)) + + # Test with MizerParams object + biomass_params <- getBiomass(params_with_cutoff) + expect_equal(length(biomass_params), nrow(params_with_cutoff@species_params)) + + # Test that use_cutoff = FALSE works with MizerParams + biomass_params_no_cutoff <- getBiomass(params_with_cutoff, use_cutoff = FALSE) + biomass_params_default <- getBiomass(params_with_cutoff) + expect_equal(biomass_params_no_cutoff, biomass_params_default) +}) + # getN ---- test_that("getN works", { N <- getN(sim) From 290fad89c7c5ae837dd7e3eced180148178e443e Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Wed, 16 Jul 2025 21:59:50 +0200 Subject: [PATCH 2/7] Simplify `matchBiomasses()` by using `getBiomass()`. --- R/match.R | 39 +++++++++++++++++-------------------- tests/testthat/test-match.R | 20 +++++++++---------- 2 files changed, 28 insertions(+), 31 deletions(-) diff --git a/R/match.R b/R/match.R index 2216db7f..b1953fe5 100644 --- a/R/match.R +++ b/R/match.R @@ -41,34 +41,31 @@ matchBiomasses <- function(params, species = NULL) { if (!("biomass_observed" %in% names(params@species_params))) { return(params) } - species <- valid_species_arg(params, species = species, + species_sel <- valid_species_arg(params, species = species, return.logical = TRUE) & !is.na(params@species_params$biomass_observed) & params@species_params$biomass_observed > 0 - if (length(species) == 0) { + if (!any(species_sel)) { 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) + model_biomass <- getBiomass(params, use_cutoff = TRUE) + observed_biomass <- params@species_params$biomass_observed + + # Only consider selected species + selected_idx <- which(species_sel) + zero_biomass <- model_biomass[selected_idx] <= 0 | is.na(model_biomass[selected_idx]) + if (any(zero_biomass)) { + cutoff <- params@species_params$biomass_cutoff[selected_idx][zero_biomass] + error_species <- params@species_params$species[selected_idx][zero_biomass] + stop(paste( + paste(error_species, "does not grow up to the biomass_cutoff size of", + cutoff, "grams."), + collapse = "\n" + )) } + factors <- observed_biomass[selected_idx] / model_biomass[selected_idx] + params@initial_n[selected_idx, ] <- params@initial_n[selected_idx, , drop = FALSE] * factors setBevertonHolt(params) } diff --git a/tests/testthat/test-match.R b/tests/testthat/test-match.R index 2cd3ddb2..73bd8532 100644 --- a/tests/testthat/test-match.R +++ b/tests/testthat/test-match.R @@ -1,25 +1,25 @@ test_that("matchBiomasses works", { params <- setBevertonHolt(NS_params) - + # Does nothing when no observed biomass expect_identical(matchBiomasses(params), params) species_params(params)$biomass_observed <- NA - expect_unchanged(matchBiomasses(params), params) - + expect_identical(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) - + # If we double the observations, we get twice the abundance species <- 1:9 - species_params(params)$biomass_observed <- + species_params(params)$biomass_observed <- species_params(params)$biomass_observed * 2 params2 <- matchBiomasses(params, species) expect_equal(params2@initial_n[6:9, ], params@initial_n[6:9, ] * 2) @@ -27,7 +27,7 @@ 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), @@ -36,7 +36,7 @@ test_that("matchBiomasses works", { test_that("matchNumbers works", { params <- setBevertonHolt(NS_params) - + # Does nothing when no observed numbers expect_identical(matchNumbers(params), params) species_params(params)$number_observed <- NA @@ -50,10 +50,10 @@ test_that("matchNumbers works", { # Even if only partially observed species_params(params)$number_observed[1:5] <- NA expect_unchanged(matchNumbers(params), params) - + # If we double the observations, we get twice the abundance species <- 1:9 - species_params(params)$number_observed <- + species_params(params)$number_observed <- species_params(params)$number_observed * 2 params2 <- matchNumbers(params, species) expect_equal(params2@initial_n[6:9, ], params@initial_n[6:9, ] * 2) From 6efe193aa3e8ddfab8693a1cd5306763f0061c03 Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Tue, 18 Nov 2025 15:12:28 +0000 Subject: [PATCH 3/7] Now handles biomass cutoff correctly --- R/matchGrowth.R | 4 ++-- R/steadySingleSpecies.R | 4 ++-- tests/testthat/test-match.R | 3 +-- 3 files changed, 5 insertions(+), 6 deletions(-) diff --git a/R/matchGrowth.R b/R/matchGrowth.R index 594c5c3f..cb9ab541 100644 --- a/R/matchGrowth.R +++ b/R/matchGrowth.R @@ -35,7 +35,7 @@ matchGrowth <- function(params, species = NULL, sp <- params@species_params keep <- match.arg(keep) - biomass <- getBiomass(params) + biomass <- getBiomass(params, usecutoff = TRUE) number <- getN(params) sp <- set_species_param_default(sp, "age_mat", NA) @@ -65,7 +65,7 @@ matchGrowth <- function(params, species = NULL, params <- steadySingleSpecies(params, species = sel) if (keep == "biomass") { - factor <- biomass / getBiomass(params) + factor <- biomass / getBiomass(params, use_cutoff = TRUE) params@initial_n <- params@initial_n * factor } if (keep == "number") { diff --git a/R/steadySingleSpecies.R b/R/steadySingleSpecies.R index b3433333..8c3502fc 100644 --- a/R/steadySingleSpecies.R +++ b/R/steadySingleSpecies.R @@ -26,7 +26,7 @@ steadySingleSpecies <- function(params, species = NULL, species <- valid_species_arg(params, species) keep <- match.arg(keep) - biomass <- getBiomass(params) + biomass <- getBiomass(params, use_cutoff = TRUE) number <- getN(params) # Use growth and mortality from current abundances @@ -66,7 +66,7 @@ steadySingleSpecies <- function(params, species = NULL, } if (keep == "biomass") { - factor <- biomass / getBiomass(params) + factor <- biomass / getBiomass(params, use_cutoff = TRUE) params@initial_n <- params@initial_n * factor } if (keep == "number") { diff --git a/tests/testthat/test-match.R b/tests/testthat/test-match.R index 73bd8532..e80fdb1d 100644 --- a/tests/testthat/test-match.R +++ b/tests/testthat/test-match.R @@ -8,8 +8,7 @@ test_that("matchBiomasses works", { # 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, "*")) + biomass_actual <- getBiomass(params, use_cutoff = TRUE) species_params(params)$biomass_observed <- biomass_actual expect_unchanged(matchBiomasses(params), params) From 0b3f318cfcd42533a4a890430f551a94830dd3b0 Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Tue, 18 Nov 2025 15:25:53 +0000 Subject: [PATCH 4/7] Remove problematic test --- tests/testthat/test-match.R | 5 ----- 1 file changed, 5 deletions(-) diff --git a/tests/testthat/test-match.R b/tests/testthat/test-match.R index e80fdb1d..a7fac506 100644 --- a/tests/testthat/test-match.R +++ b/tests/testthat/test-match.R @@ -26,11 +26,6 @@ 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", { From 338c2cbae419f021ae4dae13129d65c9de985725 Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Fri, 21 Nov 2025 11:03:43 +0000 Subject: [PATCH 5/7] add `use_cutoff` to `plotBiomass()` and `plotlyBiomass()` --- R/plots.R | 7 +++++- tests/testthat/test-plotBiomass-cutoff.R | 27 ++++++++++++++++++++++++ 2 files changed, 33 insertions(+), 1 deletion(-) create mode 100644 tests/testthat/test-plotBiomass-cutoff.R diff --git a/R/plots.R b/R/plots.R index b769946e..e128e8d6 100644 --- a/R/plots.R +++ b/R/plots.R @@ -234,6 +234,7 @@ log_breaks <- function(n = 6) { #' @param sim An object of class \linkS4class{MizerSim} #' @inheritParams valid_species_arg #' @inheritParams plotDataFrame +#' @inheritParams getBiomass #' @param start_time The first time to be plotted. Default is the beginning #' of the time series. #' @param end_time The last time to be plotted. Default is the end of the @@ -253,6 +254,7 @@ log_breaks <- function(n = 6) { #' @family plotting functions #' @seealso [plotting_functions], [getBiomass()] #' @examples +#' @examples #' \donttest{ #' plotBiomass(NS_sim) #' plotBiomass(NS_sim, species = c("Sandeel", "Herring"), total = TRUE) @@ -267,11 +269,13 @@ plotBiomass <- function(sim, species = NULL, y_ticks = 6, ylim = c(NA, NA), total = FALSE, background = TRUE, highlight = NULL, return_data = FALSE, + use_cutoff = FALSE, ...) { assert_that(is(sim, "MizerSim"), is.flag(total), is.flag(background), is.flag(return_data), + is.flag(use_cutoff), length(ylim) == 2) params <- sim@params species <- valid_species_arg(sim, species, error_on_empty = TRUE) @@ -285,7 +289,7 @@ plotBiomass <- function(sim, species = NULL, # First we get the data frame for all species, including the background, # for all times but only the desired size range, by passing any size range # arguments on to getBiomass() - bm <- getBiomass(sim, ...) + bm <- getBiomass(sim, use_cutoff = use_cutoff, ...) # Select time range bm <- bm[(as.numeric(dimnames(bm)[[1]]) >= start_time) & (as.numeric(dimnames(bm)[[1]]) <= end_time), , drop = FALSE] @@ -337,6 +341,7 @@ plotlyBiomass <- function(sim, total = FALSE, background = TRUE, highlight = NULL, + use_cutoff = FALSE, ...) { argg <- c(as.list(environment()), list(...)) ggplotly(do.call("plotBiomass", argg), diff --git a/tests/testthat/test-plotBiomass-cutoff.R b/tests/testthat/test-plotBiomass-cutoff.R new file mode 100644 index 00000000..318c13f2 --- /dev/null +++ b/tests/testthat/test-plotBiomass-cutoff.R @@ -0,0 +1,27 @@ +devtools::load_all() +test_that("plotBiomass works with use_cutoff", { + params <- NS_params + species_params(params)$biomass_cutoff <- 10 + sim <- project(params, t_max = 1, effort = 1) + + # Test with return_data = TRUE to check values + # Default behavior (use_cutoff = FALSE) + p_default <- plotBiomass(sim, return_data = TRUE) + bm_default <- getBiomass(sim) + # Check total for a species matches + expect_equal(p_default$Biomass[p_default$Species == "Cod" & p_default$Year == 1], + bm_default["1", "Cod"], ignore_attr = TRUE) + + # With use_cutoff = TRUE + p_cutoff <- plotBiomass(sim, use_cutoff = TRUE, return_data = TRUE) + bm_cutoff <- getBiomass(sim, use_cutoff = TRUE) + expect_equal(p_cutoff$Biomass[p_cutoff$Species == "Cod" & p_cutoff$Year == 1], + bm_cutoff["1", "Cod"], ignore_attr = TRUE) + + # Check that values are different (since cutoff is 10g) + expect_true(p_default$Biomass[p_default$Species == "Cod" & p_default$Year == 1] > + p_cutoff$Biomass[p_cutoff$Species == "Cod" & p_cutoff$Year == 1]) + + # Test plotlyBiomass accepts the argument + expect_error(plotlyBiomass(sim, use_cutoff = TRUE), NA) +}) From 55bc7d07c365da17b583eccf0a33081033d1df0f Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Fri, 21 Nov 2025 11:28:48 +0000 Subject: [PATCH 6/7] No need to load package in test file --- tests/testthat/test-plotBiomass-cutoff.R | 1 - 1 file changed, 1 deletion(-) diff --git a/tests/testthat/test-plotBiomass-cutoff.R b/tests/testthat/test-plotBiomass-cutoff.R index 318c13f2..36c76822 100644 --- a/tests/testthat/test-plotBiomass-cutoff.R +++ b/tests/testthat/test-plotBiomass-cutoff.R @@ -1,4 +1,3 @@ -devtools::load_all() test_that("plotBiomass works with use_cutoff", { params <- NS_params species_params(params)$biomass_cutoff <- 10 From be6470eff9e8c10e015faa55408cba9acf0c39c7 Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Fri, 21 Nov 2025 12:24:43 +0000 Subject: [PATCH 7/7] Fix man pages --- R/plots.R | 1 - R/summary_methods.R | 4 ++-- man/getBiomass.Rd | 4 ++-- man/plotBiomass.Rd | 7 +++++++ 4 files changed, 11 insertions(+), 5 deletions(-) diff --git a/R/plots.R b/R/plots.R index e128e8d6..76184865 100644 --- a/R/plots.R +++ b/R/plots.R @@ -254,7 +254,6 @@ log_breaks <- function(n = 6) { #' @family plotting functions #' @seealso [plotting_functions], [getBiomass()] #' @examples -#' @examples #' \donttest{ #' plotBiomass(NS_sim) #' plotBiomass(NS_sim, species = c("Sandeel", "Herring"), total = TRUE) diff --git a/R/summary_methods.R b/R/summary_methods.R index ffd1fe1f..8c76826b 100644 --- a/R/summary_methods.R +++ b/R/summary_methods.R @@ -239,9 +239,9 @@ getSSB <- function(object) { #' biomass <- getBiomass(NS_sim, min_w = 10, max_w = 1000) #' biomass["1972", "Herring"] #' -#' # If species_params contains a biomass_cutoff column, it can be used +#' # If species_params contains a `biomass_cutoff`` column, it can be used #' # as the minimum weight when use_cutoff = TRUE -#' species_params(params)$biomass_cutoff <- species_params(params)$w_mat +#' species_params(NS_sim@params)$biomass_cutoff <- 10 #' biomass <- getBiomass(NS_sim, use_cutoff = TRUE) # Uses biomass_cutoff as min_w #' biomass["1972", "Herring"] getBiomass <- function(object, use_cutoff = FALSE, ...) { diff --git a/man/getBiomass.Rd b/man/getBiomass.Rd index b4aec16e..23cd1801 100644 --- a/man/getBiomass.Rd +++ b/man/getBiomass.Rd @@ -56,9 +56,9 @@ biomass["1972", "Herring"] biomass <- getBiomass(NS_sim, min_w = 10, max_w = 1000) biomass["1972", "Herring"] -# If species_params contains a biomass_cutoff column, it can be used +# If species_params contains a `biomass_cutoff`` column, it can be used # as the minimum weight when use_cutoff = TRUE -species_params(params)$biomass_cutoff <- species_params(params)$w_mat +species_params(NS_sim@params)$biomass_cutoff <- 10 biomass <- getBiomass(NS_sim, use_cutoff = TRUE) # Uses biomass_cutoff as min_w biomass["1972", "Herring"] } diff --git a/man/plotBiomass.Rd b/man/plotBiomass.Rd index df26598a..b3bf5b0c 100644 --- a/man/plotBiomass.Rd +++ b/man/plotBiomass.Rd @@ -16,6 +16,7 @@ plotBiomass( background = TRUE, highlight = NULL, return_data = FALSE, + use_cutoff = FALSE, ... ) @@ -29,6 +30,7 @@ plotlyBiomass( total = FALSE, background = TRUE, highlight = NULL, + use_cutoff = FALSE, ... ) } @@ -64,6 +66,11 @@ Default is TRUE.} \item{return_data}{A boolean value that determines whether the formatted data used for the plot is returned instead of the plot itself. Default value is FALSE} +\item{use_cutoff}{If TRUE, the \code{biomass_cutoff} column in the +species parameters is used as the minimum weight for each species (ignoring any +size range arguments in \code{...}). If FALSE (default), the specified size range +arguments are used, if provided, or the full size range of the species is used.} + \item{...}{ Arguments passed on to \code{\link[=get_size_range_array]{get_size_range_array}} \describe{