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 314fcf4e..6a1c08c5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,174 @@ # 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("given_species_params<-",MizerParams) +S3method("initialN<-",MizerParams) +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) +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(dw,MizerParams) +S3method(dw_full,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(getMaturityProportion,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(getReproductionProportion,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) +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(maturity,MizerParams) +S3method(metab,MizerParams) +S3method(plotBiomass,MizerSim) +S3method(plotBiomassObservedVsModel,MizerParams) +S3method(plotBiomassObservedVsModel,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) +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) +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) +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(setParams,MizerParams) +S3method(setPredKernel,MizerParams) +S3method(setReproduction,MizerParams) +S3method(setResource,MizerParams) +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/age_mat.R b/R/age_mat.R index 8ab41dc2..4cad44eb 100644 --- a/R/age_mat.R +++ b/R/age_mat.R @@ -14,28 +14,42 @@ #' 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 -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 +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 @@ -45,14 +59,22 @@ age_mat_vB <- 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 #' @concept helper #' @examples #' age_mat(NS_params) -age_mat <- function(params) { - assert_that(is(params, "MizerParams")) +#' @rdname age_mat +#' @export +age_mat <- function(params, ...) { + UseMethod("age_mat") +} + +#' @export +age_mat.MizerParams <- function(params, ...) { sp <- params@species_params no_sp <- nrow(sp) diff --git a/R/animateSpectra.R b/R/animateSpectra.R index 189479cf..306543ec 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,8 @@ #' 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 #' @family plotting functions @@ -29,16 +30,20 @@ #' \donttest{ #' animateSpectra(NS_sim, power = 2, wlim = c(0.1, NA), time_range = 1997:2007) #' } -animateSpectra <- function(sim, - species = NULL, - time_range, - wlim = c(NA, NA), - ylim = c(NA, NA), - power = 1, - total = FALSE, - resource = TRUE) { +animateSpectra <- function(sim, species, time_range, + wlim, + ylim, + power, + total, + resource, ...) + UseMethod("animateSpectra") + +#' @export +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), + is.number(power), length(wlim) == 2, length(ylim) == 2) @@ -47,7 +52,7 @@ animateSpectra <- 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]) @@ -90,7 +95,7 @@ animateSpectra <- 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. @@ -120,3 +125,4 @@ animateSpectra <- function(sim, title = y_label), legend = list(traceorder = "normal")) } + diff --git a/R/calibrate.R b/R/calibrate.R index 339b2ffa..e7e0d7f7 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 @@ -32,7 +33,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) @@ -84,6 +89,7 @@ calibrateBiomass <- 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 @@ -92,7 +98,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) @@ -140,6 +150,7 @@ calibrateNumber <- 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 @@ -151,7 +162,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" @@ -206,10 +221,15 @@ calibrateYield <- 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 -scaleModel <- function(params, factor) { +scaleModel <- function(params, factor, ...) + 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..91a2c5a8 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 @@ -11,7 +13,11 @@ #' params2 <- params1 #' species_params(params2)$w_mat[1] <- 10 #' compareParams(params1, params2) -compareParams <- function(params1, params2) { +compareParams <- function(params1, params2, ...) + UseMethod("compareParams") + +#' @export +compareParams.MizerParams <- function(params1, params2, ...) { params1 <- validParams(params1) params2 <- validParams(params2) diff --git a/R/manipulate_species.R b/R/manipulate_species.R index 2ebf23c1..06458de4 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} #' @@ -45,8 +46,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 +60,18 @@ #' ) #' params <- addSpecies(params, species_params) #' plotSpectra(params) +#' @seealso [removeSpecies()] +#' @export +#' @rdname addSpecies addSpecies <- function(params, species_params, gear_params = data.frame(), initial_effort, - interaction) { + interaction, ...) { + UseMethod("addSpecies") +} + +#' @export +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) @@ -317,15 +325,22 @@ addSpecies <- function(params, species_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 +#' @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, species, ...) { + UseMethod("removeSpecies") +} + +#' @export +removeSpecies.MizerParams <- function(params, species, ...) { params <- validParams(params) species <- valid_species_arg(params, species, return.logical = TRUE) @@ -398,14 +413,21 @@ removeSpecies <- function(params, species) { #' @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 +#' @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, replace, ...) { + UseMethod("renameSpecies") +} + +#' @export +renameSpecies.MizerParams <- function(params, replace, ...) { params <- validParams(params) replace[] <- as.character(replace) to_replace <- names(replace) @@ -471,7 +493,6 @@ renameSpecies <- function(params, replace) { return(params) } - #' Rename gears #' #' @description @@ -484,14 +505,21 @@ renameSpecies <- function(params, replace) { #' @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 +#' @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, replace, ...) { + UseMethod("renameGear") +} + +#' @export +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 b1953fe5..c8323a9d 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 @@ -37,7 +38,11 @@ #' params <- calibrateBiomass(params) #' params <- matchBiomasses(params) #' plotBiomassObservedVsModel(params) -matchBiomasses <- function(params, species = NULL) { +matchBiomasses <- function(params, species = NULL, ...) + UseMethod("matchBiomasses") + +#' @export +matchBiomasses.MizerParams <- function(params, species = NULL, ...) { if (!("biomass_observed" %in% names(params@species_params))) { return(params) } @@ -103,6 +108,7 @@ matchBiomasses <- 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 @@ -112,7 +118,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, species = NULL, ...) + UseMethod("matchNumbers") + +#' @export +matchNumbers.MizerParams <- function(params, species = NULL, ...) { if (!("number_observed" %in% names(params@species_params))) { return(params) } @@ -182,6 +192,7 @@ matchNumbers <- 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 @@ -194,7 +205,11 @@ matchNumbers <- function(params, species = NULL) { #' params <- calibrateYield(params) #' params <- matchYields(params) #' plotYieldObservedVsModel(params) -matchYields <- function(params, species = NULL) { +matchYields <- function(params, species = NULL, ...) + 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..1bc22ce5 100644 --- a/R/matchGrowth.R +++ b/R/matchGrowth.R @@ -20,33 +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, - keep = c("egg", "biomass", "number")) { - assert_that(is(params, "MizerParams")) - sel <- valid_species_arg(params, species = species, + keep = c("egg", "biomass", "number"), ...) + UseMethod("matchGrowth") + +#' @export +matchGrowth.MizerParams <- function(params, species = NULL, + 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 @@ -61,9 +67,9 @@ matchGrowth <- 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 @@ -72,6 +78,6 @@ matchGrowth <- 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 499654ce..d7fca62a 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 @@ -18,17 +18,19 @@ #' @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. #' @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 +38,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 +73,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 +129,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 +154,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 +217,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 +228,7 @@ newMultispeciesParams <- function( } #' Set or change any model parameters -#' +#' #' This is a convenient wrapper function calling each of the following #' functions #' \itemize{ @@ -241,35 +243,36 @@ newMultispeciesParams <- function( #' \item [setFishing()] #' } #' 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 #' @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 +281,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 +309,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 @@ -326,21 +329,25 @@ 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, ...) 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 +358,7 @@ setParams <- function(params, interaction = NULL, ...) { names(linetypes) <- params@species_params$species params <- setLinetypes(params, linetypes) } - + validObject(params) params } 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/plots.R b/R/plots.R index 31b97718..503da59f 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 @@ -1474,6 +1692,8 @@ plotDiet <- function(object, species = NULL, return_data = FALSE) { #' @family plotting functions #' @seealso [plotting_functions] #' @rdname plotMizerSim +#' @name plotMizerSim +#' @aliases plot,MizerSim,missing-method #' @examples #' \donttest{ #' params <- NS_params @@ -1518,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 dcbfdb50..39bb4ea7 100644 --- a/R/project.R +++ b/R/project.R @@ -130,24 +130,30 @@ 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 (!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 @@ -331,8 +337,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 +435,14 @@ project <- function(object, effort, #' #' @export #' @concept helper -project_simple <- +project_simple <- function(params, n, n_pp, n_other, effort, t, dt, steps, + resource_dynamics_fn, other_dynamics_fns, + rates_fns, ...) { + UseMethod("project_simple") +} + +#' @export +project_simple.MizerParams <- function(params, n = params@initial_n, n_pp = params@initial_n_pp, 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/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/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/setBevertonHolt.R b/R/setBevertonHolt.R index e6a280ae..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 @@ -141,14 +144,23 @@ #' 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) { - assert_that(is(params, "MizerParams")) +setBevertonHolt <- function(params, erepro, + R_max, reproduction_level, ...) { + UseMethod("setBevertonHolt") +} +#' @export +setBevertonHolt.MizerParams <- function(params, erepro, + R_max, reproduction_level, ...) { 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.") } @@ -161,7 +173,7 @@ setBevertonHolt <- 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) @@ -227,7 +239,7 @@ setBevertonHolt <- 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.") } @@ -272,6 +284,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,7 +331,10 @@ getRequiredRDD <- function(params) { #' identical(getRDD(params) / species_params(params)$R_max, #' getReproductionLevel(params)) getReproductionLevel <- function(params) { - assert_that(is(params, "MizerParams")) + UseMethod("getReproductionLevel") +} +#' @export +getReproductionLevel.MizerParams <- function(params) { 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..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 @@ -33,14 +33,17 @@ #' getColours(params) #' getLinetypes(params) setColours <- function(params, colours) { - assert_that(is(params, "MizerParams")) + UseMethod("setColours") +} +#' @export +setColours.MizerParams <- function(params, colours) { 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 } @@ -49,12 +52,16 @@ setColours <- function(params, colours) { #' @return `getColours()`: A named vector of colours #' @export getColours <- function(params) { + UseMethod("getColours") +} +#' @export +getColours.MizerParams <- function(params) { params@linecolour } 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)) { @@ -68,18 +75,21 @@ 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) { - assert_that(is(params, "MizerParams")) + UseMethod("setLinetypes") +} +#' @export +setLinetypes.MizerParams <- function(params, linetypes) { 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 } @@ -88,6 +98,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 } @@ -95,7 +109,7 @@ getLinetypes <- 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 132a57aa..0b965c4e 100644 --- a/R/setDiffusion.R +++ b/R/setDiffusion.R @@ -10,13 +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, ...) { - assert_that(is(params, "MizerParams")) +setDiffusion <- function(params, diffusion = NULL, reset = FALSE, ...) { + UseMethod("setDiffusion") +} +#' @rdname setDiffusion +#' @export +setDiffusion.MizerParams <- function(params, diffusion = NULL, reset = FALSE, ...) { if (is.null(diffusion)) { diffusion <- params@diffusion @@ -39,6 +49,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 +60,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..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,32 +22,35 @@ #' 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, ...) { - assert_that(is(params, "MizerParams")) - + UseMethod("setExtEncounter") +} +#' @export +setExtEncounter.MizerParams <- function(params, ext_encounter = NULL, ...) { + 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) } @@ -57,12 +60,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 +81,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..464dfbdc 100644 --- a/R/setExtMort.R +++ b/R/setExtMort.R @@ -56,15 +56,20 @@ #' #' # 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, + z0 = deprecated(), ...) { + 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)) { 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) { @@ -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..f32c65b2 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,17 +106,21 @@ #' 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 #' @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"), - is.flag(reset)) + assert_that(is.flag(reset)) species_params <- params@species_params gear_params <- params@gear_params sp_names <- species_params$species @@ -125,24 +129,24 @@ setFishing <- function(params, selectivity = NULL, catchability = NULL, 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" @@ -157,7 +161,7 @@ setFishing <- function(params, selectivity = NULL, catchability = NULL, 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)) { @@ -176,7 +180,7 @@ setFishing <- function(params, selectivity = NULL, catchability = NULL, "catchability array need to be all different.") } } - + if (!is.null(selectivity)) { assert_that(length(dim(selectivity)) == 3, dim(selectivity)[[1]] == no_gears, @@ -197,7 +201,7 @@ setFishing <- function(params, selectivity = NULL, catchability = NULL, "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 @@ -211,7 +215,7 @@ setFishing <- function(params, selectivity = NULL, catchability = NULL, params@selectivity <- selectivity } } - + if (!is.null(catchability)) { assert_that(length(dim(catchability)) == 2, dim(catchability)[[2]] == no_sp) @@ -232,14 +236,14 @@ setFishing <- function(params, selectivity = NULL, catchability = NULL, } 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]] } @@ -251,28 +255,28 @@ setFishing <- function(params, selectivity = NULL, catchability = NULL, 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: @@ -283,34 +287,34 @@ setFishing <- function(params, selectivity = NULL, catchability = NULL, #' * `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"), @@ -322,10 +326,14 @@ setFishing <- function(params, selectivity = NULL, catchability = NULL, #' 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) { + UseMethod("gear_params") +} +#' @export +gear_params.MizerParams <- function(params) { params@gear_params } @@ -334,6 +342,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 +359,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 +380,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 +395,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,11 +429,15 @@ selectivity <- function(params) { #' @examples #' str(getInitialEffort(NS_params)) getInitialEffort <- function(params) { + UseMethod("getInitialEffort") +} +#' @export +getInitialEffort.MizerParams <- function(params) { params@initial_effort } #' 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 @@ -405,10 +445,10 @@ getInitialEffort <- 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 @@ -416,18 +456,22 @@ getInitialEffort <- 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 initial_effort <- function(params) { + UseMethod("initial_effort") +} +#' @export +initial_effort.MizerParams <- function(params) { params@initial_effort } @@ -436,25 +480,29 @@ 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) } #' 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 @@ -465,15 +513,15 @@ initial_effort <- 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 @@ -481,14 +529,14 @@ initial_effort <- 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", @@ -496,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 @@ -538,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") { @@ -549,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") && @@ -610,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 = ", ") @@ -620,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) { @@ -645,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") @@ -657,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 @@ -682,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 @@ -692,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 ) @@ -717,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 86107b50..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. @@ -30,8 +30,9 @@ #' 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. -#' -#' @return The `params` object with updated initial values and initial effort. +#' @param ... Additional arguments passed to the method. +#' +#' @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. @@ -45,16 +46,19 @@ #' 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))) { 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`.") } @@ -97,27 +101,27 @@ setInitialValues <- function(params, sim, time_range, geometric_mean = FALSE) { 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. #' @export `initialN<-` <- 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), ".") - } + UseMethod("initialN<-") +} +#' @export +`initialN<-.MizerParams` <- function(params, value) { assert_that(identical(dim(value), dim(params@initial_n)), all(value >= 0)) if (!is.null(dimnames(value)) && @@ -125,7 +129,7 @@ setInitialValues <- function(params, sim, time_range, geometric_mean = FALSE) { warning("The dimnames do not match. I will ignore them.") } params@initial_n[] <- value - + params@time_modified <- lubridate::now() params } @@ -136,7 +140,7 @@ setInitialValues <- function(params, sim, time_range, geometric_mean = FALSE) { #' 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", ] @@ -145,19 +149,24 @@ 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 -#' +#' #' 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 @@ -170,10 +179,10 @@ initialN <- function(object) { #' # Of course this initial state will no longer be a steady state #' params <- steady(params) `initialNResource<-` <- 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), ".") - } + UseMethod("initialNResource<-") +} +#' @export +`initialNResource<-.MizerParams` <- function(params, value) { assert_that(identical(dim(value), dim(params@initial_n_pp)), all(value >= 0)) if (!is.null(dimnames(value)) && @@ -181,7 +190,7 @@ initialN <- function(object) { warning("The dimnames do not match. I will ignore them.") } params@initial_n_pp[] <- value - + params@time_modified <- lubridate::now() params } @@ -192,11 +201,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..2386e53d 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 @@ -53,9 +54,12 @@ #' inter[1, 2:3] <- 0 #' params <- setInteraction(params, interaction = inter) #' getInteraction(params) -setInteraction <- function(params, - interaction = NULL) { - assert_that(is(params, "MizerParams")) +setInteraction <- function(params, interaction = NULL, ...) { + UseMethod("setInteraction") +} +#' @export +setInteraction.MizerParams <- function(params, + interaction = NULL, ...) { if (is.null(interaction)) { interaction <- params@interaction } @@ -81,16 +85,16 @@ setInteraction <- 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) } @@ -105,7 +109,7 @@ setInteraction <- 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, @@ -116,20 +120,24 @@ setInteraction <- 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 getInteraction <- function(params) { - lifecycle::deprecate_warn("2.4.0", "getInteraction()", + 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..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,31 +22,34 @@ #' 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 #' @family functions for setting parameters setMaxIntakeRate <- function(params, intake_max = NULL, reset = FALSE, ...) { - assert_that(is(params, "MizerParams"), - is.flag(reset)) + UseMethod("setMaxIntakeRate") +} +#' @export +setMaxIntakeRate.MizerParams <- function(params, intake_max = NULL, reset = FALSE, ...) { + 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))) { @@ -58,27 +61,27 @@ setMaxIntakeRate <- function(params, intake_max = NULL, reset = FALSE, ...) { } 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 @@ -89,7 +92,7 @@ setMaxIntakeRate <- function(params, intake_max = NULL, reset = FALSE, ...) { return(params) } params@intake_max[] <- intake_max - + params@time_modified <- lubridate::now() return(params) } @@ -99,6 +102,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 +113,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 +124,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..7e0642bb 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,8 +19,9 @@ #' 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 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". @@ -34,32 +35,37 @@ #' 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(object, metab = NULL, p = NULL, reset = FALSE, ...) { - assert_that(is(params, "MizerParams"), - is.flag(reset)) + UseMethod("setMetabolicRate") +} +#' @export +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) } 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 +76,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 +84,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 +107,7 @@ setMetabolicRate <- function(params, metab = NULL, p = NULL, return(params) } params@metab[] <- metab - + params@time_modified <- lubridate::now() return(params) } @@ -111,12 +117,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 +138,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..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,46 +69,49 @@ #' 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, +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"), - 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))) { @@ -120,15 +123,15 @@ setPredKernel <- 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)) @@ -136,12 +139,12 @@ setPredKernel <- 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) @@ -167,7 +170,7 @@ setPredKernel <- 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 @@ -181,7 +184,7 @@ setPredKernel <- 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) } @@ -191,11 +194,14 @@ 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 - # the convolution integrals. - assert_that(is(params, "MizerParams")) + # the convolution integrals. if (length(dim(params@pred_kernel)) > 1) { return(params@pred_kernel) } @@ -210,7 +216,7 @@ getPredKernel <- 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, @@ -229,6 +235,10 @@ getPredKernel <- function(params) { #' @rdname setPredKernel #' @export pred_kernel <- function(params) { + UseMethod("pred_kernel") +} +#' @export +pred_kernel.MizerParams <- function(params) { getPredKernel(params) } @@ -236,6 +246,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) } @@ -258,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") @@ -279,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 @@ -327,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 1cb430e3..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 @@ -133,12 +134,16 @@ #' 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 ---- - 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), @@ -351,20 +356,30 @@ setReproduction <- 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) } @@ -376,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 @@ -387,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 b35ee31c..6bd5f459 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. @@ -90,58 +90,62 @@ #' `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 #' @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, 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)", + + 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)) { - lifecycle::deprecate_warn("1.0.0", "setParams(kappa)", + if ("kappa" %in% names(args)) { + lifecycle::deprecate_warn("1.0.0", "setParams(kappa)", "setParams(resource_capacity)") - resource_capacity <- kappa - } - assert_that(is(params, "MizerParams"), - is.number(lambda), + resource_capacity <- args[["kappa"]] + } + assert_that(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 +154,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 +179,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 +195,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 +212,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 +228,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 +245,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 +265,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 +275,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 +284,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 +295,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 +306,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) } @@ -309,12 +329,20 @@ resource_capacity <- 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) } @@ -323,6 +351,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 +366,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..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,25 +36,28 @@ #' 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 setSearchVolume <- function(params, search_vol = NULL, reset = FALSE, ...) { - assert_that(is(params, "MizerParams"), - is.flag(reset)) + UseMethod("setSearchVolume") +} +#' @export +setSearchVolume.MizerParams <- function(params, search_vol = NULL, reset = FALSE, ...) { + 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))) { @@ -66,31 +69,31 @@ setSearchVolume <- 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 @@ -101,7 +104,7 @@ setSearchVolume <- function(params, search_vol = NULL, reset = FALSE, ...) { return(params) } params@search_vol[] <- search_vol - + params@time_modified <- lubridate::now() return(params) } @@ -111,6 +114,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 +125,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 +136,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/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/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/addSpecies.Rd b/man/addSpecies.Rd index f1433eff..20964d06 100644 --- a/man/addSpecies.Rd +++ b/man/addSpecies.Rd @@ -9,7 +9,8 @@ addSpecies( species_params, gear_params = data.frame(), initial_effort, - interaction + interaction, + ... ) } \arguments{ @@ -32,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 2e65e6fa..39c1eba7 100644 --- a/man/age_mat.Rd +++ b/man/age_mat.Rd @@ -4,10 +4,12 @@ \alias{age_mat} \title{Calculate age at maturity} \usage{ -age_mat(params) +age_mat(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 3c027e6e..e5c9195e 100644 --- a/man/age_mat_vB.Rd +++ b/man/age_mat_vB.Rd @@ -2,12 +2,23 @@ % 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} + +\item{...}{Additional arguments} } \value{ A named vector. The names are the species names and the values are diff --git a/man/animateSpectra.Rd b/man/animateSpectra.Rd index 4c34af18..cd46478d 100644 --- a/man/animateSpectra.Rd +++ b/man/animateSpectra.Rd @@ -6,13 +6,14 @@ \usage{ animateSpectra( sim, - species = NULL, + species, time_range, - wlim = c(NA, NA), - ylim = c(NA, NA), - power = 1, - total = FALSE, - resource = TRUE + wlim, + ylim, + power, + total, + resource, + ... ) } \arguments{ @@ -42,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 @@ -56,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/calibrateBiomass.Rd b/man/calibrateBiomass.Rd index eeff544c..a11f52b9 100644 --- a/man/calibrateBiomass.Rd +++ b/man/calibrateBiomass.Rd @@ -4,10 +4,12 @@ \alias{calibrateBiomass} \title{Calibrate the model scale to match total observed biomass} \usage{ -calibrateBiomass(params) +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 e390d021..9e39e360 100644 --- a/man/calibrateNumber.Rd +++ b/man/calibrateNumber.Rd @@ -4,10 +4,12 @@ \alias{calibrateNumber} \title{Calibrate the model scale to match total observed number} \usage{ -calibrateNumber(params) +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 749efbf1..d2e794fb 100644 --- a/man/calibrateYield.Rd +++ b/man/calibrateYield.Rd @@ -4,10 +4,12 @@ \alias{calibrateYield} \title{Calibrate the model scale to match total observed yield} \usage{ -calibrateYield(params) +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 8f6c3c94..be370c9a 100644 --- a/man/compareParams.Rd +++ b/man/compareParams.Rd @@ -4,12 +4,14 @@ \alias{compareParams} \title{Compare two MizerParams objects and print out differences} \usage{ -compareParams(params1, params2) +compareParams(params1, params2, ...) } \arguments{ \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/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 20747393..3cb6a929 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, species = NULL, ...) } \arguments{ \item{params}{A MizerParams object} @@ -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 25ed8335..1a049481 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, species = NULL, keep = c("egg", "biomass", "number"), ...) } \arguments{ \item{params}{A MizerParams object} @@ -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 7d390530..f1d2a895 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, species = NULL, ...) } \arguments{ \item{params}{A MizerParams object} @@ -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 73214504..c53a07aa 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, species = NULL, ...) } \arguments{ \item{params}{A MizerParams object} @@ -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/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 be11b7a4..4a83a346 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 @@ -111,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/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/plotDiet.Rd b/man/plotDiet.Rd index 3dc6e79b..dd5b6119 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} } @@ -53,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 991a16ed..83fd199a 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 @@ -68,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 74519ae3..df446e0e 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 @@ -93,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 c5b494c2..0820cf6a 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 @@ -104,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 23a51663..8529ea81 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{ @@ -63,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 7a138d75..a6ed78ca 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 @@ -67,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 f6f365a5..a192ff3a 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 @@ -129,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 3d8a1f77..3e68a41a 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 @@ -82,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 b3a011cb..13739c35 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 @@ -72,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/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 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/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 1d971537..d191ed02 100644 --- a/man/removeSpecies.Rd +++ b/man/removeSpecies.Rd @@ -4,7 +4,7 @@ \alias{removeSpecies} \title{Remove species} \usage{ -removeSpecies(params, species) +removeSpecies(params, species, ...) } \arguments{ \item{params}{A mizer params object for the original system.} @@ -12,6 +12,8 @@ removeSpecies(params, species) \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 a798021f..2302556f 100644 --- a/man/renameGear.Rd +++ b/man/renameGear.Rd @@ -4,13 +4,15 @@ \alias{renameGear} \title{Rename gears} \usage{ -renameGear(params, replace) +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 8d7b9c08..cea3dce9 100644 --- a/man/renameSpecies.Rd +++ b/man/renameSpecies.Rd @@ -4,13 +4,15 @@ \alias{renameSpecies} \title{Rename species} \usage{ -renameSpecies(params, replace) +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/scaleModel.Rd b/man/scaleModel.Rd index 3e56a4be..f90148db 100644 --- a/man/scaleModel.Rd +++ b/man/scaleModel.Rd @@ -4,12 +4,14 @@ \alias{scaleModel} \title{Change scale of the model} \usage{ -scaleModel(params, factor) +scaleModel(params, factor, ...) } \arguments{ \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/setBevertonHolt.Rd b/man/setBevertonHolt.Rd index 4e9b9dbc..d91ca7cf 100644 --- a/man/setBevertonHolt.Rd +++ b/man/setBevertonHolt.Rd @@ -4,26 +4,23 @@ \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{...}{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/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/setInitialValues.Rd b/man/setInitialValues.Rd index 13e2b152..1ee0d013 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} @@ -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 3973afbb..304fec0d 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) @@ -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{ diff --git a/man/setMetabolicRate.Rd b/man/setMetabolicRate.Rd index d02f0ce3..df0dddbe 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 @@ -35,6 +35,8 @@ custom value has been set.} \item{...}{Unused} +\item{params}{A MizerParams object} + \item{value}{metab} } \value{ 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..90ed3a50 100644 --- a/man/setParams.Rd +++ b/man/setParams.Rd @@ -4,18 +4,19 @@ \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 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{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 @@ -43,6 +44,9 @@ 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/setReproduction.Rd b/man/setReproduction.Rd index c5d0e739..436111a3 100644 --- a/man/setReproduction.Rd +++ b/man/setReproduction.Rd @@ -56,7 +56,7 @@ reproduction rate from the density-independent rate. Defaults to \item{...}{Unused} -\item{value}{.} +\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 730c7721..becbfb41 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.} @@ -81,16 +73,17 @@ determined automatically. Set to FALSE if you do not want the balancing.} \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.} - -\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.} +\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{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{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} diff --git a/man/setRmax.Rd b/man/setRmax.Rd index 98de09c0..36c7446f 100644 --- a/man/setRmax.Rd +++ b/man/setRmax.Rd @@ -4,20 +4,23 @@ \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.} \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 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 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 - 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")) +})