# FLo-class.R - DESC
# mse/R/FLo-class.R
# Copyright Iago MOSQUEIRA (WMR), 2020
# Author: Iago MOSQUEIRA (WMR) <iago.mosqueira@wur.nl>
#
# Distributed under the terms of the EUPL-1.2
# FLo: OM parent class {{{
setClass("FLo",
slots=c(
name="character",
fleetBehaviour="mseCtrl",
projection="mseCtrl"))
# }}}
# accessors methods {{{
#' @rdname FLo-class
setMethod("name", "FLo", function(object) object@name)
#' @rdname FLo-class
#' @param value Object to assign in slot
setReplaceMethod("name", signature("FLo", "character"), function(object, value){
object@name <- value
object
})
#' @rdname FLo-class
setMethod("refpts", "FLo", function(object) object@refpts)
#' @rdname FLo-class
#' @param value Object to assign in slot
setReplaceMethod("refpts", signature("FLo", "FLPar"), function(object, value){
object@refpts <- value
object
})
#' @rdname FLo-class
setGeneric("fleetBehaviour", function(object, ...) standardGeneric("fleetBehaviour"))
#' @rdname FLo-class
setMethod("fleetBehaviour", "FLo", function(object) object@fleetBehaviour)
#' @rdname FLo-class
#' @param value Object to assign in slot
setGeneric("fleetBehaviour<-", function(object, value) standardGeneric("fleetBehaviour<-"))
#' @rdname FLo-class
setReplaceMethod("fleetBehaviour", signature("FLo", "mseCtrl"), function(object, value){
object@fleetBehaviour <- value
object
})
#' @rdname FLo-class
setGeneric("projection", function(object, ...) standardGeneric("projection"))
#' @rdname FLo-class
setMethod("projection", "FLo", function(object) object@projection)
#' @rdname FLo-class
#' @param value Object to assign in slot
setGeneric("projection<-", function(object, value) standardGeneric("projection<-"))
#' @rdname FLo-class
setReplaceMethod("projection", signature("FLo", "mseCtrl"), function(object, value){
object@projection <- value
object
})
# }}}
# show {{{
setMethod('show', signature('FLo'),
function(object) {
summary(object)
}
) # }}}
# metrics {{{
setMethod("metrics", signature(object="FLo", metrics="list"),
function(object, metrics) {
return(FLQuants(lapply(metrics, function(x) {
# PARSE
if(is(x, 'formula')) {
do.call(eval(x[[2]]),
list(object)) / refpts(object)[as.character(x[[3]]),]
} else {
do.call(x, list(object))
}})))
}
)
# }}}
# debug {{{
#' @rdname debug-mse
#' @details For objects of classes *FLom* and *FLombf*, *debug* and *undebug* will set
#' and unset the debugging flag on the function stored in the *projection* slot.
setMethod("debug", signature(fun="FLo"),
function(fun) {
debug(method(projection(fun)))
})
#' @rdname debug-mse
setMethod("undebug", signature(fun="FLo"),
function(fun) {
undebug(method(projection(fun)))
})
# }}}
# fwd.om {{{
#' A method to project the operating model (OM)
#'
#' Lorem ipsum dolor sit amet, consectetur adipiscing elit. Pellentesque eleifend
#' odio ac rutrum luctus. Aenean placerat porttitor commodo. Pellentesque eget porta
#' libero. Pellentesque molestie mi sed orci feugiat, non mollis enim tristique.
#' Suspendisse eu sapien vitae arcu lobortis ultrices vitae ac velit. Curabitur id
#'
#' @name fwd.om
#' @rdname fwd.om
#' @aliases fwd.om
#' @param object the OM as a FLStock
#' @param ctrl the fwdControl object with objectives and constraints
#' @param ...
fwd.om <- function(om, ctrl, ...){
args <- list(...)
args$object <- om
args$control <- ctrl
# CALL using tryCatch
om <- tryCatch(do.call("fwd", args),
# error, STOP
error = function(e) {
stop("fwd() could not be run, check args and ctrl, use debug(om)")
}
)
list(om=om)
}
# }}}
# relative (metrics) {{{
relative <- list(
`SB/SB[MSY]`=function(x) setunits(unitSums(ssb(x)) %/% refpts(x)$SBMSY, ""),
`SB/SB[0]`=function(x) setunits(unitSums(ssb(x)) %/% refpts(x)$SB0, ""),
`B/B[0]`=function(x) setunits(unitSums(tsb(x)) %/% refpts(x)$B0, ""),
`F/F[MSY]`=function(x) setunits(unitMeans(fbar(x)) %/% refpts(x)$FMSY, ""))
# }}}
# total (metrics) {{{
total <- list(
R = function(x) areaSums(unitSums(rec(x))),
SB = function(x) areaSums(unitSums(ssb(x))),
C = function(x) areaSums(unitSums(catch(x))),
F = function(x) areaMeans(unitMeans(fbar(x))))
# }}}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.