R/SS2MOM.R

In tcarruth/MSEtool: Management Strategy Evaluation Toolkit

#' Import Stock Synthesis to multi-fleet 2-sex MOM
#'
#' @description A function that uses the file location of a fitted SS3 model including input files to population the
#' various slots of an \linkS4class{MOM}. The function mainly populates the Stock (2-sex if needed) and Fleet (separate fleets with discarding behavior) portions
#' of the MOM; the user may still need to parameterize most of the observation and implementation portions of the MOM.
#' @param SSdir A folder with Stock Synthesis input and output files in it.
#' @param nsim The number of simulations to take for parameters with uncertainty (for OM@@cpars custom parameters).
#' @param proyears The number of projection years for MSE
#' @param reps The number of stochastic replicates within each simulation in the operating model.
#' @param maxF The maximum allowable F in the operating model.
#' @param seed The random seed for the operating model.
#' @param interval The interval at which management procedures will update the management advice in \link{multiMSE}, e.g., 1 = annual updates.
#' @param pstar The percentile of the sample of the management recommendation for the MP/MMP.
#' @param Obs The observation model (class Obs).
#' @param Imp The implementation model (class Imp). This function does not update implementation parameters.
#' @param silent Whether to silence messages to the console.
#' @param Name The name of the operating model
#' @param Source Reference to assessment documentation e.g. a url
#' @param ... Arguments to pass to \link[r4ss]{SS_output}.
#' @note Currently tested on r4ss version 1.38.1 and SS 3.30.14.
#' @return An object of class \linkS4class{MOM}.
#' @author Q. Huynh
#' @export
#' @seealso \link{SS2Data} \link{SS2OM}
SS2MOM <- function(SSdir, nsim = 48, proyears = 50, reps = 1, maxF = 3, seed = 1, interval = 1, pstar = 0.5,
                   Obs = DLMtool::Generic_Obs, Imp = DLMtool::Perfect_Imp, silent = FALSE,
                   Name = "MOM generated by SS2MOM", Source = "No Source provided", ...) {

  replist <- SS_import(SSdir, silent, ...)
  if(replist$nseasons > 1) warning("Currently only supporting one season per year.")


  # Create MOM object
  MOM <- new("MOM")
  MOM@Name <- Name
  MOM@Source <- Source
  MOM@reps <- reps
  MOM@seed <- seed
  MOM@maxF <- maxF
  MOM@interval <- 1

  if(!silent) message(replist$nsexes, "-sex and ", replist$nfishfleets, "-fleet model detected.")

  mainyrs <- replist$startyr:replist$endyr
  nyears <- length(mainyrs)
  MOM@proyears <- proyears
  allyears <- nyears + MOM@proyears
  MOM@nsim <- nsim
  MOM@pstar <- pstar

  output <- lapply(seq_len(replist$nsexes), SS2MOM_stock, replist = replist, mainyrs = mainyrs, nyears = nyears, MOM = MOM)

  MOM@Stocks <- lapply(output, getElement, "Stock")
  MOM@Fleets <- lapply(output, getElement, "Fleet")
  MOM@cpars <- lapply(output, getElement, "cpars")

  # Sample future recruitment
  Perr_proj <- sample_recruitment(log(MOM@cpars[[1]][[1]]$Perr_y), proyears, replist$sigma_R_in, MOM@Stocks[[1]]@AC[1], seed)
  MOM@cpars <- lapply(MOM@cpars, function(x) lapply(x, function(xx) {xx$Perr_y <- cbind(xx$Perr_y, exp(Perr_proj)); return(xx)}))

  MOM@Obs <- lapply(seq_len(replist$nsexes), function(x) lapply(1:length(MOM@Fleets[[1]]), function(xx) return(Obs)))
  MOM@Imps <- lapply(seq_len(replist$nsexes), function(x) lapply(1:length(MOM@Fleets[[1]]), function(xx) return(Imp)))

  if(replist$nsexes == 2) {
    MOM@SexPars <- list(SSBfrom = matrix(c(1, 0), 2, 2, byrow = TRUE))
    MOM@Complexes <- list(c(1, 2))
  }

  # Catch Fracs
  CatchFrac <- lapply(MOM@cpars, function(x) vapply(x, function(xx) xx$Data@Cat[1, ncol(xx$Data@Cat)], numeric(1)))
  MOM@CatchFrac <- lapply(CatchFrac, function(x) matrix(x/sum(x), nrow = MOM@nsim, ncol = length(x), byrow = TRUE))

  return(MOM)
}