Intitial sampling

Fixed bugs in initial sampling to ensure that bootstrapped values are used rather than exact OM data. Also added catch and discard sampling.

R/initOM.R

@@ -471,7 +471,7 @@ run_OM <- function(OM_dir,
   if (is.null(seed)) {
     seed <- stats::runif(1, 1, 9999999)
   }
-
+  
   start <- r4ss::SS_readstarter(file.path(OM_dir, "starter.ss"),
     verbose = FALSE
   )

R/manipulate_EM.R

@@ -66,13 +66,31 @@ get_EM_dat <- function(OM_dat, EM_dat, do_checks = TRUE) {
     check_OM_dat(OM_dat, EM_dat)
   }
   dat <- list(OM_dat = OM_dat, EM_dat = EM_dat)
+
+  Catches <- lapply(dat, function(x) {
+    tmp <- combine_cols(x, "catch", c("year", "seas", "fleet"))
+  })
+  # match 1 way: match each EM obs with an OM obs. extract only these OM obs.
+  matches <- which(Catches[[1]][, "combo"] %in% Catches[[2]][, "combo"])
+  # extract only the rows of interest and get rid of the "combo" column
+  new_dat[["catch"]] <- Catches[[1]][matches, -ncol(Catches[[1]])]
+
+  Discards <- lapply(dat, function(x) {
+    tmp <- combine_cols(x, "discard_data", c("Yr", "Seas", "Flt"))
+  })
+  # match 1 way: match each EM obs with an OM obs. extract only these OM obs.
+  matches <- which(Discards[[1]][, "combo"] %in% Discards[[2]][, "combo"])
+  # extract only the rows of interest and get rid of the "combo" column
+  new_dat[["discard_data"]] <- Discards[[1]][matches, -ncol(Discards[[1]])]
+
   CPUEs <- lapply(dat, function(x) {
     tmp <- combine_cols(x, "CPUE", c("year", "seas", "index"))
   })
   # match 1 way: match each EM obs with an OM obs. extract only these OM obs.
   matches <- which(CPUEs[[1]][, "combo"] %in% CPUEs[[2]][, "combo"])
   # extract only the rows of interest and get rid of the "combo" column
   new_dat[["CPUE"]] <- CPUEs[[1]][matches, -ncol(CPUEs[[1]])]
+
   # add in lcomps
   if (OM_dat[["use_lencomp"]] == 1) {
     lcomps <- lapply(dat, function(x) {
@@ -85,7 +103,7 @@ get_EM_dat <- function(OM_dat, EM_dat, do_checks = TRUE) {
     new_dat[["lencomp"]] <- lcomps[[1]][matches_l, -ncol(lcomps[[1]])]
   }
   # add in age comps
-  if (!is.null(dat[["agecomp"]])) {
+  if (!is.null(OM_dat[["agecomp"]])) {
     acomps <- lapply(dat, function(x) {
       tmp <- combine_cols(
         x, "agecomp",
@@ -97,7 +115,7 @@ get_EM_dat <- function(OM_dat, EM_dat, do_checks = TRUE) {
   }
   # TODO: check this for other types of data, esp. mean size at age, k
   # and mean size.
-  if (!is.null(dat[["meanbodywt"]])) {
+  if (!is.null(OM_dat[["meanbodywt"]])) {
     meansize <- lapply(dat, function(x) {
       tmp <- combine_cols(
         x, "meanbodywt",
@@ -107,7 +125,7 @@ get_EM_dat <- function(OM_dat, EM_dat, do_checks = TRUE) {
     matches_meansize <- which(meansize[[1]][, "combo"] %in% meansize[[2]][, "combo"])
     new_dat[["meanbodywt"]] <- meansize[[1]][matches_meansize, -ncol(meansize[[1]])]
   }
-  if (!is.null(dat[["MeanSize_at_Age_obs"]])) {
+  if (!is.null(OM_dat[["MeanSize_at_Age_obs"]])) {
     size_at_age <- lapply(dat, function(x) {
       tmp <- combine_cols(
         x, "MeanSize_at_Age_obs",

R/runSSMSE.R

@@ -611,6 +611,7 @@ run_SSMSE_iter <- function(out_dir = NULL,
       verbose = verbose, init_run = TRUE, seed = (iter_seed[["iter"]][1] + 12345)
     )
   }
+
   if (use_SS_boot == FALSE) {
     stop(
       "Currently, only sampling can be done using the bootstrapping ",
@@ -648,6 +649,7 @@ run_SSMSE_iter <- function(out_dir = NULL,
     seed = (iter_seed[["iter"]][1] + 123456),
     sample_struct = sample_struct # add for bias
   )
+
   message(
     "Finished getting catch (years ",
     min(new_catch_list[["catch"]][, "year"]), " to ", max(new_catch_list[["catch"]][, "year"]),