R/setMetabolicRate.R

In mizer: Dynamic Multi-Species Size Spectrum Modelling

#' Set metabolic rate
#'
#' Sets the rate at which energy is used for metabolism and activity. You will
#' usually not need to call this function directly. Instead change the `k`,
#' `ks` and `p` species parameters with `given_species_params(params) <-` and
#' let mizer recalculate the metabolic rate for you. Call `setMetabolicRate()`
#' directly only if you want to impose a different functional form for the
#' size dependence of the metabolic rate. See
#' `vignette("guide-change-parameters")` for a full explanation of when
#' to reach for which level of the model.
#'
#' @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,}
#' where \eqn{k_s w^p} represents the rate of standard metabolism and \eqn{k w}
#' is the rate at which energy is expended on activity and movement. The values
#' of \eqn{k_s}, \eqn{p} and \eqn{k} are taken from the `ks`, `p` and
#' `k` columns in the species parameter dataframe. If any of these
#' parameters are not supplied, the defaults are \eqn{k = 0}, \eqn{p = n} and
#' \deqn{k_s = f_c h \alpha w_{mat}^{n-p},}{k_s = f_c * h * alpha * w_mat^(n - p),}
#' 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.
#'
#' If the `metab` slot has a comment and `reset = FALSE`, then a recalculation
#' from the species parameters is suppressed and a message is issued if the
#' recalculated values would differ from the stored ones.
#'
#' @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".
#' @param p `r lifecycle::badge("deprecated")` The allometric metabolic
#'   exponent. Set the `p` column in the species parameters instead, with
#'   `species_params(params)$p <- value`. This argument never took effect on a
#'   `MizerParams` object because such an object always has a `p` column
#'   already, and the argument was only used to fill in a missing one.
#' @param reset
#'   If set to TRUE, then the metabolic 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 `setMetabolicRate()`: A MizerParams object with updated metabolic rate.
#' @export
#' @family functions for setting parameters
#' @examples
#' # Inspect the current metabolic rate
#' metab(NS_params)["Cod", 1:5]
#'
#' # Reset metabolic rate from species parameters
#' params <- setMetabolicRate(NS_params, reset = TRUE)
#' metab(params)["Cod", 1:5]
setMetabolicRate <- function(object, metab = NULL, p = deprecated(),
                             reset = FALSE, ...) {
    UseMethod("setMetabolicRate")
}
#' @export
setMetabolicRate.MizerParams <- function(object, metab = NULL, p = deprecated(),
                                         reset = FALSE, ...) {
    assert_that(is.flag(reset))
    params <- object
    if (lifecycle::is_present(p)) {
        lifecycle::deprecate_warn(
            when = "3.2.0",
            what = "setMetabolicRate(p)",
            details = "Set the `p` column in the species parameters instead, with `species_params(params)$p <- value`."
        )
        if (!is.numeric(p)) stop("p must be numeric")
        # Only fills in a missing or NA `p`, which is why this never had an
        # effect on a MizerParams object. Kept as-is until the argument goes.
        params <- set_species_param_default(params, "p", p)
    }
    params <- set_species_param_default(params, "p",
                                        params@species_params[["n"]])
    species_params <- params@species_params

    if (reset) {
        if (!is.null(metab)) {
            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))) {
                comment(metab) <- "set manually"
            } else {
                comment(metab) <- comment(params@metab)
            }
        }
        assert_that(is.array(metab),
                    identical(dim(metab), dim(params@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))
        }
        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 <-
        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
        if (different(metab, params@metab)) {
            signal_not_recalculated("metab", "metabolic rate",
                               "setMetabolicRate(params, reset = TRUE)")
        }
        return(params)
    }
    params@metab[] <- metab

    params@time_modified <- lubridate::now()
    return(params)
}

#' @rdname setMetabolicRate
#' @return `metab()`: An `ArraySpeciesBySize` object (species x size) with the
#'   metabolic rate.
#' @export
metab <- function(params) {
    UseMethod("metab")
}
#' @export
metab.MizerParams <- function(params) {
    ArraySpeciesBySize(params@metab,
                       value_name = "Metabolic rate",
                       units = "g/year",
                       params = params)
}

#' @rdname setMetabolicRate
#' @param value metab
#' @export
`metab<-` <- function(params, value) {
    setMetabolicRate(params, metab = value)
}