Nothing
#' Secondary Cardinal Parameter (CPM) model
#'
#' Secondary cardinal parameter model as defined by Rosso et al. (1995).
#'
#' @param x Value of the environmental factor.
#' @param xmin Minimum value for growth.
#' @param xopt Optimum value for growth.
#' @param xmax Maximum value for growth.
#' @param n Order of the CPM model.
#'
#' @return The corresponding gamma factor.
#'
CPM_model <- function(x, xmin, xopt, xmax, n) {
num <- (x-xmax)*(x-xmin)^n
den <- (xopt-xmin)^(n-1)*( (xopt-xmin)*(x-xopt) - (xopt-xmax)*((n-1)*xopt + xmin-n*x) )
gamma <- num/den
gamma[x < xmin] <- 0
gamma[x > xmax] <- 0
return(gamma)
}
#' Zwietering gamma model
#'
#' Gamma model as defined by Zwietering et al. (1992). To avoid unreasonable predictions,
#' it has been modified setting gamma=0 for values of x outside (xmin, xopt)
#'
#' @param x Value of the environmental factor.
#' @param xmin Minimum value of the environmental factor for growth.
#' @param xopt Maximum value for growth
#' @param n Exponent of the secondary model
#'
#' @return The corresponding gamma factor.
#'
zwietering_gamma <- function(x, xmin, xopt, n) {
gamma <- ((x-xmin)/(xopt-xmin))^n
gamma[x < xmin] <- 0
gamma[x > xopt] <- 0
return(gamma)
}
#' Full Ratkowsky model
#'
#' Gamma model adapted from the one by Ratkowsky et al. (1983).
#'
#' @param x Value of the environmental factor.
#' @param xmin Minimum value for growth
#' @param xmax Maximum value for growth
#' @param c Parameter defining the speed of the decline
#'
#' @importFrom lamW lambertW0
#'
full_Ratkowski <- function(x, xmin, xmax, c) {
b <- 1 # Does not affect predictions (see supp. material)
xopt <- (lambertW0(exp(-xmin*c + xmax*c + 1)) + c*xmin - 1)/c
mu_opt <- b*(xopt - xmin)*(1 - exp(c*(xopt - xmax)))
gamma <- b*(x - xmin)*(1 - exp(c*(x - xmax)))
gamma <- gamma/mu_opt
gamma <- gamma^2
gamma[x < xmin] <- 0
gamma[x > xmax] <- 0
return(gamma)
}
#' Calculates every gamma factor
#'
#' A helper function for [predict_dynamic_growth()] that
#' calculates the value of every gamma factor corresponding to some
#' storage time.
#'
#' @param this_t Storage time
#' @param env_func A list of functions (generated using `approxfun`) that
#' give the value of each environmental function for some storage time.
#' @param sec_models A nested list describing the secondary models.
#'
#' @return A vector of gamma factors (one per environmental factor).
#'
calculate_gammas <- function(this_t, env_func, sec_models) {
out <- lapply(names(sec_models), function(this_condition) {
this_x <- env_func[[this_condition]](this_t)
this_sec <- sec_models[[this_condition]]
this_gamma <- switch(this_sec$model,
fullRatkowsky = full_Ratkowski(this_x, this_sec$xmin,
this_sec$xmax, this_sec$c),
CPM = CPM_model(this_x, this_sec$xmin,
this_sec$xopt, this_sec$xmax, this_sec$n),
Zwietering = zwietering_gamma(this_x, this_sec$xmin, this_sec$xopt, this_sec$n),
stop(paste("Model", this_sec$model, "not known."))
)
this_gamma
})
out <- unlist(out)
names(out) <- names(sec_models)
out
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.