Moving all mp code to mse

CHANGES.md

@@ -0,0 +1,24 @@
+
+- ADDED mp.R: mp()
+
+- ADDED dispatch.R: flsval(), flival(), flpval(), flfval(), flqval()
+- RENAMED a4ampDispatch() to mpDispatch()
+
+- ADDED oem.R: sampling.eom(), perfect.oem()
+
+- ADDED sa.R: perfect.sa()
+
+- ADDED hcr.R: ices.hcr(), fixedF.hcr(), movingF.hcr()
+
+- ADDED iem.R: noise.iem()
+
+- ADDED is.R: tac.is(), effort.is()
+
+- ADDED tm.R: map.tm()
+
+- ADDED phcr.R: movingF.hcr()
+
+# TODO
+
+- Move xsa.sa to FLXSA.
+- FIX noise.iem for FLasher

DESCRIPTION

@@ -12,7 +12,7 @@ Depends:
   FLCore,
   ggplotFL,
   data.table,
-  FLBRP
+  FLRP
 Imports:
   foreach,
   parallel
@@ -28,7 +28,17 @@ Collate:
   'FLoem-class.R'
   'FLom-class.R'
   'FLiem-class.R'
-  'FLmp-class.R'
+  'FLmse-class.R'
+  'dispatch.R'
+  'fb.R'
+  'hcr.R'
+  'iem.R'
+  'is.R'
+  'mp.R'
+  'oem.R'
+  'phcr.R'
+  'sa.R'
+  'tm.R'
   'grid.R'
   'mc.R'
   'performance.R'

NAMESPACE

@@ -1,13 +1,11 @@
 import("methods")
 import("data.table")
 import("FLCore")
-importFrom(FLRP,
-  "brp")
-importFrom(stats,
-  "setNames")
 import("ggplotFL")
 import("foreach")
 import("parallel")
