Various fixes

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ss3om
 Title: Tools for Conditioning Fisheries Operating Models Using Stock Synthesis 3
-Version: 0.5.2.9015
+Version: 0.5.2.9016
 Authors@R: person("Iago", "Mosqueira", email = "[email protected]",
   role = c("aut", "cre"))
 Description: Tools for loading Stock Synthesis (SS3) models into FLR. Used in
@@ -32,4 +32,3 @@ Suggests:
 License: EUPL
 VignetteBuilder: knitr
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.1

NEWS.md

@@ -1,3 +1,9 @@
+# CHANGES IN ss3om VERSION 0.5.3
+
+## BUG FIXES
+
+-  discards are now also loaded for forecast years
+
 # CHANGES IN ss3om VERSION 0.4.8
 
 ## BUG FIXES

R/build330.R

@@ -135,7 +135,7 @@ buildFLSss330 <- function(out, morphs=out$morph_indexing$Index,
       idx <- setNames(nm=unique(datage$Fleet))
 
       discards <- ss3catch30(datage[Type == "disc",], wtatage, dmns, morphs,
-        idx=idx)
+        idx=idx, era=era)
 
       # TABLE of areas and fleets for discards
       map <- unique(datage[Fleet %in% fleets, .(Area, Fleet)])

R/check.R

@@ -41,33 +41,67 @@
 #'
 #' extractFbar(out)
 
-extractSSB <- function(out) {
+extractSSB <- function(out, endyr=sum(c(out$endyr, out$nforecastyears), na.rm=TRUE)) {
 
   ssb <- data.table(out$derived_quants)[Label %in% paste0("SSB_",
-    seq(out$startyr, out$endyr)), Value]
+    seq(out$startyr, endyr)), Value]
 
-  return(FLQuant(ssb, dimnames=list(age="all", year=seq(out$startyr, out$endyr),
+  return(FLQuant(ssb, dimnames=list(age="all", year=seq(out$startyr, endyr),
     unit=c("unique", "F")[out$nsexes]), units="t"))
 }
 
+extractSSBci <- function(out, endyr=sum(c(out$endyr, out$nforecastyears), na.rm=TRUE)) {
+
+  ssb <- data.table(out$derived_quants)[Label %in% paste0("SSB_",
+    seq(out$startyr, endyr)), .(Value, StdDev)]
+
+  res <- FLQuantPoint(FLQuant(dimnames=list(age="all",       
+    year=seq(out$startyr, endyr), unit=c("unique", "F")[out$nsexes]), 
+    units="t"))
+
+  mean(res)[] <- ssb$Value
+  median(res)[] <- ssb$Value
+  var(res)[] <- ssb$StdDev ^ 2
+  lowq(res)[] <- (ssb$Value - ssb$StdDev * 1.96)
+  uppq(res)[] <- (ssb$Value + ssb$StdDev * 1.96)
+
+  return(res)
+}
+
 #' @rdname extractSS
 
-extractRec <- function(out) {
+extractRec <- function(out, endyr=sum(c(out$endyr, out$nforecastyears), na.rm=TRUE)) {
 
   rec <- data.table(out$derived_quants)[Label %in% paste0("Recr_",
-    seq(out$startyr, out$endyr)), Value] 
-  # DEBUG
-  # * out$recruitment_dist[[1]][, "Frac/sex"]
+    seq(out$startyr, endyr)), Value] 
 
-  return(FLQuant(rec/out$nsexes, dimnames=list(age="all", year=seq(out$startyr, out$endyr),
+  return(FLQuant(rec/out$nsexes, dimnames=list(age="all",
+    year=seq(out$startyr, endyr),
     unit=list("unique", c("F", "M"))[[out$nsexes]]), units="1000"))
 }
 
+extractRecci <- function(out) {
+
+  rec <- data.table(out$derived_quants)[Label %in% paste0("Recr_",
+    seq(out$startyr, out$endyr)), .(Value, StdDev)]
+
+  res <- FLQuantPoint(FLQuant(dimnames=list(age="all",       
+    year=seq(out$startyr, out$endyr)), units="numbers"))
+
+  mean(res)[] <- rec$Value
+  median(res)[] <- rec$Value
+  var(res)[] <- rec$StdDev ^ 2
+  lowq(res)[] <- (rec$Value - rec$StdDev * 1.96)
+  uppq(res)[] <- (rec$Value + rec$StdDev * 1.96)
+
+  return(res)
+}
+
 #' @rdname extractSS
-extractFbar <- function(out) {
+extractFbar <- function(out, endyr=sum(c(out$endyr, out$nforecastyears), na.rm=TRUE)) {
 
   fbar <- data.table(out$derived_quants)[Label %in% paste0("F_",
-    seq(out$startyr + 1, out$endyr)), ]
+    seq(out$startyr + 1, endyr)), ]
 
   if(grepl("3.24", out$SS_version, fixed = TRUE))
     row <- "Fstd_MSY"
@@ -88,9 +122,28 @@ extractFbar <- function(out) {
     warning(paste("Returned F is relative to", out$F_report_basis))
   }
   return(FLQuant(fbar, dimnames=list(age="all",
-    year=seq(out$startyr + 1, out$endyr), unit="unique"), units="f"))
+    year=seq(out$startyr + 1, endyr), unit="unique"), units="f"))
 }
 
