fix: Implementation error bugs

fix for some bugs in global vs scenario specific values
nmfs-fish-tools · Jul 1, 2020 · 141631a · 141631a
1 parent c2ee6fa
commit 141631a
Show file tree

Hide file tree

Showing 2 changed files with 17 additions and 18 deletions.
diff --git a/R/impl_error.R b/R/impl_error.R
@@ -91,37 +91,37 @@ build_impl_error <- function(yrs, nyrs_assess, n_impl_error_groups, scope, impl_
     for (i in 1:n_scenarios) {
       impl_error[[i]] <- list()
       for (j in 1:length(iter_list[[i]])) {
-        impl_error[[i]][[j]] <- rep(1, yrs * n_impl_error_groups)
+        impl_error[[i]][[j]] <- rep(1, yrs[i] * n_impl_error_groups[i])
       }
     }
   } else if (impl_error_pattern == "rand") {
-    inp_var <- get_inp_var(impl_error_pars[2:(n_impl_error_groups + 1)], impl_error_pars[(n_impl_error_groups + 2):(n_impl_error_groups * 2 + 1)]^2)
-    inp_mean <- get_inp_mean(impl_error_pars[2:(n_impl_error_groups + 1)], inp_var)
-    inp_stdev <- sqrt(inp_var)
-
     for (i in 1:n_scenarios) {
-      breaks <- unique(c(seq(0, (yrs[i] * n_impl_error_groups),
-                             (impl_error_pars[1] * n_impl_error_groups)),
-                         (yrs[i] * n_impl_error_groups)))
+      inp_var <- get_inp_var(impl_error_pars[2:(n_impl_error_groups[i] + 1)], impl_error_pars[(n_impl_error_groups[i] + 2):(n_impl_error_groups[i] * 2 + 1)]^2)
+      inp_mean <- get_inp_mean(impl_error_pars[2:(n_impl_error_groups[i] + 1)], inp_var)
+      inp_stdev <- sqrt(inp_var)
+
+      breaks <- unique(c(seq(0, (yrs[i] * n_impl_error_groups[i]),
+                             (impl_error_pars[1] * n_impl_error_groups[i])),
+                         (yrs[i] * n_impl_error_groups[i])))
       if (scope == 1) {
 
         set.seed((seed$global+999))
 
-        impl_error_seq <- calc_impl_errors(breaks, (yrs[i] * n_impl_error_groups), impl_error_pars[2:(n_impl_error_groups + 1)], inp_mean, inp_stdev)
+        impl_error_seq <- calc_impl_errors(breaks, (yrs[i] * n_impl_error_groups[i]), impl_error_pars[2:(n_impl_error_groups[i] + 1)], inp_mean, inp_stdev)
       }
       impl_error[[i]] <- list()
       if (scope == 2) {
 
         set.seed((seed$scenario[i]+999))
 
-        impl_error_seq <- calc_impl_errors(breaks, (yrs[i] * n_impl_error_groups), impl_error_pars[2:(n_impl_error_groups + 1)], inp_mean, inp_stdev)
+        impl_error_seq <- calc_impl_errors(breaks, (yrs[i] * n_impl_error_groups[i]), impl_error_pars[2:(n_impl_error_groups[i] + 1)], inp_mean, inp_stdev)
       }
       for (j in 1:length(iter_list[[i]])) {
         if (scope == 3) {
 
           set.seed((seed$iter[[i]][j]+999))
 
-          impl_error_seq <- calc_impl_errors(breaks, (yrs[i] * n_impl_error_groups), impl_error_pars[2:(n_impl_error_groups + 1)], inp_mean, inp_stdev)
+          impl_error_seq <- calc_impl_errors(breaks, (yrs[i] * n_impl_error_groups[i]), impl_error_pars[2:(n_impl_error_groups[i] + 1)], inp_mean, inp_stdev)
         }
         impl_error[[i]][[j]] <- impl_error_seq
       }
@@ -131,17 +131,17 @@ build_impl_error <- function(yrs, nyrs_assess, n_impl_error_groups, scope, impl_
     for (i in 1:n_scenarios) {
       if (scope == 1) {
         impl_error_seq <- impl_error_pars
-        check_impl_error(length(impl_error_seq), (yrs[i] * n_impl_error_groups))
+        check_impl_error(length(impl_error_seq), (yrs[i] * n_impl_error_groups[i]))
       }
       impl_error[[i]] <- list()
       if (scope == 2) {
         impl_error_seq <- impl_error_pars[i, ]
-        check_impl_error(length(impl_error_seq), (yrs[i] * n_impl_error_groups))
+        check_impl_error(length(impl_error_seq), (yrs[i] * n_impl_error_groups[i]))
       }
       for (j in 1:length(iter_list[[i]])) {
         if (scope == 3) {
           impl_error_seq <- impl_error_pars[row, ]
-          check_impl_error(length(impl_error_seq), (yrs[i] * n_impl_error_groups))
+          check_impl_error(length(impl_error_seq), (yrs[i] * n_impl_error_groups[i]))
           row <- row + 1
         }
         impl_error[[i]][[j]] <- impl_error_seq

diff --git a/R/runSSMSE.R b/R/runSSMSE.R
@@ -131,7 +131,6 @@ run_SSMSE <- function(scen_list = NULL,
                       seed=NULL) {
   # Note that all input checks are done in the check_scen_list function.
   # construct scen_list from other parameters.
-
   #First reset the R random seed
   set.seed(seed=NULL)
   #Now set the global, scenario, and iteration seeds that will be used as needed
@@ -167,7 +166,7 @@ run_SSMSE <- function(scen_list = NULL,
 
   # Get directory of base OM files for each scenario as they may be different
   rec_stddev<-rep(0,length(scen_name_vec))
-
+  n_impl_error_groups <- rep(0,length(scen_name_vec))
   rec_autoCorr<-list()
 
   for(i in 1:length(scen_name_vec)){
@@ -195,7 +194,7 @@ run_SSMSE <- function(scen_list = NULL,
     # Calculate the standard deviation and autocorrelation of historic recruitment deviations
     rec_dev_comb <- rbind(parlist$recdev1, parlist$recdev2)
     rec_stddev[i] <- stats::sd(rec_dev_comb[, 2])
-
+    n_impl_error_groups[i] <- dat$nseas * dat$Nfleet
 
     if(rec_dev_pattern=="AutoCorr_rand" | rec_dev_pattern=="AutoCorr_Spec"){
       rec_autoCorr[[i]] <- stats::arima(x=rec_dev_comb[,2],order=c(0,0,4))
@@ -204,7 +203,7 @@ run_SSMSE <- function(scen_list = NULL,
   }
     rec_dev_list <- build_rec_devs(nyrs_vec, nyrs_assess_vec, scope, rec_dev_pattern, rec_dev_pars, rec_stddev, length(scen_name_vec), iter_list, rec_autoCorr, seed)
 
-    n_impl_error_groups <- dat$nseas * dat$Nfleet
+
 
     impl_error <- build_impl_error(nyrs_vec, nyrs_assess_vec, n_impl_error_groups, scope, impl_error_pattern, impl_error_pars, length(scen_name_vec), iter_list, seed)