#'
#' Access or assign maturity at age
#'
#' This function can be used to access or assign the maturity at age in an \code{\link{lhm}} object.
#'
#' Assignment can be of a list or numeric vector. When a list is assigned it should provide the \eqn{a_{crit}} and optionally the \eqn{\delta} parameter. If only \code{acrit} is supplied then maturity is knife-edged at that age. If both \code{acrit} and \code{delta} are supplied then maturity-at-age is calculated as a logistic ogive: \deqn{Maturity = 1/(1+exp((acrit-Age)/delta)).}
#'
#' Uncertainty accross iterations in the \code{lhm} object can be included by providing a \code{cv} for each of the parameters. Parameter uncertainty is assumed to be log-normal with \eqn{\sigma = \sqrt{ln(1+cv^2)}}.
#'
#' When assigning a numeric vector it is assumed that each replicate is identical.
#'
#' @param object a \code{\link{lhm}} object
#' @param value either a named \code{list} or \code{numeric} vector
#' \describe{
#' \item{\code{numeric}}{a vector of length equal to the maximum age}
#' \item{\code{list}}{a list object containing the components \code{mu} and \code{cv}}
#' \item{\code{mu}}{a list containing the parameters \code{acrit} and (optionally) \code{delta} representing their mean values}
#' \item{\code{cv}}{optional single numeric value or a list containing parameters \code{acrit} and \code{delta} representing their coefficients of variation}
#' }
#'
#' @return Accessor function returns a matrix of maturity at age across iterations. Assignment function populates the matrix across iterations.
#'
#' @examples
#'
#' # initialize single iteration
#' dat <- lhm(ainf = 30, iter = 1)
#'
#' # add knife-edged maturity
#' maturity(dat) <- list(mu = list(acrit = 10))
#' maturity(dat)
#'
#' # increase iterations
#' dat <- iterate(dat, iter = 10)
#' maturity(dat)
#'
#' # add logistic maturity ogive
#' # with uncertainty
#' maturity(dat) <- list(mu=list(acrit = 1, delta = 3),
#' cv=list(acrit = 0.01, delta = 0.01))
#' maturity(dat)
#'
#' @import methods
#' @include lhm-class.R
#'
#{{{ accessor function
#' @export
setGeneric("maturity", function(object, ...) standardGeneric("maturity"))
#' @rdname maturity
setMethod("maturity",signature(object = "lhm"), function(object) return(object@lhdat$maturity))
#}}}
#{{{ assignment functions
#' @rdname maturity
#' @export
setGeneric("maturity<-", function(object, value) standardGeneric("maturity<-"))
#{{ list
#' @rdname maturity
setMethod("maturity<-",
signature(object = "lhm", value = "list"),
function(object, value) {
acrit.mu <- value$mu$acrit
delta.mu <- value$mu$delta
if (!is.null(delta.mu)) {
if (!is.null(value$cv$acrit)) {
acrit.sd <- sqrt(log(1 + value$cv$acrit^2))
acrit <- acrit.mu * rlnorm(object@iter,-acrit.sd^2/2,acrit.sd)
} else acrit <- rep(acrit.mu,object@iter)
if (!is.null(value$cv$delta)) {
delta.sd <- sqrt(log(1 + value$cv$delta^2))
delta <- delta.mu * rlnorm(object@iter,-delta.sd^2/2,delta.sd)
} else delta <- rep(delta.mu,object@iter)
for (i in 1:object@iter)
object@lhdat[['maturity']][,i] <- 1/(1 + exp((acrit[i] - (1:object@ainf))/delta[i]))
} else {
acrit.mu <- as.integer(acrit.mu)
if (acrit.mu <= object@ainf)
object@lhdat[['maturity']][acrit.mu:object@ainf,] <- 1
}
object
}
)
#}}
#{{ numeric
#' @rdname maturity
setMethod("maturity<-",
signature(object = "lhm",value = "numeric"),
function(object,value) {
mat.mu <- value
if (length(mat.mu) < object@ainf)
mat.mu[(length(mat.mu) + 1):object@ainf] <- rep(mat.mu[length(mat.mu)],object@ainf - length(mat.mu))
if (length(mat.mu) > object@ainf)
mat.mu <- mat.mu[1:object@ainf]
object@lhdat[['maturity']] <- apply(object@lhdat[['maturity']],2,function(object) mat.mu)
object
}
)
#}}
#}}}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.