From 28040f8be190941e9893db70b0252e24fa980406 Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Fri, 21 Nov 2025 18:30:55 +0000 Subject: [PATCH 01/16] Converting plotting functions into S3 methods --- NAMESPACE | 15 ++ R/plots.R | 358 +++++++++++++++++++++++++++++------- man/plotBiomass.Rd | 31 ++-- man/plotDiet.Rd | 15 +- man/plotFMort.Rd | 19 +- man/plotFeedingLevel.Rd | 20 +- man/plotGrowthCurves.Rd | 22 ++- man/plotM2.Rd | 28 +-- man/plotPredMort.Rd | 19 +- man/plotSpectra.Rd | 25 ++- man/plotYield.Rd | 9 +- man/plotYieldGear.Rd | 9 +- tests/testthat/test-plots.R | 7 + 13 files changed, 444 insertions(+), 133 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 314fcf4e..b017266e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,20 @@ # Generated by roxygen2: do not edit by hand +S3method(plotBiomass,MizerSim) +S3method(plotDiet,MizerParams) +S3method(plotDiet,MizerSim) +S3method(plotFMort,MizerParams) +S3method(plotFMort,MizerSim) +S3method(plotFeedingLevel,MizerParams) +S3method(plotFeedingLevel,MizerSim) +S3method(plotGrowthCurves,MizerParams) +S3method(plotGrowthCurves,MizerSim) +S3method(plotPredMort,MizerParams) +S3method(plotPredMort,MizerSim) +S3method(plotSpectra,MizerParams) +S3method(plotSpectra,MizerSim) +S3method(plotYield,MizerSim) +S3method(plotYieldGear,MizerSim) export("catchability<-") export("diffusion<-") export("ext_encounter<-") diff --git a/R/plots.R b/R/plots.R index 31b97718..887b96c5 100644 --- a/R/plots.R +++ b/R/plots.R @@ -272,7 +272,15 @@ log_breaks <- function(n = 6) { #' fr <- plotBiomass(NS_sim, return_data = TRUE) #' str(fr) #' } -plotBiomass <- function(sim, species = NULL, +#' @rdname plotBiomass +#' @export +plotBiomass <- function(sim, ...) { + UseMethod("plotBiomass") +} + +#' @rdname plotBiomass +#' @export +plotBiomass.MizerSim <- function(sim, species = NULL, start_time, end_time, y_ticks = 6, ylim = c(NA, NA), total = FALSE, background = TRUE, @@ -390,7 +398,15 @@ plotlyBiomass <- function(sim, #' fr <- plotYield(sim, return_data = TRUE) #' str(fr) #' } -plotYield <- function(sim, sim2, +#' @rdname plotYield +#' @export +plotYield <- function(sim, ...) { + UseMethod("plotYield") +} + +#' @rdname plotYield +#' @export +plotYield.MizerSim <- function(sim, sim2, species = NULL, total = FALSE, log = TRUE, highlight = NULL, return_data = FALSE, @@ -494,7 +510,15 @@ plotlyYield <- function(sim, sim2, #' fr <- plotYieldGear(sim, return_data = TRUE) #' str(fr) #' } -plotYieldGear <- function(sim, +#' @rdname plotYieldGear +#' @export +plotYieldGear <- function(sim, ...) { + UseMethod("plotYieldGear") +} + +#' @rdname plotYieldGear +#' @export +plotYieldGear.MizerSim <- function(sim, species = NULL, gears = NULL, total = FALSE, @@ -618,7 +642,15 @@ plotlyYieldGear <- function(sim, species = NULL, #' fr <- plotSpectra(sim, return_data = TRUE) #' str(fr) #' } -plotSpectra <- function(object, species = NULL, +#' @rdname plotSpectra +#' @export +plotSpectra <- function(object, ...) { + UseMethod("plotSpectra") +} + +#' @rdname plotSpectra +#' @export +plotSpectra.MizerSim <- function(object, species = NULL, time_range, geometric_mean = FALSE, wlim = c(NA, NA), ylim = c(NA, NA), @@ -639,37 +671,52 @@ plotSpectra <- function(object, species = NULL, 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)) - } - time_elements <- get_time_elements(object, time_range) - mean_fn <- mean - if (geometric_mean) { - mean_fn <- function(x) { - exp(mean(log(x))) - } + if (missing(time_range)) { + time_range <- max(as.numeric(dimnames(object@n)$time)) + } + time_elements <- get_time_elements(object, time_range) + mean_fn <- mean + if (geometric_mean) { + mean_fn <- function(x) { + exp(mean(log(x))) } - n <- apply(object@n[time_elements, , , drop = FALSE], c(2, 3), mean_fn) - n_pp <- apply(object@n_pp[time_elements, , drop = FALSE], 2, mean_fn) - ps <- plot_spectra(object@params, n = n, n_pp = n_pp, - species = species, wlim = wlim, ylim = ylim, - power = power, total = total, resource = resource, - background = background, highlight = highlight, - return_data = return_data) - return(ps) - } else if (is(object, "MizerParams")) { - ps <- plot_spectra(object, n = object@initial_n, - n_pp = object@initial_n_pp, - species = species, wlim = wlim, ylim = ylim, - power = power, total = total, resource = resource, - background = background, highlight = highlight, - return_data = return_data) - return(ps) - } else { - stop("First argument of `plotSpectra()` needs to be a MizerSim or ", - "a MizerParams object.") } + n <- apply(object@n[time_elements, , , drop = FALSE], c(2, 3), mean_fn) + n_pp <- apply(object@n_pp[time_elements, , drop = FALSE], 2, mean_fn) + plot_spectra(object@params, n = n, n_pp = n_pp, + species = species, wlim = wlim, ylim = ylim, + power = power, total = total, resource = resource, + background = background, highlight = highlight, + return_data = return_data) +} + +#' @rdname plotSpectra +#' @export +plotSpectra.MizerParams <- function(object, species = NULL, + wlim = c(NA, NA), ylim = c(NA, NA), + power = 1, biomass = TRUE, + total = FALSE, resource = TRUE, + background = TRUE, + highlight = NULL, return_data = FALSE, ...) { + # to deal with old-type biomass argument + if (missing(power)) { + power <- as.numeric(biomass) + } + assert_that(is.flag(total), is.flag(resource), + is.flag(background), + is.number(power), + 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.") + } + plot_spectra(object, n = object@initial_n, + n_pp = object@initial_n_pp, + species = species, wlim = wlim, ylim = ylim, + power = power, total = total, resource = resource, + background = background, highlight = highlight, + return_data = return_data) } @@ -820,27 +867,56 @@ plotlySpectra <- function(object, species = NULL, #' fr <- plotFeedingLevel(sim, return_data = TRUE) #' str(fr) #' } -plotFeedingLevel <- function(object, species = NULL, +#' @rdname plotFeedingLevel +#' @export +plotFeedingLevel <- function(object, ...) { + UseMethod("plotFeedingLevel") +} + +#' @rdname plotFeedingLevel +#' @export +plotFeedingLevel.MizerSim <- function(object, species = NULL, time_range, highlight = NULL, all.sizes = FALSE, include_critical = FALSE, return_data = FALSE, ...) { assert_that(is.flag(all.sizes), is.flag(include_critical), is.flag(return_data)) - if (is(object, "MizerSim")) { - if (missing(time_range)) { - time_range <- max(as.numeric(dimnames(object@n)$time)) - } - params <- validParams(object@params) - feed <- getFeedingLevel(object, time_range = time_range, drop = FALSE) - } else if (is(object, "MizerParams")) { - params <- validParams(object) - feed <- getFeedingLevel(params, drop = FALSE) + if (missing(time_range)) { + time_range <- max(as.numeric(dimnames(object@n)$time)) } + params <- validParams(object@params) + feed <- getFeedingLevel(object, time_range = time_range, drop = FALSE) # If a time range was returned, average over it if (length(dim(feed)) == 3) { feed <- apply(feed, c(2, 3), mean) } + plot_feeding_level(params, feed, species = species, + highlight = highlight, all.sizes = all.sizes, + include_critical = include_critical, + return_data = return_data) +} + +#' @rdname plotFeedingLevel +#' @export +plotFeedingLevel.MizerParams <- function(object, species = NULL, + highlight = NULL, + all.sizes = FALSE, include_critical = FALSE, + return_data = FALSE, ...) { + assert_that(is.flag(all.sizes), + is.flag(include_critical), + is.flag(return_data)) + params <- validParams(object) + feed <- getFeedingLevel(params, drop = FALSE) + plot_feeding_level(params, feed, species = species, + highlight = highlight, all.sizes = all.sizes, + include_critical = include_critical, + return_data = return_data) +} + +plot_feeding_level <- function(params, feed, species, highlight, + all.sizes, include_critical, + return_data) { # selector for desired species sel_sp <- valid_species_arg(params, species, return.logical = TRUE, @@ -1012,25 +1088,51 @@ plotlyFeedingLevel <- function(object, #' fr <- plotPredMort(sim, return_data = TRUE) #' str(fr) #' } -plotPredMort <- function(object, species = NULL, +#' @rdname plotPredMort +#' @export +plotPredMort <- function(object, ...) { + UseMethod("plotPredMort") +} + +#' @rdname plotPredMort +#' @export +plotPredMort.MizerSim <- function(object, species = NULL, time_range, all.sizes = FALSE, highlight = NULL, return_data = FALSE, ...) { assert_that(is.flag(all.sizes), is.flag(return_data)) - if (is(object, "MizerSim")) { - if (missing(time_range)) { - time_range <- max(as.numeric(dimnames(object@n)$time)) - } - params <- object@params - } else { - params <- validParams(object) + if (missing(time_range)) { + time_range <- max(as.numeric(dimnames(object@n)$time)) } + params <- object@params pred_mort <- getPredMort(object, time_range = time_range, drop = FALSE) # If a time range was returned, average over it if (length(dim(pred_mort)) == 3) { pred_mort <- apply(pred_mort, c(2, 3), mean) } + plot_pred_mort(params, pred_mort, species = species, + highlight = highlight, all.sizes = all.sizes, + return_data = return_data) +} + +#' @rdname plotPredMort +#' @export +plotPredMort.MizerParams <- function(object, species = NULL, + all.sizes = FALSE, + highlight = NULL, return_data = FALSE, + ...) { + assert_that(is.flag(all.sizes), + is.flag(return_data)) + params <- validParams(object) + pred_mort <- getPredMort(object, drop = FALSE) + plot_pred_mort(params, pred_mort, species = species, + highlight = highlight, all.sizes = all.sizes, + return_data = return_data) +} + +plot_pred_mort <- function(params, pred_mort, species, highlight, + all.sizes, return_data) { species <- valid_species_arg(params, species, error_on_empty = TRUE) pred_mort <- pred_mort[as.character(dimnames(pred_mort)[[1]]) %in% species, , drop = FALSE] @@ -1105,25 +1207,51 @@ plotlyPredMort <- function(object, species = NULL, #' fr <- plotFMort(sim, return_data = TRUE) #' str(fr) #' } -plotFMort <- function(object, species = NULL, +#' @rdname plotFMort +#' @export +plotFMort <- function(object, ...) { + UseMethod("plotFMort") +} + +#' @rdname plotFMort +#' @export +plotFMort.MizerSim <- function(object, species = NULL, time_range, all.sizes = FALSE, highlight = NULL, return_data = FALSE, ...) { assert_that(is.flag(all.sizes), is.flag(return_data)) - if (is(object, "MizerSim")) { - if (missing(time_range)) { - time_range <- max(as.numeric(dimnames(object@n)$time)) - } - params <- object@params - } else { - params <- validParams(object) + if (missing(time_range)) { + time_range <- max(as.numeric(dimnames(object@n)$time)) } + params <- object@params f <- getFMort(object, time_range = time_range, drop = FALSE) # If a time range was returned, average over it if (length(dim(f)) == 3) { f <- apply(f, c(2, 3), mean) } + plot_f_mort(params, f, species = species, + highlight = highlight, all.sizes = all.sizes, + return_data = return_data) +} + +#' @rdname plotFMort +#' @export +plotFMort.MizerParams <- function(object, species = NULL, + all.sizes = FALSE, + highlight = NULL, return_data = FALSE, + ...) { + assert_that(is.flag(all.sizes), + is.flag(return_data)) + params <- validParams(object) + f <- getFMort(object, drop = FALSE) + plot_f_mort(params, f, species = species, + highlight = highlight, all.sizes = all.sizes, + return_data = return_data) +} + +plot_f_mort <- function(params, f, species, highlight, + all.sizes, return_data) { 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)), @@ -1207,7 +1335,15 @@ plotlyFMort <- function(object, species = NULL, #' fr <- plotGrowthCurves(sim, return_data = TRUE) #' str(fr) #' } -plotGrowthCurves <- function(object, species = NULL, +#' @rdname plotGrowthCurves +#' @export +plotGrowthCurves <- function(object, ...) { + UseMethod("plotGrowthCurves") +} + +#' @rdname plotGrowthCurves +#' @export +plotGrowthCurves.MizerSim <- function(object, species = NULL, max_age = 20, percentage = FALSE, species_panel = FALSE, highlight = NULL, size_at_age = NULL, @@ -1216,12 +1352,39 @@ plotGrowthCurves <- function(object, species = NULL, is.flag(species_panel), is.flag(return_data), is.number(max_age)) - if (is(object, "MizerSim")) { - params <- object@params - params <- setInitialValues(params, object) - } else if (is(object, "MizerParams")) { - params <- validParams(object) - } + params <- object@params + params <- setInitialValues(params, object) + plot_growth_curves(params, species = species, + max_age = max_age, percentage = percentage, + species_panel = species_panel, highlight = highlight, + size_at_age = size_at_age, + return_data = return_data) +} + +#' @rdname plotGrowthCurves +#' @export +plotGrowthCurves.MizerParams <- function(object, species = NULL, + max_age = 20, percentage = FALSE, + species_panel = FALSE, highlight = NULL, + size_at_age = NULL, + return_data = FALSE, ...) { + assert_that(is.flag(percentage), + is.flag(species_panel), + is.flag(return_data), + is.number(max_age)) + params <- validParams(object) + plot_growth_curves(params, species = species, + max_age = max_age, percentage = percentage, + species_panel = species_panel, highlight = highlight, + size_at_age = size_at_age, + return_data = return_data) +} + +plot_growth_curves <- function(params, species, + max_age, percentage, + species_panel, highlight, + size_at_age, + return_data) { sp <- params@species_params sp <- set_species_param_default(sp, "age_mat", age_mat_vB(params)) @@ -1404,12 +1567,67 @@ plotlyGrowthCurves <- function(object, species = NULL, #' fr <- plotDiet(NS_params, species = "Cod", return_data = TRUE) #' str(fr) #' } -plotDiet <- function(object, species = NULL, return_data = FALSE) { +#' @rdname plotDiet +#' @export +plotDiet <- function(object, ...) { + UseMethod("plotDiet") +} + +#' @rdname plotDiet +#' @export +plotDiet.MizerSim <- function(object, species = NULL, + time_range, return_data = FALSE, ...) { + assert_that(is.flag(return_data)) + if (missing(time_range)) { + time_range <- max(as.numeric(dimnames(object@n)$time)) + } + params <- object@params + # Calculate average abundances over time range + time_elements <- get_time_elements(object, time_range) + n <- apply(object@n[time_elements, , , drop = FALSE], c(2, 3), mean) + n_pp <- apply(object@n_pp[time_elements, , drop = FALSE], 2, mean) + n_other <- object@n_other[time_elements, , drop = FALSE] + if (length(dim(n_other)) == 2) { + if (ncol(n_other) > 0) { + n_other <- apply(n_other, 2, mean) + } else { + n_other <- numeric(0) + } + } else { + # If n_other is a list or has different structure, handling might be complex. + # But usually it's a matrix [time, component] + # If it's a list of arrays? + # For now assume standard structure or that getDiet handles it. + # Actually getDiet expects n_other to be passed. + # Let's check how getDiet handles n_other. + # In getDiet: n_other = initialNOther(params) default. + # We should pass the averaged n_other. + # If n_other is a list, we need to average each component. + if (is.list(n_other)) { + n_other <- lapply(n_other, function(x) { + if (length(dim(x)) == 2) apply(x, 2, mean) else mean(x) + }) + } + } + + diet <- getDiet(params, n = n, n_pp = n_pp, n_other = n_other) + plot_diet(params, n = n, diet = diet, species = species, + return_data = return_data) +} + +#' @rdname plotDiet +#' @export +plotDiet.MizerParams <- function(object, species = NULL, return_data = FALSE, ...) { assert_that(is.flag(return_data)) params <- validParams(object) - n <- params@initial_n - species <- valid_species_arg(object, species, return.logical = TRUE) - diet <- getDiet(params)[species, , , drop = FALSE] + diet <- getDiet(params) + plot_diet(params, n = params@initial_n, diet = diet, species = species, + return_data = return_data) +} + +plot_diet <- function(params, n, diet, species, return_data) { + species <- valid_species_arg(params, species, return.logical = TRUE) + diet <- diet[species, , , drop = FALSE] names(dimnames(diet)) <- c("Predator", "w", "Prey") plot_dat <- melt(diet, value.name = "Proportion") prey <- dimnames(diet)$Prey diff --git a/man/plotBiomass.Rd b/man/plotBiomass.Rd index be11b7a4..6d59000e 100644 --- a/man/plotBiomass.Rd +++ b/man/plotBiomass.Rd @@ -2,10 +2,13 @@ % Please edit documentation in R/plots.R \name{plotBiomass} \alias{plotBiomass} +\alias{plotBiomass.MizerSim} \alias{plotlyBiomass} \title{Plot the biomass of species through time} \usage{ -plotBiomass( +plotBiomass(sim, ...) + +\method{plotBiomass}{MizerSim}( sim, species = NULL, start_time, @@ -37,6 +40,19 @@ plotlyBiomass( \arguments{ \item{sim}{An object of class \linkS4class{MizerSim}} +\item{...}{ + Arguments passed on to \code{\link[=get_size_range_array]{get_size_range_array}} + \describe{ + \item{\code{min_w}}{Smallest weight in size range. Defaults to smallest weight in +the model.} + \item{\code{max_w}}{Largest weight in size range. Defaults to largest weight in the +model.} + \item{\code{min_l}}{Smallest length in size range. If supplied, this takes +precedence over \code{min_w}.} + \item{\code{max_l}}{Largest length in size range. If supplied, this takes precedence +over \code{max_w}.} + }} + \item{species}{The species to be selected. Optional. By default all target species are selected. A vector of species names, or a numeric vector with the species indices, or a logical vector indicating for @@ -71,19 +87,6 @@ used for the plot is returned instead of the plot itself. Default value is FALSE 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{ - \item{\code{min_w}}{Smallest weight in size range. Defaults to smallest weight in -the model.} - \item{\code{max_w}}{Largest weight in size range. Defaults to largest weight in the -model.} - \item{\code{min_l}}{Smallest length in size range. If supplied, this takes -precedence over \code{min_w}.} - \item{\code{max_l}}{Largest length in size range. If supplied, this takes precedence -over \code{max_w}.} - }} } \value{ A ggplot2 object, unless \code{return_data = TRUE}, in which case a data diff --git a/man/plotDiet.Rd b/man/plotDiet.Rd index 3dc6e79b..6d6ea5b8 100644 --- a/man/plotDiet.Rd +++ b/man/plotDiet.Rd @@ -2,19 +2,32 @@ % Please edit documentation in R/plots.R \name{plotDiet} \alias{plotDiet} +\alias{plotDiet.MizerSim} +\alias{plotDiet.MizerParams} \title{Plot diet, resolved by prey species, as function of predator at size.} \usage{ -plotDiet(object, species = NULL, return_data = FALSE) +plotDiet(object, ...) + +\method{plotDiet}{MizerSim}(object, species = NULL, time_range, return_data = FALSE, ...) + +\method{plotDiet}{MizerParams}(object, species = NULL, return_data = FALSE, ...) } \arguments{ \item{object}{An object of class \linkS4class{MizerSim} or \linkS4class{MizerParams}.} +\item{...}{Other arguments (currently unused)} + \item{species}{The species to be selected. Optional. By default all target species are selected. A vector of species names, or a numeric vector with the species indices, or a logical vector indicating for each species whether it is to be selected (TRUE) or not.} +\item{time_range}{The time range (either a vector of values, a vector of min +and max time, or a single value) to average the abundances over. Default is +the final time step. Ignored when called with a \linkS4class{MizerParams} +object.} + \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} } diff --git a/man/plotFMort.Rd b/man/plotFMort.Rd index 991a16ed..d67a2070 100644 --- a/man/plotFMort.Rd +++ b/man/plotFMort.Rd @@ -2,10 +2,14 @@ % Please edit documentation in R/plots.R \name{plotFMort} \alias{plotFMort} +\alias{plotFMort.MizerSim} +\alias{plotFMort.MizerParams} \alias{plotlyFMort} \title{Plot total fishing mortality of each species by size} \usage{ -plotFMort( +plotFMort(object, ...) + +\method{plotFMort}{MizerSim}( object, species = NULL, time_range, @@ -15,12 +19,23 @@ plotFMort( ... ) +\method{plotFMort}{MizerParams}( + object, + species = NULL, + all.sizes = FALSE, + highlight = NULL, + return_data = FALSE, + ... +) + plotlyFMort(object, species = NULL, time_range, highlight = NULL, ...) } \arguments{ \item{object}{An object of class \linkS4class{MizerSim} or \linkS4class{MizerParams}.} +\item{...}{Other arguments (currently unused)} + \item{species}{The species to be selected. Optional. By default all target species are selected. A vector of species names, or a numeric vector with the species indices, or a logical vector indicating for @@ -38,8 +53,6 @@ outside a species' size range. Default FALSE.} \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{...}{Other arguments (currently unused)} } \value{ A ggplot2 object, unless \code{return_data = TRUE}, in which case a data diff --git a/man/plotFeedingLevel.Rd b/man/plotFeedingLevel.Rd index 74519ae3..4eb3eba3 100644 --- a/man/plotFeedingLevel.Rd +++ b/man/plotFeedingLevel.Rd @@ -2,10 +2,14 @@ % Please edit documentation in R/plots.R \name{plotFeedingLevel} \alias{plotFeedingLevel} +\alias{plotFeedingLevel.MizerSim} +\alias{plotFeedingLevel.MizerParams} \alias{plotlyFeedingLevel} \title{Plot the feeding level of species by size} \usage{ -plotFeedingLevel( +plotFeedingLevel(object, ...) + +\method{plotFeedingLevel}{MizerSim}( object, species = NULL, time_range, @@ -16,6 +20,16 @@ plotFeedingLevel( ... ) +\method{plotFeedingLevel}{MizerParams}( + object, + species = NULL, + highlight = NULL, + all.sizes = FALSE, + include_critical = FALSE, + return_data = FALSE, + ... +) + plotlyFeedingLevel( object, species = NULL, @@ -29,6 +43,8 @@ plotlyFeedingLevel( \item{object}{An object of class \linkS4class{MizerSim} or \linkS4class{MizerParams}.} +\item{...}{Other arguments (currently unused)} + \item{species}{The species to be selected. Optional. By default all target species are selected. A vector of species names, or a numeric vector with the species indices, or a logical vector indicating for @@ -49,8 +65,6 @@ plotted. Default FALSE.} \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{...}{Other arguments (currently unused)} } \value{ A ggplot2 object, unless \code{return_data = TRUE}, in which case a data diff --git a/man/plotGrowthCurves.Rd b/man/plotGrowthCurves.Rd index c5b494c2..b13a9e64 100644 --- a/man/plotGrowthCurves.Rd +++ b/man/plotGrowthCurves.Rd @@ -2,10 +2,26 @@ % Please edit documentation in R/plots.R \name{plotGrowthCurves} \alias{plotGrowthCurves} +\alias{plotGrowthCurves.MizerSim} +\alias{plotGrowthCurves.MizerParams} \alias{plotlyGrowthCurves} \title{Plot growth curves} \usage{ -plotGrowthCurves( +plotGrowthCurves(object, ...) + +\method{plotGrowthCurves}{MizerSim}( + object, + species = NULL, + max_age = 20, + percentage = FALSE, + species_panel = FALSE, + highlight = NULL, + size_at_age = NULL, + return_data = FALSE, + ... +) + +\method{plotGrowthCurves}{MizerParams}( object, species = NULL, max_age = 20, @@ -32,6 +48,8 @@ plotlyGrowthCurves( simulation to calculate the size at age. If given a \linkS4class{MizerParams} object, uses the initial growth rates instead.} +\item{...}{Other arguments (currently unused)} + \item{species}{The species to be selected. Optional. By default all target species are selected. A vector of species names, or a numeric vector with the species indices, or a logical vector indicating for @@ -55,8 +73,6 @@ or \code{length} (in cm). If both \code{weight} and \code{length} are provided, \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{...}{Other arguments (currently unused)} } \value{ A ggplot2 object diff --git a/man/plotM2.Rd b/man/plotM2.Rd index 23a51663..5e658779 100644 --- a/man/plotM2.Rd +++ b/man/plotM2.Rd @@ -4,38 +4,12 @@ \alias{plotM2} \title{Alias for \code{plotPredMort()}} \usage{ -plotM2( - object, - species = NULL, - time_range, - all.sizes = FALSE, - highlight = NULL, - return_data = FALSE, - ... -) +plotM2(object, ...) } \arguments{ \item{object}{An object of class \linkS4class{MizerSim} or \linkS4class{MizerParams}.} -\item{species}{The species to be selected. Optional. By default all target -species are selected. A vector of species names, or a -numeric vector with the species indices, or a logical vector indicating for -each species whether it is to be selected (TRUE) or not.} - -\item{time_range}{The time range (either a vector of values, a vector of min -and max time, or a single value) to average the abundances over. Default is -the final time step. Ignored when called with a \linkS4class{MizerParams} -object.} - -\item{all.sizes}{If TRUE, then predation mortality is plotted also for sizes -outside a species' size range. Default FALSE.} - -\item{highlight}{Name or vector of names of the species to be highlighted.} - -\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{...}{Other arguments (currently unused)} } \value{ diff --git a/man/plotPredMort.Rd b/man/plotPredMort.Rd index 7a138d75..455c9dc4 100644 --- a/man/plotPredMort.Rd +++ b/man/plotPredMort.Rd @@ -2,10 +2,14 @@ % Please edit documentation in R/plots.R \name{plotPredMort} \alias{plotPredMort} +\alias{plotPredMort.MizerSim} +\alias{plotPredMort.MizerParams} \alias{plotlyPredMort} \title{Plot predation mortality rate of each species against size} \usage{ -plotPredMort( +plotPredMort(object, ...) + +\method{plotPredMort}{MizerSim}( object, species = NULL, time_range, @@ -15,12 +19,23 @@ plotPredMort( ... ) +\method{plotPredMort}{MizerParams}( + object, + species = NULL, + all.sizes = FALSE, + highlight = NULL, + return_data = FALSE, + ... +) + plotlyPredMort(object, species = NULL, time_range, highlight = NULL, ...) } \arguments{ \item{object}{An object of class \linkS4class{MizerSim} or \linkS4class{MizerParams}.} +\item{...}{Other arguments (currently unused)} + \item{species}{The species to be selected. Optional. By default all target species are selected. A vector of species names, or a numeric vector with the species indices, or a logical vector indicating for @@ -38,8 +53,6 @@ outside a species' size range. Default FALSE.} \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{...}{Other arguments (currently unused)} } \value{ A ggplot2 object, unless \code{return_data = TRUE}, in which case a data diff --git a/man/plotSpectra.Rd b/man/plotSpectra.Rd index f6f365a5..4ffb882a 100644 --- a/man/plotSpectra.Rd +++ b/man/plotSpectra.Rd @@ -2,10 +2,14 @@ % Please edit documentation in R/plots.R \name{plotSpectra} \alias{plotSpectra} +\alias{plotSpectra.MizerSim} +\alias{plotSpectra.MizerParams} \alias{plotlySpectra} \title{Plot the abundance spectra} \usage{ -plotSpectra( +plotSpectra(object, ...) + +\method{plotSpectra}{MizerSim}( object, species = NULL, time_range, @@ -22,6 +26,21 @@ plotSpectra( ... ) +\method{plotSpectra}{MizerParams}( + object, + species = NULL, + wlim = c(NA, NA), + ylim = c(NA, NA), + power = 1, + biomass = TRUE, + total = FALSE, + resource = TRUE, + background = TRUE, + highlight = NULL, + return_data = FALSE, + ... +) + plotlySpectra( object, species = NULL, @@ -42,6 +61,8 @@ plotlySpectra( \item{object}{An object of class \linkS4class{MizerSim} or \linkS4class{MizerParams}.} +\item{...}{Other arguments (currently unused)} + \item{species}{The species to be selected. Optional. By default all target species are selected. A vector of species names, or a numeric vector with the species indices, or a logical vector indicating for @@ -91,8 +112,6 @@ 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{...}{Other arguments (currently unused)} } \value{ A ggplot2 object, unless \code{return_data = TRUE}, in which case a data diff --git a/man/plotYield.Rd b/man/plotYield.Rd index 3d8a1f77..cde876ab 100644 --- a/man/plotYield.Rd +++ b/man/plotYield.Rd @@ -2,10 +2,13 @@ % Please edit documentation in R/plots.R \name{plotYield} \alias{plotYield} +\alias{plotYield.MizerSim} \alias{plotlyYield} \title{Plot the total yield of species through time} \usage{ -plotYield( +plotYield(sim, ...) + +\method{plotYield}{MizerSim}( sim, sim2, species = NULL, @@ -29,6 +32,8 @@ plotlyYield( \arguments{ \item{sim}{An object of class \linkS4class{MizerSim}} +\item{...}{Other arguments (currently unused)} + \item{sim2}{An optional second object of class \linkS4class{MizerSim}. If this is provided its yields will be shown on the same plot in bolder lines.} @@ -49,8 +54,6 @@ Defaults to 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{...}{Other arguments (currently unused)} } \value{ A ggplot2 object, unless \code{return_data = TRUE}, in which case a data diff --git a/man/plotYieldGear.Rd b/man/plotYieldGear.Rd index b3a011cb..0a086407 100644 --- a/man/plotYieldGear.Rd +++ b/man/plotYieldGear.Rd @@ -2,10 +2,13 @@ % Please edit documentation in R/plots.R \name{plotYieldGear} \alias{plotYieldGear} +\alias{plotYieldGear.MizerSim} \alias{plotlyYieldGear} \title{Plot the total yield of each species by gear through time} \usage{ -plotYieldGear( +plotYieldGear(sim, ...) + +\method{plotYieldGear}{MizerSim}( sim, species = NULL, gears = NULL, @@ -20,6 +23,8 @@ plotlyYieldGear(sim, species = NULL, total = FALSE, highlight = NULL, ...) \arguments{ \item{sim}{An object of class \linkS4class{MizerSim}} +\item{...}{Other arguments (currently unused)} + \item{species}{The species to be selected. Optional. By default all target species are selected. A vector of species names, or a numeric vector with the species indices, or a logical vector indicating for @@ -37,8 +42,6 @@ Default is FALSE.} \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{...}{Other arguments (currently unused)} } \value{ A ggplot2 object, unless \code{return_data = TRUE}, in which case a data diff --git a/tests/testthat/test-plots.R b/tests/testthat/test-plots.R index b2c49252..88c45561 100644 --- a/tests/testthat/test-plots.R +++ b/tests/testthat/test-plots.R @@ -213,3 +213,10 @@ test_that("axis limits are set correctly", { expect_equal(p$scales$scales[[1]]$limits[1], -20) expect_equal(p$scales$scales[[1]]$limits[2], 8) }) + +test_that("plotDiet works with MizerSim", { + p <- plotDiet(sim, species = 11) # Species 11 is Cod in setup + expect_true(is(p, "ggplot")) + p <- plotDiet(sim, species = 11, time_range = 1:2) + expect_true(is(p, "ggplot")) +}) From b5cc929b1f71b1e73d638c2f4088b947b5260858 Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Fri, 21 Nov 2025 18:44:37 +0000 Subject: [PATCH 02/16] Changing functions in `age_mat.R` into S3 method --- NAMESPACE | 4 ++++ R/age_mat.R | 45 +++++++++++++++++++++++++++++++++------------ man/age_mat.Rd | 5 ++++- man/age_mat_vB.Rd | 11 ++++++++++- 4 files changed, 51 insertions(+), 14 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index b017266e..96b5af2f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,9 @@ # Generated by roxygen2: do not edit by hand +S3method(age_mat,MizerParams) +S3method(age_mat_vB,MizerParams) +S3method(age_mat_vB,data.frame) +S3method(age_mat_vB,default) S3method(plotBiomass,MizerSim) S3method(plotDiet,MizerParams) S3method(plotDiet,MizerSim) diff --git a/R/age_mat.R b/R/age_mat.R index 8ab41dc2..17792bae 100644 --- a/R/age_mat.R +++ b/R/age_mat.R @@ -17,25 +17,38 @@ #' @return A named vector. The names are the species names and the values are #' the ages at maturity. #' @export -age_mat_vB <- function(object) { - if (is(object, "MizerParams")) { - sp <- object@species_params - } else { - if (!is.data.frame(object)) { - stop("The first argument must be either a MizerParams object or a species_params data frame.") - } - sp <- validSpeciesParams(object) - } +#' @rdname age_mat_vB +#' @export +age_mat_vB <- function(object, ...) { + UseMethod("age_mat_vB") +} + +#' @rdname age_mat_vB +#' @export +age_mat_vB.MizerParams <- function(object, ...) { + age_mat_vB.data.frame(object@species_params) +} + +#' @rdname age_mat_vB +#' @export +age_mat_vB.data.frame <- function(object, ...) { + sp <- object sp <- set_species_param_default(sp, "t0", 0) sp <- set_species_param_default(sp, "b", 3) sp <- set_species_param_default(sp, "k_vb", NA) sp <- set_species_param_default(sp, "w_inf", sp$w_max) - a_mat <- -log(1 - (sp$w_mat / sp$w_inf) ^ (1/sp$b)) / sp$k_vb + sp$t0 + a_mat <- -log(1 - (sp$w_mat / sp$w_inf)^(1 / sp$b)) / sp$k_vb + sp$t0 names(a_mat) <- sp$species a_mat } +#' @rdname age_mat_vB +#' @export +age_mat_vB.default <- function(object, ...) { + stop("The first argument must be either a MizerParams object or a species_params data frame.") +} + #' Calculate age at maturity #' #' Uses the growth rate and the size at maturity to calculate the age at @@ -51,8 +64,16 @@ age_mat_vB <- function(object) { #' @concept helper #' @examples #' age_mat(NS_params) -age_mat <- function(params) { - assert_that(is(params, "MizerParams")) +#' @rdname age_mat +#' @export +age_mat <- function(object, ...) { + UseMethod("age_mat") +} + +#' @rdname age_mat +#' @export +age_mat.MizerParams <- function(object, ...) { + params <- object sp <- params@species_params no_sp <- nrow(sp) diff --git a/man/age_mat.Rd b/man/age_mat.Rd index 2e65e6fa..b3e8778e 100644 --- a/man/age_mat.Rd +++ b/man/age_mat.Rd @@ -2,9 +2,12 @@ % Please edit documentation in R/age_mat.R \name{age_mat} \alias{age_mat} +\alias{age_mat.MizerParams} \title{Calculate age at maturity} \usage{ -age_mat(params) +age_mat(object, ...) + +\method{age_mat}{MizerParams}(object, ...) } \arguments{ \item{params}{A MizerParams object} diff --git a/man/age_mat_vB.Rd b/man/age_mat_vB.Rd index 3c027e6e..3bce68fb 100644 --- a/man/age_mat_vB.Rd +++ b/man/age_mat_vB.Rd @@ -2,9 +2,18 @@ % Please edit documentation in R/age_mat.R \name{age_mat_vB} \alias{age_mat_vB} +\alias{age_mat_vB.MizerParams} +\alias{age_mat_vB.data.frame} +\alias{age_mat_vB.default} \title{Calculate age at maturity from von Bertalanffy growth parameters} \usage{ -age_mat_vB(object) +age_mat_vB(object, ...) + +\method{age_mat_vB}{MizerParams}(object, ...) + +\method{age_mat_vB}{data.frame}(object, ...) + +\method{age_mat_vB}{default}(object, ...) } \arguments{ \item{object}{A MizerParams object or a species_params data frame} From 4666debd169d72d36f5ea997855a95b3c2109eda Mon Sep 17 00:00:00 2001 From: Gustav W Delius Date: Sat, 22 Nov 2025 09:25:55 +0000 Subject: [PATCH 03/16] Convert manipulate_species functions to S3 methods --- NAMESPACE | 8 +++++ R/manipulate_species.R | 68 +++++++++++++++++++++++++++++++++++++----- 2 files changed, 68 insertions(+), 8 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 96b5af2f..74d5226e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,6 +4,8 @@ S3method(age_mat,MizerParams) S3method(age_mat_vB,MizerParams) S3method(age_mat_vB,data.frame) S3method(age_mat_vB,default) +S3method(addSpecies,MizerParams) +S3method(addSpecies,default) S3method(plotBiomass,MizerSim) S3method(plotDiet,MizerParams) S3method(plotDiet,MizerSim) @@ -19,6 +21,12 @@ S3method(plotSpectra,MizerParams) S3method(plotSpectra,MizerSim) S3method(plotYield,MizerSim) S3method(plotYieldGear,MizerSim) +S3method(removeSpecies,MizerParams) +S3method(removeSpecies,default) +S3method(renameGear,MizerParams) +S3method(renameGear,default) +S3method(renameSpecies,MizerParams) +S3method(renameSpecies,default) export("catchability<-") export("diffusion<-") export("ext_encounter<-") diff --git a/R/manipulate_species.R b/R/manipulate_species.R index 2ebf23c1..757f29be 100644 --- a/R/manipulate_species.R +++ b/R/manipulate_species.R @@ -45,8 +45,6 @@ #' The new species will have a reproduction level of 1/4, this can then be #' changed with [setBevertonHolt()] #' -#' @seealso [removeSpecies()] -#' @export #' @examples #' params <- newTraitParams() #' species_params <- data.frame( @@ -61,9 +59,18 @@ #' ) #' params <- addSpecies(params, species_params) #' plotSpectra(params) -addSpecies <- function(params, species_params, - gear_params = data.frame(), initial_effort, - interaction) { +#' @seealso [removeSpecies()] +#' @export +#' @rdname addSpecies +addSpecies <- function(params, ...) { + UseMethod("addSpecies") +} + +#' @rdname addSpecies +#' @export +addSpecies.MizerParams <- function(params, species_params, + gear_params = data.frame(), initial_effort, + interaction) { # check validity of parameters ---- params <- validParams(params) given_species_params <- validGivenSpeciesParams(species_params) @@ -303,6 +310,12 @@ addSpecies <- function(params, species_params, return(p) } +#' @rdname addSpecies +#' @export +addSpecies.default <- function(params, ...) { + stop("The first argument to addSpecies() must be a MizerParams object.") +} + #' Remove species #' @@ -320,12 +333,19 @@ addSpecies <- function(params, species_params, #' #' @return An object of type \linkS4class{MizerParams} #' @export +#' @rdname removeSpecies #' @examples #' params <- NS_params #' species_params(params)$species #' params <- removeSpecies(params, c("Cod", "Haddock")) #' species_params(params)$species -removeSpecies <- function(params, species) { +removeSpecies <- function(params, ...) { + UseMethod("removeSpecies") +} + +#' @rdname removeSpecies +#' @export +removeSpecies.MizerParams <- function(params, species) { params <- validParams(params) species <- valid_species_arg(params, species, return.logical = TRUE) @@ -386,6 +406,12 @@ removeSpecies <- function(params, species) { return(p) } +#' @rdname removeSpecies +#' @export +removeSpecies.default <- function(params, ...) { + stop("The first argument to removeSpecies() must be a MizerParams object.") +} + #' Rename species #' @@ -401,11 +427,18 @@ removeSpecies <- function(params, species) { #' #' @return An object of type \linkS4class{MizerParams} #' @export +#' @rdname renameSpecies #' @examples #' replace <- c(Cod = "Kabeljau", Haddock = "Schellfisch") #' params <- renameSpecies(NS_params, replace) #' species_params(params)$species -renameSpecies <- function(params, replace) { +renameSpecies <- function(params, ...) { + UseMethod("renameSpecies") +} + +#' @rdname renameSpecies +#' @export +renameSpecies.MizerParams <- function(params, replace) { params <- validParams(params) replace[] <- as.character(replace) to_replace <- names(replace) @@ -471,6 +504,12 @@ renameSpecies <- function(params, replace) { return(params) } +#' @rdname renameSpecies +#' @export +renameSpecies.default <- function(params, ...) { + stop("The first argument to renameSpecies() must be a MizerParams object.") +} + #' Rename gears #' @@ -487,11 +526,18 @@ renameSpecies <- function(params, replace) { #' #' @return An object of type \linkS4class{MizerParams} #' @export +#' @rdname renameGear #' @examples #' replace <- c(Industrial = "Trawl", Otter = "Beam_Trawl") #' params <- renameGear(NS_params, replace) #' gear_params(params)$gear -renameGear <- function(params, replace) { +renameGear <- function(params, ...) { + UseMethod("renameGear") +} + +#' @rdname renameGear +#' @export +renameGear.MizerParams <- function(params, replace) { params <- validParams(params) replace[] <- as.character(replace) to_replace <- names(replace) @@ -531,3 +577,9 @@ renameGear <- function(params, replace) { params@time_modified <- lubridate::now() return(params) } + +#' @rdname renameGear +#' @export +renameGear.default <- function(params, ...) { + stop("The first argument to renameGear() must be a MizerParams object.") +} From e03cc75d6769a27df7bc07312ebe06aa64b64da7 Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Sat, 22 Nov 2025 09:28:28 +0000 Subject: [PATCH 04/16] Delete outdated snapshot --- tests/testthat/_snaps/age_mat.md | 10 ---------- 1 file changed, 10 deletions(-) delete mode 100644 tests/testthat/_snaps/age_mat.md diff --git a/tests/testthat/_snaps/age_mat.md b/tests/testthat/_snaps/age_mat.md deleted file mode 100644 index be26f234..00000000 --- a/tests/testthat/_snaps/age_mat.md +++ /dev/null @@ -1,10 +0,0 @@ -# age_mat works - - Code - age_mat(NS_params) - Output - Sprat Sandeel N.pout Herring Dab Whiting Sole Gurnard - 2.5560864 0.9832776 1.7962884 3.0382630 1.9612689 2.7122876 4.4940829 4.1384558 - Plaice Haddock Cod Saithe - 6.2608150 3.4391147 2.8583434 4.6315535 - From 7c59ce20855552c436c1d9f8e2f6c5a9bd42494f Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Sat, 22 Nov 2025 09:39:46 +0000 Subject: [PATCH 05/16] Document and add default method for `age_mat()` --- NAMESPACE | 5 +++-- R/age_mat.R | 11 ++++++++--- man/addSpecies.Rd | 8 +++++++- man/age_mat.Rd | 7 +++++-- man/removeSpecies.Rd | 8 +++++++- man/renameGear.Rd | 8 +++++++- man/renameSpecies.Rd | 8 +++++++- 7 files changed, 44 insertions(+), 11 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 74d5226e..ef9f30cb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,11 +1,12 @@ # Generated by roxygen2: do not edit by hand +S3method(addSpecies,MizerParams) +S3method(addSpecies,default) S3method(age_mat,MizerParams) +S3method(age_mat,default) S3method(age_mat_vB,MizerParams) S3method(age_mat_vB,data.frame) S3method(age_mat_vB,default) -S3method(addSpecies,MizerParams) -S3method(addSpecies,default) S3method(plotBiomass,MizerSim) S3method(plotDiet,MizerParams) S3method(plotDiet,MizerSim) diff --git a/R/age_mat.R b/R/age_mat.R index 17792bae..6d9bcf1b 100644 --- a/R/age_mat.R +++ b/R/age_mat.R @@ -66,14 +66,13 @@ age_mat_vB.default <- function(object, ...) { #' age_mat(NS_params) #' @rdname age_mat #' @export -age_mat <- function(object, ...) { +age_mat <- function(params, ...) { UseMethod("age_mat") } #' @rdname age_mat #' @export -age_mat.MizerParams <- function(object, ...) { - params <- object +age_mat.MizerParams <- function(params, ...) { sp <- params@species_params no_sp <- nrow(sp) @@ -87,3 +86,9 @@ age_mat.MizerParams <- function(object, ...) { a_mat } + +#' @rdname age_mat +#' @export +age_mat.default <- function(params, ...) { + stop("The first argument must be a MizerParams object.") +} diff --git a/man/addSpecies.Rd b/man/addSpecies.Rd index f1433eff..80ec2001 100644 --- a/man/addSpecies.Rd +++ b/man/addSpecies.Rd @@ -2,15 +2,21 @@ % Please edit documentation in R/manipulate_species.R \name{addSpecies} \alias{addSpecies} +\alias{addSpecies.MizerParams} +\alias{addSpecies.default} \title{Add new species} \usage{ -addSpecies( +addSpecies(params, ...) + +\method{addSpecies}{MizerParams}( params, species_params, gear_params = data.frame(), initial_effort, interaction ) + +\method{addSpecies}{default}(params, ...) } \arguments{ \item{params}{A mizer params object for the original system.} diff --git a/man/age_mat.Rd b/man/age_mat.Rd index b3e8778e..5be1b1c6 100644 --- a/man/age_mat.Rd +++ b/man/age_mat.Rd @@ -3,11 +3,14 @@ \name{age_mat} \alias{age_mat} \alias{age_mat.MizerParams} +\alias{age_mat.default} \title{Calculate age at maturity} \usage{ -age_mat(object, ...) +age_mat(params, ...) -\method{age_mat}{MizerParams}(object, ...) +\method{age_mat}{MizerParams}(params, ...) + +\method{age_mat}{default}(params, ...) } \arguments{ \item{params}{A MizerParams object} diff --git a/man/removeSpecies.Rd b/man/removeSpecies.Rd index 1d971537..d8d0933e 100644 --- a/man/removeSpecies.Rd +++ b/man/removeSpecies.Rd @@ -2,9 +2,15 @@ % Please edit documentation in R/manipulate_species.R \name{removeSpecies} \alias{removeSpecies} +\alias{removeSpecies.MizerParams} +\alias{removeSpecies.default} \title{Remove species} \usage{ -removeSpecies(params, species) +removeSpecies(params, ...) + +\method{removeSpecies}{MizerParams}(params, species) + +\method{removeSpecies}{default}(params, ...) } \arguments{ \item{params}{A mizer params object for the original system.} diff --git a/man/renameGear.Rd b/man/renameGear.Rd index a798021f..5ac9324e 100644 --- a/man/renameGear.Rd +++ b/man/renameGear.Rd @@ -2,9 +2,15 @@ % Please edit documentation in R/manipulate_species.R \name{renameGear} \alias{renameGear} +\alias{renameGear.MizerParams} +\alias{renameGear.default} \title{Rename gears} \usage{ -renameGear(params, replace) +renameGear(params, ...) + +\method{renameGear}{MizerParams}(params, replace) + +\method{renameGear}{default}(params, ...) } \arguments{ \item{params}{A mizer params object} diff --git a/man/renameSpecies.Rd b/man/renameSpecies.Rd index 8d7b9c08..23e8fb99 100644 --- a/man/renameSpecies.Rd +++ b/man/renameSpecies.Rd @@ -2,9 +2,15 @@ % Please edit documentation in R/manipulate_species.R \name{renameSpecies} \alias{renameSpecies} +\alias{renameSpecies.MizerParams} +\alias{renameSpecies.default} \title{Rename species} \usage{ -renameSpecies(params, replace) +renameSpecies(params, ...) + +\method{renameSpecies}{MizerParams}(params, replace) + +\method{renameSpecies}{default}(params, ...) } \arguments{ \item{params}{A mizer params object} From faf157654088a8945e1d7b06d344e654e6f0819f Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Sat, 22 Nov 2025 10:16:03 +0000 Subject: [PATCH 06/16] Convert `project()` and `project_simple()` to S3 --- R/project.R | 54 ++++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 45 insertions(+), 9 deletions(-) diff --git a/R/project.R b/R/project.R index dcbfdb50..35727371 100644 --- a/R/project.R +++ b/R/project.R @@ -130,19 +130,28 @@ NULL #' # Control save times with an effort array using t_save #' sim <- project(params, effort = effort_array, t_save = 2) #' } +#' @rdname project +#' @export project <- function(object, effort, t_max = 100, dt = 0.1, t_save = 1, t_start = 0, initial_n, initial_n_pp, append = TRUE, progress_bar = TRUE, ...) { + UseMethod("project") +} + +#' @rdname project +#' @export +project.MizerParams <- function(object, effort, + t_max = 100, dt = 0.1, t_save = 1, t_start = 0, + initial_n, initial_n_pp, + append = TRUE, + progress_bar = TRUE, ...) { + params <- object # Set and check initial values ---- assert_that(t_max > 0) - if (is(object, "MizerSim")) { - validObject(object) - params <- setInitialValues(object@params, object) - t_start <- getTimes(object)[idxFinalT(object)] - } else if (is(object, "MizerParams")) { - params <- validParams(object) + if (is(params, "MizerParams")) { + params <- validParams(params) if (!missing(initial_n)) params@initial_n[] <- initial_n if (!missing(initial_n_pp)) params@initial_n_pp[] <- initial_n_pp } else { @@ -331,8 +340,29 @@ project <- function(object, effort, sim@n_other[i, ] <- unserialize(serialize(n_list$n_other, NULL)) } - # append to previous simulation ---- - if (is(object, "MizerSim") && append) { + return(sim) +} + +#' @rdname project +#' @export +project.MizerSim <- function(object, effort, + t_max = 100, dt = 0.1, t_save = 1, t_start = 0, + initial_n, initial_n_pp, + append = TRUE, + progress_bar = TRUE, ...) { + validObject(object) + params <- setInitialValues(object@params, object) + t_start <- getTimes(object)[idxFinalT(object)] + + sim <- project(params, + effort = effort, t_max = t_max, dt = dt, + t_save = t_save, t_start = t_start, + initial_n = initial_n, initial_n_pp = initial_n_pp, + progress_bar = progress_bar, ... + ) + + if (append) { + times <- as.numeric(dimnames(sim@n)[[1]]) no_t_old <- dim(object@n)[1] no_t <- length(times) new_t_dimnames <- c( @@ -408,7 +438,13 @@ project <- function(object, effort, #' #' @export #' @concept helper -project_simple <- +project_simple <- function(params, n, n_pp, n_other, effort, t, dt, steps, ...) { + UseMethod("project_simple") +} + +#' @rdname project_simple +#' @export +project_simple.MizerParams <- function(params, n = params@initial_n, n_pp = params@initial_n_pp, From a37d841d5522fe7963856d1fe4d1a24fac3a3b13 Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Sat, 22 Nov 2025 10:55:25 +0000 Subject: [PATCH 07/16] Updated man pages --- NAMESPACE | 8 +++----- R/age_mat.R | 12 ++++-------- R/manipulate_species.R | 43 ++++++++++-------------------------------- R/project.R | 5 +++-- man/addSpecies.Rd | 13 +++++-------- man/age_mat.Rd | 8 ++------ man/age_mat_vB.Rd | 2 ++ man/project.Rd | 30 +++++++++++++++++++++++++++++ man/project_simple.Rd | 18 +++++++++--------- man/removeSpecies.Rd | 10 +++------- man/renameGear.Rd | 10 +++------- man/renameSpecies.Rd | 10 +++------- man/validParams.Rd | 3 +++ 13 files changed, 80 insertions(+), 92 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index ef9f30cb..175ec878 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,9 +1,7 @@ # Generated by roxygen2: do not edit by hand S3method(addSpecies,MizerParams) -S3method(addSpecies,default) S3method(age_mat,MizerParams) -S3method(age_mat,default) S3method(age_mat_vB,MizerParams) S3method(age_mat_vB,data.frame) S3method(age_mat_vB,default) @@ -22,12 +20,12 @@ S3method(plotSpectra,MizerParams) S3method(plotSpectra,MizerSim) S3method(plotYield,MizerSim) S3method(plotYieldGear,MizerSim) +S3method(project,MizerParams) +S3method(project,MizerSim) +S3method(project_simple,MizerParams) S3method(removeSpecies,MizerParams) -S3method(removeSpecies,default) S3method(renameGear,MizerParams) -S3method(renameGear,default) S3method(renameSpecies,MizerParams) -S3method(renameSpecies,default) export("catchability<-") export("diffusion<-") export("ext_encounter<-") diff --git a/R/age_mat.R b/R/age_mat.R index 6d9bcf1b..4cad44eb 100644 --- a/R/age_mat.R +++ b/R/age_mat.R @@ -14,11 +14,12 @@ #' missing. If `w_inf` is missing, `w_max` is used instead. #' #' @param object A MizerParams object or a species_params data frame +#' @param ... Additional arguments +#' #' @return A named vector. The names are the species names and the values are #' the ages at maturity. #' @export #' @rdname age_mat_vB -#' @export age_mat_vB <- function(object, ...) { UseMethod("age_mat_vB") } @@ -58,6 +59,8 @@ age_mat_vB.default <- function(object, ...) { #' \deqn{\mathrm{age_{mat}} = \int_0^{w_{mat}.}\frac{dw}{g(w)}}{age_mat = \int_0^w_mat 1/g(w) dw.} #' #' @param params A MizerParams object +#' @param ... Additional arguments +#' #' @return A named vector. The names are the species names and the values are #' the ages at maturity. #' @export @@ -70,7 +73,6 @@ age_mat <- function(params, ...) { UseMethod("age_mat") } -#' @rdname age_mat #' @export age_mat.MizerParams <- function(params, ...) { sp <- params@species_params @@ -86,9 +88,3 @@ age_mat.MizerParams <- function(params, ...) { a_mat } - -#' @rdname age_mat -#' @export -age_mat.default <- function(params, ...) { - stop("The first argument must be a MizerParams object.") -} diff --git a/R/manipulate_species.R b/R/manipulate_species.R index 757f29be..eb89c2a5 100644 --- a/R/manipulate_species.R +++ b/R/manipulate_species.R @@ -26,6 +26,7 @@ #' fished by already existing gear. Should not include effort values #' for existing gear. New gear for which no effort is set via this #' vector will have an initial effort of 0. +#' @param ... Additional arguments #' #' @return An object of type \linkS4class{MizerParams} #' @@ -62,11 +63,12 @@ #' @seealso [removeSpecies()] #' @export #' @rdname addSpecies -addSpecies <- function(params, ...) { +addSpecies <- function(params, species_params, + gear_params = data.frame(), initial_effort, + interaction, ...) { UseMethod("addSpecies") } -#' @rdname addSpecies #' @export addSpecies.MizerParams <- function(params, species_params, gear_params = data.frame(), initial_effort, @@ -310,12 +312,6 @@ addSpecies.MizerParams <- function(params, species_params, return(p) } -#' @rdname addSpecies -#' @export -addSpecies.default <- function(params, ...) { - stop("The first argument to addSpecies() must be a MizerParams object.") -} - #' Remove species #' @@ -330,6 +326,7 @@ addSpecies.default <- function(params, ...) { #' @param species The species to be removed. A vector of species names, or a #' numeric vector of species indices, or a logical vector indicating for #' each species whether it is to be removed (TRUE) or not. +#' @param ... Additional arguments #' #' @return An object of type \linkS4class{MizerParams} #' @export @@ -339,11 +336,10 @@ addSpecies.default <- function(params, ...) { #' species_params(params)$species #' params <- removeSpecies(params, c("Cod", "Haddock")) #' species_params(params)$species -removeSpecies <- function(params, ...) { +removeSpecies <- function(params, species, ...) { UseMethod("removeSpecies") } -#' @rdname removeSpecies #' @export removeSpecies.MizerParams <- function(params, species) { params <- validParams(params) @@ -406,12 +402,6 @@ removeSpecies.MizerParams <- function(params, species) { return(p) } -#' @rdname removeSpecies -#' @export -removeSpecies.default <- function(params, ...) { - stop("The first argument to removeSpecies() must be a MizerParams object.") -} - #' Rename species #' @@ -424,6 +414,7 @@ removeSpecies.default <- function(params, ...) { #' @param params A mizer params object #' @param replace A named character vector, with new names as values, and old #' names as names. +#' @param ... Additional arguments #' #' @return An object of type \linkS4class{MizerParams} #' @export @@ -432,11 +423,10 @@ removeSpecies.default <- function(params, ...) { #' replace <- c(Cod = "Kabeljau", Haddock = "Schellfisch") #' params <- renameSpecies(NS_params, replace) #' species_params(params)$species -renameSpecies <- function(params, ...) { +renameSpecies <- function(params, replace, ...) { UseMethod("renameSpecies") } -#' @rdname renameSpecies #' @export renameSpecies.MizerParams <- function(params, replace) { params <- validParams(params) @@ -504,13 +494,6 @@ renameSpecies.MizerParams <- function(params, replace) { return(params) } -#' @rdname renameSpecies -#' @export -renameSpecies.default <- function(params, ...) { - stop("The first argument to renameSpecies() must be a MizerParams object.") -} - - #' Rename gears #' #' @description @@ -523,6 +506,7 @@ renameSpecies.default <- function(params, ...) { #' @param params A mizer params object #' @param replace A named character vector, with new names as values, and old #' names as names. +#' @param ... Additional arguments #' #' @return An object of type \linkS4class{MizerParams} #' @export @@ -531,11 +515,10 @@ renameSpecies.default <- function(params, ...) { #' replace <- c(Industrial = "Trawl", Otter = "Beam_Trawl") #' params <- renameGear(NS_params, replace) #' gear_params(params)$gear -renameGear <- function(params, ...) { +renameGear <- function(params, replace, ...) { UseMethod("renameGear") } -#' @rdname renameGear #' @export renameGear.MizerParams <- function(params, replace) { params <- validParams(params) @@ -577,9 +560,3 @@ renameGear.MizerParams <- function(params, replace) { params@time_modified <- lubridate::now() return(params) } - -#' @rdname renameGear -#' @export -renameGear.default <- function(params, ...) { - stop("The first argument to renameGear() must be a MizerParams object.") -} diff --git a/R/project.R b/R/project.R index 35727371..b70e844e 100644 --- a/R/project.R +++ b/R/project.R @@ -438,11 +438,12 @@ project.MizerSim <- function(object, effort, #' #' @export #' @concept helper -project_simple <- function(params, n, n_pp, n_other, effort, t, dt, steps, ...) { +project_simple <- function(params, n, n_pp, n_other, effort, t, dt, steps, + resource_dynamics_fn, other_dynamics_fns, + rates_fns, ...) { UseMethod("project_simple") } -#' @rdname project_simple #' @export project_simple.MizerParams <- function(params, diff --git a/man/addSpecies.Rd b/man/addSpecies.Rd index 80ec2001..20964d06 100644 --- a/man/addSpecies.Rd +++ b/man/addSpecies.Rd @@ -2,21 +2,16 @@ % Please edit documentation in R/manipulate_species.R \name{addSpecies} \alias{addSpecies} -\alias{addSpecies.MizerParams} -\alias{addSpecies.default} \title{Add new species} \usage{ -addSpecies(params, ...) - -\method{addSpecies}{MizerParams}( +addSpecies( params, species_params, gear_params = data.frame(), initial_effort, - interaction + interaction, + ... ) - -\method{addSpecies}{default}(params, ...) } \arguments{ \item{params}{A mizer params object for the original system.} @@ -38,6 +33,8 @@ interaction coefficients between all species or only those between the new species. In the latter case all interaction between an old and a new species are set to 1. If this argument is missing, all interactions involving a new species are set to 1.} + +\item{...}{Additional arguments} } \value{ An object of type \linkS4class{MizerParams} diff --git a/man/age_mat.Rd b/man/age_mat.Rd index 5be1b1c6..39c1eba7 100644 --- a/man/age_mat.Rd +++ b/man/age_mat.Rd @@ -2,18 +2,14 @@ % Please edit documentation in R/age_mat.R \name{age_mat} \alias{age_mat} -\alias{age_mat.MizerParams} -\alias{age_mat.default} \title{Calculate age at maturity} \usage{ age_mat(params, ...) - -\method{age_mat}{MizerParams}(params, ...) - -\method{age_mat}{default}(params, ...) } \arguments{ \item{params}{A MizerParams object} + +\item{...}{Additional arguments} } \value{ A named vector. The names are the species names and the values are diff --git a/man/age_mat_vB.Rd b/man/age_mat_vB.Rd index 3bce68fb..e5c9195e 100644 --- a/man/age_mat_vB.Rd +++ b/man/age_mat_vB.Rd @@ -17,6 +17,8 @@ age_mat_vB(object, ...) } \arguments{ \item{object}{A MizerParams object or a species_params data frame} + +\item{...}{Additional arguments} } \value{ A named vector. The names are the species names and the values are diff --git a/man/project.Rd b/man/project.Rd index 6555c460..c6d4ae3d 100644 --- a/man/project.Rd +++ b/man/project.Rd @@ -2,6 +2,8 @@ % Please edit documentation in R/project.R \name{project} \alias{project} +\alias{project.MizerParams} +\alias{project.MizerSim} \title{Project size spectrum forward in time} \usage{ project( @@ -17,6 +19,34 @@ project( progress_bar = TRUE, ... ) + +\method{project}{MizerParams}( + object, + effort, + t_max = 100, + dt = 0.1, + t_save = 1, + t_start = 0, + initial_n, + initial_n_pp, + append = TRUE, + progress_bar = TRUE, + ... +) + +\method{project}{MizerSim}( + object, + effort, + t_max = 100, + dt = 0.1, + t_save = 1, + t_start = 0, + initial_n, + initial_n_pp, + append = TRUE, + progress_bar = TRUE, + ... +) } \arguments{ \item{object}{Either a \linkS4class{MizerParams} object or a diff --git a/man/project_simple.Rd b/man/project_simple.Rd index e209edfb..60528362 100644 --- a/man/project_simple.Rd +++ b/man/project_simple.Rd @@ -6,16 +6,16 @@ \usage{ project_simple( params, - n = params@initial_n, - n_pp = params@initial_n_pp, - n_other = params@initial_n_other, - effort = params@initial_effort, - t = 0, - dt = 0.1, + n, + n_pp, + n_other, + effort, + t, + dt, steps, - resource_dynamics_fn = get(params@resource_dynamics), - other_dynamics_fns = lapply(params@other_dynamics, get), - rates_fns = lapply(params@rates_funcs, get), + resource_dynamics_fn, + other_dynamics_fns, + rates_fns, ... ) } diff --git a/man/removeSpecies.Rd b/man/removeSpecies.Rd index d8d0933e..d191ed02 100644 --- a/man/removeSpecies.Rd +++ b/man/removeSpecies.Rd @@ -2,15 +2,9 @@ % Please edit documentation in R/manipulate_species.R \name{removeSpecies} \alias{removeSpecies} -\alias{removeSpecies.MizerParams} -\alias{removeSpecies.default} \title{Remove species} \usage{ -removeSpecies(params, ...) - -\method{removeSpecies}{MizerParams}(params, species) - -\method{removeSpecies}{default}(params, ...) +removeSpecies(params, species, ...) } \arguments{ \item{params}{A mizer params object for the original system.} @@ -18,6 +12,8 @@ removeSpecies(params, ...) \item{species}{The species to be removed. A vector of species names, or a numeric vector of species indices, or a logical vector indicating for each species whether it is to be removed (TRUE) or not.} + +\item{...}{Additional arguments} } \value{ An object of type \linkS4class{MizerParams} diff --git a/man/renameGear.Rd b/man/renameGear.Rd index 5ac9324e..2302556f 100644 --- a/man/renameGear.Rd +++ b/man/renameGear.Rd @@ -2,21 +2,17 @@ % Please edit documentation in R/manipulate_species.R \name{renameGear} \alias{renameGear} -\alias{renameGear.MizerParams} -\alias{renameGear.default} \title{Rename gears} \usage{ -renameGear(params, ...) - -\method{renameGear}{MizerParams}(params, replace) - -\method{renameGear}{default}(params, ...) +renameGear(params, replace, ...) } \arguments{ \item{params}{A mizer params object} \item{replace}{A named character vector, with new names as values, and old names as names.} + +\item{...}{Additional arguments} } \value{ An object of type \linkS4class{MizerParams} diff --git a/man/renameSpecies.Rd b/man/renameSpecies.Rd index 23e8fb99..cea3dce9 100644 --- a/man/renameSpecies.Rd +++ b/man/renameSpecies.Rd @@ -2,21 +2,17 @@ % Please edit documentation in R/manipulate_species.R \name{renameSpecies} \alias{renameSpecies} -\alias{renameSpecies.MizerParams} -\alias{renameSpecies.default} \title{Rename species} \usage{ -renameSpecies(params, ...) - -\method{renameSpecies}{MizerParams}(params, replace) - -\method{renameSpecies}{default}(params, ...) +renameSpecies(params, replace, ...) } \arguments{ \item{params}{A mizer params object} \item{replace}{A named character vector, with new names as values, and old names as names.} + +\item{...}{Additional arguments} } \value{ An object of type \linkS4class{MizerParams} diff --git a/man/validParams.Rd b/man/validParams.Rd index 2f121ba8..98e57679 100644 --- a/man/validParams.Rd +++ b/man/validParams.Rd @@ -8,6 +8,9 @@ validParams(params, info_level = 3) } \arguments{ \item{params}{The MizerParams object to validate} + +\item{info_level}{Controls the amount of information messages and warnings +that are shown. Higher levels lead to more messages.} } \value{ A valid MizerParams object From 2f32a245c65403c6fd77b0dcbc81924bb4c7130e Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Sat, 22 Nov 2025 12:49:14 +0000 Subject: [PATCH 08/16] Converted more functions into methods --- NAMESPACE | 10 ++++++++++ R/animateSpectra.R | 7 ++++++- R/calibrate.R | 24 ++++++++++++++++++++---- R/compareParams.R | 6 +++++- R/match.R | 18 +++++++++++++++--- R/matchGrowth.R | 6 +++++- man/animateSpectra.Rd | 11 +---------- man/calibrateBiomass.Rd | 2 +- man/calibrateNumber.Rd | 2 +- man/calibrateYield.Rd | 2 +- man/compareParams.Rd | 2 +- man/matchBiomasses.Rd | 2 +- man/matchGrowth.Rd | 2 +- man/matchNumbers.Rd | 2 +- man/matchYields.Rd | 2 +- man/scaleModel.Rd | 2 +- 16 files changed, 71 insertions(+), 29 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 175ec878..7d96b42f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,6 +5,15 @@ S3method(age_mat,MizerParams) S3method(age_mat_vB,MizerParams) S3method(age_mat_vB,data.frame) S3method(age_mat_vB,default) +S3method(animateSpectra,MizerSim) +S3method(calibrateBiomass,MizerParams) +S3method(calibrateNumber,MizerParams) +S3method(calibrateYield,MizerParams) +S3method(compareParams,MizerParams) +S3method(matchBiomasses,MizerParams) +S3method(matchGrowth,MizerParams) +S3method(matchNumbers,MizerParams) +S3method(matchYields,MizerParams) S3method(plotBiomass,MizerSim) S3method(plotDiet,MizerParams) S3method(plotDiet,MizerSim) @@ -26,6 +35,7 @@ S3method(project_simple,MizerParams) S3method(removeSpecies,MizerParams) S3method(renameGear,MizerParams) S3method(renameSpecies,MizerParams) +S3method(scaleModel,MizerParams) export("catchability<-") export("diffusion<-") export("ext_encounter<-") diff --git a/R/animateSpectra.R b/R/animateSpectra.R index 189479cf..d72dd0f4 100644 --- a/R/animateSpectra.R +++ b/R/animateSpectra.R @@ -29,7 +29,11 @@ #' \donttest{ #' animateSpectra(NS_sim, power = 2, wlim = c(0.1, NA), time_range = 1997:2007) #' } -animateSpectra <- function(sim, +animateSpectra <- function(sim, ...) + UseMethod("animateSpectra") + +#' @export +animateSpectra.MizerSim <- function(sim, species = NULL, time_range, wlim = c(NA, NA), @@ -120,3 +124,4 @@ animateSpectra <- function(sim, title = y_label), legend = list(traceorder = "normal")) } + diff --git a/R/calibrate.R b/R/calibrate.R index 339b2ffa..96c85709 100644 --- a/R/calibrate.R +++ b/R/calibrate.R @@ -32,7 +32,11 @@ #' species_params(params)$biomass_cutoff <- 10 #' params2 <- calibrateBiomass(params) #' plotBiomassObservedVsModel(params2) -calibrateBiomass <- function(params) { +calibrateBiomass <- function(params, ...) + UseMethod("calibrateBiomass") + +#' @export +calibrateBiomass.MizerParams <- function(params) { if ((!("biomass_observed" %in% names(params@species_params))) || all(is.na(params@species_params$biomass_observed))) { return(params) @@ -92,7 +96,11 @@ calibrateBiomass <- function(params) { #' c(0.8, 61, 12, 35, 1.6, 20, 10, 7.6, 135, 60, 30, 78) #' species_params(params)$number_cutoff <- 10 #' params2 <- calibrateNumber(params) -calibrateNumber <- function(params) { +calibrateNumber <- function(params, ...) + UseMethod("calibrateNumber") + +#' @export +calibrateNumber.MizerParams <- function(params) { if ((!("number_observed" %in% names(params@species_params))) || all(is.na(params@species_params$number_observed))) { return(params) @@ -151,7 +159,11 @@ calibrateNumber <- function(params) { #' c(1.3, 0.065, 0.31, 0.18, 0.98, 0.24, 0.37, 0.46, 0.18, 0.30, 0.27, 0.39) #' params2 <- calibrateYield(params) #' plotYieldObservedVsModel(params2) -calibrateYield <- function(params) { +calibrateYield <- function(params, ...) + UseMethod("calibrateYield") + +#' @export +calibrateYield.MizerParams <- function(params) { lifecycle::deprecate_warn( "2.6.0", "calibrateYield()", details = "This function has not proven useful. If you do have a use case for it, please let the developers know by creating an issue at https://github.com/sizespectrum/mizer/issues" @@ -209,7 +221,11 @@ calibrateYield <- function(params) { #' #' @return The rescaled MizerParams object #' @export -scaleModel <- function(params, factor) { +scaleModel <- function(params, ...) + UseMethod("scaleModel") + +#' @export +scaleModel.MizerParams <- function(params, factor) { params <- validParams(params) assert_that(is.number(factor), factor > 0) diff --git a/R/compareParams.R b/R/compareParams.R index 4f5e6872..176b09ae 100644 --- a/R/compareParams.R +++ b/R/compareParams.R @@ -11,7 +11,11 @@ #' params2 <- params1 #' species_params(params2)$w_mat[1] <- 10 #' compareParams(params1, params2) -compareParams <- function(params1, params2) { +compareParams <- function(params1, ...) + UseMethod("compareParams") + +#' @export +compareParams.MizerParams <- function(params1, params2) { params1 <- validParams(params1) params2 <- validParams(params2) diff --git a/R/match.R b/R/match.R index b1953fe5..e7b15431 100644 --- a/R/match.R +++ b/R/match.R @@ -37,7 +37,11 @@ #' params <- calibrateBiomass(params) #' params <- matchBiomasses(params) #' plotBiomassObservedVsModel(params) -matchBiomasses <- function(params, species = NULL) { +matchBiomasses <- function(params, ...) + UseMethod("matchBiomasses") + +#' @export +matchBiomasses.MizerParams <- function(params, species = NULL) { if (!("biomass_observed" %in% names(params@species_params))) { return(params) } @@ -112,7 +116,11 @@ matchBiomasses <- function(params, species = NULL) { #' species_params(params)$number_cutoff <- 10 #' params <- calibrateNumber(params) #' params <- matchNumbers(params) -matchNumbers <- function(params, species = NULL) { +matchNumbers <- function(params, ...) + UseMethod("matchNumbers") + +#' @export +matchNumbers.MizerParams <- function(params, species = NULL) { if (!("number_observed" %in% names(params@species_params))) { return(params) } @@ -194,7 +202,11 @@ matchNumbers <- function(params, species = NULL) { #' params <- calibrateYield(params) #' params <- matchYields(params) #' plotYieldObservedVsModel(params) -matchYields <- function(params, species = NULL) { +matchYields <- function(params, ...) + UseMethod("matchYields") + +#' @export +matchYields.MizerParams <- function(params, species = NULL) { lifecycle::deprecate_warn( "2.6.0", "matchYields()", "mizerExperimental::matchYield()", details = "This function has not proven useful. If you do have a use case for it, please let the developers know by creating an issue at https://github.com/sizespectrum/mizer/issues" diff --git a/R/matchGrowth.R b/R/matchGrowth.R index cb9ab541..c77e84fc 100644 --- a/R/matchGrowth.R +++ b/R/matchGrowth.R @@ -27,7 +27,11 @@ #' consumption rate and metabolic rate and rescaled species parameters #' `gamma`,`h`, `ks` and `k`. #' @export -matchGrowth <- function(params, species = NULL, +matchGrowth <- function(params, ...) + UseMethod("matchGrowth") + +#' @export +matchGrowth.MizerParams <- function(params, species = NULL, keep = c("egg", "biomass", "number")) { assert_that(is(params, "MizerParams")) sel <- valid_species_arg(params, species = species, diff --git a/man/animateSpectra.Rd b/man/animateSpectra.Rd index 4c34af18..40af912a 100644 --- a/man/animateSpectra.Rd +++ b/man/animateSpectra.Rd @@ -4,16 +4,7 @@ \alias{animateSpectra} \title{Animation of the abundance spectra} \usage{ -animateSpectra( - sim, - species = NULL, - time_range, - wlim = c(NA, NA), - ylim = c(NA, NA), - power = 1, - total = FALSE, - resource = TRUE -) +animateSpectra(sim, ...) } \arguments{ \item{sim}{A MizerSim object} diff --git a/man/calibrateBiomass.Rd b/man/calibrateBiomass.Rd index eeff544c..cf0f7d1b 100644 --- a/man/calibrateBiomass.Rd +++ b/man/calibrateBiomass.Rd @@ -4,7 +4,7 @@ \alias{calibrateBiomass} \title{Calibrate the model scale to match total observed biomass} \usage{ -calibrateBiomass(params) +calibrateBiomass(params, ...) } \arguments{ \item{params}{A MizerParams object} diff --git a/man/calibrateNumber.Rd b/man/calibrateNumber.Rd index e390d021..928fa366 100644 --- a/man/calibrateNumber.Rd +++ b/man/calibrateNumber.Rd @@ -4,7 +4,7 @@ \alias{calibrateNumber} \title{Calibrate the model scale to match total observed number} \usage{ -calibrateNumber(params) +calibrateNumber(params, ...) } \arguments{ \item{params}{A MizerParams object} diff --git a/man/calibrateYield.Rd b/man/calibrateYield.Rd index 749efbf1..50011d40 100644 --- a/man/calibrateYield.Rd +++ b/man/calibrateYield.Rd @@ -4,7 +4,7 @@ \alias{calibrateYield} \title{Calibrate the model scale to match total observed yield} \usage{ -calibrateYield(params) +calibrateYield(params, ...) } \arguments{ \item{params}{A MizerParams object} diff --git a/man/compareParams.Rd b/man/compareParams.Rd index 8f6c3c94..99f9c244 100644 --- a/man/compareParams.Rd +++ b/man/compareParams.Rd @@ -4,7 +4,7 @@ \alias{compareParams} \title{Compare two MizerParams objects and print out differences} \usage{ -compareParams(params1, params2) +compareParams(params1, ...) } \arguments{ \item{params1}{First MizerParams object} diff --git a/man/matchBiomasses.Rd b/man/matchBiomasses.Rd index 20747393..16e557ab 100644 --- a/man/matchBiomasses.Rd +++ b/man/matchBiomasses.Rd @@ -4,7 +4,7 @@ \alias{matchBiomasses} \title{Match biomasses to observations} \usage{ -matchBiomasses(params, species = NULL) +matchBiomasses(params, ...) } \arguments{ \item{params}{A MizerParams object} diff --git a/man/matchGrowth.Rd b/man/matchGrowth.Rd index 25ed8335..4de50cbf 100644 --- a/man/matchGrowth.Rd +++ b/man/matchGrowth.Rd @@ -4,7 +4,7 @@ \alias{matchGrowth} \title{Adjust model to produce observed growth} \usage{ -matchGrowth(params, species = NULL, keep = c("egg", "biomass", "number")) +matchGrowth(params, ...) } \arguments{ \item{params}{A MizerParams object} diff --git a/man/matchNumbers.Rd b/man/matchNumbers.Rd index 7d390530..e3826b15 100644 --- a/man/matchNumbers.Rd +++ b/man/matchNumbers.Rd @@ -4,7 +4,7 @@ \alias{matchNumbers} \title{Match numbers to observations} \usage{ -matchNumbers(params, species = NULL) +matchNumbers(params, ...) } \arguments{ \item{params}{A MizerParams object} diff --git a/man/matchYields.Rd b/man/matchYields.Rd index 73214504..49b57645 100644 --- a/man/matchYields.Rd +++ b/man/matchYields.Rd @@ -4,7 +4,7 @@ \alias{matchYields} \title{Match yields to observations} \usage{ -matchYields(params, species = NULL) +matchYields(params, ...) } \arguments{ \item{params}{A MizerParams object} diff --git a/man/scaleModel.Rd b/man/scaleModel.Rd index 3e56a4be..7fd9aa06 100644 --- a/man/scaleModel.Rd +++ b/man/scaleModel.Rd @@ -4,7 +4,7 @@ \alias{scaleModel} \title{Change scale of the model} \usage{ -scaleModel(params, factor) +scaleModel(params, ...) } \arguments{ \item{params}{A MizerParams object} From 1b519d5c30ba1288116d6b998e895ace1be94536 Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Sat, 22 Nov 2025 14:44:53 +0000 Subject: [PATCH 09/16] Convert setter functions into methods --- DESCRIPTION | 2 +- NAMESPACE | 67 ++++++++++++++++++++ R/animateSpectra.R | 17 +++-- R/calibrate.R | 2 +- R/compareParams.R | 2 +- R/match.R | 6 +- R/matchGrowth.R | 5 +- R/newMultispeciesParams.R | 107 +++++++++++++++---------------- R/setBevertonHolt.R | 17 ++++- R/setColours.R | 16 +++++ R/setDiffusion.R | 21 ++++++- R/setExtEncounter.R | 16 +++++ R/setExtMort.R | 19 +++++- R/setFishing.R | 49 +++++++++++++++ R/setInitialValues.R | 55 +++++++++++----- R/setInteraction.R | 20 +++++- R/setMaxIntakeRate.R | 16 +++++ R/setMetabolicRate.R | 50 ++++++++++----- R/setMetadata.R | 13 +++- R/setPredKernel.R | 18 +++++- R/setReproduction.R | 7 ++- R/setResource.R | 121 +++++++++++++++++++++++------------- R/setSearchVolume.R | 16 +++++ man/animateSpectra.Rd | 12 +++- man/compareParams.Rd | 2 +- man/initialN-set.Rd | 6 ++ man/initialNResource-set.Rd | 6 ++ man/matchBiomasses.Rd | 2 +- man/matchGrowth.Rd | 2 +- man/matchNumbers.Rd | 2 +- man/matchYields.Rd | 2 +- man/scaleModel.Rd | 2 +- man/setBevertonHolt.Rd | 14 ++--- man/setDiffusion.Rd | 12 +++- man/setExtMort.Rd | 7 +-- man/setInitialValues.Rd | 2 +- man/setInteraction.Rd | 2 +- man/setMetadata.Rd | 10 ++- man/setParams.Rd | 7 ++- man/setResource.Rd | 24 ++++--- man/setRmax.Rd | 5 +- 41 files changed, 581 insertions(+), 200 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index bd3bfda7..50d0884d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -19,7 +19,7 @@ Authors@R: c(person("Gustav", "Delius", email="gustav.delius@york.ac.uk", comment = c(ORCID = "0000-0002-8478-3430")), person("Richard", "Southwell", email="richard.southwell@york.ac.uk", role=c("ctb", "cph"))) -Version: 2.5.4.9001 +Version: 2.5.4.9011 License: GPL-3 Imports: assertthat, diff --git a/NAMESPACE b/NAMESPACE index 7d96b42f..0c034cfe 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,22 @@ # Generated by roxygen2: do not edit by hand +S3method("catchability<-",MizerParams) +S3method("diffusion<-",MizerParams) +S3method("ext_encounter<-",MizerParams) +S3method("ext_mort<-",MizerParams) +S3method("gear_params<-",MizerParams) +S3method("initialN<-",MizerParams) +S3method("initialNResource<-",MizerParams) +S3method("initial_effort<-",MizerParams) +S3method("intake_max<-",MizerParams) +S3method("interaction_matrix<-",MizerParams) +S3method("metab<-",MizerParams) +S3method("pred_kernel<-",MizerParams) +S3method("resource_capacity<-",MizerParams) +S3method("resource_dynamics<-",MizerParams) +S3method("resource_rate<-",MizerParams) +S3method("search_vol<-",MizerParams) +S3method("selectivity<-",MizerParams) S3method(addSpecies,MizerParams) S3method(age_mat,MizerParams) S3method(age_mat_vB,MizerParams) @@ -9,11 +26,39 @@ S3method(animateSpectra,MizerSim) S3method(calibrateBiomass,MizerParams) S3method(calibrateNumber,MizerParams) S3method(calibrateYield,MizerParams) +S3method(catchability,MizerParams) S3method(compareParams,MizerParams) +S3method(diffusion,MizerParams) +S3method(ext_encounter,MizerParams) +S3method(ext_mort,MizerParams) +S3method(gear_params,MizerParams) +S3method(getCatchability,MizerParams) +S3method(getColours,MizerParams) +S3method(getExtEncounter,MizerParams) +S3method(getExtMort,MizerParams) +S3method(getInitialEffort,MizerParams) +S3method(getInteraction,MizerParams) +S3method(getLinetypes,MizerParams) +S3method(getMaxIntakeRate,MizerParams) +S3method(getMetabolicRate,MizerParams) +S3method(getMetadata,MizerParams) +S3method(getPredKernel,MizerParams) +S3method(getReproductionLevel,MizerParams) +S3method(getRequiredRDD,MizerParams) +S3method(getSearchVolume,MizerParams) +S3method(getSelectivity,MizerParams) +S3method(initialN,MizerParams) +S3method(initialN,MizerSim) +S3method(initialNResource,MizerParams) +S3method(initialNResource,MizerSim) +S3method(initial_effort,MizerParams) +S3method(intake_max,MizerParams) +S3method(interaction_matrix,MizerParams) S3method(matchBiomasses,MizerParams) S3method(matchGrowth,MizerParams) S3method(matchNumbers,MizerParams) S3method(matchYields,MizerParams) +S3method(metab,MizerParams) S3method(plotBiomass,MizerSim) S3method(plotDiet,MizerParams) S3method(plotDiet,MizerSim) @@ -29,13 +74,35 @@ S3method(plotSpectra,MizerParams) S3method(plotSpectra,MizerSim) S3method(plotYield,MizerSim) S3method(plotYieldGear,MizerSim) +S3method(pred_kernel,MizerParams) S3method(project,MizerParams) S3method(project,MizerSim) S3method(project_simple,MizerParams) S3method(removeSpecies,MizerParams) S3method(renameGear,MizerParams) S3method(renameSpecies,MizerParams) +S3method(resource_capacity,MizerParams) +S3method(resource_dynamics,MizerParams) +S3method(resource_rate,MizerParams) S3method(scaleModel,MizerParams) +S3method(search_vol,MizerParams) +S3method(selectivity,MizerParams) +S3method(setBevertonHolt,MizerParams) +S3method(setColours,MizerParams) +S3method(setDiffusion,MizerParams) +S3method(setExtEncounter,MizerParams) +S3method(setExtMort,MizerParams) +S3method(setFishing,MizerParams) +S3method(setInitialValues,MizerParams) +S3method(setInteraction,MizerParams) +S3method(setLinetypes,MizerParams) +S3method(setMaxIntakeRate,MizerParams) +S3method(setMetabolicRate,MizerParams) +S3method(setMetadata,MizerParams) +S3method(setPredKernel,MizerParams) +S3method(setReproduction,MizerParams) +S3method(setResource,MizerParams) +S3method(setSearchVolume,MizerParams) export("catchability<-") export("diffusion<-") export("ext_encounter<-") diff --git a/R/animateSpectra.R b/R/animateSpectra.R index d72dd0f4..8eb621d8 100644 --- a/R/animateSpectra.R +++ b/R/animateSpectra.R @@ -3,7 +3,7 @@ #' `r lifecycle::badge("experimental")` #' #' @param sim A MizerSim object -#' @param species Name or vector of names of the species to be plotted. By +#' @param species Name or vector of names of the species to be plotted. By #' default all species are plotted. #' @param time_range The time range to animate over. Either a vector of values #' or a vector of min and max time. Default is the entire time range of the @@ -21,7 +21,7 @@ #' species in the system is plotted as well. Default is FALSE. #' @param resource A boolean value that determines whether resource is included. #' Default is TRUE. -#' +#' #' @return A plotly object #' @export #' @family plotting functions @@ -29,7 +29,12 @@ #' \donttest{ #' animateSpectra(NS_sim, power = 2, wlim = c(0.1, NA), time_range = 1997:2007) #' } -animateSpectra <- function(sim, ...) +animateSpectra <- function(sim, species, time_range, + wlim, + ylim, + power, + total, + resource, ...) UseMethod("animateSpectra") #' @export @@ -42,7 +47,7 @@ animateSpectra.MizerSim <- function(sim, total = FALSE, resource = TRUE) { assert_that(is.flag(total), is.flag(resource), - is.number(power), + is.number(power), length(wlim) == 2, length(ylim) == 2) @@ -51,7 +56,7 @@ animateSpectra.MizerSim <- function(sim, time_range <- as.numeric(dimnames(sim@n)$time) } time_elements <- get_time_elements(sim, time_range) - + nf <- melt(sim@n[time_elements, as.character(dimnames(sim@n)$sp) %in% species, , drop = FALSE]) @@ -94,7 +99,7 @@ animateSpectra.MizerSim <- function(sim, value <= ylim[2], w >= wlim[1], w <= wlim[2]) - + # Order legend to follow params@species_params$species via linecolour order ---- # Keep only groups present in data, but preserve the order given by # names(sim@params@linecolour) which follows params@species_params$species. diff --git a/R/calibrate.R b/R/calibrate.R index 96c85709..884a19c3 100644 --- a/R/calibrate.R +++ b/R/calibrate.R @@ -221,7 +221,7 @@ calibrateYield.MizerParams <- function(params) { #' #' @return The rescaled MizerParams object #' @export -scaleModel <- function(params, ...) +scaleModel <- function(params, factor, ...) UseMethod("scaleModel") #' @export diff --git a/R/compareParams.R b/R/compareParams.R index 176b09ae..19a2873e 100644 --- a/R/compareParams.R +++ b/R/compareParams.R @@ -11,7 +11,7 @@ #' params2 <- params1 #' species_params(params2)$w_mat[1] <- 10 #' compareParams(params1, params2) -compareParams <- function(params1, ...) +compareParams <- function(params1, params2, ...) UseMethod("compareParams") #' @export diff --git a/R/match.R b/R/match.R index e7b15431..18701c0e 100644 --- a/R/match.R +++ b/R/match.R @@ -37,7 +37,7 @@ #' params <- calibrateBiomass(params) #' params <- matchBiomasses(params) #' plotBiomassObservedVsModel(params) -matchBiomasses <- function(params, ...) +matchBiomasses <- function(params, species = NULL, ...) UseMethod("matchBiomasses") #' @export @@ -116,7 +116,7 @@ matchBiomasses.MizerParams <- function(params, species = NULL) { #' species_params(params)$number_cutoff <- 10 #' params <- calibrateNumber(params) #' params <- matchNumbers(params) -matchNumbers <- function(params, ...) +matchNumbers <- function(params, species = NULL, ...) UseMethod("matchNumbers") #' @export @@ -202,7 +202,7 @@ matchNumbers.MizerParams <- function(params, species = NULL) { #' params <- calibrateYield(params) #' params <- matchYields(params) #' plotYieldObservedVsModel(params) -matchYields <- function(params, ...) +matchYields <- function(params, species = NULL, ...) UseMethod("matchYields") #' @export diff --git a/R/matchGrowth.R b/R/matchGrowth.R index c77e84fc..184a963f 100644 --- a/R/matchGrowth.R +++ b/R/matchGrowth.R @@ -27,12 +27,13 @@ #' consumption rate and metabolic rate and rescaled species parameters #' `gamma`,`h`, `ks` and `k`. #' @export -matchGrowth <- function(params, ...) +matchGrowth <- function(params, species = NULL, + keep = c("egg", "biomass", "number"), ...) UseMethod("matchGrowth") #' @export matchGrowth.MizerParams <- function(params, species = NULL, - keep = c("egg", "biomass", "number")) { + keep = c("egg", "biomass", "number")){ assert_that(is(params, "MizerParams")) sel <- valid_species_arg(params, species = species, return.logical = TRUE) diff --git a/R/newMultispeciesParams.R b/R/newMultispeciesParams.R index 499654ce..456004d3 100644 --- a/R/newMultispeciesParams.R +++ b/R/newMultispeciesParams.R @@ -6,7 +6,7 @@ #' all of them have sensible default values. The only required argument is #' the `species_params` data frame. All arguments are described in more #' details in the sections below the list. -#' +#' #' @inheritParams emptyParams #' @inheritParams setInteraction #' @inheritParams setPredKernel @@ -22,13 +22,13 @@ #' @param min_w_pp The smallest size of the resource spectrum. By default this #' is set to the smallest value at which any of the consumers can feed. #' @param n The allometric growth exponent. This can be overruled for individual -#' species by including a `n` column in the `species_params`. +#' species by including a `n` column in the `species_params`. #' @param info_level Controls the amount of information messages that are shown #' when the function sets default values for parameters. Higher levels lead #' to more messages. #' #' @return An object of type \linkS4class{MizerParams} -#' +#' #' @section Species parameters: #' The only essential argument is a data frame that contains the species #' parameters. The data frame is arranged species by parameter, so each column @@ -36,28 +36,28 @@ #' parameters for one of the species in the model. #' #' There are two essential columns that must be included in the species -#' parameter data.frame and that do not have default values: the +#' parameter data.frame and that do not have default values: the #' `species` column that should hold strings with the names of the #' species and the `w_max` column with the maximum sizes of the species #' in grams. (You could alternatively specify the maximum length in cm in an #' `l_max` column.) -#' +#' #' The `species_params dataframe` also needs to contain the parameters needed #' by any predation kernel function (size selectivity function). This will #' be mentioned in the appropriate sections below. -#' +#' #' For all other species parameters, mizer will calculate default values if they #' are not included in the species parameter data frame. They will be #' automatically added when the `MizerParams` object is created. For these #' parameters you can also specify values for only some species and leave the #' other entries as NA and the missing values will be set to the defaults. #' So the `species_params` data frame saved in the returned MizerParams object -#' will differ from the one you supply because it will have the missing +#' will differ from the one you supply because it will have the missing #' species parameters filled in with default values. -#' +#' #' If you are not happy with any of the species parameter values used you can #' always change them later with [species_params<-()]. -#' +#' #' All the parameters will be mentioned in the following sections. #' @inheritSection emptyParams Size grid #' @inheritSection setParams Units in mizer @@ -71,17 +71,17 @@ #' @inheritSection setReproduction Setting reproduction #' @inheritSection setFishing Setting fishing #' @inheritSection setResource Setting resource dynamics -#' +#' #' @section Setting initial values: -#' The initial values for the species number densities are set using the +#' The initial values for the species number densities are set using the #' function `get_initial_n()`. These are quite arbitrary and not very close to -#' the steady state abundances. We intend to improve this in the future. -#' +#' the steady state abundances. We intend to improve this in the future. +#' #' The initial resource number density \eqn{N_R(w)} is set to a power law with #' coefficient `kappa` (\eqn{\kappa}) and exponent `-lambda` (\eqn{-\lambda}): #' \deqn{N_R(w) = \kappa\, w^{-\lambda}}{c_R(w) = \kappa w^{-\lambda}} #' for all \eqn{w} less than `w_pp_cutoff` and zero for larger sizes. -#' +#' #' @export #' @family functions for setting up models #' @examples @@ -127,19 +127,19 @@ newMultispeciesParams <- function( initial_effort = NULL, info_level = 3, z0 = deprecated(), - r_pp = deprecated()) { - + r_pp = deprecated()) { + if (lifecycle::is_present(r_pp)) { - lifecycle::deprecate_warn("1.0.0", "newMultispeciesParams(r_pp)", + lifecycle::deprecate_warn("1.0.0", "newMultispeciesParams(r_pp)", "newMultispeciesParams(resource_rate)") resource_rate <- r_pp } if (lifecycle::is_present(z0)) { - lifecycle::deprecate_warn("2.2.3", "newMultispeciesParams(z0)", + lifecycle::deprecate_warn("2.2.3", "newMultispeciesParams(z0)", "newMultispeciesParams(ext_mort)") ext_mort <- z0 } - + # Define a signal handler that collects the information signals # into the `infos` list. infos <- list() @@ -152,33 +152,33 @@ newMultispeciesParams <- function( withCallingHandlers( info_about_default = collect_info, { no_sp <- nrow(species_params) - + species_params <- set_species_param_default(species_params, "n", n) species_params <- set_species_param_default(species_params, "p", p) given_species_params <- validGivenSpeciesParams(species_params) - + species_params <- validSpeciesParams(species_params) gear_params <- validGearParams(gear_params, species_params) - + ## Create MizerParams object ---- params <- emptyParams(given_species_params, gear_params, - no_w = no_w, - min_w = min_w, - max_w = max_w, + no_w = no_w, + min_w = min_w, + max_w = max_w, min_w_pp = min_w_pp) - + # Fill the slots ---- if (is.null(interaction)) { interaction <- matrix(1, nrow = no_sp, ncol = no_sp) } - + params@initial_n_pp[] <- kappa * params@w_full ^ (-lambda) params@initial_n_pp[params@w_full >= w_pp_cutoff] <- 0 params@resource_params$kappa <- kappa params@resource_params$lambda <- lambda params@resource_params$w_pp_cutoff <- w_pp_cutoff - + params <- params %>% setParams( # setInteraction @@ -215,7 +215,7 @@ newMultispeciesParams <- function( n = n, w_pp_cutoff = w_pp_cutoff, balance = FALSE) - + params@initial_n <- get_initial_n(params) params@A <- rep(1, nrow(species_params)) }) @@ -226,7 +226,7 @@ newMultispeciesParams <- function( } #' Set or change any model parameters -#' +#' #' This is a convenient wrapper function calling each of the following #' functions #' \itemize{ @@ -241,7 +241,7 @@ newMultispeciesParams <- function( #' \item [setFishing()] #' } #' See the Details section below for a discussion of how to use this function. -#' +#' #' @param params A \linkS4class{MizerParams} object #' @inheritParams setInteraction #' @inheritDotParams setPredKernel -reset @@ -249,27 +249,28 @@ newMultispeciesParams <- function( #' @inheritDotParams setMaxIntakeRate -reset #' @inheritDotParams setMetabolicRate -reset #' @inheritDotParams setExtMort -reset +#' @inheritDotParams setExtEncounter #' @inheritDotParams setReproduction -reset #' @inheritDotParams setFishing -reset -#' +#' #' @return A \linkS4class{MizerParams} object -#' -#' @details +#' +#' @details #' If you are not happy with the assumptions that mizer makes by default about #' the shape of the model functions, for example if you want to change one of #' the allometric scaling assumptions, you can do this by providing your #' choice as an array in the appropriate argument to `setParams()`. The #' sections below discuss all the model functions that you can change this way. -#' +#' #' Because of the way the R language works, `setParams` does not make the #' changes to the `params` object that you pass to it but instead returns a new #' params object. So to affect the change you call the function in the form #' `params <- setParams(params, ...)`. -#' +#' #' Usually, if you are happy with the way mizer calculates its model functions #' from the species parameters and only want to change the values of some #' species parameters, you would make those changes in the `species_params` data -#' frame contained in the `params` object using [species_params<-()]. +#' frame contained in the `params` object using [species_params<-()]. #' Here is an example which assumes that #' you have have a MizerParams object `params` in which you just want to change #' the `gamma` parameter of the third species: @@ -278,26 +279,26 @@ newMultispeciesParams <- function( #' ``` #' Internally that will actually call `setParams()` to recalculate any of the #' other parameters that are affected by the change in the species parameter. -#' +#' #' `setParams()` will use the species parameters in the `params` object to #' recalculate the values of all the model functions except those for which you #' have set custom values. -#' +#' #' @section Units in mizer: #' Mizer uses grams to measure weight, centimetres to measure lengths, and #' years to measure time. -#' -#' Mizer is agnostic about whether abundances are given as -#' 1. numbers per area, +#' +#' Mizer is agnostic about whether abundances are given as +#' 1. numbers per area, #' 2. numbers per volume or -#' 3. total numbers for the entire study area. -#' +#' 3. total numbers for the entire study area. +#' #' You should make the choice most convenient for your application and then #' stick with it. If you make choice 1 or 2 you will also have to choose a unit #' for area or volume. Your choice will then determine the units for some of #' the parameters. This will be mentioned when the parameters are discussed in #' the sections below. -#' +#' #' Your choice will also affect the units of the quantities you may want to #' calculate with the model. For example, the yield will be in grams/year/m^2 in #' case 1 if you choose m^2 as your measure of area, in grams/year/m^3 in case 2 @@ -306,13 +307,13 @@ newMultispeciesParams <- function( #' grams/area in case 1, grams/volume in case 2 or simply grams in case 3. When #' mizer puts units on axes in plots, it will choose the units appropriate for #' case 3. So for example in [plotBiomass()] it gives the unit as grams. -#' +#' #' You can convert between these choices. For example, if you use case 1, you -#' need to multiply with the area of the ecosystem to get the total quantity. -#' If you work with case 2, you need to multiply by both area and the thickness +#' need to multiply with the area of the ecosystem to get the total quantity. +#' If you work with case 2, you need to multiply by both area and the thickness #' of the productive layer. In that respect, case 2 is a bit cumbersome. The #' function [scaleModel()] is useful to change the units you are using. -#' +#' #' @inheritSection setInteraction Setting interaction matrix #' @inheritSection setPredKernel Setting predation kernel #' @inheritSection setSearchVolume Setting search volume @@ -328,19 +329,19 @@ newMultispeciesParams <- function( # the `...` is for backwards compatibility. It used to be the second argument. setParams <- function(params, interaction = NULL, ...) { params <- validParams(params) - + params <- setInteraction(params, interaction) params <- setPredKernel(params, ...) params <- setMaxIntakeRate(params, ...) params <- setMetabolicRate(params, ...) params <- setExtMort(params, ...) params <- setExtEncounter(params, ...) - # setSearchVolume() should be called only after + # setSearchVolume() should be called only after # setMaxIntakeRate() and setPredKernel() params <- setSearchVolume(params, ...) params <- setReproduction(params, ...) params <- setFishing(params, ...) - + colours <- params@species_params$linecolour if (!is.null(colours)) { names(colours) <- params@species_params$species @@ -351,7 +352,7 @@ setParams <- function(params, interaction = NULL, ...) { names(linetypes) <- params@species_params$species params <- setLinetypes(params, linetypes) } - + validObject(params) params } diff --git a/R/setBevertonHolt.R b/R/setBevertonHolt.R index e6a280ae..c6307788 100644 --- a/R/setBevertonHolt.R +++ b/R/setBevertonHolt.R @@ -141,8 +141,13 @@ #' params <- setBevertonHolt(params, reproduction_level = 0.3) #' t(species_params(params)[, c("erepro", "R_max")]) #' @export -setBevertonHolt <- function(params, R_factor = deprecated(), erepro, - R_max, reproduction_level) { +setBevertonHolt <- function(params, erepro, + R_max, reproduction_level, ...) { + UseMethod("setBevertonHolt") +} +#' @export +setBevertonHolt.MizerParams <- function(params, R_factor = deprecated(), erepro, + R_max, reproduction_level, ...) { assert_that(is(params, "MizerParams")) no_sp <- nrow(params@species_params) @@ -272,6 +277,10 @@ setBevertonHolt <- function(params, R_factor = deprecated(), erepro, } getRequiredRDD <- function(params) { + UseMethod("getRequiredRDD") +} +#' @export +getRequiredRDD.MizerParams <- function(params) { # Calculate required rdd mumu <- getMort(params) gg <- getEGrowth(params) @@ -315,6 +324,10 @@ getRequiredRDD <- function(params) { #' identical(getRDD(params) / species_params(params)$R_max, #' getReproductionLevel(params)) getReproductionLevel <- function(params) { + UseMethod("getReproductionLevel") +} +#' @export +getReproductionLevel.MizerParams <- function(params) { assert_that(is(params, "MizerParams")) if (!"R_max" %in% names(params@species_params)) { stop("No `R_max` is included in the species parameters.") diff --git a/R/setColours.R b/R/setColours.R index b6a73542..c9b6c1d2 100644 --- a/R/setColours.R +++ b/R/setColours.R @@ -33,6 +33,10 @@ #' getColours(params) #' getLinetypes(params) setColours <- function(params, colours) { + UseMethod("setColours") +} +#' @export +setColours.MizerParams <- function(params, colours) { assert_that(is(params, "MizerParams")) colours <- validColours(colours) if (identical(colours, as.list(params@linecolour))) { @@ -49,6 +53,10 @@ setColours <- function(params, colours) { #' @return `getColours()`: A named vector of colours #' @export getColours <- function(params) { + UseMethod("getColours") +} +#' @export +getColours.MizerParams <- function(params) { params@linecolour } @@ -72,6 +80,10 @@ validColours <- function(colours) { #' @return `setLinetypes()`: The MizerParams object with updated linetypes #' @export setLinetypes <- function(params, linetypes) { + UseMethod("setLinetypes") +} +#' @export +setLinetypes.MizerParams <- function(params, linetypes) { assert_that(is(params, "MizerParams")) linetypes <- validLinetypes(linetypes) if (identical(linetypes, as.list(params@linetype))) { @@ -88,6 +100,10 @@ setLinetypes <- function(params, linetypes) { #' @return `getLinetypes()`: A named vector of linetypes #' @export getLinetypes <- function(params) { + UseMethod("getLinetypes") +} +#' @export +getLinetypes.MizerParams <- function(params) { params@linetype } diff --git a/R/setDiffusion.R b/R/setDiffusion.R index 132a57aa..c6978e67 100644 --- a/R/setDiffusion.R +++ b/R/setDiffusion.R @@ -10,12 +10,23 @@ #' @param params MizerParams #' @param diffusion Optional. An array (species x size) holding the diffusion rate. If #' not supplied, the diffusion rate is left unchanged. Initially it is set to 0. +#' @param reset `r lifecycle::badge("experimental")` +#' If set to TRUE, then the diffusion rate will be reset to the value +#' calculated from the species parameters, even if it was previously +#' overwritten with a custom value. If set to FALSE (default) then a +#' recalculation from the species parameters will take place only if no +#' custom value has been set. #' @param ... Unused #' #' @return `setDiffusion()`: A MizerParams object with updated diffusion rate. #' @export #' @family functions for setting parameters -setDiffusion <- function(params, diffusion = NULL, ...) { +setDiffusion <- function(params, diffusion = NULL, reset = FALSE, ...) { + UseMethod("setDiffusion") +} +#' @rdname setDiffusion +#' @export +setDiffusion.MizerParams <- function(params, diffusion = NULL, reset = FALSE, ...) { assert_that(is(params, "MizerParams")) if (is.null(diffusion)) { @@ -39,6 +50,10 @@ setDiffusion <- function(params, diffusion = NULL, ...) { #' @return `diffusion()`: An array (species x size) with the diffusion rate. #' @export diffusion <- function(params) { + UseMethod("diffusion") +} +#' @export +diffusion.MizerParams <- function(params) { params@diffusion } @@ -46,5 +61,9 @@ diffusion <- function(params) { #' @param value diffusion #' @export `diffusion<-` <- function(params, value) { + UseMethod("diffusion<-") +} +#' @export +`diffusion<-.MizerParams` <- function(params, value) { setDiffusion(params, diffusion = value) } diff --git a/R/setExtEncounter.R b/R/setExtEncounter.R index e3e49f9f..2a7a6917 100644 --- a/R/setExtEncounter.R +++ b/R/setExtEncounter.R @@ -33,6 +33,10 @@ #' # Change the external encounter rate in the params object #' ext_encounter(params) <- allo_encounter setExtEncounter <- function(params, ext_encounter = NULL, ...) { + UseMethod("setExtEncounter") +} +#' @export +setExtEncounter.MizerParams <- function(params, ext_encounter = NULL, ...) { assert_that(is(params, "MizerParams")) if (is.null(ext_encounter)) { @@ -57,12 +61,20 @@ setExtEncounter <- function(params, ext_encounter = NULL, ...) { #' (species x size) with the external encounter rate. #' @export getExtEncounter <- function(params) { + UseMethod("getExtEncounter") +} +#' @export +getExtEncounter.MizerParams <- function(params) { params@ext_encounter } #' @rdname setExtEncounter #' @export ext_encounter <- function(params) { + UseMethod("ext_encounter") +} +#' @export +ext_encounter.MizerParams <- function(params) { params@ext_encounter } @@ -70,5 +82,9 @@ ext_encounter <- function(params) { #' @param value ext_encounter #' @export `ext_encounter<-` <- function(params, value) { + UseMethod("ext_encounter<-") +} +#' @export +`ext_encounter<-.MizerParams` <- function(params, value) { setExtEncounter(params, ext_encounter = value) } \ No newline at end of file diff --git a/R/setExtMort.R b/R/setExtMort.R index fc283b6b..db3b3084 100644 --- a/R/setExtMort.R +++ b/R/setExtMort.R @@ -56,7 +56,12 @@ #' #' # Change the external mortality rate in the params object #' ext_mort(params) <- allo_mort -setExtMort <- function(params, ext_mort = NULL, +setExtMort <- function(params, ext_mort = NULL, z0pre = 0.6, + z0exp = params@resource_params$n - 1, reset = FALSE, ...) { + UseMethod("setExtMort") +} +#' @export +setExtMort.MizerParams <- function(params, ext_mort = NULL, z0pre = 0.6, z0exp = params@resource_params$n - 1, reset = FALSE, z0 = deprecated(), ...) { if (lifecycle::is_present(z0)) { @@ -126,12 +131,20 @@ setExtMort <- function(params, ext_mort = NULL, #' size) with the external mortality. #' @export getExtMort <- function(params) { + UseMethod("getExtMort") +} +#' @export +getExtMort.MizerParams <- function(params) { params@mu_b } #' @rdname setExtMort #' @export ext_mort <- function(params) { + UseMethod("ext_mort") +} +#' @export +ext_mort.MizerParams <- function(params) { params@mu_b } @@ -139,5 +152,9 @@ ext_mort <- function(params) { #' @param value ext_mort #' @export `ext_mort<-` <- function(params, value) { + UseMethod("ext_mort<-") +} +#' @export +`ext_mort<-.MizerParams` <- function(params, value) { setExtMort(params, ext_mort = value) } diff --git a/R/setFishing.R b/R/setFishing.R index b109b289..871a9e17 100644 --- a/R/setFishing.R +++ b/R/setFishing.R @@ -113,6 +113,11 @@ #' @seealso [gear_params()] #' @family functions for setting parameters setFishing <- function(params, selectivity = NULL, catchability = NULL, + reset = FALSE, initial_effort = NULL, ...) { + UseMethod("setFishing") +} +#' @export +setFishing.MizerParams <- function(params, selectivity = NULL, catchability = NULL, reset = FALSE, initial_effort = NULL, ...) { assert_that(is(params, "MizerParams"), @@ -326,6 +331,10 @@ setFishing <- function(params, selectivity = NULL, catchability = NULL, #' # changing an individual entry #' gear_params(params)["Cod, gear1", "catchability"] <- 0.8 gear_params <- function(params) { + UseMethod("gear_params") +} +#' @export +gear_params.MizerParams <- function(params) { params@gear_params } @@ -334,6 +343,10 @@ gear_params <- function(params) { #' @seealso [validGearParams()] #' @export `gear_params<-` <- function(params, value) { + UseMethod("gear_params<-") +} +#' @export +`gear_params<-.MizerParams` <- function(params, value) { value <- validGearParams(value, params@species_params) params@gear_params <- value setFishing(params) @@ -347,12 +360,20 @@ gear_params <- function(params) { #' @examples #' str(getCatchability(NS_params)) getCatchability <- function(params) { + UseMethod("getCatchability") +} +#' @export +getCatchability.MizerParams <- function(params) { params@catchability } #' @rdname setFishing #' @export catchability <- function(params) { + UseMethod("catchability") +} +#' @export +catchability.MizerParams <- function(params) { params@catchability } @@ -360,6 +381,10 @@ catchability <- function(params) { #' @param value . #' @export `catchability<-` <- function(params, value) { + UseMethod("catchability<-") +} +#' @export +`catchability<-.MizerParams` <- function(params, value) { setFishing(params, catchability = value) } @@ -371,18 +396,30 @@ catchability <- function(params) { #' @examples #' str(getSelectivity(NS_params)) getSelectivity <- function(params) { + UseMethod("getSelectivity") +} +#' @export +getSelectivity.MizerParams <- function(params) { params@selectivity } #' @rdname setFishing #' @export selectivity <- function(params) { + UseMethod("selectivity") +} +#' @export +selectivity.MizerParams <- function(params) { params@selectivity } #' @rdname setFishing #' @export `selectivity<-` <- function(params, value) { + UseMethod("selectivity<-") +} +#' @export +`selectivity<-.MizerParams` <- function(params, value) { setFishing(params, selectivity = value) } @@ -393,6 +430,10 @@ selectivity <- function(params) { #' @examples #' str(getInitialEffort(NS_params)) getInitialEffort <- function(params) { + UseMethod("getInitialEffort") +} +#' @export +getInitialEffort.MizerParams <- function(params) { params@initial_effort } @@ -428,6 +469,10 @@ getInitialEffort <- function(params) { #' @return Effort vector #' @export initial_effort <- function(params) { + UseMethod("initial_effort") +} +#' @export +initial_effort.MizerParams <- function(params) { params@initial_effort } @@ -436,6 +481,10 @@ initial_effort <- function(params) { #' below. #' @export `initial_effort<-` <- function(params, value) { + UseMethod("initial_effort<-") +} +#' @export +`initial_effort<-.MizerParams` <- function(params, value) { setFishing(params, initial_effort = value) } diff --git a/R/setInitialValues.R b/R/setInitialValues.R index 86107b50..8a087cac 100644 --- a/R/setInitialValues.R +++ b/R/setInitialValues.R @@ -45,9 +45,12 @@ #' sim <- project(params, t_max = 20, effort = 0.5) #' params <- setInitialValues(params, sim) #' } -setInitialValues <- function(params, sim, time_range, geometric_mean = FALSE) { - assert_that(is(params, "MizerParams"), - is(sim, "MizerSim"), +setInitialValues <- function(params, sim, time_range, geometric_mean = FALSE, ...) { + UseMethod("setInitialValues") +} +#' @export +setInitialValues.MizerParams <- function(params, sim, time_range, geometric_mean = FALSE) { + assert_that(is(sim, "MizerSim"), is.flag(geometric_mean)) no_t <- dim(sim@n)[1] if (!identical(dim(sim@n)[2:3], dim(params@initial_n))) { @@ -114,6 +117,10 @@ setInitialValues <- function(params, sim, time_range, geometric_mean = FALSE) { #' number densities for the fish spectra. #' @export `initialN<-` <- function(params, value) { + UseMethod("initialN<-") +} +#' @export +`initialN<-.MizerParams` <- function(params, value) { if (!is(params, "MizerParams")) { stop("You can only assign an initial N to a MizerParams object. ", params, " is of class ", class(params), ".") @@ -145,13 +152,18 @@ setInitialValues <- function(params, sim, time_range, geometric_mean = FALSE) { #' # Of course this initial state will no longer be a steady state #' params <- steady(params) initialN <- function(object) { - if (is(object, "MizerParams")) { - params <- validParams(object) - return(params@initial_n) - } - if (is(object, "MizerSim")) { - return(object@params@initial_n) - } + UseMethod("initialN") +} +#' @rdname initialN-set +#' @export +initialN.MizerParams <- function(object) { + params <- validParams(object) + return(params@initial_n) +} +#' @rdname initialN-set +#' @export +initialN.MizerSim <- function(object) { + return(object@params@initial_n) } #' Initial value for resource spectrum @@ -170,6 +182,10 @@ initialN <- function(object) { #' # Of course this initial state will no longer be a steady state #' params <- steady(params) `initialNResource<-` <- function(params, value) { + UseMethod("initialNResource<-") +} +#' @export +`initialNResource<-.MizerParams` <- function(params, value) { if (!is(params, "MizerParams")) { stop("You can only assign an initial N to a MizerParams object. ", params, " is of class ", class(params), ".") @@ -192,11 +208,16 @@ initialN <- function(object) { #' spectrum #' @export initialNResource <- function(object) { - if (is(object, "MizerParams")) { - params <- validParams(object) - return(params@initial_n_pp) - } - if (is(object, "MizerSim")) { - return(object@params@initial_n_pp) - } + UseMethod("initialNResource") +} +#' @rdname initialNResource-set +#' @export +initialNResource.MizerParams <- function(object) { + params <- validParams(object) + return(params@initial_n_pp) +} +#' @rdname initialNResource-set +#' @export +initialNResource.MizerSim <- function(object) { + return(object@params@initial_n_pp) } diff --git a/R/setInteraction.R b/R/setInteraction.R index 4aeeb7b1..9e2bc099 100644 --- a/R/setInteraction.R +++ b/R/setInteraction.R @@ -53,8 +53,12 @@ #' inter[1, 2:3] <- 0 #' params <- setInteraction(params, interaction = inter) #' getInteraction(params) -setInteraction <- function(params, - interaction = NULL) { +setInteraction <- function(params, interaction = NULL, ...) { + UseMethod("setInteraction") +} +#' @export +setInteraction.MizerParams <- function(params, + interaction = NULL, ...) { assert_that(is(params, "MizerParams")) if (is.null(interaction)) { interaction <- params@interaction @@ -129,6 +133,10 @@ setInteraction <- function(params, #' @export #' @keywords internal getInteraction <- function(params) { + UseMethod("getInteraction") +} +#' @export +getInteraction.MizerParams <- function(params) { lifecycle::deprecate_warn("2.4.0", "getInteraction()", "interaction_matrix()") interaction_matrix(params) @@ -140,6 +148,10 @@ getInteraction <- function(params) { #' prey species) #' @export interaction_matrix <- function(params) { + UseMethod("interaction_matrix") +} +#' @export +interaction_matrix.MizerParams <- function(params) { params@interaction } @@ -147,5 +159,9 @@ interaction_matrix <- function(params) { #' @param value An interaction matrix #' @export `interaction_matrix<-` <- function(params, value) { + UseMethod("interaction_matrix<-") +} +#' @export +`interaction_matrix<-.MizerParams` <- function(params, value) { setInteraction(params, interaction = value) } diff --git a/R/setMaxIntakeRate.R b/R/setMaxIntakeRate.R index 54e8a291..0914486f 100644 --- a/R/setMaxIntakeRate.R +++ b/R/setMaxIntakeRate.R @@ -33,6 +33,10 @@ #' @export #' @family functions for setting parameters setMaxIntakeRate <- function(params, intake_max = NULL, reset = FALSE, ...) { + UseMethod("setMaxIntakeRate") +} +#' @export +setMaxIntakeRate.MizerParams <- function(params, intake_max = NULL, reset = FALSE, ...) { assert_that(is(params, "MizerParams"), is.flag(reset)) species_params <- params@species_params @@ -99,6 +103,10 @@ setMaxIntakeRate <- function(params, intake_max = NULL, reset = FALSE, ...) { #' (species x size) with the maximum intake rate. #' @export getMaxIntakeRate <- function(params) { + UseMethod("getMaxIntakeRate") +} +#' @export +getMaxIntakeRate.MizerParams <- function(params) { params@intake_max } @@ -106,6 +114,10 @@ getMaxIntakeRate <- function(params) { #' @rdname setMaxIntakeRate #' @export intake_max <- function(params) { + UseMethod("intake_max") +} +#' @export +intake_max.MizerParams <- function(params) { params@intake_max } @@ -113,5 +125,9 @@ intake_max <- function(params) { #' @param value intake_max #' @export `intake_max<-` <- function(params, value) { + UseMethod("intake_max<-") +} +#' @export +`intake_max<-.MizerParams` <- function(params, value) { setMaxIntakeRate(params, intake_max = value) } diff --git a/R/setMetabolicRate.R b/R/setMetabolicRate.R index 4d30d2d7..1e180d37 100644 --- a/R/setMetabolicRate.R +++ b/R/setMetabolicRate.R @@ -1,12 +1,12 @@ #' Set metabolic rate -#' +#' #' Sets the rate at which energy is used for metabolism and activity -#' +#' #' @section Setting metabolic rate: #' The metabolic rate is subtracted from the energy income rate to calculate #' the rate at which energy is available for growth and reproduction, see #' [getEReproAndGrowth()]. It is measured in grams/year. -#' +#' #' If the `metab` argument is not supplied, then for each species the #' metabolic rate \eqn{k(w)} for an individual of size \eqn{w} is set to #' \deqn{k(w) = k_s w^p + k w,} @@ -19,7 +19,7 @@ #' where \eqn{f_c} is the critical feeding level taken from the `fc` column #' in the species parameter data frame. If the critical feeding level is not #' specified, a default of \eqn{f_c = 0.2} is used. -#' +#' #' @param params MizerParams #' @param metab Optional. An array (species x size) holding the metabolic rate #' for each species at size. If not supplied, a default is set as described in @@ -34,14 +34,18 @@ #' recalculation from the species parameters will take place only if no #' custom value has been set. #' @param ... Unused -#' +#' #' @return `setMetabolicRate()`: A MizerParams object with updated metabolic rate. #' @export #' @family functions for setting parameters -setMetabolicRate <- function(params, metab = NULL, p = NULL, +setMetabolicRate <- function(params, metab = NULL, p = NULL, reset = FALSE, ...) { - assert_that(is(params, "MizerParams"), - is.flag(reset)) + UseMethod("setMetabolicRate") +} +#' @export +setMetabolicRate.MizerParams <- function(params, metab = NULL, p = NULL, + reset = FALSE, ...) { + assert_that(is.flag(reset)) if (!is.null(p)) { assert_that(is.numeric(p)) params <- set_species_param_default(params, "p", p) @@ -49,17 +53,17 @@ setMetabolicRate <- function(params, metab = NULL, p = NULL, params <- set_species_param_default(params, "p", 3/4) } species_params <- params@species_params - + if (reset) { if (!is.null(metab)) { - warning("Because you set `reset = TRUE`, the value you provided ", + warning("Because you set `reset = TRUE`, the value you provided ", "for `metab` will be ignored and a value will be ", "calculated from the species parameters.") metab <- NULL } comment(params@metab) <- NULL } - + if (!is.null(metab)) { if (is.null(comment(metab))) { if (is.null(comment(params@metab))) { @@ -70,7 +74,7 @@ setMetabolicRate <- function(params, metab = NULL, p = NULL, } assert_that(is.array(metab), identical(dim(metab), dim(params@metab))) - if (!is.null(dimnames(metab)) && + if (!is.null(dimnames(metab)) && !all(dimnames(metab)[[1]] == species_params$species)) { stop("You need to use the same ordering of species as in the ", "params object: ", toString(species_params$species)) @@ -78,19 +82,19 @@ setMetabolicRate <- function(params, metab = NULL, p = NULL, assert_that(all(metab >= 0)) params@metab[] <- metab comment(params@metab) <- comment(metab) - + params@time_modified <- lubridate::now() return(params) } - + params <- set_species_param_default(params, "k", 0) params@species_params$ks <- get_ks_default(params) - metab <- + metab <- sweep(outer(params@species_params[["p"]], params@w, function(x, y) y ^ x), 1, params@species_params$ks, "*") + outer(params@species_params[["k"]], params@w) - + # Prevent overwriting slot if it has been commented if (!is.null(comment(params@metab))) { # Issue warning but only if a change was actually requested @@ -101,7 +105,7 @@ setMetabolicRate <- function(params, metab = NULL, p = NULL, return(params) } params@metab[] <- metab - + params@time_modified <- lubridate::now() return(params) } @@ -111,12 +115,20 @@ setMetabolicRate <- function(params, metab = NULL, p = NULL, #' (species x size) with the metabolic rate. #' @export getMetabolicRate <- function(params) { + UseMethod("getMetabolicRate") +} +#' @export +getMetabolicRate.MizerParams <- function(params) { params@metab } #' @rdname setMetabolicRate #' @export metab <- function(params) { + UseMethod("metab") +} +#' @export +metab.MizerParams <- function(params) { params@metab } @@ -124,5 +136,9 @@ metab <- function(params) { #' @param value metab #' @export `metab<-` <- function(params, value) { + UseMethod("metab<-") +} +#' @export +`metab<-.MizerParams` <- function(params, value) { setMetabolicRate(params, metab = value) } diff --git a/R/setMetadata.R b/R/setMetadata.R index 7bc8c4c6..93c8f71c 100644 --- a/R/setMetadata.R +++ b/R/setMetadata.R @@ -41,8 +41,13 @@ #' #' @return `setMetadata()`: The MizerParams object with updated metadata #' @export -setMetadata <- function(params, title, description, - authors, url, doi, ...) { +setMetadata <- function(params, title = NULL, description = NULL, + authors = NULL, url = NULL, doi = NULL, ...) { + UseMethod("setMetadata") +} +#' @export +setMetadata.MizerParams <- function(params, title = NULL, description = NULL, + authors = NULL, url = NULL, doi = NULL, ...) { params <- validParams(params) extra <- list(...) special <- c("mizer_version", "extensions", "time_modified", "time_created") @@ -82,6 +87,10 @@ setMetadata <- function(params, title, description, #' including at least #' `mizer_version`, `extensions`, `time_created` and `time_modified`. getMetadata <- function(params) { + UseMethod("getMetadata") +} +#' @export +getMetadata.MizerParams <- function(params) { list <- params@metadata list$mizer_version <- params@mizer_version list$extensions <- params@extensions diff --git a/R/setPredKernel.R b/R/setPredKernel.R index 0c21935a..76a5de3b 100644 --- a/R/setPredKernel.R +++ b/R/setPredKernel.R @@ -93,7 +93,11 @@ #' pred_kernel["Herring", , ] <- sweep(pred_kernel["Herring", , ], 2, #' params@w_full, "*") #' params<- setPredKernel(params, pred_kernel = pred_kernel) -setPredKernel <- function(params, +setPredKernel <- function(params, pred_kernel = NULL, reset = FALSE, ...) { + UseMethod("setPredKernel") +} +#' @export +setPredKernel.MizerParams <- function(params, pred_kernel = NULL, reset = FALSE, ...) { assert_that(is(params, "MizerParams"), @@ -191,6 +195,10 @@ setPredKernel <- function(params, #' species x predator_size x prey_size) #' @export getPredKernel <- function(params) { + UseMethod("getPredKernel") +} +#' @export +getPredKernel.MizerParams <- function(params) { # This function is more complicated than you might have thought because # usually the predation kernel is not stored in the MizerParams object, # but rather only the Fourier coefficients needed for fast calculation of @@ -229,6 +237,10 @@ getPredKernel <- function(params) { #' @rdname setPredKernel #' @export pred_kernel <- function(params) { + UseMethod("pred_kernel") +} +#' @export +pred_kernel.MizerParams <- function(params) { getPredKernel(params) } @@ -236,6 +248,10 @@ pred_kernel <- function(params) { #' @param value pred_kernel #' @export `pred_kernel<-` <- function(params, value) { + UseMethod("pred_kernel<-") +} +#' @export +`pred_kernel<-.MizerParams` <- function(params, value) { setPredKernel(params, pred_kernel = value) } diff --git a/R/setReproduction.R b/R/setReproduction.R index 1cb430e3..523d600a 100644 --- a/R/setReproduction.R +++ b/R/setReproduction.R @@ -133,7 +133,12 @@ #' library(ggplot2) #' ggplot(dff) + geom_line(aes(x = Size, y = Proportion, colour = Type)) #' } -setReproduction <- function(params, maturity = NULL, +setReproduction <- function(params, maturity = NULL, repro_prop = NULL, + reset = FALSE, RDD = NULL, ...) { + UseMethod("setReproduction") +} +#' @export +setReproduction.MizerParams <- function(params, maturity = NULL, repro_prop = NULL, reset = FALSE, RDD = NULL, ...) { # check arguments ---- diff --git a/R/setResource.R b/R/setResource.R index b35ee31c..44235c10 100644 --- a/R/setResource.R +++ b/R/setResource.R @@ -1,31 +1,31 @@ #' Set resource dynamics -#' +#' #' Sets the intrinsic resource birth rate and the intrinsic resource carrying #' capacity as well as the name of the function used to simulate the resource #' dynamics. By default, the birth rate and the carrying capacity are changed #' together in such a way that the resource replenishes at the same rate at -#' which it is consumed. So you should only provide either the +#' which it is consumed. So you should only provide either the #' `resource_rate` or the `resource_capacity` (or `resource_level`) because #' the other is determined by the requirement that the resource replenishes #' at the same rate at which it is consumed. -#' -#' You would usually set the resource dynamics only after having finished the +#' +#' You would usually set the resource dynamics only after having finished the #' calibration of the steady state. Then setting the resource dynamics with -#' this function will preserve that steady state, unless you explicitly +#' this function will preserve that steady state, unless you explicitly #' choose to set `balance = FALSE`. Your choice of the resource dynamics only #' affects the dynamics around the steady state. The higher the resource rate #' or the lower the resource capacity the less sensitive the model will be to #' changes in the competition for resource. -#' +#' #' If you provide the `resource_level` then that sets the `resource_capacity` #' to the current resource number density divided by the resource level. So #' in that case you should not specify `resource_capacity` as well. -#' +#' #' If you provide none of the arguments `resource_level`, `resource_rate` or #' `resource_capacity` then the resource rate is kept at its previous value. -#' +#' #' @section Setting resource dynamics: -#' +#' #' The `resource_dynamics` argument allows you to choose the resource dynamics #' function. By default, mizer uses a semichemostat model to describe the #' resource dynamics in each size class independently. This semichemostat @@ -33,12 +33,12 @@ #' change that to use a logistic model implemented by [resource_logistic()] or #' you can use [resource_constant()] which keeps the resource constant or you #' can write your own function. -#' +#' #' Both the [resource_semichemostat()] and the [resource_logistic()] dynamics -#' are parametrised in terms of a size-dependent birth rate \eqn{r_R(w)} and a +#' are parametrised in terms of a size-dependent birth rate \eqn{r_R(w)} and a #' size-dependent capacity \eqn{c_R}. The help pages of these functions give #' the details. -#' +#' #' The `resource_rate` argument can be a vector (with the same length as #' `w_full(params)`) specifying the intrinsic resource birth rate for each size #' class. Alternatively it can be a single number that is used as the @@ -46,7 +46,7 @@ #' size \eqn{w} is set to #' \deqn{r_R(w) = r_R w^{n-1}.} #' The power-law exponent \eqn{n} is taken from the `n` argument. -#' +#' #' The `resource_capacity` argument can be a vector specifying the intrinsic #' resource carrying capacity for each size class. Alternatively it can be a #' single number that is used as the coefficient in a truncated power @@ -60,14 +60,14 @@ #' in the `resource_params` slot of the MizerParams object so that they can be #' re-used automatically in the future. That list can be accessed with #' [resource_params()]. -#' +#' #' @param params A MizerParams object #' @param resource_rate Optional. A vector of per-capita resource birth #' rate for each size class or a single number giving the coefficient in the #' power-law for this rate, see "Setting resource dynamics" below. #' Must be strictly positive. #' @param resource_capacity Optional. Vector of resource intrinsic carrying -#' capacities or coefficient in the power-law for the capacity, see +#' capacities or coefficient in the power-law for the capacity, see #' "Setting resource dynamics" below. #' The resource capacity must be larger than the resource abundance. #' @param resource_level Optional. The ratio between the current resource number @@ -78,9 +78,9 @@ #' `resource_capacity`. #' @param resource_dynamics Optional. Name of the function that determines the #' resource dynamics by calculating the resource spectrum at the next time -#' step from the current state. -#' @param balance By default, if possible, the resource parameters are -#' set so that the resource replenishes at the same rate at which it is +#' step from the current state. +#' @param balance By default, if possible, the resource parameters are +#' set so that the resource replenishes at the same rate at which it is #' consumed. In this case you should only specify either the resource rate #' or the resource capacity (or resource level) because the other is then #' determined automatically. Set to FALSE if you do not want the balancing. @@ -99,49 +99,58 @@ #' @param kappa `r lifecycle::badge("deprecated")`. Use `resource_capacity` #' argument instead. #' @param ... Unused -#' +#' #' @return `setResource`: A MizerParams object with updated resource parameters #' @seealso [setParams()] #' @export -setResource <- function(params, +setResource <- function(params, resource_rate = NULL, resource_capacity = NULL, + resource_level = NULL, resource_dynamics = NULL, + lambda = resource_params(params)[["lambda"]], + n = resource_params(params)[["n"]], + w_pp_cutoff = resource_params(params)[["w_pp_cutoff"]], + balance = NULL, ...) { + UseMethod("setResource") +} +#' @export +setResource.MizerParams <- function(params, resource_rate = NULL, resource_capacity = NULL, resource_level = NULL, resource_dynamics = NULL, - balance = NULL, + r_pp = deprecated(), + kappa = deprecated(), lambda = resource_params(params)[["lambda"]], n = resource_params(params)[["n"]], w_pp_cutoff = resource_params(params)[["w_pp_cutoff"]], - r_pp = deprecated(), - kappa = deprecated(), + balance = NULL, ...) { - + if (lifecycle::is_present(r_pp)) { - lifecycle::deprecate_warn("1.0.0", "setParams(r_pp)", + lifecycle::deprecate_warn("1.0.0", "setParams(r_pp)", "setParams(resource_rate)") resource_rate <- r_pp } if (lifecycle::is_present(kappa)) { - lifecycle::deprecate_warn("1.0.0", "setParams(kappa)", + lifecycle::deprecate_warn("1.0.0", "setParams(kappa)", "setParams(resource_capacity)") resource_capacity <- kappa - } + } assert_that(is(params, "MizerParams"), is.number(lambda), is.number(w_pp_cutoff), w_pp_cutoff > 0, is.number(n)) - + # Store the old w_pp_cutoff before updating old_w_pp_cutoff <- params@resource_params[["w_pp_cutoff"]] - + params@resource_params[["lambda"]] <- lambda params@resource_params[["n"]] <- n params@resource_params[["w_pp_cutoff"]] <- w_pp_cutoff - + if (!is.null(resource_capacity) && !is.null(resource_level)) { stop("You should specify only either 'resource_level' or 'resource_capacity'.") } - + # Check and set dynamics function ---- if (!is.null(resource_dynamics)) { assert_that(is.character(resource_dynamics)) @@ -150,12 +159,12 @@ setResource <- function(params, } params@resource_dynamics <- resource_dynamics } - + w_full <- w_full(params) no_w_full <- length(w_full) mu <- getResourceMort(params) NR <- initialNResource(params) - + # Check resource level ---- if (!is.null(resource_level)) { assert_that(is.numeric(resource_level)) @@ -175,7 +184,7 @@ setResource <- function(params, resource_capacity[is.nan(resource_level)] <- 0 comment(resource_capacity) <- comment(resource_level) } - + # Check growth rate ---- if (!is.null(resource_rate)) { assert_that(is.numeric(resource_rate)) @@ -191,7 +200,7 @@ setResource <- function(params, stop("The 'resource_rate' must always be non-negative.") } } - + # Check capacity ---- if (!is.null(resource_capacity)) { assert_that(is.numeric(resource_capacity)) @@ -208,9 +217,9 @@ setResource <- function(params, stop("The 'resource_capacity' must never be negative.") } } - + # Handle w_pp_cutoff change when capacity is not explicitly provided ---- - if (is.null(resource_capacity) && is.null(resource_level) && + if (is.null(resource_capacity) && is.null(resource_level) && !is.null(old_w_pp_cutoff) && w_pp_cutoff != old_w_pp_cutoff) { if (w_pp_cutoff > old_w_pp_cutoff) { stop("You cannot increase w_pp_cutoff without also providing the resource_capacity for the extended range.") @@ -224,7 +233,7 @@ setResource <- function(params, # Update NR for consistency NR <- params@initial_n_pp } - + # Balance ---- balance_fn <- get0(paste0("balance_", params@resource_dynamics)) if (is.null(balance)) { @@ -241,18 +250,18 @@ setResource <- function(params, # no values given, so use previous resource_rate resource_rate <- params@rr_pp } - - # For balancing the resource capacity must be above current abundance + + # For balancing the resource capacity must be above current abundance # except where both are zero if (!is.null(resource_capacity) && any(resource_capacity <= NR & NR > 0)) { stop("The 'resource_capacity' must always be greater than current resource number density.") } - + balance_fn <- get0(paste0("balance_", params@resource_dynamics)) if (!is.function(balance_fn)) { stop("There is no balancing function available for ", - params@resource_dynamics, + params@resource_dynamics, ". You should not set `balance = TRUE`.") } balance <- balance_fn(params, @@ -261,7 +270,7 @@ setResource <- function(params, resource_rate <- balance$resource_rate resource_capacity <- balance$resource_capacity } - + # Set rates if (!is.null(resource_rate)) { params@rr_pp[] <- resource_rate @@ -271,7 +280,7 @@ setResource <- function(params, params@cc_pp[] <- resource_capacity comment(params@cc_pp) <- comment(resource_capacity) } - + params@time_modified <- lubridate::now() return(params) } @@ -280,6 +289,10 @@ setResource <- function(params, #' @return A vector with the intrinsic resource birth rate for each size class. #' @export resource_rate <- function(params) { + UseMethod("resource_rate") +} +#' @export +resource_rate.MizerParams <- function(params) { params@rr_pp } @@ -287,6 +300,10 @@ resource_rate <- function(params) { #' @param value The desired new value for the respective parameter. #' @export `resource_rate<-` <- function(params, value) { + UseMethod("resource_rate<-") +} +#' @export +`resource_rate<-.MizerParams` <- function(params, value) { setResource(params, resource_rate = value) } @@ -294,12 +311,20 @@ resource_rate <- function(params) { #' @return A vector with the intrinsic resource capacity for each size class. #' @export resource_capacity <- function(params) { + UseMethod("resource_capacity") +} +#' @export +resource_capacity.MizerParams <- function(params) { params@cc_pp } #' @rdname setResource #' @export `resource_capacity<-` <- function(params, value) { + UseMethod("resource_capacity<-") +} +#' @export +`resource_capacity<-.MizerParams` <- function(params, value) { setResource(params, resource_capacity = value) } @@ -323,6 +348,10 @@ resource_level <- function(params) { #' @return The name of the function that determines the resource dynamics. #' @export resource_dynamics <- function(params) { + UseMethod("resource_dynamics") +} +#' @export +resource_dynamics.MizerParams <- function(params) { params@resource_dynamics } @@ -334,5 +363,9 @@ resource_dynamics <- function(params) { #' resource_dynamics(params) #' resource_dynamics(params) <- "resource_constant" `resource_dynamics<-` <- function(params, value) { + UseMethod("resource_dynamics<-") +} +#' @export +`resource_dynamics<-.MizerParams` <- function(params, value) { setResource(params, resource_dynamics = value) } diff --git a/R/setSearchVolume.R b/R/setSearchVolume.R index aee54ac1..c3b34d52 100644 --- a/R/setSearchVolume.R +++ b/R/setSearchVolume.R @@ -41,6 +41,10 @@ #' @export #' @family functions for setting parameters setSearchVolume <- function(params, search_vol = NULL, reset = FALSE, ...) { + UseMethod("setSearchVolume") +} +#' @export +setSearchVolume.MizerParams <- function(params, search_vol = NULL, reset = FALSE, ...) { assert_that(is(params, "MizerParams"), is.flag(reset)) species_params <- params@species_params @@ -111,6 +115,10 @@ setSearchVolume <- function(params, search_vol = NULL, reset = FALSE, ...) { #' x size) holding the search volume #' @export getSearchVolume <- function(params) { + UseMethod("getSearchVolume") +} +#' @export +getSearchVolume.MizerParams <- function(params) { params@search_vol } @@ -118,6 +126,10 @@ getSearchVolume <- function(params) { #' @rdname setSearchVolume #' @export search_vol <- function(params) { + UseMethod("search_vol") +} +#' @export +search_vol.MizerParams <- function(params) { params@search_vol } @@ -125,5 +137,9 @@ search_vol <- function(params) { #' @param value search_vol #' @export `search_vol<-` <- function(params, value) { + UseMethod("search_vol<-") +} +#' @export +`search_vol<-.MizerParams` <- function(params, value) { setSearchVolume(params, search_vol = value) } diff --git a/man/animateSpectra.Rd b/man/animateSpectra.Rd index 40af912a..55ed5574 100644 --- a/man/animateSpectra.Rd +++ b/man/animateSpectra.Rd @@ -4,7 +4,17 @@ \alias{animateSpectra} \title{Animation of the abundance spectra} \usage{ -animateSpectra(sim, ...) +animateSpectra( + sim, + species, + time_range, + wlim, + ylim, + power, + total, + resource, + ... +) } \arguments{ \item{sim}{A MizerSim object} diff --git a/man/compareParams.Rd b/man/compareParams.Rd index 99f9c244..0531e1dc 100644 --- a/man/compareParams.Rd +++ b/man/compareParams.Rd @@ -4,7 +4,7 @@ \alias{compareParams} \title{Compare two MizerParams objects and print out differences} \usage{ -compareParams(params1, ...) +compareParams(params1, params2, ...) } \arguments{ \item{params1}{First MizerParams object} diff --git a/man/initialN-set.Rd b/man/initialN-set.Rd index 883b044a..1ddcd9c7 100644 --- a/man/initialN-set.Rd +++ b/man/initialN-set.Rd @@ -3,11 +3,17 @@ \name{initialN<-} \alias{initialN<-} \alias{initialN} +\alias{initialN.MizerParams} +\alias{initialN.MizerSim} \title{Initial values for fish spectra} \usage{ initialN(params) <- value initialN(object) + +\method{initialN}{MizerParams}(object) + +\method{initialN}{MizerSim}(object) } \arguments{ \item{params}{A MizerParams object} diff --git a/man/initialNResource-set.Rd b/man/initialNResource-set.Rd index fe59f15c..5f1b7d48 100644 --- a/man/initialNResource-set.Rd +++ b/man/initialNResource-set.Rd @@ -3,11 +3,17 @@ \name{initialNResource<-} \alias{initialNResource<-} \alias{initialNResource} +\alias{initialNResource.MizerParams} +\alias{initialNResource.MizerSim} \title{Initial value for resource spectrum} \usage{ initialNResource(params) <- value initialNResource(object) + +\method{initialNResource}{MizerParams}(object) + +\method{initialNResource}{MizerSim}(object) } \arguments{ \item{params}{A MizerParams object} diff --git a/man/matchBiomasses.Rd b/man/matchBiomasses.Rd index 16e557ab..8d8332f4 100644 --- a/man/matchBiomasses.Rd +++ b/man/matchBiomasses.Rd @@ -4,7 +4,7 @@ \alias{matchBiomasses} \title{Match biomasses to observations} \usage{ -matchBiomasses(params, ...) +matchBiomasses(params, species = NULL, ...) } \arguments{ \item{params}{A MizerParams object} diff --git a/man/matchGrowth.Rd b/man/matchGrowth.Rd index 4de50cbf..3926c373 100644 --- a/man/matchGrowth.Rd +++ b/man/matchGrowth.Rd @@ -4,7 +4,7 @@ \alias{matchGrowth} \title{Adjust model to produce observed growth} \usage{ -matchGrowth(params, ...) +matchGrowth(params, species = NULL, keep = c("egg", "biomass", "number"), ...) } \arguments{ \item{params}{A MizerParams object} diff --git a/man/matchNumbers.Rd b/man/matchNumbers.Rd index e3826b15..4a84fcb9 100644 --- a/man/matchNumbers.Rd +++ b/man/matchNumbers.Rd @@ -4,7 +4,7 @@ \alias{matchNumbers} \title{Match numbers to observations} \usage{ -matchNumbers(params, ...) +matchNumbers(params, species = NULL, ...) } \arguments{ \item{params}{A MizerParams object} diff --git a/man/matchYields.Rd b/man/matchYields.Rd index 49b57645..5f9d34b1 100644 --- a/man/matchYields.Rd +++ b/man/matchYields.Rd @@ -4,7 +4,7 @@ \alias{matchYields} \title{Match yields to observations} \usage{ -matchYields(params, ...) +matchYields(params, species = NULL, ...) } \arguments{ \item{params}{A MizerParams object} diff --git a/man/scaleModel.Rd b/man/scaleModel.Rd index 7fd9aa06..94e82165 100644 --- a/man/scaleModel.Rd +++ b/man/scaleModel.Rd @@ -4,7 +4,7 @@ \alias{scaleModel} \title{Change scale of the model} \usage{ -scaleModel(params, ...) +scaleModel(params, factor, ...) } \arguments{ \item{params}{A MizerParams object} diff --git a/man/setBevertonHolt.Rd b/man/setBevertonHolt.Rd index 4e9b9dbc..7620168d 100644 --- a/man/setBevertonHolt.Rd +++ b/man/setBevertonHolt.Rd @@ -4,26 +4,20 @@ \alias{setBevertonHolt} \title{Set Beverton-Holt reproduction without changing the steady state} \usage{ -setBevertonHolt( - params, - R_factor = deprecated(), - erepro, - R_max, - reproduction_level -) +setBevertonHolt(params, erepro, R_max, reproduction_level, ...) } \arguments{ \item{params}{A MizerParams object} -\item{R_factor}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use -\code{reproduction_level = 1 / R_factor} instead.} - \item{erepro}{Reproductive efficiency for each species. See details.} \item{R_max}{Maximum reproduction rate. See details.} \item{reproduction_level}{Sets \code{R_max} so that the reproduction rate at the initial state is \code{R_max * reproduction_level}.} + +\item{R_factor}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use +\code{reproduction_level = 1 / R_factor} instead.} } \value{ A MizerParams object diff --git a/man/setDiffusion.Rd b/man/setDiffusion.Rd index 3149d258..2d41784d 100644 --- a/man/setDiffusion.Rd +++ b/man/setDiffusion.Rd @@ -2,11 +2,14 @@ % Please edit documentation in R/setDiffusion.R \name{setDiffusion} \alias{setDiffusion} +\alias{setDiffusion.MizerParams} \alias{diffusion} \alias{diffusion<-} \title{Set diffusion rate} \usage{ -setDiffusion(params, diffusion = NULL, ...) +setDiffusion(params, diffusion = NULL, reset = FALSE, ...) + +\method{setDiffusion}{MizerParams}(params, diffusion = NULL, reset = FALSE, ...) diffusion(params) @@ -18,6 +21,13 @@ diffusion(params) <- value \item{diffusion}{Optional. An array (species x size) holding the diffusion rate. If not supplied, the diffusion rate is left unchanged. Initially it is set to 0.} +\item{reset}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +If set to TRUE, then the diffusion rate will be reset to the value +calculated from the species parameters, even if it was previously +overwritten with a custom value. If set to FALSE (default) then a +recalculation from the species parameters will take place only if no +custom value has been set.} + \item{...}{Unused} \item{value}{diffusion} diff --git a/man/setExtMort.Rd b/man/setExtMort.Rd index 26b64f36..d6c1e5d3 100644 --- a/man/setExtMort.Rd +++ b/man/setExtMort.Rd @@ -13,7 +13,6 @@ setExtMort( z0pre = 0.6, z0exp = params@resource_params$n - 1, reset = FALSE, - z0 = deprecated(), ... ) @@ -45,12 +44,12 @@ previously overwritten with a custom value. If set to FALSE (default) then a recalculation from the species parameters will take place only if no custom value has been set.} -\item{z0}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{ext_mort} instead. Not to -be confused with the species_parameter \code{z0}.} - \item{...}{Unused} \item{value}{ext_mort} + +\item{z0}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{ext_mort} instead. Not to +be confused with the species_parameter \code{z0}.} } \value{ \code{setExtMort()}: A MizerParams object with updated external mortality diff --git a/man/setInitialValues.Rd b/man/setInitialValues.Rd index 13e2b152..a9426f85 100644 --- a/man/setInitialValues.Rd +++ b/man/setInitialValues.Rd @@ -4,7 +4,7 @@ \alias{setInitialValues} \title{Set initial values to values from a simulation} \usage{ -setInitialValues(params, sim, time_range, geometric_mean = FALSE) +setInitialValues(params, sim, time_range, geometric_mean = FALSE, ...) } \arguments{ \item{params}{A \code{MizerParams} object in which to set the initial values} diff --git a/man/setInteraction.Rd b/man/setInteraction.Rd index 3973afbb..c50f9a9b 100644 --- a/man/setInteraction.Rd +++ b/man/setInteraction.Rd @@ -6,7 +6,7 @@ \alias{interaction_matrix<-} \title{Set species interaction matrix} \usage{ -setInteraction(params, interaction = NULL) +setInteraction(params, interaction = NULL, ...) interaction_matrix(params) diff --git a/man/setMetadata.Rd b/man/setMetadata.Rd index dc060b4f..a4c019a8 100644 --- a/man/setMetadata.Rd +++ b/man/setMetadata.Rd @@ -5,7 +5,15 @@ \alias{getMetadata} \title{Set metadata for a model} \usage{ -setMetadata(params, title, description, authors, url, doi, ...) +setMetadata( + params, + title = NULL, + description = NULL, + authors = NULL, + url = NULL, + doi = NULL, + ... +) getMetadata(params) } diff --git a/man/setParams.Rd b/man/setParams.Rd index 95842ca8..2549f0e7 100644 --- a/man/setParams.Rd +++ b/man/setParams.Rd @@ -14,7 +14,7 @@ species x prey species). By default all entries are 1. See "Setting interaction matrix" section below.} \item{...}{ - Arguments passed on to \code{\link[=setPredKernel]{setPredKernel}}, \code{\link[=setSearchVolume]{setSearchVolume}}, \code{\link[=setMaxIntakeRate]{setMaxIntakeRate}}, \code{\link[=setMetabolicRate]{setMetabolicRate}}, \code{\link[=setExtMort]{setExtMort}}, \code{\link[=setReproduction]{setReproduction}}, \code{\link[=setFishing]{setFishing}} + Arguments passed on to \code{\link[=setPredKernel]{setPredKernel}}, \code{\link[=setSearchVolume]{setSearchVolume}}, \code{\link[=setMaxIntakeRate]{setMaxIntakeRate}}, \code{\link[=setMetabolicRate]{setMetabolicRate}}, \code{\link[=setExtMort]{setExtMort}}, \code{\link[=setExtEncounter]{setExtEncounter}}, \code{\link[=setReproduction]{setReproduction}}, \code{\link[=setFishing]{setFishing}} \describe{ \item{\code{pred_kernel}}{Optional. An array (species x predator size x prey size) that holds the predation coefficient of each predator at size on each prey @@ -41,8 +41,9 @@ Default value is 0.6.} \item{\code{z0exp}}{If \code{z0}, the mortality from other sources, is not a column in the species data frame, it is calculated as \code{z0pre * w_max ^ z0exp}. Default value is \code{n-1}.} - \item{\code{z0}}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{ext_mort} instead. Not to -be confused with the species_parameter \code{z0}.} + \item{\code{ext_encounter}}{Optional. An array (species x size) holding the external +encounter rate. If not supplied, the external encounter rate is left +unchanged. Initially is is set to 0.} \item{\code{maturity}}{Optional. An array (species x size) that holds the proportion of individuals of each species at size that are mature. If not supplied, a default is set as described in the section "Setting reproduction".} diff --git a/man/setResource.Rd b/man/setResource.Rd index 730c7721..73e46a55 100644 --- a/man/setResource.Rd +++ b/man/setResource.Rd @@ -18,12 +18,10 @@ setResource( resource_capacity = NULL, resource_level = NULL, resource_dynamics = NULL, - balance = NULL, lambda = resource_params(params)[["lambda"]], n = resource_params(params)[["n"]], w_pp_cutoff = resource_params(params)[["w_pp_cutoff"]], - r_pp = deprecated(), - kappa = deprecated(), + balance = NULL, ... ) @@ -67,12 +65,6 @@ determines the resource capacity, so do not specify both this and resource dynamics by calculating the resource spectrum at the next time step from the current state.} -\item{balance}{By default, if possible, the resource parameters are -set so that the resource replenishes at the same rate at which it is -consumed. In this case you should only specify either the resource rate -or the resource capacity (or resource level) because the other is then -determined automatically. Set to FALSE if you do not want the balancing.} - \item{lambda}{Used to set power-law exponent for resource capacity if the \code{resource_capacity} argument is given as a single number.} @@ -86,15 +78,21 @@ be decreased. In that case, both the carrying capacity and the initial resource abundance will be cut off at the new value. To increase the cutoff, you must also provide the \code{resource_capacity} for the extended range.} +\item{balance}{By default, if possible, the resource parameters are +set so that the resource replenishes at the same rate at which it is +consumed. In this case you should only specify either the resource rate +or the resource capacity (or resource level) because the other is then +determined automatically. Set to FALSE if you do not want the balancing.} + +\item{...}{Unused} + +\item{value}{The desired new value for the respective parameter.} + \item{r_pp}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}. Use \code{resource_rate} argument instead.} \item{kappa}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}. Use \code{resource_capacity} argument instead.} - -\item{...}{Unused} - -\item{value}{The desired new value for the respective parameter.} } \value{ \code{setResource}: A MizerParams object with updated resource parameters diff --git a/man/setRmax.Rd b/man/setRmax.Rd index 98de09c0..4b974283 100644 --- a/man/setRmax.Rd +++ b/man/setRmax.Rd @@ -4,14 +4,11 @@ \alias{setRmax} \title{Alias for \code{setBevertonHolt()}} \usage{ -setRmax(params, R_factor = deprecated(), erepro, R_max, reproduction_level) +setRmax(params, erepro, R_max, reproduction_level, ...) } \arguments{ \item{params}{A MizerParams object} -\item{R_factor}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use -\code{reproduction_level = 1 / R_factor} instead.} - \item{erepro}{Reproductive efficiency for each species. See details.} \item{R_max}{Maximum reproduction rate. See details.} From 3ba3c211bd20e3287e35e385b8bd4b427e5c695d Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Sat, 22 Nov 2025 15:28:23 +0000 Subject: [PATCH 10/16] Deal with weird message dispatch error The following simple code demonstrates the problem: ``` test <- function(params, ...) { UseMethod("test") } test.MizerParams <- function(params, p = 1) { p } test(NS_params, p = 1) ``` --- R/setMetabolicRate.R | 9 +++++---- man/setMetabolicRate.Rd | 4 ++-- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/R/setMetabolicRate.R b/R/setMetabolicRate.R index 1e180d37..12ed25a1 100644 --- a/R/setMetabolicRate.R +++ b/R/setMetabolicRate.R @@ -20,7 +20,7 @@ #' in the species parameter data frame. If the critical feeding level is not #' specified, a default of \eqn{f_c = 0.2} is used. #' -#' @param params MizerParams +#' @param object A MizerParams object #' @param metab Optional. An array (species x size) holding the metabolic rate #' for each species at size. If not supplied, a default is set as described in #' the section "Setting metabolic rate". @@ -38,16 +38,17 @@ #' @return `setMetabolicRate()`: A MizerParams object with updated metabolic rate. #' @export #' @family functions for setting parameters -setMetabolicRate <- function(params, metab = NULL, p = NULL, +setMetabolicRate <- function(object, metab = NULL, p = NULL, reset = FALSE, ...) { UseMethod("setMetabolicRate") } #' @export -setMetabolicRate.MizerParams <- function(params, metab = NULL, p = NULL, +setMetabolicRate.MizerParams <- function(object, metab = NULL, p = NULL, reset = FALSE, ...) { assert_that(is.flag(reset)) + params <- object if (!is.null(p)) { - assert_that(is.numeric(p)) + if (!is.numeric(p)) stop("p must be numeric") params <- set_species_param_default(params, "p", p) } else { params <- set_species_param_default(params, "p", 3/4) diff --git a/man/setMetabolicRate.Rd b/man/setMetabolicRate.Rd index d02f0ce3..49706c41 100644 --- a/man/setMetabolicRate.Rd +++ b/man/setMetabolicRate.Rd @@ -7,7 +7,7 @@ \alias{metab<-} \title{Set metabolic rate} \usage{ -setMetabolicRate(params, metab = NULL, p = NULL, reset = FALSE, ...) +setMetabolicRate(object, metab = NULL, p = NULL, reset = FALSE, ...) getMetabolicRate(params) @@ -16,7 +16,7 @@ metab(params) metab(params) <- value } \arguments{ -\item{params}{MizerParams} +\item{object}{A MizerParams object} \item{metab}{Optional. An array (species x size) holding the metabolic rate for each species at size. If not supplied, a default is set as described in From 75b53b3625cbafe0228b27f83af38c6d58d539d8 Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Sat, 22 Nov 2025 15:36:08 +0000 Subject: [PATCH 11/16] Make `setParams()` into a method --- NAMESPACE | 1 + R/newMultispeciesParams.R | 10 +++++++--- man/setParams.Rd | 5 +++-- 3 files changed, 11 insertions(+), 5 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 0c034cfe..a974eefc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -99,6 +99,7 @@ S3method(setLinetypes,MizerParams) S3method(setMaxIntakeRate,MizerParams) S3method(setMetabolicRate,MizerParams) S3method(setMetadata,MizerParams) +S3method(setParams,MizerParams) S3method(setPredKernel,MizerParams) S3method(setReproduction,MizerParams) S3method(setResource,MizerParams) diff --git a/R/newMultispeciesParams.R b/R/newMultispeciesParams.R index 456004d3..6c71713b 100644 --- a/R/newMultispeciesParams.R +++ b/R/newMultispeciesParams.R @@ -242,7 +242,7 @@ newMultispeciesParams <- function( #' } #' See the Details section below for a discussion of how to use this function. #' -#' @param params A \linkS4class{MizerParams} object +#' @param object A \linkS4class{MizerParams} object #' @inheritParams setInteraction #' @inheritDotParams setPredKernel -reset #' @inheritDotParams setSearchVolume -reset @@ -327,8 +327,12 @@ newMultispeciesParams <- function( #' @family functions for setting parameters # The reason we list `interaction` explicitly rather than including it in # the `...` is for backwards compatibility. It used to be the second argument. -setParams <- function(params, interaction = NULL, ...) { - params <- validParams(params) +setParams <- function(object, interaction = NULL, ...) { + UseMethod("setParams") +} +#' @export +setParams.MizerParams <- function(object, interaction = NULL, ...) { + params <- validParams(object) params <- setInteraction(params, interaction) params <- setPredKernel(params, ...) diff --git a/man/setParams.Rd b/man/setParams.Rd index 2549f0e7..2c760c00 100644 --- a/man/setParams.Rd +++ b/man/setParams.Rd @@ -4,10 +4,10 @@ \alias{setParams} \title{Set or change any model parameters} \usage{ -setParams(params, interaction = NULL, ...) +setParams(object, interaction = NULL, ...) } \arguments{ -\item{params}{A \linkS4class{MizerParams} object} +\item{object}{A \linkS4class{MizerParams} object} \item{interaction}{Optional interaction matrix of the species (predator species x prey species). By default all entries are 1. See "Setting @@ -16,6 +16,7 @@ interaction matrix" section below.} \item{...}{ Arguments passed on to \code{\link[=setPredKernel]{setPredKernel}}, \code{\link[=setSearchVolume]{setSearchVolume}}, \code{\link[=setMaxIntakeRate]{setMaxIntakeRate}}, \code{\link[=setMetabolicRate]{setMetabolicRate}}, \code{\link[=setExtMort]{setExtMort}}, \code{\link[=setExtEncounter]{setExtEncounter}}, \code{\link[=setReproduction]{setReproduction}}, \code{\link[=setFishing]{setFishing}} \describe{ + \item{\code{params}}{A MizerParams object} \item{\code{pred_kernel}}{Optional. An array (species x predator size x prey size) that holds the predation coefficient of each predator at size on each prey size. If not supplied, a default is set as described in section "Setting From 612c2cc3c054f191f63e6a7964fa645f10ebfab7 Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Sat, 22 Nov 2025 16:31:14 +0000 Subject: [PATCH 12/16] Document ... argument --- R/animateSpectra.R | 1 + R/calibrate.R | 4 ++++ R/compareParams.R | 2 ++ R/match.R | 3 +++ R/matchGrowth.R | 2 ++ R/setInitialValues.R | 3 ++- R/setInteraction.R | 1 + man/animateSpectra.Rd | 2 ++ man/calibrateBiomass.Rd | 2 ++ man/calibrateNumber.Rd | 2 ++ man/calibrateYield.Rd | 2 ++ man/compareParams.Rd | 2 ++ man/matchBiomasses.Rd | 2 ++ man/matchGrowth.Rd | 2 ++ man/matchNumbers.Rd | 2 ++ man/matchYields.Rd | 2 ++ man/scaleModel.Rd | 2 ++ man/setInitialValues.Rd | 2 ++ man/setInteraction.Rd | 2 ++ 19 files changed, 39 insertions(+), 1 deletion(-) diff --git a/R/animateSpectra.R b/R/animateSpectra.R index 8eb621d8..f8522602 100644 --- a/R/animateSpectra.R +++ b/R/animateSpectra.R @@ -21,6 +21,7 @@ #' species in the system is plotted as well. Default is FALSE. #' @param resource A boolean value that determines whether resource is included. #' Default is TRUE. +#' @param ... Additional arguments passed to the method. #' #' @return A plotly object #' @export diff --git a/R/calibrate.R b/R/calibrate.R index 884a19c3..20fee66d 100644 --- a/R/calibrate.R +++ b/R/calibrate.R @@ -23,6 +23,7 @@ #' use [calibrateYield()] instead of this function. #' #' @param params A MizerParams object +#' @param ... Additional arguments passed to the method. #' @return A MizerParams object #' @export #' @examples @@ -88,6 +89,7 @@ calibrateBiomass.MizerParams <- function(params) { #' use [calibrateYield()] instead of this function. #' #' @param params A MizerParams object +#' @param ... Additional arguments passed to the method. #' @return A MizerParams object #' @export #' @examples @@ -148,6 +150,7 @@ calibrateNumber.MizerParams <- function(params) { #' use [calibrateBiomass()] instead of this function. #' #' @param params A MizerParams object +#' @param ... Additional arguments passed to the method. #' @return A MizerParams object #' @concept deprecated #' @export @@ -218,6 +221,7 @@ calibrateYield.MizerParams <- function(params) { #' #' @param params A MizerParams object #' @param factor The factor by which the scale is multiplied +#' @param ... Additional arguments passed to the method. #' #' @return The rescaled MizerParams object #' @export diff --git a/R/compareParams.R b/R/compareParams.R index 19a2873e..2c0232c9 100644 --- a/R/compareParams.R +++ b/R/compareParams.R @@ -4,6 +4,8 @@ #' #' @param params1 First MizerParams object #' @param params2 Second MizerParams object +#' @param ... Additional arguments passed to the method. +#' #' @return String describing the differences #' @export #' @examples diff --git a/R/match.R b/R/match.R index 18701c0e..14986802 100644 --- a/R/match.R +++ b/R/match.R @@ -27,6 +27,7 @@ #' biomasses will be matched. A vector of species names, or a numeric vector #' with the species indices, or a logical vector indicating for each species #' whether it is to be affected (TRUE) or not. +#' @param ... Additional arguments passed to the method. #' @return A MizerParams object #' @export #' @examples @@ -107,6 +108,7 @@ matchBiomasses.MizerParams <- function(params, species = NULL) { #' numbers will be matched. A vector of species names, or a numeric vector #' with the species indices, or a logical vector indicating for each species #' whether it is to be affected (TRUE) or not. +#' @param ... Additional arguments passed to the method. #' @return A MizerParams object #' @export #' @examples @@ -190,6 +192,7 @@ matchNumbers.MizerParams <- function(params, species = NULL) { #' yields will be matched. A vector of species names, or a numeric vector #' with the species indices, or a logical vector indicating for each species #' whether it is to be affected (TRUE) or not. +#' @param ... Additional arguments passed to the method. #' @return A MizerParams object #' @concept deprecated #' @export diff --git a/R/matchGrowth.R b/R/matchGrowth.R index 184a963f..4cb2beaa 100644 --- a/R/matchGrowth.R +++ b/R/matchGrowth.R @@ -23,6 +23,8 @@ #' choices are "egg" which keeps the egg density constant, "biomass" which #' keeps the total biomass of the species constant and "number" which keeps #' the total number of individuals constant. +#' @param ... Additional arguments passed to the method. +#' #' @return A modified MizerParams object with rescaled search volume, maximum #' consumption rate and metabolic rate and rescaled species parameters #' `gamma`,`h`, `ks` and `k`. diff --git a/R/setInitialValues.R b/R/setInitialValues.R index 8a087cac..a8b9c916 100644 --- a/R/setInitialValues.R +++ b/R/setInitialValues.R @@ -30,6 +30,7 @@ #' time range is a geometric mean instead of the default arithmetic mean. This #' does not affect the average of the effort or of other components, which is #' always arithmetic. +#' @param ... Additional arguments passed to the method. #' #' @return The `params` object with updated initial values and initial effort. #' Because of the way the @@ -49,7 +50,7 @@ setInitialValues <- function(params, sim, time_range, geometric_mean = FALSE, .. UseMethod("setInitialValues") } #' @export -setInitialValues.MizerParams <- function(params, sim, time_range, geometric_mean = FALSE) { +setInitialValues.MizerParams <- function(params, sim, time_range, geometric_mean = FALSE, ...) { assert_that(is(sim, "MizerSim"), is.flag(geometric_mean)) no_t <- dim(sim@n)[1] diff --git a/R/setInteraction.R b/R/setInteraction.R index 9e2bc099..22b92323 100644 --- a/R/setInteraction.R +++ b/R/setInteraction.R @@ -42,6 +42,7 @@ #' @param interaction Optional interaction matrix of the species (predator #' species x prey species). By default all entries are 1. See "Setting #' interaction matrix" section below. +#' @param ... Additional arguments passed to the method. #' #' @return `setInteraction`: A MizerParams object with updated interaction #' matrix diff --git a/man/animateSpectra.Rd b/man/animateSpectra.Rd index 55ed5574..b1058337 100644 --- a/man/animateSpectra.Rd +++ b/man/animateSpectra.Rd @@ -43,6 +43,8 @@ species in the system is plotted as well. Default is FALSE.} \item{resource}{A boolean value that determines whether resource is included. Default is TRUE.} + +\item{...}{Additional arguments passed to the method.} } \value{ A plotly object diff --git a/man/calibrateBiomass.Rd b/man/calibrateBiomass.Rd index cf0f7d1b..a11f52b9 100644 --- a/man/calibrateBiomass.Rd +++ b/man/calibrateBiomass.Rd @@ -8,6 +8,8 @@ calibrateBiomass(params, ...) } \arguments{ \item{params}{A MizerParams object} + +\item{...}{Additional arguments passed to the method.} } \value{ A MizerParams object diff --git a/man/calibrateNumber.Rd b/man/calibrateNumber.Rd index 928fa366..9e39e360 100644 --- a/man/calibrateNumber.Rd +++ b/man/calibrateNumber.Rd @@ -8,6 +8,8 @@ calibrateNumber(params, ...) } \arguments{ \item{params}{A MizerParams object} + +\item{...}{Additional arguments passed to the method.} } \value{ A MizerParams object diff --git a/man/calibrateYield.Rd b/man/calibrateYield.Rd index 50011d40..d2e794fb 100644 --- a/man/calibrateYield.Rd +++ b/man/calibrateYield.Rd @@ -8,6 +8,8 @@ calibrateYield(params, ...) } \arguments{ \item{params}{A MizerParams object} + +\item{...}{Additional arguments passed to the method.} } \value{ A MizerParams object diff --git a/man/compareParams.Rd b/man/compareParams.Rd index 0531e1dc..be370c9a 100644 --- a/man/compareParams.Rd +++ b/man/compareParams.Rd @@ -10,6 +10,8 @@ compareParams(params1, params2, ...) \item{params1}{First MizerParams object} \item{params2}{Second MizerParams object} + +\item{...}{Additional arguments passed to the method.} } \value{ String describing the differences diff --git a/man/matchBiomasses.Rd b/man/matchBiomasses.Rd index 8d8332f4..3cb6a929 100644 --- a/man/matchBiomasses.Rd +++ b/man/matchBiomasses.Rd @@ -13,6 +13,8 @@ matchBiomasses(params, species = NULL, ...) biomasses will be matched. A vector of species names, or a numeric vector with the species indices, or a logical vector indicating for each species whether it is to be affected (TRUE) or not.} + +\item{...}{Additional arguments passed to the method.} } \value{ A MizerParams object diff --git a/man/matchGrowth.Rd b/man/matchGrowth.Rd index 3926c373..1a049481 100644 --- a/man/matchGrowth.Rd +++ b/man/matchGrowth.Rd @@ -19,6 +19,8 @@ not.} choices are "egg" which keeps the egg density constant, "biomass" which keeps the total biomass of the species constant and "number" which keeps the total number of individuals constant.} + +\item{...}{Additional arguments passed to the method.} } \value{ A modified MizerParams object with rescaled search volume, maximum diff --git a/man/matchNumbers.Rd b/man/matchNumbers.Rd index 4a84fcb9..f1d2a895 100644 --- a/man/matchNumbers.Rd +++ b/man/matchNumbers.Rd @@ -13,6 +13,8 @@ matchNumbers(params, species = NULL, ...) numbers will be matched. A vector of species names, or a numeric vector with the species indices, or a logical vector indicating for each species whether it is to be affected (TRUE) or not.} + +\item{...}{Additional arguments passed to the method.} } \value{ A MizerParams object diff --git a/man/matchYields.Rd b/man/matchYields.Rd index 5f9d34b1..c53a07aa 100644 --- a/man/matchYields.Rd +++ b/man/matchYields.Rd @@ -13,6 +13,8 @@ matchYields(params, species = NULL, ...) yields will be matched. A vector of species names, or a numeric vector with the species indices, or a logical vector indicating for each species whether it is to be affected (TRUE) or not.} + +\item{...}{Additional arguments passed to the method.} } \value{ A MizerParams object diff --git a/man/scaleModel.Rd b/man/scaleModel.Rd index 94e82165..f90148db 100644 --- a/man/scaleModel.Rd +++ b/man/scaleModel.Rd @@ -10,6 +10,8 @@ scaleModel(params, factor, ...) \item{params}{A MizerParams object} \item{factor}{The factor by which the scale is multiplied} + +\item{...}{Additional arguments passed to the method.} } \value{ The rescaled MizerParams object diff --git a/man/setInitialValues.Rd b/man/setInitialValues.Rd index a9426f85..1ee0d013 100644 --- a/man/setInitialValues.Rd +++ b/man/setInitialValues.Rd @@ -21,6 +21,8 @@ If TRUE then the average of the abundances over the time range is a geometric mean instead of the default arithmetic mean. This does not affect the average of the effort or of other components, which is always arithmetic.} + +\item{...}{Additional arguments passed to the method.} } \value{ The \code{params} object with updated initial values and initial effort. diff --git a/man/setInteraction.Rd b/man/setInteraction.Rd index c50f9a9b..304fec0d 100644 --- a/man/setInteraction.Rd +++ b/man/setInteraction.Rd @@ -19,6 +19,8 @@ interaction_matrix(params) <- value species x prey species). By default all entries are 1. See "Setting interaction matrix" section below.} +\item{...}{Additional arguments passed to the method.} + \item{value}{An interaction matrix} } \value{ From b838edac120f89e2b53d24f058ddbe57717fd528 Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Sat, 22 Nov 2025 17:21:13 +0000 Subject: [PATCH 13/16] Continuing conversion to methods --- NAMESPACE | 51 ++++ R/plotBiomassObservedVsModel.R | 35 ++- R/plotYieldObservedVsModel.R | 51 ++-- R/rate_functions.R | 395 +++++++++++++++++++----------- R/saveParams.R | 4 + R/species_params.R | 149 ++++++----- R/steady.R | 31 ++- R/steadySingleSpecies.R | 5 + R/summary_methods.R | 183 ++++++++------ man/plotBiomassObservedVsModel.Rd | 8 +- man/plotYieldObservedVsModel.Rd | 8 +- 11 files changed, 601 insertions(+), 319 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index a974eefc..5bbae7e3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,6 +5,7 @@ S3method("diffusion<-",MizerParams) S3method("ext_encounter<-",MizerParams) S3method("ext_mort<-",MizerParams) S3method("gear_params<-",MizerParams) +S3method("given_species_params<-",MizerParams) S3method("initialN<-",MizerParams) S3method("initialNResource<-",MizerParams) S3method("initial_effort<-",MizerParams) @@ -17,36 +18,77 @@ S3method("resource_dynamics<-",MizerParams) S3method("resource_rate<-",MizerParams) S3method("search_vol<-",MizerParams) S3method("selectivity<-",MizerParams) +S3method("species_params<-",MizerParams) S3method(addSpecies,MizerParams) S3method(age_mat,MizerParams) S3method(age_mat_vB,MizerParams) S3method(age_mat_vB,data.frame) S3method(age_mat_vB,default) S3method(animateSpectra,MizerSim) +S3method(calculated_species_params,MizerParams) S3method(calibrateBiomass,MizerParams) S3method(calibrateNumber,MizerParams) S3method(calibrateYield,MizerParams) S3method(catchability,MizerParams) S3method(compareParams,MizerParams) S3method(diffusion,MizerParams) +S3method(distanceMaxRelRDI,MizerParams) +S3method(distanceSSLogN,MizerParams) S3method(ext_encounter,MizerParams) S3method(ext_mort,MizerParams) S3method(gear_params,MizerParams) +S3method(getBiomass,MizerParams) +S3method(getBiomass,MizerSim) S3method(getCatchability,MizerParams) S3method(getColours,MizerParams) +S3method(getCommunitySlope,MizerSim) +S3method(getCriticalFeedingLevel,MizerParams) +S3method(getDiet,MizerParams) +S3method(getEGrowth,MizerParams) +S3method(getERepro,MizerParams) +S3method(getEReproAndGrowth,MizerParams) +S3method(getEncounter,MizerParams) S3method(getExtEncounter,MizerParams) S3method(getExtMort,MizerParams) +S3method(getFMort,MizerParams) +S3method(getFMort,MizerSim) +S3method(getFMortGear,MizerParams) +S3method(getFMortGear,MizerSim) +S3method(getFeedingLevel,MizerParams) +S3method(getFeedingLevel,MizerSim) +S3method(getGrowthCurves,MizerParams) +S3method(getGrowthCurves,MizerSim) S3method(getInitialEffort,MizerParams) S3method(getInteraction,MizerParams) S3method(getLinetypes,MizerParams) S3method(getMaxIntakeRate,MizerParams) +S3method(getMeanMaxWeight,MizerSim) +S3method(getMeanWeight,MizerSim) S3method(getMetabolicRate,MizerParams) S3method(getMetadata,MizerParams) +S3method(getMort,MizerParams) +S3method(getN,MizerParams) +S3method(getN,MizerSim) S3method(getPredKernel,MizerParams) +S3method(getPredMort,MizerParams) +S3method(getPredMort,MizerSim) +S3method(getPredRate,MizerParams) +S3method(getProportionOfLargeFish,MizerSim) +S3method(getRDD,MizerParams) +S3method(getRDI,MizerParams) +S3method(getRates,MizerParams) S3method(getReproductionLevel,MizerParams) S3method(getRequiredRDD,MizerParams) +S3method(getResourceMort,MizerParams) +S3method(getSSB,MizerParams) +S3method(getSSB,MizerSim) S3method(getSearchVolume,MizerParams) S3method(getSelectivity,MizerParams) +S3method(getYield,MizerParams) +S3method(getYield,MizerSim) +S3method(getYieldGear,MizerParams) +S3method(getYieldGear,MizerSim) +S3method(given_species_params,MizerParams) S3method(initialN,MizerParams) S3method(initialN,MizerSim) S3method(initialNResource,MizerParams) @@ -60,6 +102,8 @@ S3method(matchNumbers,MizerParams) S3method(matchYields,MizerParams) S3method(metab,MizerParams) S3method(plotBiomass,MizerSim) +S3method(plotBiomassObservedVsModel,MizerParams) +S3method(plotBiomassObservedVsModel,MizerSim) S3method(plotDiet,MizerParams) S3method(plotDiet,MizerSim) S3method(plotFMort,MizerParams) @@ -74,9 +118,12 @@ S3method(plotSpectra,MizerParams) S3method(plotSpectra,MizerSim) S3method(plotYield,MizerSim) S3method(plotYieldGear,MizerSim) +S3method(plotYieldObservedVsModel,MizerParams) +S3method(plotYieldObservedVsModel,MizerSim) S3method(pred_kernel,MizerParams) S3method(project,MizerParams) S3method(project,MizerSim) +S3method(projectToSteady,MizerParams) S3method(project_simple,MizerParams) S3method(removeSpecies,MizerParams) S3method(renameGear,MizerParams) @@ -84,6 +131,7 @@ S3method(renameSpecies,MizerParams) S3method(resource_capacity,MizerParams) S3method(resource_dynamics,MizerParams) S3method(resource_rate,MizerParams) +S3method(saveParams,MizerParams) S3method(scaleModel,MizerParams) S3method(search_vol,MizerParams) S3method(selectivity,MizerParams) @@ -104,6 +152,9 @@ S3method(setPredKernel,MizerParams) S3method(setReproduction,MizerParams) S3method(setResource,MizerParams) S3method(setSearchVolume,MizerParams) +S3method(species_params,MizerParams) +S3method(steady,MizerParams) +S3method(steadySingleSpecies,MizerParams) export("catchability<-") export("diffusion<-") export("ext_encounter<-") diff --git a/R/plotBiomassObservedVsModel.R b/R/plotBiomassObservedVsModel.R index d3f6c2e5..0b3adda3 100644 --- a/R/plotBiomassObservedVsModel.R +++ b/R/plotBiomassObservedVsModel.R @@ -40,6 +40,8 @@ #' shown as if their observed biomass was equal to the model biomass. #' @param return_data Whether to return the data frame for the plot (TRUE) or #' not (FALSE). Default is FALSE. +#' @param ... Additional arguments passed to the plot function. +#' #' @return A ggplot2 object with the plot of model biomass by species compared #' to observed biomass. If `return_data = TRUE`, the data frame used to #' create the plot is returned instead of the plot. @@ -64,18 +66,16 @@ #' plotBiomassObservedVsModel(params) plotBiomassObservedVsModel <- function(object, species = NULL, ratio = TRUE, log_scale = TRUE, return_data = FALSE, - labels = TRUE, show_unobserved = FALSE) { - + labels = TRUE, show_unobserved = FALSE, ...) { + UseMethod("plotBiomassObservedVsModel") +} +#' @export +plotBiomassObservedVsModel.MizerParams <- function(object, species = NULL, ratio = TRUE, + log_scale = TRUE, return_data = FALSE, + labels = TRUE, show_unobserved = FALSE, ...) { # preliminary checks - if (is(object, "MizerSim")) { - params <- object@params # pull out params object - n <- finalN(object) # we want final numbers - } else if (is(object, "MizerParams")) { - params <- object # params object is just input - n <- initialN(params) # we want initial numbers - } else { - stop("You have not provided a valid mizerSim or mizerParams object.") - } + params <- object # params object is just input + n <- initialN(params) # we want initial numbers sp_params <- params@species_params # get species_params data frame # Select appropriate species @@ -187,13 +187,22 @@ plotBiomassObservedVsModel <- function(object, species = NULL, ratio = TRUE, } gg } +#' @export +plotBiomassObservedVsModel.MizerSim <- function(object, species = NULL, ratio = FALSE, + log_scale = TRUE, return_data = FALSE, + labels = TRUE, show_unobserved = FALSE, ...) { + params <- setInitialValues(object@params, object) + plotBiomassObservedVsModel(params, species = species, ratio = ratio, + log_scale = log_scale, return_data = return_data, + labels = labels, show_unobserved = show_unobserved) +} #' @rdname plotBiomassObservedVsModel #' @export plotlyBiomassObservedVsModel <- function(object, species = NULL, ratio = FALSE, log_scale = TRUE, return_data = FALSE, - show_unobserved = FALSE) { + show_unobserved = FALSE, ...) { argg <- as.list(environment()) argg$labels <- FALSE - ggplotly(do.call("plotBiomassObservedVsModel", argg)) + ggplotly(do.call("plotBiomassObservedVsModel", argg), ...) } diff --git a/R/plotYieldObservedVsModel.R b/R/plotYieldObservedVsModel.R index 299dd231..c5209ae3 100644 --- a/R/plotYieldObservedVsModel.R +++ b/R/plotYieldObservedVsModel.R @@ -35,6 +35,8 @@ #' shown as if their observed yield was equal to the model yield. #' @param return_data Whether to return the data frame for the plot (TRUE) or #' not (FALSE). Default is FALSE. +#' @param ... Additional arguments passed to the generic function. +#' #' @return A ggplot2 object with the plot of model yield by species compared #' to observed yield. If `return_data = TRUE`, the data frame used to #' create the plot is returned instead of the plot. @@ -56,27 +58,24 @@ #' #' # Show the ratio instead #' plotYieldObservedVsModel(params, ratio = TRUE) -plotYieldObservedVsModel = function(object, species = NULL, ratio = FALSE, - log_scale = TRUE, return_data = FALSE, - labels = TRUE, show_unobserved = FALSE) { - - # preliminary checks - if (is(object, "MizerSim")) { - params = object@params # pull out params object - n <- finalN(object) # we want final numbers - } else if (is(object, "MizerParams")) { - params = object # params object is just input - n <- initialN(params) # we want initial numbers - } else { - stop("You have not provided a valid mizerSim or mizerParams object.") - } - sp_params <- params@species_params # get species_params data frame +plotYieldObservedVsModel <- function(object, species = NULL, ratio = FALSE, + log_scale = TRUE, return_data = FALSE, + labels = TRUE, show_unobserved = FALSE, ...) { + UseMethod("plotYieldObservedVsModel") +} +#' @export +plotYieldObservedVsModel.MizerParams <- function(object, species = NULL, ratio = FALSE, + log_scale = TRUE, return_data = FALSE, + labels = TRUE, show_unobserved = FALSE, ...) { + + params <- object + sp_params <- params@species_params biomass <- sweep(params@initial_n, 2, params@w * params@dw, "*") yield_model <- rowSums(biomass * getFMort(params)) # Select appropriate species - species = valid_species_arg(object, species) + species <- valid_species_arg(object, species) no_yield <- yield_model[species] == 0 if (any(no_yield)) { message("The following species are not being fished in your model ", @@ -87,7 +86,7 @@ plotYieldObservedVsModel = function(object, species = NULL, ratio = FALSE, if (length(species) == 0) stop("No species selected, please fix.") # find rows corresponding to species selected - row_select = match(species, sp_params$species) + row_select <- match(species, sp_params$species) if (!"yield_observed" %in% names(sp_params)) { stop("You have not provided values for the column 'yield_observed' ", "in the mizerParams/mizerSim object.") @@ -95,11 +94,11 @@ plotYieldObservedVsModel = function(object, species = NULL, ratio = FALSE, stop("The column 'yield_observed' in the mizerParams/mizerSim object", " is not numeric, please fix.") } else { # accept - yield_observed = sp_params$yield_observed + yield_observed <- sp_params$yield_observed } # Build dataframe - dummy = data.frame(species = species, + dummy <- data.frame(species = species, model = yield_model[row_select], observed = yield_observed[row_select]) %>% mutate(species = factor(species, levels = species), @@ -172,13 +171,23 @@ plotYieldObservedVsModel = function(object, species = NULL, ratio = FALSE, } gg } +#' @export +plotYieldObservedVsModel.MizerSim <- function(object, species = NULL, ratio = FALSE, + log_scale = TRUE, return_data = FALSE, + labels = TRUE, show_unobserved = FALSE, ...) { + params <- setInitialValues(object@params, object) + plotYieldObservedVsModel(params, species = species, ratio = ratio, + log_scale = log_scale, return_data = return_data, + labels = labels, show_unobserved = show_unobserved) +} + #' @rdname plotYieldObservedVsModel #' @export plotlyYieldObservedVsModel <- function(object, species = NULL, ratio = FALSE, log_scale = TRUE, return_data = FALSE, - show_unobserved = FALSE) { + show_unobserved = FALSE, ...) { argg <- as.list(environment()) argg$labels <- FALSE - ggplotly(do.call("plotYieldObservedVsModel", argg)) + ggplotly(do.call("plotYieldObservedVsModel", argg), ...) } \ No newline at end of file diff --git a/R/rate_functions.R b/R/rate_functions.R index e21d6e38..0e17037f 100644 --- a/R/rate_functions.R +++ b/R/rate_functions.R @@ -34,6 +34,13 @@ getRates <- function(params, n = initialN(params), n_pp = initialNResource(params), n_other = initialNOther(params), effort, t = 0, ...) { + UseMethod("getRates") +} +#' @export +getRates.MizerParams <- function(params, n = initialN(params), + n_pp = initialNResource(params), + n_other = initialNOther(params), + effort, t = 0, ...) { params <- validParams(params) if (missing(effort)) { effort <- params@initial_effort @@ -61,6 +68,13 @@ getEncounter <- function(params, n = initialN(params), n_pp = initialNResource(params), n_other = initialNOther(params), t = 0, ...) { + UseMethod("getEncounter") +} +#' @export +getEncounter.MizerParams <- function(params, n = initialN(params), + n_pp = initialNResource(params), + n_other = initialNOther(params), + t = 0, ...) { params <- validParams(params) assert_that(is.array(n), is.numeric(n_pp), @@ -116,31 +130,40 @@ getEncounter <- function(params, n = initialN(params), #' } getFeedingLevel <- function(object, n, n_pp, n_other, time_range, drop = FALSE, ...) { - if (is(object, "MizerParams")) { - params <- validParams(object) - if (missing(time_range)) time_range <- 0 - t <- min(time_range) - if (missing(n)) n <- params@initial_n - if (missing(n_pp)) n_pp <- params@initial_n_pp - if (missing(n_other)) n_other <- params@initial_n_other - # calculate feeding level - f <- get(params@rates_funcs$FeedingLevel) - feeding_level <- f(params, n = n, n_pp = n_pp, n_other = n_other, - encounter = getEncounter(params, n, n_pp, n_other, - t = t), + UseMethod("getFeedingLevel") +} + +#' @export +getFeedingLevel.MizerParams <- function(object, n, n_pp, n_other, + time_range, drop = FALSE, ...) { + params <- validParams(object) + if (missing(time_range)) time_range <- 0 + t <- min(time_range) + if (missing(n)) n <- params@initial_n + if (missing(n_pp)) n_pp <- params@initial_n_pp + if (missing(n_other)) n_other <- params@initial_n_other + # calculate feeding level + f <- get(params@rates_funcs$FeedingLevel) + feeding_level <- f(params, n = n, n_pp = n_pp, n_other = n_other, + encounter = getEncounter(params, n, n_pp, n_other, + t = t), t = t) - dimnames(feeding_level) <- dimnames(params@metab) - return(feeding_level) - } else { - sim <- object - if (missing(time_range)) { - time_range <- dimnames(sim@n)$time - } - time_elements <- get_time_elements(sim, time_range) - feed_time <- plyr::aaply(which(time_elements), 1, function(x) { - # Necessary as we only want single time step but may only have 1 - # species which makes using drop impossible - n <- array(sim@n[x, , ], dim = dim(sim@n)[2:3]) + dimnames(feeding_level) <- dimnames(params@metab) + return(feeding_level) +} + +#' @export +getFeedingLevel.MizerSim <- function(object, n, n_pp, n_other, + time_range, drop = FALSE, ...) { + sim <- object + if (missing(time_range)) { + time_range <- dimnames(sim@n)$time + } + time_elements <- get_time_elements(sim, time_range) + feed_time <- plyr::aaply(which(time_elements), 1, function(x) { + # Necessary as we only want single time step but may only have 1 + # species which makes using drop impossible + n <- array(sim@n[x, , ], dim = dim(sim@n)[2:3]) dimnames(n) <- dimnames(sim@n)[2:3] n_other <- sim@n_other[x, ] names(n_other) <- dimnames(sim@n_other)$component @@ -150,12 +173,11 @@ getFeedingLevel <- function(object, n, n_pp, n_other, n_other = n_other, time_range = t) return(feed) - }, .drop = FALSE) - # Before we drop dimensions we want to set the time dimname - names(dimnames(feed_time))[[1]] <- "time" - feed_time <- feed_time[, , , drop = drop] - return(feed_time) - } + }, .drop = FALSE) + # Before we drop dimensions we want to set the time dimname + names(dimnames(feed_time))[[1]] <- "time" + feed_time <- feed_time[, , , drop = drop] + return(feed_time) } @@ -173,6 +195,10 @@ getFeedingLevel <- function(object, n, n_pp, n_other, #' str(getFeedingLevel(NS_params)) #' } getCriticalFeedingLevel <- function(params) { + UseMethod("getCriticalFeedingLevel") +} +#' @export +getCriticalFeedingLevel.MizerParams <- function(params) { params <- validParams(params) params@metab / params@intake_max / params@species_params$alpha } @@ -208,6 +234,14 @@ getEReproAndGrowth <- function(params, n = initialN(params), n_pp = initialNResource(params), n_other = initialNOther(params), t = 0, ...) { + UseMethod("getEReproAndGrowth") +} + +#' @export +getEReproAndGrowth.MizerParams <- function(params, n = initialN(params), + n_pp = initialNResource(params), + n_other = initialNOther(params), + t = 0, ...) { params <- validParams(params) f <- get(params@rates_funcs$EReproAndGrowth) e <- f(params, n = n, n_pp = n_pp, n_other = n_other, t = t, @@ -252,6 +286,14 @@ getPredRate <- function(params, n = initialN(params), n_pp = initialNResource(params), n_other = initialNOther(params), t = 0, ...) { + UseMethod("getPredRate") +} + +#' @export +getPredRate.MizerParams <- function(params, n = initialN(params), + n_pp = initialNResource(params), + n_other = initialNOther(params), + t = 0, ...) { params <- validParams(params) f <- get(params@rates_funcs$PredRate) pred_rate <- f(params, n = n, n_pp = n_pp, n_other = n_other, t = t, @@ -301,24 +343,33 @@ getPredRate <- function(params, n = initialN(params), #' } getPredMort <- function(object, n, n_pp, n_other, time_range, drop = TRUE, ...) { - if (is(object, "MizerParams")) { - params <- validParams(object) - if (missing(n)) n <- params@initial_n - if (missing(n_pp)) n_pp <- params@initial_n_pp - if (missing(n_other)) n_other <- params@initial_n_other - if (missing(time_range)) time_range <- 0 - t <- min(time_range) - - f <- get(params@rates_funcs$PredMort) - pred_mort <- f(params, n = n, n_pp = n_pp, n_other = n_other, t = t, - pred_rate = getPredRate(params, n = n, n_pp = n_pp, - n_other = n_other, t = t)) - dimnames(pred_mort) <- list(prey = dimnames(params@initial_n)$sp, - w_prey = dimnames(params@initial_n)$w) - pred_mort - } else { - sim <- object - if (missing(time_range)) { + UseMethod("getPredMort") +} + +#' @export +getPredMort.MizerParams <- function(object, n, n_pp, n_other, + time_range, drop = TRUE, ...) { + params <- validParams(object) + if (missing(n)) n <- params@initial_n + if (missing(n_pp)) n_pp <- params@initial_n_pp + if (missing(n_other)) n_other <- params@initial_n_other + if (missing(time_range)) time_range <- 0 + t <- min(time_range) + + f <- get(params@rates_funcs$PredMort) + pred_mort <- f(params, n = n, n_pp = n_pp, n_other = n_other, t = t, + pred_rate = getPredRate(params, n = n, n_pp = n_pp, + n_other = n_other, t = t)) + dimnames(pred_mort) <- list(prey = dimnames(params@initial_n)$sp, + w_prey = dimnames(params@initial_n)$w) + pred_mort +} + +#' @export +getPredMort.MizerSim <- function(object, n, n_pp, n_other, + time_range, drop = TRUE, ...) { + sim <- object + if (missing(time_range)) { time_range <- dimnames(sim@n)$time } time_elements <- get_time_elements(sim, time_range) @@ -336,7 +387,6 @@ getPredMort <- function(object, n, n_pp, n_other, names(dimnames(pred_mort_time))[[1]] <- "time" pred_mort_time <- pred_mort_time[, , , drop = drop] return(pred_mort_time) - } } #' Alias for `getPredMort()` @@ -373,7 +423,14 @@ getResourceMort <- n_pp = initialNResource(params), n_other = initialNOther(params), t = 0, ...) { - + UseMethod("getResourceMort") +} + +#' @export +getResourceMort.MizerParams <- function(params, n = initialN(params), + n_pp = initialNResource(params), + n_other = initialNOther(params), + t = 0, ...) { params <- validParams(params) f <- get(params@rates_funcs$ResourceMort) @@ -452,20 +509,16 @@ getM2Background <- getResourceMort #' } #' getFMortGear <- function(object, effort, time_range) { - if (is(object, "MizerSim")) { - sim <- object - if (missing(time_range)) { - time_range <- dimnames(sim@effort)$time - } - time_elements <- get_time_elements(sim, time_range) - f_mort_gear <- getFMortGear(sim@params, sim@effort) - return(f_mort_gear[time_elements, , , , drop = FALSE]) - } else { - params <- validParams(object) - if (missing(effort)) { - effort <- params@initial_effort - } - if (is(effort, "numeric")) { + UseMethod("getFMortGear") +} + +#' @export +getFMortGear.MizerParams <- function(object, effort, time_range) { + params <- validParams(object) + if (missing(effort)) { + effort <- params@initial_effort + } + if (is(effort, "numeric")) { no_gear <- dim(params@catchability)[1] # If a single value, just repeat it for all gears if (length(effort) == 1) { @@ -478,7 +531,6 @@ getFMortGear <- function(object, effort, time_range) { f <- mizerFMortGear(params, effort = effort) dimnames(f) <- dimnames(params@selectivity) return(f) - } else { # assuming effort is a matrix, and object is of MizerParams class no_gear <- dim(params@catchability)[1] @@ -496,9 +548,18 @@ getFMortGear <- function(object, effort, time_range) { out <- aperm(out, c(4, 1, 2, 3)) return(out) } - } } +#' @export +getFMortGear.MizerSim <- function(object, effort, time_range) { + sim <- object + if (missing(time_range)) { + time_range <- dimnames(sim@effort)$time + } + time_elements <- get_time_elements(sim, time_range) + f_mort_gear <- getFMortGear(sim@params, sim@effort) + return(f_mort_gear[time_elements, , , , drop = FALSE]) +} #' Get the total fishing mortality rate from all fishing gears by time, species #' and size. @@ -569,94 +630,97 @@ getFMortGear <- function(object, effort, time_range) { #' F <- getFMort(sim, time_range = c(10, 20)) #' } getFMort <- function(object, effort, time_range, drop = TRUE) { - if (is(object, "MizerParams")) { - params <- validParams(object) - if (missing(effort)) { - effort <- params@initial_effort - } - if (missing(time_range)) time_range <- 0 - t <- min(time_range) - n <- params@initial_n - n_pp <- params@initial_n_pp - n_other <- params@initial_n_other - no_gears <- dim(params@catchability)[[1]] - f <- get(params@rates_funcs$FMort) - if (length(dim(effort)) == 2) { - times <- dimnames(effort)$time - f_mort <- array(0, - dim = c(dim(effort)[[1]], dim(params@initial_n)), - dimnames = c(list(time = times), - dimnames(params@initial_n))) - times <- as.numeric(times) - for (i in seq_len(dim(effort)[1])) { - f_mort[i, , ] <- - f(params, n = n, n_pp = n_pp, n_other = n_other, - effort = effort[i, ], t = times[i], - e_growth = getEGrowth(params, n = n, n_pp = n_pp, - n_other = n_other, t = times[i]), - pred_mort = getPredMort(params, n = n, n_pp = n_pp, - n_other = n_other, - time_range = times[i])) - } - return(f_mort) - } else if (length(effort) <= 1) { - fmort <- f(params, n = n, n_pp = n_pp, n_other = n_other, - effort = rep(effort, no_gears), t = t, - e_growth = getEGrowth(params, n = n, n_pp = n_pp, - n_other = n_other, t = t), - pred_mort = getPredMort(params, n = n, n_pp = n_pp, - n_other = n_other, - time_range = t)) - dimnames(fmort) <- dimnames(params@metab) - return(fmort) - } else if (length(effort) == no_gears) { - fmort <- f(params, n = n, n_pp = n_pp, n_other = n_other, - effort = effort, t = t, - e_growth = getEGrowth(params, n = n, n_pp = n_pp, - n_other = n_other, t = t), - pred_mort = getPredMort(params, n = n, n_pp = n_pp, - n_other = n_other, - time_range = t)) - dimnames(fmort) <- dimnames(params@metab) - return(fmort) - } else { - stop("Invalid effort argument") - } - } else if (is(object, "MizerSim")) { - #case where object is MizerSim, and we use effort from there - sim <- object - params <- sim@params - f <- get(params@rates_funcs$FMort) - if (missing(time_range)) { - time_range <- dimnames(sim@effort)$time - } - time_elements <- get_time_elements(sim, time_range) - effort <- sim@effort[time_elements, , drop = FALSE] - n <- sim@n[time_elements, , , drop = FALSE] - n_pp <- sim@n_pp[time_elements, , drop = FALSE] - n_other <- sim@n_other[time_elements, , drop = FALSE] + UseMethod("getFMort") +} + +#' @export +getFMort.MizerParams <- function(object, effort, time_range, drop = TRUE) { + params <- validParams(object) + if (missing(effort)) { + effort <- params@initial_effort + } + if (missing(time_range)) time_range <- 0 + t <- min(time_range) + n <- params@initial_n + n_pp <- params@initial_n_pp + n_other <- params@initial_n_other + no_gears <- dim(params@catchability)[[1]] + f <- get(params@rates_funcs$FMort) + if (length(dim(effort)) == 2) { times <- dimnames(effort)$time f_mort <- array(0, dim = c(dim(effort)[[1]], dim(params@initial_n)), - dimnames = c(list(time = times), - dimnames(params@initial_n))) + dimnames = c(list(time = times), + dimnames(params@initial_n))) times <- as.numeric(times) for (i in seq_len(dim(effort)[1])) { f_mort[i, , ] <- - f(params, n = n[i, , ], n_pp = n_pp[i, ], - n_other = n_other[i, ], effort = effort[i, ], t = times[i], - e_growth = getEGrowth(params, n = n[i, , ], n_pp = n_pp[i, ], - n_other = n_other[i, ], t = times[i]), - pred_mort = getPredMort(params, n = n[i, , ], - n_pp = n_pp[i, ], - n_other = n_other[i, ], + f(params, n = n, n_pp = n_pp, n_other = n_other, + effort = effort[i, ], t = times[i], + e_growth = getEGrowth(params, n = n, n_pp = n_pp, + n_other = n_other, t = times[i]), + pred_mort = getPredMort(params, n = n, n_pp = n_pp, + n_other = n_other, time_range = times[i])) } - return(f_mort[, , , drop = drop]) + return(f_mort) + } else if (length(effort) <= 1) { + fmort <- f(params, n = n, n_pp = n_pp, n_other = n_other, + effort = rep(effort, no_gears), t = t, + e_growth = getEGrowth(params, n = n, n_pp = n_pp, + n_other = n_other, t = t), + pred_mort = getPredMort(params, n = n, n_pp = n_pp, + n_other = n_other, + time_range = t)) + dimnames(fmort) <- dimnames(params@metab) + return(fmort) + } else if (length(effort) == no_gears) { + fmort <- f(params, n = n, n_pp = n_pp, n_other = n_other, + effort = effort, t = t, + e_growth = getEGrowth(params, n = n, n_pp = n_pp, + n_other = n_other, t = t), + pred_mort = getPredMort(params, n = n, n_pp = n_pp, + n_other = n_other, + time_range = t)) + dimnames(fmort) <- dimnames(params@metab) + return(fmort) } else { - stop("The first argument needs to be a MizerParams or MizerSim object.") + stop("Invalid effort argument") } } +#' +#' @export +getFMort.MizerSim <- function(object, effort, time_range, drop = TRUE) { + sim <- object + params <- sim@params + f <- get(params@rates_funcs$FMort) + if (missing(time_range)) { + time_range <- dimnames(sim@effort)$time + } + time_elements <- get_time_elements(sim, time_range) + effort <- sim@effort[time_elements, , drop = FALSE] + n <- sim@n[time_elements, , , drop = FALSE] + n_pp <- sim@n_pp[time_elements, , drop = FALSE] + n_other <- sim@n_other[time_elements, , drop = FALSE] + times <- dimnames(effort)$time + f_mort <- array(0, + dim = c(dim(effort)[[1]], dim(params@initial_n)), + dimnames = c(list(time = times), + dimnames(params@initial_n))) + times <- as.numeric(times) + for (i in seq_len(dim(effort)[1])) { + f_mort[i, , ] <- + f(params, n = n[i, , ], n_pp = n_pp[i, ], + n_other = n_other[i, ], effort = effort[i, ], t = times[i], + e_growth = getEGrowth(params, n = n[i, , ], n_pp = n_pp[i, ], + n_other = n_other[i, ], t = times[i]), + pred_mort = getPredMort(params, n = n[i, , ], + n_pp = n_pp[i, ], + n_other = n_other[i, ], + time_range = times[i])) + } + return(f_mort[, , , drop = drop]) +} #' Get total mortality rate @@ -692,6 +756,16 @@ getMort <- function(params, n_other = initialNOther(params), effort = getInitialEffort(params), t = 0, ...) { + UseMethod("getMort") +} + +#' @export +getMort.MizerParams <- function(params, + n = initialN(params), + n_pp = initialNResource(params), + n_other = initialNOther(params), + effort = getInitialEffort(params), + t = 0, ...) { params <- validParams(params) f <- get(params@rates_funcs$Mort) @@ -745,6 +819,14 @@ getERepro <- function(params, n = initialN(params), n_pp = initialNResource(params), n_other = initialNOther(params), t = 0, ...) { + UseMethod("getERepro") +} + +#' @export +getERepro.MizerParams <- function(params, n = initialN(params), + n_pp = initialNResource(params), + n_other = initialNOther(params), + t = 0, ...) { params <- validParams(params) f <- get(params@rates_funcs$ERepro) erepro <- f(params, n = n, n_pp = n_pp, n_other = n_other, t = t, @@ -791,6 +873,14 @@ getEGrowth <- function(params, n = initialN(params), n_pp = initialNResource(params), n_other = initialNOther(params), t = 0, ...) { + UseMethod("getEGrowth") +} + +#' @export +getEGrowth.MizerParams <- function(params, n = initialN(params), + n_pp = initialNResource(params), + n_other = initialNOther(params), + t = 0, ...) { params <- validParams(params) f <- get(params@rates_funcs$EGrowth) g <- f(params, n = n, n_pp = n_pp, n_other = n_other, t = t, @@ -827,6 +917,15 @@ getRDI <- function(params, n = initialN(params), n_pp = initialNResource(params), n_other = initialNOther(params), t = 0, ...) { + UseMethod("getRDI") +} + +#' @export +getRDI.MizerParams <- function(params, n = initialN(params), + n_pp = initialNResource(params), + n_other = initialNOther(params), + t = 0, ...) { + params <- validParams(params) f <- get(params@rates_funcs$RDI) rdi <- f(params, n = n, n_pp = n_pp, n_other = n_other, t = t, e_repro = getERepro(params, n = n, n_pp = n_pp, @@ -873,6 +972,16 @@ getRDD <- function(params, n = initialN(params), t = 0, rdi = getRDI(params, n = n, n_pp = n_pp, n_other = n_other, t = t), ...) { + UseMethod("getRDD") +} + +#' @export +getRDD.MizerParams <- function(params, n = initialN(params), + n_pp = initialNResource(params), + n_other = initialNOther(params), + t = 0, + rdi = getRDI(params, n = n, n_pp = n_pp, + n_other = n_other, t = t), ...) { params <- validParams(params) # Avoid getting into infinite loops if (params@rates_funcs$RDD == "getRDD") { diff --git a/R/saveParams.R b/R/saveParams.R index 6f2161ac..43cfb961 100644 --- a/R/saveParams.R +++ b/R/saveParams.R @@ -14,6 +14,10 @@ #' @return NULL invisibly #' @export saveParams <- function(params, file) { + UseMethod("saveParams") +} +#' @export +saveParams.MizerParams <- function(params, file) { params <- validParams(params) kernel_fns <- paste0(unique(params@species_params$pred_kernel_type), diff --git a/R/species_params.R b/R/species_params.R index e898a10c..db15e931 100644 --- a/R/species_params.R +++ b/R/species_params.R @@ -1,22 +1,22 @@ #' Species parameters -#' +#' #' These functions allow you to get or set the species-specific parameters #' stored in a MizerParams object. #' -#' +#' #' There are a lot of species parameters and we will list them all below, but #' most of them have sensible default values. The only required columns are #' `species` for the species name and `w_max` for its maximum size. However #' if you have information about the values of other parameters then you should #' provide them. -#' +#' #' Mizer distinguishes between the species parameters that you have given #' explicitly and the species parameters that have been calculated by mizer or #' set to default values. You can retrieve the given species parameters with #' `given_species_params()` and the calculated ones with #' `calculated_species_params()`. You get all species_params with #' `species_params()`. -#' +#' #' If you change given species parameters with `given_species_params<-()` this #' will trigger a re-calculation of the calculated species parameters, where #' necessary. However if you change species parameters with `species_params<-()` @@ -24,13 +24,13 @@ #' overwritten by a future recalculation triggered by a call to #' `given_species_params<-()` . So in most use cases you will only want to use #' `given_species_params<-()`. -#' +#' #' There are some species parameters that are used to set up the #' size-dependent parameters that are used in the mizer model: -#' +#' #' * `gamma` and `q` are used to set the search volume, see [setSearchVolume()]. #' * `h` and `n` are used to set the maximum intake rate, see [setMaxIntakeRate()]. -#' * `k`, `ks` and `p` are used to set activity and basic metabolic rate, +#' * `k`, `ks` and `p` are used to set activity and basic metabolic rate, #' see [setMetabolicRate()]. #' * `z0` is used to set the external mortality rate, see [setExtMort()]. #' * `w_mat`, `w_mat25`, `w_repro_max` and `m` are used to set the allocation to @@ -39,18 +39,18 @@ #' is a "lognormal", for other options see the "Setting predation kernel" #' section in the help for [setPredKernel()]. #' * `beta` and `sigma` are parameters of the lognormal predation kernel, see -#' [lognormal_pred_kernel()]. There will be other parameters if you are +#' [lognormal_pred_kernel()]. There will be other parameters if you are #' using other predation kernel functions. -#' -#' When you change one of the above species parameters using +#' +#' When you change one of the above species parameters using #' `given_species_params<-()` or `species_params<-()`, the new value will be #' used to update the corresponding size-dependent rates automatically, unless #' you have set those size-dependent rates manually, in which case the #' corresponding species parameters will be ignored. -#' +#' #' There are some species parameters that are used directly in the model #' rather than being used for setting up size-dependent parameters: -#' +#' #' * `alpha` is the assimilation efficiency, the proportion of the consumed #' biomass that can be used for growth, metabolism and reproduction, see #' the help for [getEReproAndGrowth()]. @@ -67,70 +67,73 @@ #' #' Two parameters are used only by functions that need to convert between #' weight and length: -#' +#' #' * `a` and `b` are the parameters in the allometric weight-length #' relationship \eqn{w = a l ^ b}. -#' +#' #' If you have supplied the `a` and `b` parameters, then you can replace weight #' parameters like `w_max`, `w_mat`, `w_mat25`, `w_repro_max` and `w_min` by #' their corresponding length parameters `l_max`, `l_mat`, `l_mat25`, #' `l_repro_max` and `l_min`. -#' +#' #' The parameters that are only used to calculate default values for other #' parameters are: -#' +#' #' * `f0` is the feeding level and is used to get a default value for the #' coefficient of the search volume `gamma`, see [get_gamma_default()]. -#' * `fc` is the critical feeding level below which the species can not +#' * `fc` is the critical feeding level below which the species can not #' maintain itself. This is used to get a default value for the coefficient #' `ks` of the metabolic rate, see [get_ks_default()]. #' * `age_mat` is the age at maturity and is used to get a default value for #' the coefficient `h` of the maximum intake rate, see [get_h_default()]. -#' +#' #' Note that setting these parameters with `species_params<-()` will have no #' effect. You need to set them with `given_species_params<-()` in order to #' trigger a re-calculation of the other species parameters. -#' +#' #' In the past, mizer also used the von Bertalanffy parameters `k_vb`, `w_inf` #' and `t0` to determine a default for `h`. This is unreliable and is therefore #' now deprecated. -#' +#' #' There are other species parameters that are used in tuning the model to #' observations: -#' +#' #' * `biomass_observed` and `biomass_cutoff` allow you to specify for each #' species the total observed biomass above some cutoff size. This is #' used by [calibrateBiomass()] and [matchBiomasses()]. #' * `yield_observed` allows you to specify for each #' species the total annual fisheries yield. This is #' used by [calibrateYield()] and [matchYields()]. -#' +#' #' Finally there are two species parameters that control the way the species are #' represented in plots: #' #' * `linecolour` specifies the colour and can be any valid R colour value. #' * `linetype` specifies the line type ("solid", "dashed", "dotted", "dotdash", -#' "longdash", "twodash" or "blank") -#' +#' "longdash", "twodash" or "blank") +#' #' Other species-specific information that is related to how the species is #' fished is specified in a gear parameter data frame, see [gear_params()]. -#' However in the case where each species is caught by only a single gear, +#' However in the case where each species is caught by only a single gear, #' this information can also optionally be provided as species parameters and #' [newMultispeciesParams()] will transfer them to the `gear_params` data frame. #' However changing these parameters later in the species parameter data frames #' will have no effect. -#' +#' #' You are allowed to include additional columns in the species parameter #' data frames. They will simply be ignored by mizer but will be stored in the #' MizerParams object, in case your own code makes use of them. -#' +#' #' @param params A MizerParams object #' @return Data frame of species parameters #' @export #' @seealso [validSpeciesParams()], [setParams()] #' @family functions for setting parameters species_params <- function(params) { - assert_that(is(params, "MizerParams")) + UseMethod("species_params") +} +#' @export +species_params.MizerParams <- function(params) { params@species_params } @@ -138,7 +141,10 @@ species_params <- function(params) { #' @param value A data frame with the species parameters #' @export `species_params<-` <- function(params, value) { - assert_that(is(params, "MizerParams")) + UseMethod("species_params<-") +} +#' @export +`species_params<-.MizerParams` <- function(params, value) { value <- validSpeciesParams(value) if (!all(value$species == params@species_params$species)) { stop("The species names in the new species parameter data frame do not match the species names in the model.") @@ -151,21 +157,27 @@ species_params <- function(params) { #' @rdname species_params #' @export given_species_params <- function(params) { - assert_that(is(params, "MizerParams")) + UseMethod("given_species_params") +} +#' @export +given_species_params.MizerParams <- function(params) { params@given_species_params } #' @rdname species_params #' @export `given_species_params<-` <- function(params, value) { - assert_that(is(params, "MizerParams")) + UseMethod("given_species_params<-") +} +#' @export +`given_species_params<-.MizerParams` <- function(params, value) { value <- validGivenSpeciesParams(value) if (!all(value$species == params@species_params$species)) { stop("The species names in the new species parameter data frame do not match the species names in the model.") } old_value <- params@given_species_params - - # Create data frame which contains only the values that have changed + + # Create data frame which contains only the values that have changed common_columns <- intersect(names(value), names(params@given_species_params)) new_columns <- setdiff(names(value), names(params@given_species_params)) changes <- value[common_columns] @@ -174,7 +186,7 @@ given_species_params <- function(params) { changes <- changes %>% select(where(~ !all(is.na(.)))) # Add new columns changes <- cbind(changes, value[new_columns]) - + # Give warnings when values are changed that will have no impact if ("gamma" %in% names(params@given_species_params) & "f0" %in% names(changes) & @@ -191,16 +203,16 @@ given_species_params <- function(params) { any(!is.na(params@given_species_params$h[!is.na(changes$age_mat)]))) { warning("You have specified some values for `age_mat` that are going to be ignored because values for `h` have already been given.") } - + # Warn when user tries to change gear parameters - if (any(c("catchability", "selectivity", "l50", "l25", "sel_func") %in% + if (any(c("catchability", "selectivity", "l50", "l25", "sel_func") %in% names(changes))) { warning("To make changes to gears you should use `gear_params()<-`, not `species_params()`.") } if ("yield_observed" %in% names(changes)) { warning("To change the observed yield you should use `gear_params()<-`, not `species_params()`.") } - + params@given_species_params <- value params@species_params <- validSpeciesParams(value) suppressMessages(setParams(params)) @@ -209,21 +221,24 @@ given_species_params <- function(params) { #' @rdname species_params #' @export calculated_species_params <- function(params) { - assert_that(is(params, "MizerParams")) + UseMethod("calculated_species_params") +} +#' @export +calculated_species_params.MizerParams <- function(params) { # Identifying common columns - common_cols <- intersect(names(params@species_params), + common_cols <- intersect(names(params@species_params), names(params@given_species_params)) # Copy df1 to new_df calculated <- params@species_params # remove the entries that are also in given_species_params for (col in common_cols) { - calculated[[col]] <- replace_with_na(calculated[[col]], + calculated[[col]] <- replace_with_na(calculated[[col]], params@given_species_params[[col]]) } # Removing columns that only contain NAs calculated <- calculated %>% select(where(~ !all(is.na(.)))) - + return(calculated) } @@ -288,18 +303,18 @@ set_species_param_default <- function(object, parname, default, #' Get default value for h -#' +#' #' Sets `h` so that the species reaches maturity size `w_mat` at the maturity #' age `age_mat` if it feeds at feeding level `f0`. #' #' If `age_mat` is missing in the species parameter data frame, then it is #' calculated from the von Bertalanffy growth curve parameters `k_vb` and #' (optionally `t0`) taken from the species parameter data frame. This is not -#' reliable and a warning is issued. -#' +#' reliable and a warning is issued. +#' #' If no growth information is given at all for a species, the default is set #' to `h = 30`. -#' +#' #' @param params A MizerParams object or a species parameter data frame #' @return A vector with the values of h for all species #' @export @@ -330,23 +345,23 @@ get_h_default <- function(params) { signal("Because you have n != p, the default value for `h` is not very good.", class = "info_about_default", var = "h", level = 1) } - species_params <- species_params %>% - set_species_param_default("fc", 0.2) %>% + species_params <- species_params %>% + set_species_param_default("fc", 0.2) %>% set_species_param_default( "age_mat", age_mat_vB(species_params), - strwrap("Because the age at maturity is not known, I need to - fall back to using von Bertalanffy parameters, where + strwrap("Because the age at maturity is not known, I need to + fall back to using von Bertalanffy parameters, where available, and this is not reliable.") ) w_mat <- species_params$w_mat w_min <- species_params$w_min age_mat <- species_params$age_mat n <- species_params[["n"]] - h <- (w_mat^(1 - n) - w_min^(1 - n)) / age_mat / (1 - n) / + h <- (w_mat^(1 - n) - w_min^(1 - n)) / age_mat / (1 - n) / species_params$alpha / (species_params$f0 - species_params$fc) - + species_params[missing, "h"] <- h[missing] - + # If no acceptable default could be calculated, set h=30 missing <- is.na(species_params[["h"]]) | species_params[["h"]] <= 0 if (any(missing)) { @@ -360,11 +375,11 @@ get_h_default <- function(params) { #' Get default value for gamma -#' +#' #' Fills in any missing values for gamma so that fish feeding on a resource #' spectrum described by the power law \eqn{\kappa w^{-\lambda}} achieve a #' feeding level \eqn{f_0}. Only for internal use. -#' +#' #' @param params A MizerParams object #' @return A vector with the values of gamma for all species #' @export @@ -384,7 +399,7 @@ get_gamma_default <- function(params) { is.numeric(species_params$f0)) signal("Using f0, h, lambda, kappa and the predation kernel to calculate gamma.", class = "info_about_default", var = "gamma", level = 3) - if (!"h" %in% names(params@species_params) || + if (!"h" %in% names(params@species_params) || any(is.na(species_params[["h"]]))) { species_params[["h"]] <- get_h_default(params) } @@ -398,13 +413,13 @@ get_gamma_default <- function(params) { # See issue #238 params@species_params$interaction_resource <- 1 } - params@initial_n_pp[] <- params@resource_params$kappa * + params@initial_n_pp[] <- params@resource_params$kappa * params@w_full^(-params@resource_params$lambda) avail_energy <- getEncounter(params)[, length(params@w)] / - params@w[length(params@w)] ^ + params@w[length(params@w)] ^ (2 + params@species_params[["q"]] - params@resource_params$lambda) # Now set gamma so that this available energy leads to f0 - gamma_default <- (species_params[["h"]] / avail_energy) * + gamma_default <- (species_params[["h"]] / avail_energy) * (species_params$f0 / (1 - species_params$f0)) # Only overwrite missing gammas with calculated values if (any(is.na(gamma_default[missing]))) { @@ -416,17 +431,17 @@ get_gamma_default <- function(params) { } #' Get default value for f0 -#' +#' #' Fills in any missing values for f0 so that if the prey abundance was #' described by the power law \eqn{\kappa w^{-\lambda}} then the encounter rate #' coming from the given `gamma` parameter would lead to the feeding level #' \eqn{f_0}. This is thus doing the inverse of [get_gamma_default()]. #' Only for internal use. -#' +#' #' For species for which no value for `gamma` is specified in the species #' parameter data frame, the `f0` values is kept as provided in the species #' parameter data frame or it is set to 0.6 if it is not provided. -#' +#' #' @param params A MizerParams object #' @return A vector with the values of f0 for all species #' @export @@ -444,17 +459,17 @@ get_f0_default <- function(params) { assert_that(is.number(params@resource_params$lambda), is.number(params@resource_params$kappa), is.numeric(species_params$gamma)) - if (!"h" %in% names(params@species_params) || + if (!"h" %in% names(params@species_params) || any(is.na(species_params[["h"]]))) { species_params[["h"]] <- get_h_default(params) } # Calculate available energy by setting a power-law prey spectrum params@initial_n[] <- 0 params@species_params$interaction_resource <- 1 - params@initial_n_pp[] <- params@resource_params$kappa * + params@initial_n_pp[] <- params@resource_params$kappa * params@w_full^(-params@resource_params$lambda) avail_energy <- getEncounter(params)[, length(params@w)] / - params@w[length(params@w)] ^ + params@w[length(params@w)] ^ (2 + params@species_params[["q"]] - params@resource_params$lambda) # Now set f0 so that this available energy leads to f0 f0_default <- 1 / (species_params[["h"]] / avail_energy + 1) @@ -468,12 +483,12 @@ get_f0_default <- function(params) { } #' Get default value for `ks` -#' +#' #' Fills in any missing values for `ks` so that the critical feeding level needed #' to sustain the species is as specified in the `fc` column in the species #' parameter data frame. If that column is not provided the default critical #' feeding level \eqn{f_c = 0.2} is used. -#' +#' #' @param params A MizerParams object #' @return A vector with the values of ks for all species #' @export @@ -490,7 +505,7 @@ get_ks_default <- function(params) { params <- set_species_param_default(params, "fc", 0.2) sp <- params@species_params ks_default <- sp$fc * sp$alpha * sp[["h"]] * sp$w_mat^(sp[["n"]] - sp[["p"]]) - + message <- ("No ks column so calculating from critical feeding level.") sp <- set_species_param_default(sp, "ks", ks_default, message) if (any(is.na(sp$ks) | is.infinite(sp$ks))) { diff --git a/R/steady.R b/R/steady.R index 605ce234..76b767e0 100644 --- a/R/steady.R +++ b/R/steady.R @@ -17,6 +17,10 @@ #' @concept helper #' @export distanceMaxRelRDI <- function(params, current, previous) { + UseMethod("distanceMaxRelRDI") +} +#' @export +distanceMaxRelRDI.MizerParams <- function(params, current, previous) { current_rdi <- getRDI(params, n = current$n, n_pp = current$n_pp, n_other = current$n_other) previous_rdi <- getRDI(params, n = previous$n, n_pp = previous$n_pp, @@ -45,6 +49,10 @@ distanceMaxRelRDI <- function(params, current, previous) { #' @concept helper #' @export distanceSSLogN <- function(params, current, previous) { + UseMethod("distanceSSLogN") +} +#' @export +distanceSSLogN.MizerParams <- function(params, current, previous) { sel <- current$n > 0 & previous$n > 0 sum((log(current$n[sel]) - log(previous$n[sel]))^2) } @@ -81,6 +89,18 @@ projectToSteady <- function(params, tol = 0.1 * t_per, return_sim = FALSE, progress_bar = TRUE, ...) { + UseMethod("projectToSteady") +} +#' @export +projectToSteady.MizerParams <- function(params, + effort = params@initial_effort, + distance_func = distanceSSLogN, + t_per = 1.5, + t_max = 100, + dt = 0.1, + tol = 0.1 * t_per, + return_sim = FALSE, + progress_bar = TRUE, ...) { params <- validParams(params) effort <- validEffortVector(effort, params = params) params@initial_effort <- effort @@ -231,7 +251,14 @@ steady <- function(params, t_max = 100, t_per = 1.5, dt = 0.1, tol = 0.1 * dt, return_sim = FALSE, preserve = c("reproduction_level", "erepro", "R_max"), progress_bar = TRUE) { - params <- validParams(params) + UseMethod("steady") +} + +#' @export +steady.MizerParams <- function(params, t_max = 100, t_per = 1.5, dt = 0.1, + tol = 0.1 * dt, return_sim = FALSE, + preserve = c("reproduction_level", "erepro", "R_max"), + progress_bar = TRUE) { if (params@rates_funcs$RDD == "BevertonHoltRDD") { preserve <- match.arg(preserve) @@ -417,7 +444,7 @@ valid_species_arg <- function(object, species = NULL, return.logical = FALSE, #' @export #' @concept helper valid_gears_arg <- function(object, gears = NULL, - error_on_empty = FALSE) { + error_on_empty = FALSE) { if (is(object, "MizerSim")) { params <- object@params } else if (is(object, "MizerParams")) { diff --git a/R/steadySingleSpecies.R b/R/steadySingleSpecies.R index 9862e55c..7fcaffb4 100644 --- a/R/steadySingleSpecies.R +++ b/R/steadySingleSpecies.R @@ -23,6 +23,11 @@ #' @export steadySingleSpecies <- function(params, species = NULL, keep = c("egg", "biomass", "number")) { + UseMethod("steadySingleSpecies") +} +#' @export +steadySingleSpecies.MizerParams <- function(params, species = NULL, + keep = c("egg", "biomass", "number")) { species <- valid_species_arg(params, species) keep <- match.arg(keep) diff --git a/R/summary_methods.R b/R/summary_methods.R index 161c779b..a6e03667 100644 --- a/R/summary_methods.R +++ b/R/summary_methods.R @@ -85,6 +85,14 @@ getDiet <- function(params, n_pp = initialNResource(params), n_other = initialNOther(params), proportion = TRUE) { + UseMethod("getDiet") +} +#' @export +getDiet.MizerParams <- function(params, + n = initialN(params), + n_pp = initialNResource(params), + n_other = initialNOther(params), + proportion = TRUE) { # The code is based on that for getEncounter() params <- validParams(params) species <- params@species_params$species @@ -187,17 +195,19 @@ getDiet <- function(params, #' ssb <- getSSB(NS_sim) #' ssb[c("1972", "2010"), c("Herring", "Cod")] getSSB <- function(object) { - if (is(object, "MizerSim")) { - sim <- object - return(apply(sweep(sweep(sim@n, c(2, 3), sim@params@maturity, "*"), 3, - sim@params@w * sim@params@dw, "*"), c(1, 2), sum) ) - } - if (is(object, "MizerParams")) { - params <- object - return(((params@initial_n * params@maturity) %*% - (params@w * params@dw))[, , drop = TRUE]) - } - stop("'object' should be a MizerParams or a MizerSim object") + UseMethod("getSSB") +} +#' @export +getSSB.MizerSim <- function(object) { + sim <- object + return(apply(sweep(sweep(sim@n, c(2, 3), sim@params@maturity, "*"), 3, + sim@params@w * sim@params@dw, "*"), c(1, 2), sum) ) +} +#' @export +getSSB.MizerParams <- function(object) { + params <- object + return(((params@initial_n * params@maturity) %*% + (params@w * params@dw))[, , drop = TRUE]) } @@ -245,10 +255,13 @@ getSSB <- function(object) { #' 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 + UseMethod("getBiomass") +} +#' @export +getBiomass.MizerSim <- function(object, use_cutoff = FALSE, ...) { + sim <- object - if (use_cutoff && "biomass_cutoff" %in% names(sim@params@species_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 @@ -259,11 +272,12 @@ getBiomass <- function(object, use_cutoff = FALSE, ...) { } 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 +} +#' @export +getBiomass.MizerParams <- function(object, use_cutoff = FALSE, ...) { + params <- object - if (use_cutoff && "biomass_cutoff" %in% names(params@species_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 @@ -274,8 +288,6 @@ getBiomass <- function(object, use_cutoff = FALSE, ...) { } return(((params@initial_n * size_range) %*% (params@w * params@dw))[, , drop = TRUE]) - } - stop("'object' should be a MizerParams or a MizerSim object") } @@ -303,18 +315,20 @@ getBiomass <- function(object, use_cutoff = FALSE, ...) { #' numbers <- getN(NS_sim, min_w = 10, max_w = 1000) #' numbers["1972", "Herring"] getN <- function(object, ...) { - if (is(object, "MizerSim")) { - sim <- object - size_range <- get_size_range_array(sim@params, ...) - return(apply(sweep(sweep(sim@n, c(2, 3), size_range, "*"), 3, - sim@params@dw, "*"), c(1, 2), sum)) - } - if (is(object, "MizerParams")) { - params <- object - size_range <- get_size_range_array(params, ...) - return(((params@initial_n * size_range) %*% params@dw)[, , drop = TRUE]) - } - stop("'object' should be a MizerParams or a MizerSim object") + UseMethod("getN") +} +#' @export +getN.MizerSim <- function(object, ...) { + sim <- object + size_range <- get_size_range_array(sim@params, ...) + return(apply(sweep(sweep(sim@n, c(2, 3), size_range, "*"), 3, + sim@params@dw, "*"), c(1, 2), sum)) +} +#' @export +getN.MizerParams <- function(object, ...) { + params <- object + size_range <- get_size_range_array(params, ...) + return(((params@initial_n * size_range) %*% params@dw)[, , drop = TRUE]) } @@ -341,21 +355,22 @@ getN <- function(object, ...) { #' yield["1972", "Herring", "Herring"] #' # (In this example MizerSim object each species was set up with its own gear) getYieldGear <- function(object) { - if (is(object, "MizerSim")) { - sim <- object - biomass <- sweep(sim@n, 3, sim@params@w * sim@params@dw, "*") - f_gear <- getFMortGear(sim) - return(apply(sweep(f_gear, c(1, 3, 4), biomass, "*"), c(1, 2, 3), sum)) - } - if (is(object, "MizerParams")) { - params <- object - biomass <- sweep(params@initial_n, 2, params@w * params@dw, "*") - f_gear <- getFMortGear(params) - return(apply(sweep(f_gear, c(2, 3), biomass, "*"), c(1, 2), sum)) - } - stop("'object' should be a MizerParams or a MizerSim object") + UseMethod("getYieldGear") +} +#' @export +getYieldGear.MizerSim <- function(object) { + sim <- object + biomass <- sweep(sim@n, 3, sim@params@w * sim@params@dw, "*") + f_gear <- getFMortGear(sim) + return(apply(sweep(f_gear, c(1, 3, 4), biomass, "*"), c(1, 2, 3), sum)) +} +#' @export +getYieldGear.MizerParams <- function(object) { + params <- object + biomass <- sweep(params@initial_n, 2, params@w * params@dw, "*") + f_gear <- getFMortGear(params) + return(apply(sweep(f_gear, c(2, 3), biomass, "*"), c(1, 2), sum)) } - #' Calculate the rate at which biomass of each species is fished #' @@ -406,19 +421,21 @@ getYieldGear <- function(object) { #' # We get the total catch in the year by averaging over the year #' sum(getYield(sim)[1:10, "Herring"] / 10) getYield <- function(object) { - if (is(object, "MizerSim")) { - sim <- object - biomass <- sweep(sim@n, 3, sim@params@w * sim@params@dw, "*") - f <- getFMort(sim, drop = FALSE) - return(apply(f * biomass, c(1, 2), sum)) - } - if (is(object, "MizerParams")) { - params <- object - biomass <- sweep(params@initial_n, 2, params@w * params@dw, "*") - f <- getFMort(params, drop = FALSE) - return(apply(f * biomass, 1, sum)) - } - stop("'object' should be a MizerParams or a MizerSim object") + UseMethod("getYield") +} +#' @export +getYield.MizerSim <- function(object) { + sim <- object + biomass <- sweep(sim@n, 3, sim@params@w * sim@params@dw, "*") + f <- getFMort(sim, drop = FALSE) + return(apply(f * biomass, c(1, 2), sum)) +} +#' @export +getYield.MizerParams <- function(object) { + params <- object + biomass <- sweep(params@initial_n, 2, params@w * params@dw, "*") + f <- getFMort(params, drop = FALSE) + return(apply(f * biomass, 1, sum)) } @@ -449,15 +466,23 @@ getGrowthCurves <- function(object, species = NULL, max_age = 20, percentage = FALSE) { - if (is(object, "MizerSim")) { - params <- object@params - params <- setInitialValues(params, object) - } else if (is(object, "MizerParams")) { - params <- validParams(object) - } else { - stop("The first argument to `getGrowthCurves()` must be a ", - "MizerParams or a MizerSim object.") - } + UseMethod("getGrowthCurves") +} +#' @export +getGrowthCurves.MizerSim <- function(object, + species = NULL, + max_age = 20, + percentage = FALSE) { + params <- object@params + params <- setInitialValues(params, object) + getGrowthCurves(params, species, max_age, percentage) +} +#' @export +getGrowthCurves.MizerParams <- function(object, + species = NULL, + max_age = 20, + percentage = FALSE) { + params <- object species <- valid_species_arg(params, species) # reorder list of species to coincide with order in params idx <- which(params@species_params$species %in% species) @@ -695,7 +720,13 @@ getProportionOfLargeFish <- function(sim, species = NULL, threshold_w = 100, threshold_l = NULL, biomass_proportion = TRUE, ...) { - assert_that(is(sim, "MizerSim")) + UseMethod("getProportionOfLargeFish") +} +#' @export +getProportionOfLargeFish.MizerSim <- function(sim, + species = NULL, + threshold_w = 100, threshold_l = NULL, + biomass_proportion = TRUE, ...) { species <- valid_species_arg(sim, species) total_size_range <- get_size_range_array(sim@params, ...) @@ -755,6 +786,10 @@ getProportionOfLargeFish <- function(sim, #' getMeanWeight(NS_sim, species = c("Herring", "Sprat", "N.pout"))[years] #' getMeanWeight(NS_sim, min_w = 10, max_w = 5000)[years] getMeanWeight <- function(sim, species = NULL, ...) { + UseMethod("getMeanWeight") +} +#' @export +getMeanWeight.MizerSim <- function(sim, species = NULL, ...) { assert_that(is(sim, "MizerSim")) species <- valid_species_arg(sim, species) n_species <- getN(sim, ...) @@ -795,6 +830,11 @@ getMeanWeight <- function(sim, species = NULL, ...) { #' getMeanMaxWeight(NS_sim, min_w = 10, max_w = 5000)[years, ] getMeanMaxWeight <- function(sim, species = NULL, measure = "both", ...) { + UseMethod("getMeanMaxWeight") +} +#' @export +getMeanMaxWeight.MizerSim <- function(sim, species = NULL, + measure = "both", ...) { assert_that(is(sim, "MizerSim")) if (!(measure %in% c("both", "numbers", "biomass"))) { stop("measure must be one of 'both', 'numbers' or 'biomass'") @@ -858,6 +898,11 @@ getMeanMaxWeight <- function(sim, species = NULL, #' slope_biomass[1, ] # in 1976 getCommunitySlope <- function(sim, species = NULL, biomass = TRUE, ...) { + UseMethod("getCommunitySlope") +} +#' @export +getCommunitySlope.MizerSim <- function(sim, species = NULL, + biomass = TRUE, ...) { assert_that(is(sim, "MizerSim")) species <- valid_species_arg(sim, species) size_range <- get_size_range_array(sim@params, ...) diff --git a/man/plotBiomassObservedVsModel.Rd b/man/plotBiomassObservedVsModel.Rd index 37f28551..65b7e7dd 100644 --- a/man/plotBiomassObservedVsModel.Rd +++ b/man/plotBiomassObservedVsModel.Rd @@ -12,7 +12,8 @@ plotBiomassObservedVsModel( log_scale = TRUE, return_data = FALSE, labels = TRUE, - show_unobserved = FALSE + show_unobserved = FALSE, + ... ) plotlyBiomassObservedVsModel( @@ -21,7 +22,8 @@ plotlyBiomassObservedVsModel( ratio = FALSE, log_scale = TRUE, return_data = FALSE, - show_unobserved = FALSE + show_unobserved = FALSE, + ... ) } \arguments{ @@ -49,6 +51,8 @@ not (FALSE). Default is FALSE.} \item{show_unobserved}{Whether to include also species for which no biomass observation is available. If TRUE, these species will be shown as if their observed biomass was equal to the model biomass.} + +\item{...}{Additional arguments passed to the plot function.} } \value{ A ggplot2 object with the plot of model biomass by species compared diff --git a/man/plotYieldObservedVsModel.Rd b/man/plotYieldObservedVsModel.Rd index 80c72d71..44ff5a62 100644 --- a/man/plotYieldObservedVsModel.Rd +++ b/man/plotYieldObservedVsModel.Rd @@ -12,7 +12,8 @@ plotYieldObservedVsModel( log_scale = TRUE, return_data = FALSE, labels = TRUE, - show_unobserved = FALSE + show_unobserved = FALSE, + ... ) plotlyYieldObservedVsModel( @@ -21,7 +22,8 @@ plotlyYieldObservedVsModel( ratio = FALSE, log_scale = TRUE, return_data = FALSE, - show_unobserved = FALSE + show_unobserved = FALSE, + ... ) } \arguments{ @@ -49,6 +51,8 @@ not (FALSE). Default is FALSE.} \item{show_unobserved}{Whether to include also species for which no yield observation is available. If TRUE, these species will be shown as if their observed yield was equal to the model yield.} + +\item{...}{Additional arguments passed to the generic function.} } \value{ A ggplot2 object with the plot of model yield by species compared From 1af138c07ac3ff87b222cce2853b5e6adb450634 Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Sat, 22 Nov 2025 20:19:13 +0000 Subject: [PATCH 14/16] Finishing conversion to S3 methods --- NAMESPACE | 14 ++++++++++++++ R/MizerParams-class.R | 16 ++++++++++++++++ R/resource_dynamics.R | 11 ++++++++++- R/setReproduction.R | 28 ++++++++++++++++++++++++---- R/setResource.R | 8 ++++++++ man/setReproduction.Rd | 2 -- 6 files changed, 72 insertions(+), 7 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 5bbae7e3..6a1c08c5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,10 +11,14 @@ S3method("initialNResource<-",MizerParams) S3method("initial_effort<-",MizerParams) S3method("intake_max<-",MizerParams) S3method("interaction_matrix<-",MizerParams) +S3method("maturity<-",MizerParams) S3method("metab<-",MizerParams) S3method("pred_kernel<-",MizerParams) +S3method("repro_prop<-",MizerParams) S3method("resource_capacity<-",MizerParams) S3method("resource_dynamics<-",MizerParams) +S3method("resource_level<-",MizerParams) +S3method("resource_params<-",MizerParams) S3method("resource_rate<-",MizerParams) S3method("search_vol<-",MizerParams) S3method("selectivity<-",MizerParams) @@ -34,6 +38,8 @@ S3method(compareParams,MizerParams) S3method(diffusion,MizerParams) S3method(distanceMaxRelRDI,MizerParams) S3method(distanceSSLogN,MizerParams) +S3method(dw,MizerParams) +S3method(dw_full,MizerParams) S3method(ext_encounter,MizerParams) S3method(ext_mort,MizerParams) S3method(gear_params,MizerParams) @@ -61,6 +67,7 @@ S3method(getGrowthCurves,MizerSim) S3method(getInitialEffort,MizerParams) S3method(getInteraction,MizerParams) S3method(getLinetypes,MizerParams) +S3method(getMaturityProportion,MizerParams) S3method(getMaxIntakeRate,MizerParams) S3method(getMeanMaxWeight,MizerSim) S3method(getMeanWeight,MizerSim) @@ -78,6 +85,7 @@ S3method(getRDD,MizerParams) S3method(getRDI,MizerParams) S3method(getRates,MizerParams) S3method(getReproductionLevel,MizerParams) +S3method(getReproductionProportion,MizerParams) S3method(getRequiredRDD,MizerParams) S3method(getResourceMort,MizerParams) S3method(getSSB,MizerParams) @@ -100,6 +108,7 @@ S3method(matchBiomasses,MizerParams) S3method(matchGrowth,MizerParams) S3method(matchNumbers,MizerParams) S3method(matchYields,MizerParams) +S3method(maturity,MizerParams) S3method(metab,MizerParams) S3method(plotBiomass,MizerSim) S3method(plotBiomassObservedVsModel,MizerParams) @@ -128,8 +137,11 @@ S3method(project_simple,MizerParams) S3method(removeSpecies,MizerParams) S3method(renameGear,MizerParams) S3method(renameSpecies,MizerParams) +S3method(repro_prop,MizerParams) S3method(resource_capacity,MizerParams) S3method(resource_dynamics,MizerParams) +S3method(resource_level,MizerParams) +S3method(resource_params,MizerParams) S3method(resource_rate,MizerParams) S3method(saveParams,MizerParams) S3method(scaleModel,MizerParams) @@ -155,6 +167,8 @@ S3method(setSearchVolume,MizerParams) S3method(species_params,MizerParams) S3method(steady,MizerParams) S3method(steadySingleSpecies,MizerParams) +S3method(w,MizerParams) +S3method(w_full,MizerParams) export("catchability<-") export("diffusion<-") export("ext_encounter<-") diff --git a/R/MizerParams-class.R b/R/MizerParams-class.R index de7fe2c7..03149196 100644 --- a/R/MizerParams-class.R +++ b/R/MizerParams-class.R @@ -789,6 +789,10 @@ emptyParams <- function(species_params, #' # Summing to get total biomass #' sum(biomass) w <- function(params) { + UseMethod("w") +} +#' @export +w.MizerParams <- function(params) { params@w } @@ -798,6 +802,10 @@ w <- function(params) { #' the consumer spectrum. #' @export w_full <- function(params) { + UseMethod("w_full") +} +#' @export +w_full.MizerParams <- function(params) { params@w_full } @@ -806,6 +814,10 @@ w_full <- function(params) { #' consumer spectrum. #' @export dw <- function(params) { + UseMethod("dw") +} +#' @export +dw.MizerParams <- function(params) { params@dw } @@ -814,6 +826,10 @@ dw <- function(params) { #' resource spectrum. #' @export dw_full <- function(params) { + UseMethod("dw_full") +} +#' @export +dw_full.MizerParams <- function(params) { params@dw_full } diff --git a/R/resource_dynamics.R b/R/resource_dynamics.R index c9fa7511..54a2594c 100644 --- a/R/resource_dynamics.R +++ b/R/resource_dynamics.R @@ -62,6 +62,11 @@ resource_constant <- function(params, n_pp, ...) { #' @seealso [setResource()] #' @export resource_params <- function(params) { + UseMethod("resource_params") +} +#' @export +resource_params.MizerParams <- function(params) { # nolint + params@resource_params } @@ -69,8 +74,12 @@ resource_params <- function(params) { #' @param value A named list of resource parameters. #' @export `resource_params<-` <- function(params, value) { + UseMethod("resource_params<-") +} +#' @export +`resource_params<-.MizerParams` <- function(params, value) { # nolint + assert_that( - is(params, "MizerParams"), is.number(value$lambda), value$lambda >= 0, is.number(value$kappa), diff --git a/R/setReproduction.R b/R/setReproduction.R index 523d600a..1d569a8b 100644 --- a/R/setReproduction.R +++ b/R/setReproduction.R @@ -356,20 +356,30 @@ setReproduction.MizerParams <- function(params, maturity = NULL, #' of individuals of each species at size that are mature. #' @export getMaturityProportion <- function(params) { - assert_that(is(params, "MizerParams")) + UseMethod("getMaturityProportion") +} +#' @export +getMaturityProportion.MizerParams <- function(params) { params@maturity } #' @rdname setReproduction #' @export maturity <- function(params) { + UseMethod("maturity") +} +#' @export +maturity.MizerParams <- function(params) { params@maturity } #' @rdname setReproduction -#' @param value . #' @export `maturity<-` <- function(params, value) { + UseMethod("maturity<-") +} +#' @export +`maturity<-.MizerParams` <- function(params, value) { setReproduction(params, maturity = value) } @@ -381,7 +391,10 @@ maturity <- function(params) { #' proportion is zero, also the reproduction proportion is returned as zero. #' @export getReproductionProportion <- function(params) { - assert_that(is(params, "MizerParams")) + UseMethod("getReproductionProportion") +} +#' @export +getReproductionProportion.MizerParams <- function(params) { repro_prop <- params@psi / params@maturity repro_prop[is.nan(repro_prop)] <- 0 repro_prop[repro_prop > 1] <- 1 @@ -392,12 +405,19 @@ getReproductionProportion <- function(params) { #' @rdname setReproduction #' @export repro_prop <- function(params) { + UseMethod("repro_prop") +} +#' @export +repro_prop.MizerParams <- function(params) { getReproductionProportion(params) } #' @rdname setReproduction -#' @param value . #' @export `repro_prop<-` <- function(params, value) { + UseMethod("repro_prop<-") +} +#' @export +`repro_prop<-.MizerParams` <- function(params, value) { setReproduction(params, repro_prop = value) } diff --git a/R/setResource.R b/R/setResource.R index 44235c10..7e7919f5 100644 --- a/R/setResource.R +++ b/R/setResource.R @@ -334,12 +334,20 @@ resource_capacity.MizerParams <- function(params) { #' and the resource capacity for each size class. #' @export resource_level <- function(params) { + UseMethod("resource_level") +} +#' @export +resource_level.MizerParams <- function(params) { params@initial_n_pp / params@cc_pp } #' @rdname setResource #' @export `resource_level<-` <- function(params, value) { + UseMethod("resource_level<-") +} +#' @export +`resource_level<-.MizerParams` <- function(params, value) { setResource(params, resource_level = value) } diff --git a/man/setReproduction.Rd b/man/setReproduction.Rd index c5d0e739..68f8a9c9 100644 --- a/man/setReproduction.Rd +++ b/man/setReproduction.Rd @@ -55,8 +55,6 @@ reproduction rate from the density-independent rate. Defaults to "\code{\link[=BevertonHoltRDD]{BevertonHoltRDD()}}".} \item{...}{Unused} - -\item{value}{.} } \value{ \code{setReproduction()}: A MizerParams object with updated reproduction From 9812548d13fee478bca2dab55643abe59e27bdf9 Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Sun, 23 Nov 2025 03:12:05 +0000 Subject: [PATCH 15/16] Remove build warnings --- R/animateSpectra.R | 11 +- R/calibrate.R | 8 +- R/compareParams.R | 2 +- R/manipulate_species.R | 11 +- R/match.R | 6 +- R/matchGrowth.R | 25 +-- R/newMultispeciesParams.R | 2 + R/plots.R | 4 + R/project.R | 11 +- R/setBevertonHolt.R | 22 +- R/setColours.R | 14 +- R/setDiffusion.R | 1 - R/setExtEncounter.R | 25 +-- R/setExtMort.R | 6 +- R/setFishing.R | 208 +++++++++--------- R/setInitialValues.R | 40 ++-- R/setInteraction.R | 19 +- R/setMaxIntakeRate.R | 35 ++- R/setMetabolicRate.R | 1 + R/setPredKernel.R | 64 +++--- R/setReproduction.R | 4 +- R/setResource.R | 27 +-- R/setSearchVolume.R | 45 ++-- R/wrapper_functions.R | 1 + man/animateSpectra.Rd | 4 +- man/newCommunityParams.Rd | 3 +- man/newMultispeciesParams.Rd | 9 +- man/plotBiomass.Rd | 4 +- man/plotDiet.Rd | 4 +- man/plotFMort.Rd | 4 +- man/plotFeedingLevel.Rd | 4 +- man/plotGrowthCurves.Rd | 4 +- man/plotM2.Rd | 4 +- ...s-missing-method.Rd => plotMizerParams.Rd} | 5 +- man/plotMizerSim.Rd | 5 +- man/plotPredMort.Rd | 4 +- man/plotSpectra.Rd | 4 +- man/plotYield.Rd | 4 +- man/plotYieldGear.Rd | 4 +- man/plotting_functions.Rd | 4 +- man/setBevertonHolt.Rd | 7 +- man/setExtMort.Rd | 7 +- man/setMetabolicRate.Rd | 2 + man/setParams.Rd | 2 + man/setReproduction.Rd | 2 + man/setResource.Rd | 15 +- man/setRmax.Rd | 6 + 47 files changed, 348 insertions(+), 355 deletions(-) rename man/{plot-MizerParams-missing-method.Rd => plotMizerParams.Rd} (93%) diff --git a/R/animateSpectra.R b/R/animateSpectra.R index f8522602..306543ec 100644 --- a/R/animateSpectra.R +++ b/R/animateSpectra.R @@ -39,14 +39,9 @@ animateSpectra <- function(sim, species, time_range, UseMethod("animateSpectra") #' @export -animateSpectra.MizerSim <- function(sim, - species = NULL, - time_range, - wlim = c(NA, NA), - ylim = c(NA, NA), - power = 1, - total = FALSE, - resource = TRUE) { +animateSpectra.MizerSim <- function(sim, species = NULL, time_range = NULL, + wlim = c(NA, NA), ylim = c(NA, NA), + power = 1, total = FALSE, resource = TRUE, ...) { assert_that(is.flag(total), is.flag(resource), is.number(power), length(wlim) == 2, diff --git a/R/calibrate.R b/R/calibrate.R index 20fee66d..e7e0d7f7 100644 --- a/R/calibrate.R +++ b/R/calibrate.R @@ -37,7 +37,7 @@ calibrateBiomass <- function(params, ...) UseMethod("calibrateBiomass") #' @export -calibrateBiomass.MizerParams <- function(params) { +calibrateBiomass.MizerParams <- function(params, ...) { if ((!("biomass_observed" %in% names(params@species_params))) || all(is.na(params@species_params$biomass_observed))) { return(params) @@ -102,7 +102,7 @@ calibrateNumber <- function(params, ...) UseMethod("calibrateNumber") #' @export -calibrateNumber.MizerParams <- function(params) { +calibrateNumber.MizerParams <- function(params, ...) { if ((!("number_observed" %in% names(params@species_params))) || all(is.na(params@species_params$number_observed))) { return(params) @@ -166,7 +166,7 @@ calibrateYield <- function(params, ...) UseMethod("calibrateYield") #' @export -calibrateYield.MizerParams <- function(params) { +calibrateYield.MizerParams <- function(params, ...) { lifecycle::deprecate_warn( "2.6.0", "calibrateYield()", details = "This function has not proven useful. If you do have a use case for it, please let the developers know by creating an issue at https://github.com/sizespectrum/mizer/issues" @@ -229,7 +229,7 @@ scaleModel <- function(params, factor, ...) UseMethod("scaleModel") #' @export -scaleModel.MizerParams <- function(params, factor) { +scaleModel.MizerParams <- function(params, factor, ...) { params <- validParams(params) assert_that(is.number(factor), factor > 0) diff --git a/R/compareParams.R b/R/compareParams.R index 2c0232c9..91a2c5a8 100644 --- a/R/compareParams.R +++ b/R/compareParams.R @@ -17,7 +17,7 @@ compareParams <- function(params1, params2, ...) UseMethod("compareParams") #' @export -compareParams.MizerParams <- function(params1, params2) { +compareParams.MizerParams <- function(params1, params2, ...) { params1 <- validParams(params1) params2 <- validParams(params2) diff --git a/R/manipulate_species.R b/R/manipulate_species.R index eb89c2a5..06458de4 100644 --- a/R/manipulate_species.R +++ b/R/manipulate_species.R @@ -70,9 +70,8 @@ addSpecies <- function(params, species_params, } #' @export -addSpecies.MizerParams <- function(params, species_params, - gear_params = data.frame(), initial_effort, - interaction) { +addSpecies.MizerParams <- function(params, species_params, gear_params = data.frame(), + initial_effort = NULL, interaction = NULL, ...) { # check validity of parameters ---- params <- validParams(params) given_species_params <- validGivenSpeciesParams(species_params) @@ -341,7 +340,7 @@ removeSpecies <- function(params, species, ...) { } #' @export -removeSpecies.MizerParams <- function(params, species) { +removeSpecies.MizerParams <- function(params, species, ...) { params <- validParams(params) species <- valid_species_arg(params, species, return.logical = TRUE) @@ -428,7 +427,7 @@ renameSpecies <- function(params, replace, ...) { } #' @export -renameSpecies.MizerParams <- function(params, replace) { +renameSpecies.MizerParams <- function(params, replace, ...) { params <- validParams(params) replace[] <- as.character(replace) to_replace <- names(replace) @@ -520,7 +519,7 @@ renameGear <- function(params, replace, ...) { } #' @export -renameGear.MizerParams <- function(params, replace) { +renameGear.MizerParams <- function(params, replace, ...) { params <- validParams(params) replace[] <- as.character(replace) to_replace <- names(replace) diff --git a/R/match.R b/R/match.R index 14986802..c8323a9d 100644 --- a/R/match.R +++ b/R/match.R @@ -42,7 +42,7 @@ matchBiomasses <- function(params, species = NULL, ...) UseMethod("matchBiomasses") #' @export -matchBiomasses.MizerParams <- function(params, species = NULL) { +matchBiomasses.MizerParams <- function(params, species = NULL, ...) { if (!("biomass_observed" %in% names(params@species_params))) { return(params) } @@ -122,7 +122,7 @@ matchNumbers <- function(params, species = NULL, ...) UseMethod("matchNumbers") #' @export -matchNumbers.MizerParams <- function(params, species = NULL) { +matchNumbers.MizerParams <- function(params, species = NULL, ...) { if (!("number_observed" %in% names(params@species_params))) { return(params) } @@ -209,7 +209,7 @@ matchYields <- function(params, species = NULL, ...) UseMethod("matchYields") #' @export -matchYields.MizerParams <- function(params, species = NULL) { +matchYields.MizerParams <- function(params, species = NULL, ...) { lifecycle::deprecate_warn( "2.6.0", "matchYields()", "mizerExperimental::matchYield()", details = "This function has not proven useful. If you do have a use case for it, please let the developers know by creating an issue at https://github.com/sizespectrum/mizer/issues" diff --git a/R/matchGrowth.R b/R/matchGrowth.R index 4cb2beaa..1bc22ce5 100644 --- a/R/matchGrowth.R +++ b/R/matchGrowth.R @@ -20,40 +20,39 @@ #' vector indicating for each species whether it is to be affected (TRUE) or #' not. #' @param keep A string determining which quantity is to be kept constant. The -#' choices are "egg" which keeps the egg density constant, "biomass" which +#' choices are "egg" which keeps the egg density constant, "biomass" which #' keeps the total biomass of the species constant and "number" which keeps #' the total number of individuals constant. #' @param ... Additional arguments passed to the method. -#' +#' #' @return A modified MizerParams object with rescaled search volume, maximum #' consumption rate and metabolic rate and rescaled species parameters #' `gamma`,`h`, `ks` and `k`. #' @export -matchGrowth <- function(params, species = NULL, +matchGrowth <- function(params, species = NULL, keep = c("egg", "biomass", "number"), ...) UseMethod("matchGrowth") #' @export matchGrowth.MizerParams <- function(params, species = NULL, - keep = c("egg", "biomass", "number")){ - assert_that(is(params, "MizerParams")) - sel <- valid_species_arg(params, species = species, + keep = c("egg", "biomass", "number"), ...) { + sel <- valid_species_arg(params, species = species, return.logical = TRUE) sp <- params@species_params keep <- match.arg(keep) - + biomass <- getBiomass(params, usecutoff = TRUE) number <- getN(params) - + sp <- set_species_param_default(sp, "age_mat", NA) # If age at maturity is not specified, calculate it from von Bertalanffy if (all(c("k_vb", "w_inf") %in% names(sp))) { sp <- set_species_param_default(sp, "age_mat", age_mat_vB(params)) } - + # Don't affect species where no age at maturity is available sel <- sel & !is.na(sp$age_mat) - + factor <- age_mat(params)[sel] / sp$age_mat[sel] params@search_vol[sel, ] <- params@search_vol[sel, ] * factor @@ -68,9 +67,9 @@ matchGrowth.MizerParams <- function(params, species = NULL, if ("k" %in% names(sp)) { params@species_params[sel, "k"] <- sp[sel, "k"] * factor } - + params <- steadySingleSpecies(params, species = sel) - + if (keep == "biomass") { factor <- biomass / getBiomass(params, use_cutoff = TRUE) params@initial_n <- params@initial_n * factor @@ -79,6 +78,6 @@ matchGrowth.MizerParams <- function(params, species = NULL, factor <- number / getN(params) params@initial_n <- params@initial_n * factor } - + setBevertonHolt(params) } diff --git a/R/newMultispeciesParams.R b/R/newMultispeciesParams.R index 6c71713b..d7fca62a 100644 --- a/R/newMultispeciesParams.R +++ b/R/newMultispeciesParams.R @@ -18,6 +18,8 @@ #' @inheritParams setReproduction #' @inheritParams setFishing #' @inheritParams setResource +#' @param r_pp `r lifecycle::badge("deprecated")`. Use `resource_rate` argument +#' instead. #' @param kappa The coefficient of the initial resource abundance power-law. #' @param min_w_pp The smallest size of the resource spectrum. By default this #' is set to the smallest value at which any of the consumers can feed. diff --git a/R/plots.R b/R/plots.R index 887b96c5..503da59f 100644 --- a/R/plots.R +++ b/R/plots.R @@ -1692,6 +1692,8 @@ plot_diet <- function(params, n, diet, species, return_data) { #' @family plotting functions #' @seealso [plotting_functions] #' @rdname plotMizerSim +#' @name plotMizerSim +#' @aliases plot,MizerSim,missing-method #' @examples #' \donttest{ #' params <- NS_params @@ -1736,6 +1738,8 @@ setMethod("plot", signature(x = "MizerSim", y = "missing"), #' @export #' @family plotting functions #' @seealso [plotting_functions] +#' @name plotMizerParams +#' @aliases plot,MizerParams,missing-method #' @examples #' \donttest{ #' params <- NS_params diff --git a/R/project.R b/R/project.R index b70e844e..39bb4ea7 100644 --- a/R/project.R +++ b/R/project.R @@ -150,13 +150,10 @@ project.MizerParams <- function(object, effort, params <- object # Set and check initial values ---- assert_that(t_max > 0) - if (is(params, "MizerParams")) { - params <- validParams(params) - if (!missing(initial_n)) params@initial_n[] <- initial_n - if (!missing(initial_n_pp)) params@initial_n_pp[] <- initial_n_pp - } else { - stop("The `object` argument must be either a MizerParams or a MizerSim object.") - } + params <- validParams(params) + if (!missing(initial_n)) params@initial_n[] <- initial_n + if (!missing(initial_n_pp)) params@initial_n_pp[] <- initial_n_pp + initial_n <- params@initial_n initial_n_pp <- params@initial_n_pp initial_n_other <- params@initial_n_other diff --git a/R/setBevertonHolt.R b/R/setBevertonHolt.R index c6307788..2fd1ecdc 100644 --- a/R/setBevertonHolt.R +++ b/R/setBevertonHolt.R @@ -120,8 +120,11 @@ #' @param R_max Maximum reproduction rate. See details. #' @param reproduction_level Sets `R_max` so that the reproduction rate at #' the initial state is `R_max * reproduction_level`. -#' @param R_factor `r lifecycle::badge("deprecated")` Use -#' `reproduction_level = 1 / R_factor` instead. +#' @param ... Unused +#' \itemize{ +#' \item `R_factor`: `r lifecycle::badge("deprecated")` Use +#' `reproduction_level = 1 / R_factor` instead. +#' } #' #' @return A MizerParams object #' @examples @@ -146,14 +149,18 @@ setBevertonHolt <- function(params, erepro, UseMethod("setBevertonHolt") } #' @export -setBevertonHolt.MizerParams <- function(params, R_factor = deprecated(), erepro, +setBevertonHolt.MizerParams <- function(params, erepro, R_max, reproduction_level, ...) { - assert_that(is(params, "MizerParams")) no_sp <- nrow(params@species_params) + args <- list(...) + if ("R_factor" %in% names(args)) { + R_factor <- args[["R_factor"]] + } + # check number of arguments num_args <- hasArg("erepro") + hasArg("R_max") + - hasArg("reproduction_level") + hasArg("R_factor") + hasArg("reproduction_level") + exists("R_factor") if (num_args > 1) { stop("You should only provide `params` and one other argument.") } @@ -166,7 +173,7 @@ setBevertonHolt.MizerParams <- function(params, R_factor = deprecated(), erepro, if (!missing("erepro")) values <- erepro if (hasArg("R_max")) values <- R_max if (hasArg("reproduction_level")) values <- reproduction_level - if (hasArg("R_factor")) values <- R_factor + if (exists("R_factor")) values <- R_factor if (length(values) == 1 && is.null(names(values))) { values <- rep(values, no_sp) @@ -232,7 +239,7 @@ setBevertonHolt.MizerParams <- function(params, R_factor = deprecated(), erepro, } r_max_new <- rdd_new / values } - if (!missing(R_factor)) { + if (exists("R_factor")) { if (!all(values > 1)) { stop("The R_factor must be greater than 1.") } @@ -328,7 +335,6 @@ getReproductionLevel <- function(params) { } #' @export getReproductionLevel.MizerParams <- function(params) { - assert_that(is(params, "MizerParams")) if (!"R_max" %in% names(params@species_params)) { stop("No `R_max` is included in the species parameters.") } diff --git a/R/setColours.R b/R/setColours.R index c9b6c1d2..ddf34d20 100644 --- a/R/setColours.R +++ b/R/setColours.R @@ -15,7 +15,7 @@ #' #' You can use the same colours in your own ggplot2 plots by adding #' `scale_colour_manual(values = getColours(params))` to your plot. Similarly -#' you can use the linetypes with +#' you can use the linetypes with #' `scale_linetype_manual(values = getLinetypes(params))`. #' #' @param params A MizerParams object @@ -37,14 +37,13 @@ setColours <- function(params, colours) { } #' @export setColours.MizerParams <- function(params, colours) { - assert_that(is(params, "MizerParams")) colours <- validColours(colours) if (identical(colours, as.list(params@linecolour))) { return(params) } params@linecolour <- unlist( modifyList(as.list(params@linecolour), colours)) - + params@time_modified <- lubridate::now() params } @@ -62,7 +61,7 @@ getColours.MizerParams <- function(params) { validColours <- function(colours) { valid <- sapply(colours, function(X) { - tryCatch(is.matrix(col2rgb(X)), + tryCatch(is.matrix(col2rgb(X)), error = function(e) FALSE) }) if (!all(valid)) { @@ -76,7 +75,7 @@ validColours <- function(colours) { #' @rdname setColours #' @param linetypes A named list or named vector of linetypes. -#' +#' #' @return `setLinetypes()`: The MizerParams object with updated linetypes #' @export setLinetypes <- function(params, linetypes) { @@ -84,14 +83,13 @@ setLinetypes <- function(params, linetypes) { } #' @export setLinetypes.MizerParams <- function(params, linetypes) { - assert_that(is(params, "MizerParams")) linetypes <- validLinetypes(linetypes) if (identical(linetypes, as.list(params@linetype))) { return(params) } params@linetype <- unlist( modifyList(as.list(params@linetype), as.list(linetypes))) - + params@time_modified <- lubridate::now() params } @@ -111,7 +109,7 @@ getLinetypes.MizerParams <- function(params) { validLinetypes <- function(linetypes) { linetypes <- linetypes[!is.na(linetypes)] - list_of_types <- list(0, 1, 2, 3, 4, 5, 6, "blank", "solid", "dashed", + list_of_types <- list(0, 1, 2, 3, 4, 5, 6, "blank", "solid", "dashed", "dotted", "dotdash", "longdash", "twodash") valid <- linetypes %in% list_of_types diff --git a/R/setDiffusion.R b/R/setDiffusion.R index c6978e67..0b965c4e 100644 --- a/R/setDiffusion.R +++ b/R/setDiffusion.R @@ -27,7 +27,6 @@ setDiffusion <- function(params, diffusion = NULL, reset = FALSE, ...) { #' @rdname setDiffusion #' @export setDiffusion.MizerParams <- function(params, diffusion = NULL, reset = FALSE, ...) { - assert_that(is(params, "MizerParams")) if (is.null(diffusion)) { diffusion <- params@diffusion diff --git a/R/setExtEncounter.R b/R/setExtEncounter.R index 2a7a6917..1b0443db 100644 --- a/R/setExtEncounter.R +++ b/R/setExtEncounter.R @@ -1,19 +1,19 @@ #' Set external encounter rate -#' +#' #' @section Setting external encounter rate: #' The external encounter rate is the rate at which a predator encounters #' food that is not explicitly modelled. It is a rate with units mass/year. -#' +#' #' The `ext_encounter` argument allows you to specify an external encounter rate #' that depends on species and body size. You can see an example of this in #' the Examples section of the help page for [setExtEncounter()]. -#' +#' #' @param params MizerParams #' @param ext_encounter Optional. An array (species x size) holding the external #' encounter rate. If not supplied, the external encounter rate is left #' unchanged. Initially is is set to 0. #' @param ... Unused -#' +#' #' @return `setExtEncounter()`: A MizerParams object with updated external encounter #' rate. #' @export @@ -22,14 +22,14 @@ #' params <- newMultispeciesParams(NS_species_params) #' #' #### Setting allometric encounter rate ####################### -#' +#' #' # Set coefficient for each species. Here we choose 0.1 for each species #' encounter_pre <- rep(0.1, nrow(species_params(params))) -#' +#' #' # Multiply by power of size with exponent, here chosen to be 3/4 #' # The outer() function makes it an array species x size #' allo_encounter <- outer(encounter_pre, w(params)^(3/4)) -#' +#' #' # Change the external encounter rate in the params object #' ext_encounter(params) <- allo_encounter setExtEncounter <- function(params, ext_encounter = NULL, ...) { @@ -37,21 +37,20 @@ setExtEncounter <- function(params, ext_encounter = NULL, ...) { } #' @export setExtEncounter.MizerParams <- function(params, ext_encounter = NULL, ...) { - assert_that(is(params, "MizerParams")) - + if (is.null(ext_encounter)) { ext_encounter <- params@ext_encounter } - + assert_that(is.array(ext_encounter), identical(dim(ext_encounter), dim(params@ext_encounter))) params@ext_encounter[] <- ext_encounter - + # Keep old comment if new comment is NULL if (!is.null(comment(ext_encounter))) { comment(params@ext_encounter) <- comment(ext_encounter) } - + params@time_modified <- lubridate::now() return(params) } @@ -87,4 +86,4 @@ ext_encounter.MizerParams <- function(params) { #' @export `ext_encounter<-.MizerParams` <- function(params, value) { setExtEncounter(params, ext_encounter = value) -} \ No newline at end of file +} diff --git a/R/setExtMort.R b/R/setExtMort.R index db3b3084..464dfbdc 100644 --- a/R/setExtMort.R +++ b/R/setExtMort.R @@ -57,7 +57,8 @@ #' # Change the external mortality rate in the params object #' ext_mort(params) <- allo_mort setExtMort <- function(params, ext_mort = NULL, z0pre = 0.6, - z0exp = params@resource_params$n - 1, reset = FALSE, ...) { + z0exp = params@resource_params$n - 1, reset = FALSE, + z0 = deprecated(), ...) { UseMethod("setExtMort") } #' @export @@ -68,8 +69,7 @@ setExtMort.MizerParams <- function(params, ext_mort = NULL, lifecycle::deprecate_warn("2.2.3", "setExtMort(z0)", "setExtMort(ext_mort)") ext_mort <- z0 } - assert_that(is(params, "MizerParams"), - is.flag(reset), + assert_that(is.flag(reset), is.number(z0pre), is.number(z0exp)) if (reset) { diff --git a/R/setFishing.R b/R/setFishing.R index 871a9e17..a868325f 100644 --- a/R/setFishing.R +++ b/R/setFishing.R @@ -1,9 +1,9 @@ #' Set fishing parameters -#' +#' #' @section Setting fishing: -#' +#' #' \strong{Gears} -#' +#' #' In `mizer`, fishing mortality is imposed on species by fishing gears. The #' total per-capita fishing mortality (1/year) is obtained by summing over the #' mortality from all gears, @@ -11,19 +11,19 @@ #' where the fishing mortality \eqn{F_{g,i}(w)} imposed by gear \eqn{g} on #' species \eqn{i} at size \eqn{w} is calculated as: #' \deqn{F_{g,i}(w) = S_{g,i}(w) Q_{g,i} E_{g},} -#' where \eqn{S} is the selectivity by species, gear and size, \eqn{Q} is the +#' where \eqn{S} is the selectivity by species, gear and size, \eqn{Q} is the #' catchability by species and gear and \eqn{E} is the fishing effort by gear. -#' +#' #' \strong{Selectivity} -#' +#' #' The selectivity at size of each gear for each species is saved as a three -#' dimensional array (gear x species x size). Each entry has a range between 0 +#' dimensional array (gear x species x size). Each entry has a range between 0 #' (that gear is not selecting that species at that size) to 1 (that gear is #' selecting all individuals of that species of that size). This three #' dimensional array can be specified explicitly via the `selectivity` #' argument, but usually mizer calculates it from the `gear_params` slot of #' the MizerParams object. -#' +#' #' To allow the calculation of the `selectivity` array, the `gear_params` slot #' must be a data frame with one row for each gear-species combination. So if #' for example a gear can select three species, then that gear contributes three @@ -32,11 +32,11 @@ #' holding the name of the species, and `sel_func`, holding the name of the #' function that calculates the selectivity curve. Some selectivity functions #' are included in the package: `knife_edge()`, `sigmoid_length()`, -#' `double_sigmoid_length()`, and `sigmoid_weight()`. +#' `double_sigmoid_length()`, and `sigmoid_weight()`. #' Users are able to write their own size-based selectivity function. The first #' argument to the function must be `w` and the function must return a vector of #' the selectivity (between 0 and 1) at size. -#' +#' #' Each selectivity function may have parameters. Values for these #' parameters must be included as columns in the gear parameters data.frame. #' The names of the columns must exactly match the names of the corresponding @@ -50,14 +50,14 @@ #' function there should be a `knife_edge_size` column. Because `knife_edge()` #' is the default selectivity function, the `knife_edge_size` argument has a #' default value = `w_mat`. -#' +#' #' The most commonly-used selectivity function is `sigmoid_length()`. It has a #' smooth transition from 0 to 1 at a certain size. The `sigmoid_length()` #' function has the two parameters `l50` and `l25` that are the lengths in cm at #' which 50% or 25% of the fish are selected by the gear. If you choose this #' selectivity function then the `l50` and `l25` columns must be included in the #' gear parameters data.frame. -#' +#' #' In case each species is only selected by one gear, the columns of the #' `gear_params` data frame can alternatively be provided as columns of the #' `species_params` data frame, if this is more convenient for the user to set @@ -67,30 +67,30 @@ #' data frame. #' #' \strong{Catchability} -#' +#' #' Catchability is used as an additional factor to make the link between gear #' selectivity, fishing effort and fishing mortality. For example, it can be set #' so that an effort of 1 gives a desired fishing mortality. In this way effort #' can then be specified relative to a 'base effort', e.g. the effort in a -#' particular year. -#' +#' particular year. +#' #' Catchability is stored as a two dimensional array (gear x species). This can #' either be provided explicitly via the `catchability` argument, or the #' information can be provided via a `catchability` column in the `gear_params` -#' data frame. -#' +#' data frame. +#' #' In the case where each species is selected by only a single gear, the #' `catchability` column can also be provided in the `species_params` data #' frame. Mizer will then copy this over to the `gear_params` data frame when #' the MizerParams object is created. -#' +#' #' \strong{Effort} -#' +#' #' The initial fishing effort is stored in the `MizerParams` object. If it is #' not supplied, it is set to zero. The initial effort can be overruled when #' the simulation is run with `project()`, where it is also possible to specify #' an effort that varies through time. -#' +#' #' @param params A MizerParams object #' @param selectivity Optional. An array (gear x species x size) that holds the #' selectivity of each gear for species and size, \eqn{S_{g,i,w}}. @@ -106,7 +106,7 @@ #' a recalculation from the gear parameters will take place only if no custom #' value has been set. #' @param ... Unused -#' +#' #' @return `setFishing()`: A MizerParams object with updated fishing #' parameters. #' @export @@ -120,8 +120,7 @@ setFishing <- function(params, selectivity = NULL, catchability = NULL, setFishing.MizerParams <- function(params, selectivity = NULL, catchability = NULL, reset = FALSE, initial_effort = NULL, ...) { - assert_that(is(params, "MizerParams"), - is.flag(reset)) + assert_that(is.flag(reset)) species_params <- params@species_params gear_params <- params@gear_params sp_names <- species_params$species @@ -130,24 +129,24 @@ setFishing.MizerParams <- function(params, selectivity = NULL, catchability = NU no_w <- length(params@w) gear_names <- unique(gear_params$gear) no_gears <- length(gear_names) - + if (reset) { if (!is.null(selectivity)) { - warning("Because you set `reset = TRUE`, the value you provided ", + warning("Because you set `reset = TRUE`, the value you provided ", "for `selectivity` will be ignored and a value will be ", "calculated from the gear parameters.") selectivity <- NULL } comment(params@selectivity) <- NULL if (!is.null(catchability)) { - warning("Because you set `reset = TRUE`, the value you provided ", + warning("Because you set `reset = TRUE`, the value you provided ", "for `catchability` will be ignored and a value will be ", "calculated from the gear parameters.") catchability <- NULL } comment(params@catchability) <- NULL } - + if (!is.null(selectivity) && is.null(comment(selectivity))) { if (is.null(comment(params@selectivity))) { comment(selectivity) <- "set manually" @@ -162,7 +161,7 @@ setFishing.MizerParams <- function(params, selectivity = NULL, catchability = NU comment(catchability) <- comment(params@catchability) } } - + # The number of gears could be set by the catchability array if (!is.null(catchability) && (dim(catchability)[[1]] != no_gears)) { if (is.null(selectivity)) { @@ -181,7 +180,7 @@ setFishing.MizerParams <- function(params, selectivity = NULL, catchability = NU "catchability array need to be all different.") } } - + if (!is.null(selectivity)) { assert_that(length(dim(selectivity)) == 3, dim(selectivity)[[1]] == no_gears, @@ -202,7 +201,7 @@ setFishing.MizerParams <- function(params, selectivity = NULL, catchability = NU "selectivity array to agree with mizer conventions.") } } - dimnames(selectivity) <- list(gear = gear_names, + dimnames(selectivity) <- list(gear = gear_names, sp = sp_names, w = w_names) params@selectivity <- selectivity @@ -216,7 +215,7 @@ setFishing.MizerParams <- function(params, selectivity = NULL, catchability = NU params@selectivity <- selectivity } } - + if (!is.null(catchability)) { assert_that(length(dim(catchability)) == 2, dim(catchability)[[2]] == no_sp) @@ -237,14 +236,14 @@ setFishing.MizerParams <- function(params, selectivity = NULL, catchability = NU } params@catchability <- catchability } else { - catchability <- + catchability <- array(0, dim = c(no_gears, no_sp), - dimnames = list(gear = gear_names, + dimnames = list(gear = gear_names, sp = sp_names ) ) for (g in seq_len(nrow(gear_params))) { - catchability[[gear_params$gear[[g]], + catchability[[gear_params$gear[[g]], gear_params$species[[g]]]] <- gear_params$catchability[[g]] } @@ -256,28 +255,28 @@ setFishing.MizerParams <- function(params, selectivity = NULL, catchability = NU params@catchability <- catchability } } - + if (!is.null(initial_effort)) { params@initial_effort[] <- validEffortVector(initial_effort, params) comment(params@initial_effort) <- comment(initial_effort) } - + # Get rid of any efforts for gears that no longer exist and set effort # for new gears to zero (done by `validEffortVector()`). existing <- names(params@initial_effort) %in% gear_names - params@initial_effort <- validEffortVector(params@initial_effort[existing], + params@initial_effort <- validEffortVector(params@initial_effort[existing], params) params@time_modified <- lubridate::now() return(params) } #' Gear parameters -#' +#' #' These functions allow you to get or set the gear parameters stored in -#' a MizerParams object. These are used by [setFishing()] to set up the +#' a MizerParams object. These are used by [setFishing()] to set up the #' selectivity and catchability and thus together with the fishing effort #' determine the fishing mortality. -#' +#' #' The `gear_params` data has one row for each gear-species pair and one #' column for each parameter that determines how that gear interacts with that #' species. The columns are: @@ -288,34 +287,34 @@ setFishing.MizerParams <- function(params, selectivity = NULL, catchability = NU #' * `sel_func` The name of the function that calculates the selectivity curve. #' * One column for each selectivity parameter needed by the selectivity #' functions. -#' -#' For the details see [setFishing()]. -#' +#' +#' For the details see [setFishing()]. +#' #' There can optionally also be a column `yield_observed` that allows you to -#' specify for each gear and species the total annual fisheries yield. -#' +#' specify for each gear and species the total annual fisheries yield. +#' #' The fishing effort, which is also needed to determine the fishing mortality #' exerted by a gear is not set via the `gear_params` data frame but is set #' with `initial_effort()` or is specified when calling `project()`. -#' +#' #' If you change a gear parameter, this will be used to recalculate the #' `selectivity` and `catchability` arrays by calling [setFishing()], #' unless you have previously set these by hand. -#' +#' #' `gear_params<-` automatically sets the row names to contain the species name #' and the gear name, separated by a comma and a space. The last example below #' illustrates how this facilitates changing an individual gear parameter. -#' +#' #' @param params A MizerParams object #' @return Data frame with gear parameters #' @export #' @family functions for setting parameters -#' @examples +#' @examples #' params <- NS_params -#' +#' #' # gears set up in example #' gear_params(params) -#' +#' #' # setting totally different gears #' gear_params(params) <- data.frame( #' gear = c("gear1", "gear2", "gear1"), @@ -327,7 +326,7 @@ setFishing.MizerParams <- function(params, selectivity = NULL, catchability = NU #' knife_edge_size = c(NA, 1000, NA) #' ) #' gear_params(params) -#' +#' #' # changing an individual entry #' gear_params(params)["Cod, gear1", "catchability"] <- 0.8 gear_params <- function(params) { @@ -438,7 +437,7 @@ getInitialEffort.MizerParams <- function(params) { } #' Initial fishing effort -#' +#' #' The fishing effort is a named vector, specifying for each fishing gear the #' effort invested into fishing with that gear. The effort value for each gear #' is multiplied by the catchability and the selectivity to determine the @@ -446,10 +445,10 @@ getInitialEffort.MizerParams <- function(params) { #' The initial effort you have set can be overruled when running a simulation #' by providing an `effort` argument to [project()] which allows you to #' specify a time-varying effort. -#' +#' #' A valid effort vector is a named vector with one effort value for each gear. #' However you can also supply the effort value in different ways: -#' +#' #' * a scalar, which is then replicated for each gear #' * an unnamed vector, which is then assumed to be in the same order as the #' gears in the params object @@ -457,14 +456,14 @@ getInitialEffort.MizerParams <- function(params) { #' params object. This is then sorted correctly. #' * a named vector which only supplies values for some of the gears. #' The effort for the other gears is then set to zero. -#' +#' #' These conversions are done by the function `validEffortVector()`. -#' +#' #' An `effort` argument will lead to an error if it is either #' * unnamed and of the wrong length #' * named but where some names do not match any of the gears #' * not numeric -#' +#' #' @param params A MizerParams object #' @return Effort vector #' @export @@ -489,21 +488,21 @@ initial_effort.MizerParams <- function(params) { } #' Check validity of gear parameters and set defaults -#' +#' #' The function returns a valid gear parameter data frame that can be used #' by `setFishing()` or it gives an error message. -#' +#' #' The gear_params data frame is allowed to have zero rows, but if it has #' rows, then the following requirements apply: -#' * There must be columns `species` and `gear` and any species - gear pair is +#' * There must be columns `species` and `gear` and any species - gear pair is #' allowed to appear at most once. Any species that appears must also appear #' in the `species_params` data frame. -#' * There must be a `sel_func` column. If a selectivity function is not +#' * There must be a `sel_func` column. If a selectivity function is not #' supplied, it will be set to "knife_edge". #' * There must be a `catchability` column. If a catchability is not supplied, #' it will be set to 1. #' * All the parameters required by the selectivity functions must be provided. -#' +#' #' If gear_params is empty, then this function tries to find the necessary #' information in the species_params data frame. This restricts each species #' to be fished by only one gear. Defaults are used for information that can @@ -514,15 +513,15 @@ initial_effort.MizerParams <- function(params) { #' * If there is no `catchability` column or it is NA then this is set to 1. #' * If the selectivity function is `knife_edge` and no `knife_edge_size` is #' provided, it is set to `w_mat`. -#' +#' #' The row names of the returned data frame are of the form #' "species, gear". -#' +#' #' When `gear_params` is `NULL` and there is no gear information in #' `species_params`, then a gear called `knife_edge_gear` is set up with a #' `knife_edge` selectivity for each species and a `knive_edge_size` equal to #' `w_mat`. Catchability is set to 0.3 for all species. -#' +#' #' @param gear_params Gear parameter data frame #' @param species_params Species parameter data frame #' @return A valid gear parameter data frame @@ -530,14 +529,14 @@ initial_effort.MizerParams <- function(params) { #' @seealso [gear_params()] #' @export validGearParams <- function(gear_params, species_params) { - + catchability_default <- ifelse(defaults_edition() < 2, 1, 0.3) - + # if no gear parameters are given, set up knife-edge gear - if (is.null(gear_params) && - !("gear" %in% names(species_params) || + if (is.null(gear_params) && + !("gear" %in% names(species_params) || "sel_func" %in% names(species_params))) { - gear_params <- + gear_params <- data.frame(species = species_params$species, gear = "knife_edge_gear", sel_func = "knife_edge", @@ -545,23 +544,23 @@ validGearParams <- function(gear_params, species_params) { catchability = catchability_default, stringsAsFactors = FALSE) # for old versions of R } - + species_params <- validSpeciesParams(species_params) no_sp <- nrow(species_params) - + # If no gear_params are supplied, but there is either a gear or sel_func # column in the species_params data frame, then try to extract information # from there. if ((is.null(gear_params) || nrow(gear_params) == 0) && - ("gear" %in% names(species_params) || + ("gear" %in% names(species_params) || "sel_func" %in% names(species_params))) { # Try to take parameters from species_params - gear_params <- + gear_params <- data.frame(species = species_params$species, stringsAsFactors = FALSE) if ("gear" %in% names(species_params)) { gear_params$gear <- species_params$gear - gear_params$gear[is.na(gear_params$gear)] <- + gear_params$gear[is.na(gear_params$gear)] <- species_params$species[is.na(gear_params$gear)] } else { gear_params$gear <- species_params$species @@ -587,7 +586,7 @@ validGearParams <- function(gear_params, species_params) { if (!arg %in% names(gear_params)) { gear_params[[arg]] <- NA } - if (arg %in% names(species_params) && + if (arg %in% names(species_params) && !is.na(species_params[g, arg])) { gear_params[g, arg] <- species_params[g, arg] } else if (arg == "knife_edge_size") { @@ -598,45 +597,45 @@ validGearParams <- function(gear_params, species_params) { } } } - + # An empty gear_params data frame is valid if (nrow(gear_params) == 0) { return(gear_params) } - + if (!all(c("species", "gear") %in% names(gear_params))) { stop("`gear_params` must have columns 'species' and 'gear'.") } - + gear_params$species <- as.character(gear_params$species) gear_params$gear <- as.character(gear_params$gear) - + # Check that every species mentioned in gear_params exists if (!all(gear_params$species %in% species_params$species)) { stop("The gear_params dataframe contains species that do not exist in the model.") } - + # Check that there are no duplicate gear-species pairs if (anyDuplicated(gear_params[, c("species", "gear")])) { stop("Some species - gear pairs appear more than once.") } - + # Default selectivity function is knife_edge if (!("sel_func" %in% names(gear_params))) { gear_params$sel_func <- "knife_edge" } gear_params$sel_func[is.na(gear_params$sel_func)] <- "knife_edge" - + # Default gear name is species name sel <- is.na(gear_params$gear) gear_params$gear[sel] <- gear_params$species[sel] - + # Ensure there is knife_edge_size column if any knife_edge selectivity function if (any(gear_params$sel_func == "knife_edge") && !("knife_edge_size" %in% names(gear_params))) { gear_params$knife_edge_size <- NA } - + # Check that every row is complete for (g in seq_len(nrow(gear_params))) { if ((gear_params$sel_func[[g]] == "knife_edge") && @@ -659,9 +658,9 @@ validGearParams <- function(gear_params, species_params) { if (!("catchability" %in% names(gear_params))) { gear_params$catchability <- catchability_default } - gear_params$catchability[is.na(gear_params$catchability)] <- + gear_params$catchability[is.na(gear_params$catchability)] <- catchability_default - + rownames(gear_params) <- paste(gear_params$species, gear_params$gear, sep = ", ") @@ -669,24 +668,23 @@ validGearParams <- function(gear_params, species_params) { } #' Make a valid effort vector -#' +#' #' @param effort A vector or scalar with the initial fishing effort, see Details #' below. -#' +#' #' @export #' @rdname initial_effort validEffortVector <- function(effort, params) { - assert_that(is(params, "MizerParams"), - (is.null(effort) || is.numeric(effort))) + assert_that(is.null(effort), is.numeric(effort)) gear_names <- dimnames(params@catchability)[[1]] no_gears <- length(gear_names) - + # If only one effort is given, it is replicated for all gears if (length(effort) == 1) { effort <- rep(effort, no_gears) names(effort) <- gear_names } - + # If effort is unnamed but of the right length, then set gear names if (is.null(names(effort))) { if (length(effort) != no_gears) { @@ -694,7 +692,7 @@ validEffortVector <- function(effort, params) { } names(effort) <- gear_names } - + # Effort vector should not supply effort for non-existent gears if (!all(names(effort) %in% gear_names)) { stop("The effort vector is invalid as it has names that are not among the gear names") @@ -706,22 +704,22 @@ validEffortVector <- function(effort, params) { new <- rep(effort_default, length(missing)) names(new) <- missing effort <- c(effort, new) - + # Set any NAs to default effort[is.na(effort)] <- effort_default - + # Sort vector effort <- effort[gear_names] - + return(effort) } #' Calculate selectivity from gear parameters -#' +#' #' This function calculates the selectivity for each gear, species and size from #' the gear parameters. It is called by [setFishing()] when the `selectivity` is #' not set by the user. -#' +#' #' @param params A MizerParams object #' @return An array (gear x species x size) with the selectivity values #' @concept helper @@ -731,7 +729,7 @@ validEffortVector <- function(effort, params) { #' str(calc_selectivity(params)) #' calc_selectivity(params)["Pelagic", "Herring", ] calc_selectivity <- function(params) { - + assert_that(is(params, "MizerParams")) species_params <- params@species_params gear_params <- params@gear_params @@ -741,10 +739,10 @@ calc_selectivity <- function(params) { no_w <- length(params@w) gear_names <- unique(gear_params$gear) no_gears <- length(gear_names) - - selectivity <- + + selectivity <- array(0, dim = c(no_gears, no_sp, no_w), - dimnames = list(gear = gear_names, + dimnames = list(gear = gear_names, sp = sp_names, w = w_names ) @@ -766,7 +764,7 @@ calc_selectivity <- function(params) { stop("Some selectivity parameters are NA.") } # Call selectivity function with selectivity parameters - par <- c(list(w = params@w, + par <- c(list(w = params@w, species_params = as.list(species_params[species, ])), as.list(gear_params[g, arg])) sel <- do.call(sel_func, args = par) diff --git a/R/setInitialValues.R b/R/setInitialValues.R index a8b9c916..0326030d 100644 --- a/R/setInitialValues.R +++ b/R/setInitialValues.R @@ -1,8 +1,8 @@ #' Set initial values to values from a simulation -#' +#' #' This is used to use the results from one simulation as the starting values #' for another simulation. -#' +#' #' The initial abundances (for both species and resource) in the `params` #' object are set to the abundances in a MizerSim object, averaged over #' a range of times. Similarly, the initial effort in the `params` object is @@ -10,11 +10,11 @@ #' of times. #' When no time range is specified, the initial values are taken from the final #' time step of the simulation. -#' +#' #' If the model described by `sim` and `params` has additional components #' created with [setComponent()] then the values of these components are also #' averaged and copied to `params`. -#' +#' #' The MizerSim object must come from a model with the same set of species and #' gears and other components and the same size bins as the MizerParams object. #' Otherwise an error is raised. @@ -31,8 +31,8 @@ #' does not affect the average of the effort or of other components, which is #' always arithmetic. #' @param ... Additional arguments passed to the method. -#' -#' @return The `params` object with updated initial values and initial effort. +#' +#' @return The `params` object with updated initial values and initial effort. #' Because of the way the #' R language works, `setInitialValues()` does not make the changes to the #' params object that you pass to it but instead returns a new params object. @@ -58,7 +58,7 @@ setInitialValues.MizerParams <- function(params, sim, time_range, geometric_mean stop("The consumer size spectrum of the simulation in `sim` has a ", "different size from that in `params`.") } - if (!identical(params@species_params$species, + if (!identical(params@species_params$species, sim@params@species_params$species)) { stop("The species in `sim` have different names from those in `params`.") } @@ -101,18 +101,18 @@ setInitialValues.MizerParams <- function(params, sim, time_range, geometric_mean apply(sim@n_other[time_elements, , drop = FALSE], 2, function(l) Reduce(mizer_add, l) / length(l), simplify = FALSE) - + params@initial_effort[] <- apply(sim@effort[time_elements, , drop = FALSE], 2, mean) - + params@time_modified <- lubridate::now() params } #' Initial values for fish spectra -#' +#' #' Values used as starting values for simulations with `project()`. -#' +#' #' @param params A MizerParams object #' @param value A matrix with dimensions species x size holding the initial #' number densities for the fish spectra. @@ -122,10 +122,6 @@ setInitialValues.MizerParams <- function(params, sim, time_range, geometric_mean } #' @export `initialN<-.MizerParams` <- function(params, value) { - if (!is(params, "MizerParams")) { - stop("You can only assign an initial N to a MizerParams object. ", - params, " is of class ", class(params), ".") - } assert_that(identical(dim(value), dim(params@initial_n)), all(value >= 0)) if (!is.null(dimnames(value)) && @@ -133,7 +129,7 @@ setInitialValues.MizerParams <- function(params, sim, time_range, geometric_mean warning("The dimnames do not match. I will ignore them.") } params@initial_n[] <- value - + params@time_modified <- lubridate::now() params } @@ -144,7 +140,7 @@ setInitialValues.MizerParams <- function(params, sim, time_range, geometric_mean #' densities for the fish spectra. #' @export #' @seealso [initialNResource()], [initialNOther()] -#' @examples +#' @examples #' # Doubling abundance of Cod in the initial state of the North Sea model #' params <- NS_params #' initialN(params)["Cod", ] <- 2 * initialN(params)["Cod", ] @@ -168,9 +164,9 @@ initialN.MizerSim <- function(object) { } #' Initial value for resource spectrum -#' +#' #' Value used as starting value for simulations with `project()`. -#' +#' #' @param params A MizerParams object #' @param value A vector with the initial number densities for the resource #' spectrum @@ -187,10 +183,6 @@ initialN.MizerSim <- function(object) { } #' @export `initialNResource<-.MizerParams` <- function(params, value) { - if (!is(params, "MizerParams")) { - stop("You can only assign an initial N to a MizerParams object. ", - params, " is of class ", class(params), ".") - } assert_that(identical(dim(value), dim(params@initial_n_pp)), all(value >= 0)) if (!is.null(dimnames(value)) && @@ -198,7 +190,7 @@ initialN.MizerSim <- function(object) { warning("The dimnames do not match. I will ignore them.") } params@initial_n_pp[] <- value - + params@time_modified <- lubridate::now() params } diff --git a/R/setInteraction.R b/R/setInteraction.R index 22b92323..2386e53d 100644 --- a/R/setInteraction.R +++ b/R/setInteraction.R @@ -60,7 +60,6 @@ setInteraction <- function(params, interaction = NULL, ...) { #' @export setInteraction.MizerParams <- function(params, interaction = NULL, ...) { - assert_that(is(params, "MizerParams")) if (is.null(interaction)) { interaction <- params@interaction } @@ -86,16 +85,16 @@ setInteraction.MizerParams <- function(params, names(dimnames(params@interaction)))) { message("Note: Your interaction matrix has dimensions called: `", toString(names(dimnames(interaction))), - "`. I expected 'predator, prey'. ", + "`. I expected 'predator, prey'. ", "I will now ignore your names.") } } names(dimnames(interaction)) <- names(dimnames(params@interaction)) # If user did not supply rownames, then save to assume that they have - # put the rows in the same order as the columns, so copy over + # put the rows in the same order as the columns, so copy over # the colnames - if (is.null(rownames(interaction)) || - all(rownames(interaction) == + if (is.null(rownames(interaction)) || + all(rownames(interaction) == as.character(seq_len(nrow(interaction))))) { rownames(interaction) <- colnames(interaction) } @@ -110,7 +109,7 @@ setInteraction.MizerParams <- function(params, } } params@interaction[] <- interaction - + # Check the interaction_resource column in species_params message <- "Note: No interaction_resource column in species data frame so assuming all species feed on resource." species_params <- set_species_param_default(params@species_params, @@ -121,15 +120,15 @@ setInteraction.MizerParams <- function(params, stop("Values in the resource interaction vector must be non-negative.") } params@species_params$interaction_resource <- species_params$interaction_resource - + params@time_modified <- lubridate::now() return(params) } #' Deprecated function to get interaction matrix -#' +#' #' You should now use [interaction_matrix()] instead. -#' +#' #' @param params A MizerParams object #' @export #' @keywords internal @@ -138,7 +137,7 @@ getInteraction <- function(params) { } #' @export getInteraction.MizerParams <- function(params) { - lifecycle::deprecate_warn("2.4.0", "getInteraction()", + lifecycle::deprecate_warn("2.4.0", "getInteraction()", "interaction_matrix()") interaction_matrix(params) } diff --git a/R/setMaxIntakeRate.R b/R/setMaxIntakeRate.R index 0914486f..0d4b8f0e 100644 --- a/R/setMaxIntakeRate.R +++ b/R/setMaxIntakeRate.R @@ -6,13 +6,13 @@ #' [getFeedingLevel()]. It is measured in grams/year. #' #' If the `intake_max` argument is not supplied, then the maximum intake -#' rate is set to \deqn{h_i(w) = h_i w^{n_i}.} +#' rate is set to \deqn{h_i(w) = h_i w^{n_i}.} #' The values of \eqn{h_i} (the maximum intake rate of an individual of size 1 #' gram) and \eqn{n_i} (the allometric exponent for the intake rate) are taken #' from the `h` and `n` columns in the species parameter dataframe. If #' the `h` column is not supplied in the species parameter dataframe, it is #' calculated by the [get_h_default()] function. -#' +#' #' If \eqn{h_i} is set to `Inf`, fish of species i will consume all encountered #' food. #' @@ -22,12 +22,12 @@ #' described in the section "Setting maximum intake rate". #' @param reset `r lifecycle::badge("experimental")` #' If set to TRUE, then the intake rate will be reset to the value -#' calculated from the species parameters, even if it was previously +#' calculated from the species parameters, even if it was previously #' overwritten with a custom value. If set to FALSE (default) then a #' recalculation from the species parameters will take place only if no #' custom value has been set. #' @param ... Unused -#' +#' #' @return `setReproduction()`: A MizerParams object with updated maximum #' intake rate. #' @export @@ -37,20 +37,19 @@ setMaxIntakeRate <- function(params, intake_max = NULL, reset = FALSE, ...) { } #' @export setMaxIntakeRate.MizerParams <- function(params, intake_max = NULL, reset = FALSE, ...) { - assert_that(is(params, "MizerParams"), - is.flag(reset)) + assert_that(is.flag(reset)) species_params <- params@species_params - + if (reset) { if (!is.null(intake_max)) { - warning("Because you set `reset = TRUE`, the value you provided ", + warning("Because you set `reset = TRUE`, the value you provided ", "for `intake_max` will be ignored and a value will be ", "calculated from the species parameters.") intake_max <- NULL } comment(params@intake_max) <- NULL } - + # If intake_max array is supplied, check it, store it and return if (!is.null(intake_max)) { if (is.null(comment(intake_max))) { @@ -62,27 +61,27 @@ setMaxIntakeRate.MizerParams <- function(params, intake_max = NULL, reset = FALS } assert_that(is.array(intake_max), identical(dim(intake_max), dim(params@intake_max))) - if (!is.null(dimnames(intake_max)) && + if (!is.null(dimnames(intake_max)) && !all(dimnames(intake_max)[[1]] == species_params$species)) { stop("You need to use the same ordering of species in the ", - "intake_max array as in the params object: ", + "intake_max array as in the params object: ", toString(species_params$species)) } assert_that(all(intake_max >= 0)) params@intake_max[] <- intake_max comment(params@intake_max) <- comment(intake_max) - + params@time_modified <- lubridate::now() return(params) } - + # Else recalculate from species params params@species_params[["h"]] <- get_h_default(params) - - intake_max <- sweep(outer(params@species_params[["n"]], + + intake_max <- sweep(outer(params@species_params[["n"]], params@w, function(x, y) y^x), - 1, params@species_params[["h"]], "*") - + 1, params@species_params[["h"]], "*") + # Prevent overwriting slot if it has been commented if (!is.null(comment(params@intake_max))) { # Issue warning but only if a change was actually requested @@ -93,7 +92,7 @@ setMaxIntakeRate.MizerParams <- function(params, intake_max = NULL, reset = FALS return(params) } params@intake_max[] <- intake_max - + params@time_modified <- lubridate::now() return(params) } diff --git a/R/setMetabolicRate.R b/R/setMetabolicRate.R index 12ed25a1..7e0642bb 100644 --- a/R/setMetabolicRate.R +++ b/R/setMetabolicRate.R @@ -21,6 +21,7 @@ #' specified, a default of \eqn{f_c = 0.2} is used. #' #' @param object A MizerParams object +#' @param params A MizerParams object #' @param metab Optional. An array (species x size) holding the metabolic rate #' for each species at size. If not supplied, a default is set as described in #' the section "Setting metabolic rate". diff --git a/R/setPredKernel.R b/R/setPredKernel.R index 76a5de3b..044850cc 100644 --- a/R/setPredKernel.R +++ b/R/setPredKernel.R @@ -1,5 +1,5 @@ #' Set predation kernel -#' +#' #' The predation kernel determines the distribution of prey sizes that a #' predator feeds on. It is used in [getEncounter()] when calculating #' the rate at which food is encountered and in [getPredRate()] when @@ -7,10 +7,10 @@ #' can be a function of the predator/prey size ratio or it can be a function of #' the predator size and the prey size separately. Both types can be set up with #' this function. -#' +#' #' @section Setting predation kernel: #' \strong{Kernel dependent on predator to prey size ratio} -#' +#' #' If the `pred_kernel` argument is not supplied, then this function sets a #' predation kernel that depends only on the ratio of predator mass to prey #' mass, not on the two masses independently. The shape of that kernel is then @@ -31,7 +31,7 @@ #' You can use any other string for `pred_kernel_type`. If for example you #' choose "my" then you need to define a function `my_pred_kernel` that you can #' model on the existing functions like [lognormal_pred_kernel()]. -#' +#' #' When using a kernel that depends on the predator/prey size ratio only, mizer #' does not need to store the entire three dimensional array in the MizerParams #' object. Such an array can be very big when there is a large number of size @@ -40,9 +40,9 @@ #' rate and the predation rate to be calculated very efficiently. However, if #' you need the full three-dimensional array you can calculate it with the #' [getPredKernel()] function. -#' +#' #' \strong{Kernel dependent on both predator and prey size} -#' +#' #' If you want to work with a feeding kernel that depends on predator mass and #' prey mass independently, you can specify the full feeding kernel as a #' three-dimensional array (predator species x predator size x prey size). @@ -56,7 +56,7 @@ #' as the order in the species params dataframe in the `params` object. If you #' supply a named array then the function will check the order and warn if it is #' different. -#' +#' #' @param params A MizerParams object #' @param pred_kernel Optional. An array (species x predator size x prey size) #' that holds the predation coefficient of each predator at size on each prey @@ -69,28 +69,28 @@ #' recalculation from the species parameters will take place only if no custom #' value has been set. #' @param ... Unused -#' +#' #' @return `setPredKernel()`: A MizerParams object with updated predation kernel. #' @export #' @family functions for setting parameters #' @examples #' ## Set up a MizerParams object #' params <- NS_params -#' -#' ## If you change predation kernel parameters after setting up a model, +#' +#' ## If you change predation kernel parameters after setting up a model, #' # this will be used to recalculate the kernel #' species_params(params)["Cod", "beta"] <- 200 -#' +#' #' ## You can change to a different predation kernel type #' species_params(params)$ppmr_max <- 4000 #' species_params(params)$ppmr_min <- 200 #' species_params(params)$pred_kernel_type <- "box" #' plot(w_full(params), getPredKernel(params)["Cod", 100, ], type="l", log="x") -#' +#' #' ## If you need a kernel that depends also on prey size you need to define #' # it yourself. #' pred_kernel <- getPredKernel(params) -#' pred_kernel["Herring", , ] <- sweep(pred_kernel["Herring", , ], 2, +#' pred_kernel["Herring", , ] <- sweep(pred_kernel["Herring", , ], 2, #' params@w_full, "*") #' params<- setPredKernel(params, pred_kernel = pred_kernel) setPredKernel <- function(params, pred_kernel = NULL, reset = FALSE, ...) { @@ -100,19 +100,18 @@ setPredKernel <- function(params, pred_kernel = NULL, reset = FALSE, ...) { setPredKernel.MizerParams <- function(params, pred_kernel = NULL, reset = FALSE, ...) { - assert_that(is(params, "MizerParams"), - is.flag(reset)) - + assert_that(is.flag(reset)) + if (reset) { if (!is.null(pred_kernel)) { - warning("Because you set `reset = TRUE`, the value you provided ", + warning("Because you set `reset = TRUE`, the value you provided ", "for `pred_kernel` will be ignored and a value will be ", "calculated from the species parameters.") pred_kernel <- NULL } comment(params@pred_kernel) <- NULL } - + if (!is.null(pred_kernel)) { if (is.null(comment(pred_kernel))) { if (is.null(comment(params@pred_kernel))) { @@ -124,15 +123,15 @@ setPredKernel.MizerParams <- function(params, # A pred kernel was supplied, so check it and store it assert_that(is.array(pred_kernel)) # psi is used in the next line just because it has the right dimension - assert_that(identical(dim(pred_kernel), + assert_that(identical(dim(pred_kernel), c(dim(params@psi), length(params@w_full)))) - if (!is.null(dimnames(pred_kernel)) && + if (!is.null(dimnames(pred_kernel)) && !all(dimnames(pred_kernel)[[1]] == params@species_params$species)) { stop(paste0("You need to use the same ordering of species as in the ", "params object: ", toString(params@species_params$species))) } assert_that(all(pred_kernel >= 0)) - dimnames(pred_kernel) <- + dimnames(pred_kernel) <- list(sp = params@species_params$species, w_pred = signif(params@w, 3), w_prey = signif(params@w_full, 3)) @@ -140,12 +139,12 @@ setPredKernel.MizerParams <- function(params, params@time_modified <- lubridate::now() return(params) } - + ## Set a pred kernel dependent on predator/prey size ratio only - + # If pred_kernel_type is not supplied use "lognormal" params <- default_pred_kernel_params(params) - + species_params <- params@species_params pred_kernel_type <- species_params$pred_kernel_type no_sp <- nrow(species_params) @@ -171,7 +170,7 @@ setPredKernel.MizerParams <- function(params, phi_p[(no_w_full - ri + 1):no_w_full] <- phi[(ri + 1):2] ft_pred_kernel_p[i, ] <- fft(phi_p) } - + # Prevent resetting if full slot has been commented if (!is.null(comment(params@pred_kernel))) { # Issue warning but only if a change was actually requested @@ -185,7 +184,7 @@ setPredKernel.MizerParams <- function(params, } params@ft_pred_kernel_e[] <- ft_pred_kernel_e params@ft_pred_kernel_p[] <- ft_pred_kernel_p - + params@time_modified <- lubridate::now() return(params) } @@ -202,8 +201,7 @@ getPredKernel.MizerParams <- function(params) { # This function is more complicated than you might have thought because # usually the predation kernel is not stored in the MizerParams object, # but rather only the Fourier coefficients needed for fast calculation of - # the convolution integrals. - assert_that(is(params, "MizerParams")) + # the convolution integrals. if (length(dim(params@pred_kernel)) > 1) { return(params@pred_kernel) } @@ -218,7 +216,7 @@ getPredKernel.MizerParams <- function(params) { phis <- get_phi(species_params, ppmr) # Do not allow feeding at own size phis[, 1] <- 0 - pred_kernel <- + pred_kernel <- array(0, dim = c(no_sp, no_w, no_w_full), dimnames = list(sp = species_params$species, @@ -274,7 +272,7 @@ default_pred_kernel_params <- function(object) { } else { species_params <- object } - + species_params <- set_species_param_default(species_params, "pred_kernel_type", "lognormal") @@ -295,12 +293,12 @@ default_pred_kernel_params <- function(object) { } #' Get values from feeding kernel function -#' +#' #' This involves finding the feeding kernel function for each species, using the #' pred_kernel_type parameter in the species_params data frame, checking that it #' is valid and all its arguments are contained in the species_params data #' frame, and then calling this function with the ppmr vector. -#' +#' #' @param species_params A species parameter data frame #' @param ppmr Values of the predator/prey mass ratio at which to evaluate the #' predation kernel function @@ -343,7 +341,7 @@ get_phi <- function(species_params, ppmr) { } pars <- c(ppmr = list(ppmr), as.list(species_params[i, args])) phi <- do.call(pred_kernel_func_name, args = pars) - + if (any(is.na(phi))) { stop("The function ", pred_kernel_func_name, " returned NA. Did you correctly specify all required", diff --git a/R/setReproduction.R b/R/setReproduction.R index 1d569a8b..848cac42 100644 --- a/R/setReproduction.R +++ b/R/setReproduction.R @@ -112,6 +112,7 @@ #' @param RDD The name of the function calculating the density-dependent #' reproduction rate from the density-independent rate. Defaults to #' "[BevertonHoltRDD()]". +#' @param value The desired new value for the respective parameter. #' @param ... Unused #' #' @return `setReproduction()`: A MizerParams object with updated reproduction @@ -142,8 +143,7 @@ setReproduction.MizerParams <- function(params, maturity = NULL, repro_prop = NULL, reset = FALSE, RDD = NULL, ...) { # check arguments ---- - assert_that(is(params, "MizerParams"), - is.flag(reset)) + assert_that(is.flag(reset)) if (is.null(RDD)) RDD <- params@rates_funcs[["RDD"]] assert_that(is.string(RDD), exists(RDD), diff --git a/R/setResource.R b/R/setResource.R index 7e7919f5..6bd5f459 100644 --- a/R/setResource.R +++ b/R/setResource.R @@ -90,14 +90,11 @@ #' `resource_capacity` argument is given as a single number. #' @param w_pp_cutoff The upper cut off size of the resource spectrum power law #' used when `resource_capacity` is given as a single number. When changing -#' `w_pp_cutoff` without providing `resource_capacity`, the cutoff can only -#' be decreased. In that case, both the carrying capacity and the initial -#' resource abundance will be cut off at the new value. To increase the cutoff, -#' you must also provide the `resource_capacity` for the extended range. -#' @param r_pp `r lifecycle::badge("deprecated")`. Use `resource_rate` argument -#' instead. -#' @param kappa `r lifecycle::badge("deprecated")`. Use `resource_capacity` -#' argument instead. +#' `w_pp_cutoff` without providing `resource_capacity`, the cutoff can only be +#' decreased. In that case, both the carrying capacity and the initial +#' resource abundance will be cut off at the new value. To increase the +#' cutoff, you must also provide the `resource_capacity` for the extended +#' range. #' @param ... Unused #' #' @return `setResource`: A MizerParams object with updated resource parameters @@ -117,26 +114,24 @@ setResource.MizerParams <- function(params, resource_capacity = NULL, resource_level = NULL, resource_dynamics = NULL, - r_pp = deprecated(), - kappa = deprecated(), lambda = resource_params(params)[["lambda"]], n = resource_params(params)[["n"]], w_pp_cutoff = resource_params(params)[["w_pp_cutoff"]], balance = NULL, ...) { - if (lifecycle::is_present(r_pp)) { + args <- list(...) + if ("r_pp" %in% names(args)) { lifecycle::deprecate_warn("1.0.0", "setParams(r_pp)", "setParams(resource_rate)") - resource_rate <- r_pp + resource_rate <- args[["r_pp"]] } - if (lifecycle::is_present(kappa)) { + if ("kappa" %in% names(args)) { lifecycle::deprecate_warn("1.0.0", "setParams(kappa)", "setParams(resource_capacity)") - resource_capacity <- kappa + resource_capacity <- args[["kappa"]] } - assert_that(is(params, "MizerParams"), - is.number(lambda), + assert_that(is.number(lambda), is.number(w_pp_cutoff), w_pp_cutoff > 0, is.number(n)) diff --git a/R/setSearchVolume.R b/R/setSearchVolume.R index c3b34d52..013576f3 100644 --- a/R/setSearchVolume.R +++ b/R/setSearchVolume.R @@ -1,11 +1,11 @@ #' Set search volume -#' +#' #' @section Setting search volume: #' The search volume \eqn{\gamma_i(w)} of an individual of species \eqn{i} #' and weight \eqn{w} multiplies the predation kernel when -#' calculating the encounter rate in [getEncounter()] and the +#' calculating the encounter rate in [getEncounter()] and the #' predation rate in [getPredRate()]. -#' +#' #' The name "search volume" is a bit misleading, because \eqn{\gamma_i(w)} does #' not have units of volume. It is simply a parameter that determines the rate #' of predation. Its units depend on your choice, see section "Units in mizer". @@ -13,10 +13,10 @@ #' 1/year. If you have chosen to work with abundances per m^2 then it has units #' of m^2/year. If you have chosen to work with abundances per m^3 then it has #' units of m^3/year. -#' -#' If the `search_vol` argument is not supplied, then the search volume is +#' +#' If the `search_vol` argument is not supplied, then the search volume is #' set to -#' \deqn{\gamma_i(w) = \gamma_i w^q_i.} +#' \deqn{\gamma_i(w) = \gamma_i w^q_i.} #' The values of \eqn{\gamma_i} (the search volume at 1g) and \eqn{q_i} (the #' allometric exponent of the search volume) are taken from the `gamma` and #' `q` columns in the species parameter dataframe. If the `gamma` @@ -24,11 +24,11 @@ #' calculated by the [get_gamma_default()] function. Note that only #' for predators of size \eqn{w = 1} gram is the value of the species parameter #' \eqn{\gamma_i} the same as the value of the search volume \eqn{\gamma_i(w)}. -#' +#' #' @param params MizerParams #' @param search_vol Optional. An array (species x size) holding the search volume #' for each species at size. If not supplied, a default is set as described in -#' the section "Setting search volume". +#' the section "Setting search volume". #' @param reset `r lifecycle::badge("experimental")` #' If set to TRUE, then the search volume will be reset to the #' value calculated from the species parameters, even if it was previously @@ -36,7 +36,7 @@ #' recalculation from the species parameters will take place only if no custom #' value has been set. #' @param ... Unused -#' +#' #' @return `setSearchVolume()`: A MizerParams object with updated search volume. #' @export #' @family functions for setting parameters @@ -45,20 +45,19 @@ setSearchVolume <- function(params, search_vol = NULL, reset = FALSE, ...) { } #' @export setSearchVolume.MizerParams <- function(params, search_vol = NULL, reset = FALSE, ...) { - assert_that(is(params, "MizerParams"), - is.flag(reset)) + assert_that(is.flag(reset)) species_params <- params@species_params - + if (reset) { if (!is.null(search_vol)) { - warning("Because you set `reset = TRUE`, the value you provided ", + warning("Because you set `reset = TRUE`, the value you provided ", "for `search_vol` will be ignored and a value will be ", "calculated from the species parameters.") search_vol <- NULL } comment(params@search_vol) <- NULL } - + # If search_vol array is supplied, check it, store it and return if (!is.null(search_vol)) { if (is.null(comment(search_vol))) { @@ -70,31 +69,31 @@ setSearchVolume.MizerParams <- function(params, search_vol = NULL, reset = FALSE } assert_that(is.array(search_vol)) assert_that(identical(dim(search_vol), dim(params@search_vol))) - if (!is.null(dimnames(search_vol)) && + if (!is.null(dimnames(search_vol)) && !all(dimnames(search_vol)[[1]] == species_params$species)) { stop("You need to use the same ordering of species in the ", - "search_vol array as in the params object: ", + "search_vol array as in the params object: ", toString(species_params$species)) } assert_that(all(search_vol >= 0)) params@search_vol[] <- search_vol comment(params@search_vol) <- comment(search_vol) - + params@time_modified <- lubridate::now() return(params) } - + # Calculate default for any missing gammas q <- params@resource_params$lambda - 2 + params@species_params[["n"]] - params@species_params <- + params@species_params <- set_species_param_default(params@species_params, "q", q) params@species_params$gamma <- get_gamma_default(params) - - search_vol <- + + search_vol <- sweep(outer(params@species_params[["q"]], params@w, function(x, y) y ^ x), 1, params@species_params$gamma, "*") - + # Prevent overwriting slot if it has been commented if (!is.null(comment(params@search_vol))) { # Issue warning but only if a change was actually requested @@ -105,7 +104,7 @@ setSearchVolume.MizerParams <- function(params, search_vol = NULL, reset = FALSE return(params) } params@search_vol[] <- search_vol - + params@time_modified <- lubridate::now() return(params) } diff --git a/R/wrapper_functions.R b/R/wrapper_functions.R index c4a1049f..da1f9f1a 100644 --- a/R/wrapper_functions.R +++ b/R/wrapper_functions.R @@ -56,6 +56,7 @@ #' spectrum is continuous with the resource spectrum. #' @param knife_edge_size The size at the edge of the knife-edge-selectivity #' function. +#' @param r_pp Growth rate parameter for the resource spectrum. #' @inheritParams newMultispeciesParams #' @export #' @return An object of type \code{\linkS4class{MizerParams}} diff --git a/man/animateSpectra.Rd b/man/animateSpectra.Rd index b1058337..cd46478d 100644 --- a/man/animateSpectra.Rd +++ b/man/animateSpectra.Rd @@ -59,13 +59,13 @@ animateSpectra(NS_sim, power = 2, wlim = c(0.1, NA), time_range = 1997:2007) } \seealso{ Other plotting functions: -\code{\link{plot,MizerParams,missing-method}}, -\code{\link{plot,MizerSim,missing-method}}, \code{\link{plotBiomass}()}, \code{\link{plotDiet}()}, \code{\link{plotFMort}()}, \code{\link{plotFeedingLevel}()}, \code{\link{plotGrowthCurves}()}, +\code{\link{plotMizerParams}}, +\code{\link{plotMizerSim}}, \code{\link{plotPredMort}()}, \code{\link{plotSpectra}()}, \code{\link{plotYield}()}, diff --git a/man/newCommunityParams.Rd b/man/newCommunityParams.Rd index fed86d2c..32582a04 100644 --- a/man/newCommunityParams.Rd +++ b/man/newCommunityParams.Rd @@ -61,8 +61,7 @@ rate of the resource.} \item{lambda}{Used to set power-law exponent for resource capacity if the \code{resource_capacity} argument is given as a single number.} -\item{r_pp}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}. Use \code{resource_rate} argument -instead.} +\item{r_pp}{Growth rate parameter for the resource spectrum.} \item{knife_edge_size}{The size at the edge of the knife-edge-selectivity function.} diff --git a/man/newMultispeciesParams.Rd b/man/newMultispeciesParams.Rd index 886266cd..74dd5f8e 100644 --- a/man/newMultispeciesParams.Rd +++ b/man/newMultispeciesParams.Rd @@ -128,10 +128,11 @@ The resource capacity must be larger than the resource abundance.} \item{w_pp_cutoff}{The upper cut off size of the resource spectrum power law used when \code{resource_capacity} is given as a single number. When changing -\code{w_pp_cutoff} without providing \code{resource_capacity}, the cutoff can only -be decreased. In that case, both the carrying capacity and the initial -resource abundance will be cut off at the new value. To increase the cutoff, -you must also provide the \code{resource_capacity} for the extended range.} +\code{w_pp_cutoff} without providing \code{resource_capacity}, the cutoff can only be +decreased. In that case, both the carrying capacity and the initial +resource abundance will be cut off at the new value. To increase the +cutoff, you must also provide the \code{resource_capacity} for the extended +range.} \item{resource_dynamics}{Optional. Name of the function that determines the resource dynamics by calculating the resource spectrum at the next time diff --git a/man/plotBiomass.Rd b/man/plotBiomass.Rd index 6d59000e..4a83a346 100644 --- a/man/plotBiomass.Rd +++ b/man/plotBiomass.Rd @@ -114,12 +114,12 @@ str(fr) Other plotting functions: \code{\link{animateSpectra}()}, -\code{\link{plot,MizerParams,missing-method}}, -\code{\link{plot,MizerSim,missing-method}}, \code{\link{plotDiet}()}, \code{\link{plotFMort}()}, \code{\link{plotFeedingLevel}()}, \code{\link{plotGrowthCurves}()}, +\code{\link{plotMizerParams}}, +\code{\link{plotMizerSim}}, \code{\link{plotPredMort}()}, \code{\link{plotSpectra}()}, \code{\link{plotYield}()}, diff --git a/man/plotDiet.Rd b/man/plotDiet.Rd index 6d6ea5b8..dd5b6119 100644 --- a/man/plotDiet.Rd +++ b/man/plotDiet.Rd @@ -66,12 +66,12 @@ str(fr) Other plotting functions: \code{\link{animateSpectra}()}, -\code{\link{plot,MizerParams,missing-method}}, -\code{\link{plot,MizerSim,missing-method}}, \code{\link{plotBiomass}()}, \code{\link{plotFMort}()}, \code{\link{plotFeedingLevel}()}, \code{\link{plotGrowthCurves}()}, +\code{\link{plotMizerParams}}, +\code{\link{plotMizerSim}}, \code{\link{plotPredMort}()}, \code{\link{plotSpectra}()}, \code{\link{plotYield}()}, diff --git a/man/plotFMort.Rd b/man/plotFMort.Rd index d67a2070..83fd199a 100644 --- a/man/plotFMort.Rd +++ b/man/plotFMort.Rd @@ -81,12 +81,12 @@ str(fr) Other plotting functions: \code{\link{animateSpectra}()}, -\code{\link{plot,MizerParams,missing-method}}, -\code{\link{plot,MizerSim,missing-method}}, \code{\link{plotBiomass}()}, \code{\link{plotDiet}()}, \code{\link{plotFeedingLevel}()}, \code{\link{plotGrowthCurves}()}, +\code{\link{plotMizerParams}}, +\code{\link{plotMizerSim}}, \code{\link{plotPredMort}()}, \code{\link{plotSpectra}()}, \code{\link{plotYield}()}, diff --git a/man/plotFeedingLevel.Rd b/man/plotFeedingLevel.Rd index 4eb3eba3..df446e0e 100644 --- a/man/plotFeedingLevel.Rd +++ b/man/plotFeedingLevel.Rd @@ -107,12 +107,12 @@ str(fr) Other plotting functions: \code{\link{animateSpectra}()}, -\code{\link{plot,MizerParams,missing-method}}, -\code{\link{plot,MizerSim,missing-method}}, \code{\link{plotBiomass}()}, \code{\link{plotDiet}()}, \code{\link{plotFMort}()}, \code{\link{plotGrowthCurves}()}, +\code{\link{plotMizerParams}}, +\code{\link{plotMizerSim}}, \code{\link{plotPredMort}()}, \code{\link{plotSpectra}()}, \code{\link{plotYield}()}, diff --git a/man/plotGrowthCurves.Rd b/man/plotGrowthCurves.Rd index b13a9e64..0820cf6a 100644 --- a/man/plotGrowthCurves.Rd +++ b/man/plotGrowthCurves.Rd @@ -120,12 +120,12 @@ str(fr) Other plotting functions: \code{\link{animateSpectra}()}, -\code{\link{plot,MizerParams,missing-method}}, -\code{\link{plot,MizerSim,missing-method}}, \code{\link{plotBiomass}()}, \code{\link{plotDiet}()}, \code{\link{plotFMort}()}, \code{\link{plotFeedingLevel}()}, +\code{\link{plotMizerParams}}, +\code{\link{plotMizerSim}}, \code{\link{plotPredMort}()}, \code{\link{plotSpectra}()}, \code{\link{plotYield}()}, diff --git a/man/plotM2.Rd b/man/plotM2.Rd index 5e658779..8529ea81 100644 --- a/man/plotM2.Rd +++ b/man/plotM2.Rd @@ -37,13 +37,13 @@ str(fr) Other plotting functions: \code{\link{animateSpectra}()}, -\code{\link{plot,MizerParams,missing-method}}, -\code{\link{plot,MizerSim,missing-method}}, \code{\link{plotBiomass}()}, \code{\link{plotDiet}()}, \code{\link{plotFMort}()}, \code{\link{plotFeedingLevel}()}, \code{\link{plotGrowthCurves}()}, +\code{\link{plotMizerParams}}, +\code{\link{plotMizerSim}}, \code{\link{plotSpectra}()}, \code{\link{plotYield}()}, \code{\link{plotYieldGear}()}, diff --git a/man/plot-MizerParams-missing-method.Rd b/man/plotMizerParams.Rd similarity index 93% rename from man/plot-MizerParams-missing-method.Rd rename to man/plotMizerParams.Rd index 15dc42da..8dc28370 100644 --- a/man/plot-MizerParams-missing-method.Rd +++ b/man/plotMizerParams.Rd @@ -1,6 +1,7 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/plots.R -\name{plot,MizerParams,missing-method} +\name{plotMizerParams} +\alias{plotMizerParams} \alias{plot,MizerParams,missing-method} \title{Summary plot for \code{MizerParams} objects} \usage{ @@ -33,12 +34,12 @@ plot(params) Other plotting functions: \code{\link{animateSpectra}()}, -\code{\link{plot,MizerSim,missing-method}}, \code{\link{plotBiomass}()}, \code{\link{plotDiet}()}, \code{\link{plotFMort}()}, \code{\link{plotFeedingLevel}()}, \code{\link{plotGrowthCurves}()}, +\code{\link{plotMizerSim}}, \code{\link{plotPredMort}()}, \code{\link{plotSpectra}()}, \code{\link{plotYield}()}, diff --git a/man/plotMizerSim.Rd b/man/plotMizerSim.Rd index 9cf058fe..3c39f68d 100644 --- a/man/plotMizerSim.Rd +++ b/man/plotMizerSim.Rd @@ -1,6 +1,7 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/plots.R -\name{plot,MizerSim,missing-method} +\name{plotMizerSim} +\alias{plotMizerSim} \alias{plot,MizerSim,missing-method} \title{Summary plot for \code{MizerSim} objects} \usage{ @@ -37,12 +38,12 @@ plot(sim) Other plotting functions: \code{\link{animateSpectra}()}, -\code{\link{plot,MizerParams,missing-method}}, \code{\link{plotBiomass}()}, \code{\link{plotDiet}()}, \code{\link{plotFMort}()}, \code{\link{plotFeedingLevel}()}, \code{\link{plotGrowthCurves}()}, +\code{\link{plotMizerParams}}, \code{\link{plotPredMort}()}, \code{\link{plotSpectra}()}, \code{\link{plotYield}()}, diff --git a/man/plotPredMort.Rd b/man/plotPredMort.Rd index 455c9dc4..a6ed78ca 100644 --- a/man/plotPredMort.Rd +++ b/man/plotPredMort.Rd @@ -80,13 +80,13 @@ str(fr) Other plotting functions: \code{\link{animateSpectra}()}, -\code{\link{plot,MizerParams,missing-method}}, -\code{\link{plot,MizerSim,missing-method}}, \code{\link{plotBiomass}()}, \code{\link{plotDiet}()}, \code{\link{plotFMort}()}, \code{\link{plotFeedingLevel}()}, \code{\link{plotGrowthCurves}()}, +\code{\link{plotMizerParams}}, +\code{\link{plotMizerSim}}, \code{\link{plotSpectra}()}, \code{\link{plotYield}()}, \code{\link{plotYieldGear}()}, diff --git a/man/plotSpectra.Rd b/man/plotSpectra.Rd index 4ffb882a..a192ff3a 100644 --- a/man/plotSpectra.Rd +++ b/man/plotSpectra.Rd @@ -148,13 +148,13 @@ str(fr) Other plotting functions: \code{\link{animateSpectra}()}, -\code{\link{plot,MizerParams,missing-method}}, -\code{\link{plot,MizerSim,missing-method}}, \code{\link{plotBiomass}()}, \code{\link{plotDiet}()}, \code{\link{plotFMort}()}, \code{\link{plotFeedingLevel}()}, \code{\link{plotGrowthCurves}()}, +\code{\link{plotMizerParams}}, +\code{\link{plotMizerSim}}, \code{\link{plotPredMort}()}, \code{\link{plotYield}()}, \code{\link{plotYieldGear}()}, diff --git a/man/plotYield.Rd b/man/plotYield.Rd index cde876ab..3e68a41a 100644 --- a/man/plotYield.Rd +++ b/man/plotYield.Rd @@ -85,13 +85,13 @@ str(fr) Other plotting functions: \code{\link{animateSpectra}()}, -\code{\link{plot,MizerParams,missing-method}}, -\code{\link{plot,MizerSim,missing-method}}, \code{\link{plotBiomass}()}, \code{\link{plotDiet}()}, \code{\link{plotFMort}()}, \code{\link{plotFeedingLevel}()}, \code{\link{plotGrowthCurves}()}, +\code{\link{plotMizerParams}}, +\code{\link{plotMizerSim}}, \code{\link{plotPredMort}()}, \code{\link{plotSpectra}()}, \code{\link{plotYieldGear}()}, diff --git a/man/plotYieldGear.Rd b/man/plotYieldGear.Rd index 0a086407..13739c35 100644 --- a/man/plotYieldGear.Rd +++ b/man/plotYieldGear.Rd @@ -75,13 +75,13 @@ str(fr) Other plotting functions: \code{\link{animateSpectra}()}, -\code{\link{plot,MizerParams,missing-method}}, -\code{\link{plot,MizerSim,missing-method}}, \code{\link{plotBiomass}()}, \code{\link{plotDiet}()}, \code{\link{plotFMort}()}, \code{\link{plotFeedingLevel}()}, \code{\link{plotGrowthCurves}()}, +\code{\link{plotMizerParams}}, +\code{\link{plotMizerSim}}, \code{\link{plotPredMort}()}, \code{\link{plotSpectra}()}, \code{\link{plotYield}()}, diff --git a/man/plotting_functions.Rd b/man/plotting_functions.Rd index ed778bea..f1b95555 100644 --- a/man/plotting_functions.Rd +++ b/man/plotting_functions.Rd @@ -79,13 +79,13 @@ p Other plotting functions: \code{\link{animateSpectra}()}, -\code{\link{plot,MizerParams,missing-method}}, -\code{\link{plot,MizerSim,missing-method}}, \code{\link{plotBiomass}()}, \code{\link{plotDiet}()}, \code{\link{plotFMort}()}, \code{\link{plotFeedingLevel}()}, \code{\link{plotGrowthCurves}()}, +\code{\link{plotMizerParams}}, +\code{\link{plotMizerSim}}, \code{\link{plotPredMort}()}, \code{\link{plotSpectra}()}, \code{\link{plotYield}()}, diff --git a/man/setBevertonHolt.Rd b/man/setBevertonHolt.Rd index 7620168d..d91ca7cf 100644 --- a/man/setBevertonHolt.Rd +++ b/man/setBevertonHolt.Rd @@ -16,8 +16,11 @@ setBevertonHolt(params, erepro, R_max, reproduction_level, ...) \item{reproduction_level}{Sets \code{R_max} so that the reproduction rate at the initial state is \code{R_max * reproduction_level}.} -\item{R_factor}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use -\code{reproduction_level = 1 / R_factor} instead.} +\item{...}{Unused +\itemize{ +\item \code{R_factor}: \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use +\code{reproduction_level = 1 / R_factor} instead. +}} } \value{ A MizerParams object diff --git a/man/setExtMort.Rd b/man/setExtMort.Rd index d6c1e5d3..26b64f36 100644 --- a/man/setExtMort.Rd +++ b/man/setExtMort.Rd @@ -13,6 +13,7 @@ setExtMort( z0pre = 0.6, z0exp = params@resource_params$n - 1, reset = FALSE, + z0 = deprecated(), ... ) @@ -44,12 +45,12 @@ previously overwritten with a custom value. If set to FALSE (default) then a recalculation from the species parameters will take place only if no custom value has been set.} +\item{z0}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{ext_mort} instead. Not to +be confused with the species_parameter \code{z0}.} + \item{...}{Unused} \item{value}{ext_mort} - -\item{z0}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{ext_mort} instead. Not to -be confused with the species_parameter \code{z0}.} } \value{ \code{setExtMort()}: A MizerParams object with updated external mortality diff --git a/man/setMetabolicRate.Rd b/man/setMetabolicRate.Rd index 49706c41..df0dddbe 100644 --- a/man/setMetabolicRate.Rd +++ b/man/setMetabolicRate.Rd @@ -35,6 +35,8 @@ custom value has been set.} \item{...}{Unused} +\item{params}{A MizerParams object} + \item{value}{metab} } \value{ diff --git a/man/setParams.Rd b/man/setParams.Rd index 2c760c00..90ed3a50 100644 --- a/man/setParams.Rd +++ b/man/setParams.Rd @@ -42,6 +42,8 @@ Default value is 0.6.} \item{\code{z0exp}}{If \code{z0}, the mortality from other sources, is not a column in the species data frame, it is calculated as \code{z0pre * w_max ^ z0exp}. Default value is \code{n-1}.} + \item{\code{z0}}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{ext_mort} instead. Not to +be confused with the species_parameter \code{z0}.} \item{\code{ext_encounter}}{Optional. An array (species x size) holding the external encounter rate. If not supplied, the external encounter rate is left unchanged. Initially is is set to 0.} diff --git a/man/setReproduction.Rd b/man/setReproduction.Rd index 68f8a9c9..436111a3 100644 --- a/man/setReproduction.Rd +++ b/man/setReproduction.Rd @@ -55,6 +55,8 @@ reproduction rate from the density-independent rate. Defaults to "\code{\link[=BevertonHoltRDD]{BevertonHoltRDD()}}".} \item{...}{Unused} + +\item{value}{The desired new value for the respective parameter.} } \value{ \code{setReproduction()}: A MizerParams object with updated reproduction diff --git a/man/setResource.Rd b/man/setResource.Rd index 73e46a55..becbfb41 100644 --- a/man/setResource.Rd +++ b/man/setResource.Rd @@ -73,10 +73,11 @@ step from the current state.} \item{w_pp_cutoff}{The upper cut off size of the resource spectrum power law used when \code{resource_capacity} is given as a single number. When changing -\code{w_pp_cutoff} without providing \code{resource_capacity}, the cutoff can only -be decreased. In that case, both the carrying capacity and the initial -resource abundance will be cut off at the new value. To increase the cutoff, -you must also provide the \code{resource_capacity} for the extended range.} +\code{w_pp_cutoff} without providing \code{resource_capacity}, the cutoff can only be +decreased. In that case, both the carrying capacity and the initial +resource abundance will be cut off at the new value. To increase the +cutoff, you must also provide the \code{resource_capacity} for the extended +range.} \item{balance}{By default, if possible, the resource parameters are set so that the resource replenishes at the same rate at which it is @@ -87,12 +88,6 @@ determined automatically. Set to FALSE if you do not want the balancing.} \item{...}{Unused} \item{value}{The desired new value for the respective parameter.} - -\item{r_pp}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}. Use \code{resource_rate} argument -instead.} - -\item{kappa}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}. Use \code{resource_capacity} -argument instead.} } \value{ \code{setResource}: A MizerParams object with updated resource parameters diff --git a/man/setRmax.Rd b/man/setRmax.Rd index 4b974283..36c7446f 100644 --- a/man/setRmax.Rd +++ b/man/setRmax.Rd @@ -15,6 +15,12 @@ setRmax(params, erepro, R_max, reproduction_level, ...) \item{reproduction_level}{Sets \code{R_max} so that the reproduction rate at the initial state is \code{R_max * reproduction_level}.} + +\item{...}{Unused +\itemize{ +\item \code{R_factor}: \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use +\code{reproduction_level = 1 / R_factor} instead. +}} } \value{ A MizerParams object From 3fd83138f1bcda961a7d82d4272138e3b0b7b10d Mon Sep 17 00:00:00 2001 From: Gustav Delius Date: Sun, 23 Nov 2025 03:32:37 +0000 Subject: [PATCH 16/16] Fix mistake from previous commit --- R/setFishing.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/setFishing.R b/R/setFishing.R index a868325f..f32c65b2 100644 --- a/R/setFishing.R +++ b/R/setFishing.R @@ -675,7 +675,7 @@ validGearParams <- function(gear_params, species_params) { #' @export #' @rdname initial_effort validEffortVector <- function(effort, params) { - assert_that(is.null(effort), is.numeric(effort)) + assert_that(is.null(effort) || is.numeric(effort)) gear_names <- dimnames(params@catchability)[[1]] no_gears <- length(gear_names)