+extractFbaci <- function(out, endyr=sum(c(out$endyr, out$nforecastyears), na.rm=TRUE)) {
+
+  fbar <- data.table(out$derived_quants)[Label %in% paste0("F_",
+    seq(out$startyr, endyr)), .(Value, StdDev)]
+
+  res <- FLQuantPoint(FLQuant(dimnames=list(age="all",       
+    year=seq(out$startyr, endyr)), units="f"))
+
+  mean(res)[] <- fbar$Value
+  median(res)[] <- fbar$Value
+  var(res)[] <- fbar$StdDev ^ 2
+  lowq(res)[] <- (fbar$Value - fbar$StdDev * 1.96)
+  uppq(res)[] <- (fbar$Value + fbar$StdDev * 1.96)
+
+  return(res)
+}
+
+
+
 #' @rdname extractSS
 
 extractZatage <- function(out) {

R/global.R

@@ -62,6 +62,7 @@ utils::globalVariables(c(
   "i",
   "int_Age",
   "K",
+  "label",
   "label.i",
   "label.j",
   "len",
@@ -81,10 +82,12 @@ utils::globalVariables(c(
   "SSB_status",
   "SSB_unfished",
   "SSB_Virgin",
+  "StdDev",
   "Type",
   "uBirthSeas",
   "uSex",
   "unit",
+  "variable",
   "vars",
   "year",
   "yr"))

R/read.R

@@ -203,7 +203,8 @@ readFLSss3 <- function(dir, repfile="Report.sso", compfile="CompReport.sso",
     stock.wt(res)[] <- wasq[["0"]]
 
     # mat, Fleet = -2 / wt
-    nmat <- wasq[["-2"]] %/% wasq[["-1"]]
+    # TODO: CHANGE 0 by ouit$spawnseas (Is it spawn_month?)
+    nmat <- wasq[["-2"]] %/% wasq[["0"]]
     mat(res)[] <- nmat
 
     # IDENTIFY catch fleets

R/utilities.R

@@ -212,3 +212,31 @@ prepareRetro <- function(path, starter="starter.ss", years=5) {
 
   invisible(TRUE)
 } # }}}
+
+# getFsByFishery {{{
+
+getFsByFishery <- function(out) {
+
+  fatage <- data.table(out$fatage)[Era %in% c("TIME", "FORE")]
+
+  # DIMS
+  fis <- unique(fatage$Fleet)
+
+  res <- FLQuants(lapply(fis, function(x) {
+
+    dat <- melt(fatage[Fleet == x,], measure.vars=names(fatage)[-seq(7)],
+      variable.name="age", value.name="data")[, .(age, Yr, Sex, Seas, Area,
+      data)]
+
+    setnames(dat, c('age', 'year', 'unit', 'season', 'area', 'data'))
+
+    return(as.FLQuant(dat))
+
+  }))
+
+  names(res) <- out$FleetNames[out$fleet_type == 1]
+
+  return(res)
+}
+
+# }}}

tests/testthat/test-fwd.R

@@ -11,6 +11,21 @@ library(ss3om)
 library(FLasher)
 library(patchwork)
 
+
+# fwd(stk, fbar)
+
+# fwd(stk, catch)
+
+# fwd(biol, fisheries, catch_f)
+
+# fwd(biol, fisheries, fbar + catch)
+
+
+
+
+
+
+
 # LOAD SS_output
 # - Using own ss3om function to deal with compressed files