+importFrom(FLRP,
+  "brp")
 importFrom("utils",
   "setTxtProgressBar")
 importFrom("stats",
@@ -18,4 +16,25 @@ importFrom("stats",
   "setNames",
   "rf")
 
+export(
+
+  "hyperstability.fb",
+
+  "fixedF.hcr",
+  "ices.hcr",
+  "movingF.hcr",
+
+  "noise.iem",
+
+  "tac.is",
+  "effort.is",
+
+  "perfect.oem",
+  "sampling.oem",
+
+  "perfect.sa",
+
+  "mpa.tm"
+)
+
 exportPattern("^[^\\.]")

R/FLmp-class.R → R/FLmse-class.R

@@ -1,6 +1,6 @@
-#' @title S4 class \code{FLmp}
+#' @title S4 class \code{FLmse}
 #'
-#' @description The \code{FLmp} class stores information relative to the MSE's management procedure'.
+#' @description The \code{FLmse} class stores information relative to the MSE's management procedure'.
 #'
 #' @section Slots:
 #' \describe{
@@ -11,25 +11,25 @@
 #' @template Accessors
 #' @template Constructors
 #' @docType class
-#' @name FLmp-class
-#' @rdname FLmp-class
-#' @aliases FLmp-class
+#' @name FLmse-class
+#' @rdname FLmse-class
+#' @aliases FLmse-class
 #' @examples
 #'
 
-FLmp <- setClass("FLmp", contains="FLom", 
+FLmse <- setClass("FLmse", contains="FLom", 
 	slots=c(
 		tracking="FLQuant",
 		genArgs="list"
 	)
 )
 
-#' @rdname FLmp-class
+#' @rdname FLmse-class
 #' @template bothargs
-#' @aliases FLmp FLmp-methods
-setGeneric("FLmp")
+#' @aliases FLmse FLmse-methods
+setGeneric("FLmse")
 
-setMethod("initialize", "FLmp",
+setMethod("initialize", "FLmse",
     function(.Object,
              ...,
              stock, sr, brp, fleetBehaviour, tracking, genArgs) {
@@ -61,34 +61,34 @@ setMethod("initialize", "FLmp",
 #  accessor methods
 #
 
-#' @rdname FLmp-class
+#' @rdname FLmse-class
 #' @aliases tracking tracking-methods
 setGeneric("tracking", function(object, ...) standardGeneric("tracking"))
 #' @rdname FLom-class
-setMethod("tracking", "FLmp", function(object) object@tracking)
+setMethod("tracking", "FLmse", function(object) object@tracking)
 
-#' @rdname FLmp-class
+#' @rdname FLmse-class
 #' @param value the new object
 #' @aliases tracking<- tracking<--methods
 setGeneric("tracking<-", function(object, value) standardGeneric("tracking<-"))
 #' @rdname FLom-class
-setReplaceMethod("tracking", signature("FLmp", "FLQuant"), function(object, value){
+setReplaceMethod("tracking", signature("FLmse", "FLQuant"), function(object, value){
 	object@tracking <- value
 	object
 })
 
-#' @rdname FLmp-class
+#' @rdname FLmse-class
 #' @aliases genArgs genArgs-methods
 setGeneric("genArgs", function(object, ...) standardGeneric("genArgs"))
 #' @rdname FLom-class
-setMethod("genArgs", "FLmp", function(object) object@genArgs)
+setMethod("genArgs", "FLmse", function(object) object@genArgs)
 
-#' @rdname FLmp-class
+#' @rdname FLmse-class
 #' @param value the new object
 #' @aliases genArgs<- genArgs<--methods
 setGeneric("genArgs<-", function(object, value) standardGeneric("genArgs<-"))
 #' @rdname FLom-class
-setReplaceMethod("genArgs", signature("FLmp", "list"), function(object, value){
+setReplaceMethod("genArgs", signature("FLmse", "list"), function(object, value){
 	object@genArgs <- value
 	object
 })

R/dispatch.R

@@ -0,0 +1,42 @@
+# dispatch.R - DESC
+# mse/R/dispatch.R
+
+# Copyright European Union, 2018
+# Author: Ernesto Jardim (EC JRC) <ernesto.jardim@ec.europa.eu>
+#         Iago Mosqueira (EC JRC) <iago.mosqueira@ec.europa.eu>
+#
+# Distributed under the terms of the European Union Public Licence (EUPL) V.1.1.
+
+# dispatching
+
+flsval <- list(object="stk", test="!is(object, \"FLS\")", msg="\"stk must be of class FLStock\"")
+
+flival <- list(object="idx", test= "!is(object, \"FLIndices\")", msg="\"idx must be of class FLIndices\"")
+
+flpval <- list(object="hcrpars", test= "!is(object, \"FLPar\")", msg="\"hcrpars must be of class FLPar\"")
+
+flfval <- list(object="ctrl", test= "!is(object, \"fwdControl\")", msg="\"ctrl must be of class fwdControl\"")
+
+flqval <- list(object="flq", test= "!is(object, \"FLQuant\")", msg="\"flq must be of class FLQuant\"")
+
+# mpDispatch {{{
+mpDispatch <- function(ioval, ...){
+	args <- list(...)
+	method <- args$method
+	args$method <- NULL
+	# checks in
+	for(i in ioval$iv){
+		object <- args[i$object]
+		str <- paste("if(", i$test, ")", i$msg, sep=" ")
+		eval(parse(text=str))
+	}
+	# dispatch
+	out <- do.call(method, args)
+	# checks out
+	for(i in ioval$ov){
+		object <- out[i$object]
+		str <- paste("if(", i$test, ")", i$msg, sep=" ")
+		eval(parse(text=str))
+	}
+	out
+} # }}}

R/fb.R

@@ -0,0 +1,26 @@
+# fb.R - DESC
+# mse/R/fb.R
+
+# Copyright European Union, 2018
+# Author: Ernesto Jardim (EC JRC) <ernesto.jardim@ec.europa.eu>
+#         Iago Mosqueira (EC JRC) <iago.mosqueira@ec.europa.eu>
+#
+# Distributed under the terms of the European Union Public Licence (EUPL) V.1.1.
+
+# hyperstability.fb {{{
+hyperstability.fb <- function(ctrl, beta=1, maxF=2, alpha=maxF^(1-beta), tracking) {
+
+	# Only operates on F targets - so nothing happens to TAC
+	# This function creates a control file to be later used in the fwd()
+	# function where two optional relations are established between
+	# fishing effort and fishing mortality
+
+  # Beta is in this MSE either 1 for a 1:1 linear relationship between
+	# F and effort, if beta = 0.7, the relation is not linear and it can
+	# mimick a hyperstability scenario.
+	# alpha = maxF^(1-beta) # linear meets curve at maxF
+
+  ctrl@trgtArray[ctrl@target[,"quantity"]=="f",,] <- alpha * ctrl@trgtArray[ctrl@target[,"quantity"]=="f",,]^beta
+	list(ctrl=ctrl, tracking=tracking)
+
+} # }}}