Merge pull request #42 from pfmc-assessments/fix-get-settings

Fix get settings

R/check_profile_range.R

@@ -13,38 +13,50 @@
 check_profile_range <- function(mydir, model_settings) {
   # Read in the base model
   rep <- r4ss::SS_output(
-    file.path(mydir, model_settings$base_name),
+    file.path(mydir, model_settings[["base_name"]]),
     covar = FALSE,
     printstats = FALSE,
     verbose = FALSE
   )
 
-  N <- nrow(model_settings$profile_details)
+  N <- nrow(model_settings[["profile_details"]])
   for (aa in 1:N) {
     profile_details <- model_settings[["profile_details"]][aa, ]
     para <- profile_details[, "parameters"]
-    est <- rep$parameters[rep$parameters$Label == para, "Value"]
+    if (!any(para == rep[["parameters"]][["Label"]])) {
+      cli::cli_abort(
+        "{para} does not match a parameter name in the model."
+      )
+    }
+    est <- rep[["parameters"]][rep[["parameters"]][["Label"]] == para, "Value"]
 
     # Determine the parameter range
-    if (profile_details$param_space == "relative") {
+    if (profile_details[["param_space"]] == "relative") {
       range <- c(
-        est + profile_details$low,
-        est + profile_details$high
+        est + profile_details[["low"]],
+        est + profile_details[["high"]]
       )
     }
-    if (profile_details$param_space == "multiplier") {
+    if (profile_details[["param_space"]] == "multiplier") {
       range <- c(
-        est - est * profile_details$low,
-        est + est * profile_details$high
+        est - est * profile_details[["low"]],
+        est + est * profile_details[["high"]]
       )
     }
-    if (profile_details$param_space == "real") {
+    if (profile_details[["param_space"]] == "real") {
       range <- c(
-        profile_details$low,
-        profile_details$high
+        profile_details[["low"]],
+        profile_details[["high"]]
+      )
+    }
+    step_size <- profile_details[["step_size"]]
+
+    if((max(range) - min(range)) < step_size) {
+      cli::cli_abort(
+        "The step size of {step_size} appears to be set too large to
+        profile over {para} from value of {range[1]} to {range[2]}."
       )
     }
-    step_size <- profile_details$step_size
 
     # Create parameter vect from base down and the base up
     if (est != round_any(est, step_size, f = floor)) {
@@ -66,8 +78,13 @@ check_profile_range <- function(mydir, model_settings) {
     }
 
     vec <- c(low, high)
-    cli::cli_inform(
-      "Profiling over {para} across values of {vec}."
-    )
+    if (est %in% vec) {
+      vec <- vec[!vec == est]
+    }
+    if(model_settings[["verbose"]]) {
+      cli::cli_inform(
+        "Profiling over {para} across values of {sort(vec)}."
+      )
+    }
   }
 }

R/get_settings.R

@@ -1,11 +1,10 @@
 #' Check that all of the settings are in the list
 #'
+#' @template mydir
 #' @param settings A list of the current settings where each object in the list
 #'   must be named. Those names that are not found in the stored list will be
 #'   added. The default value of \code{NULL} leads to a full list being
 #'   returned.
-#' @param verbose A logical value specifying if the message should be output to
-#'   the screen or not.
 #'
 #' @return
 #' A list of settings for running model diagnostics.
@@ -14,9 +13,13 @@
 #' @export
 #'
 #' @examples
-#' get_settings(list("Njitter" = 10))
+#' \dontrun{
+#'   get_settings(
+#'     mydir = "directory"
+#'     settings = list("Njitter" = 10))
+#' }
 #'
-get_settings <- function(settings = NULL, verbose = FALSE) {
+get_settings <- function(mydir = NULL, settings = NULL) {
   if (is.vector(settings)) settings <- as.list(settings)
 
   Settings_all <- list(
@@ -26,7 +29,7 @@ get_settings <- function(settings = NULL, verbose = FALSE) {
     profile_details = NULL,
     version = "3.30",
     exe = "ss3",
-    verbose = FALSE,
+    verbose = TRUE,
 
     # Jitter Settings
     extras = "-nohess",
@@ -90,7 +93,14 @@ get_settings <- function(settings = NULL, verbose = FALSE) {
   }
 
   if ("profile" %in% Settings_all[["run"]]) {
-    if (Settings_all[["verbose"]]) {
+    if (is.null(mydir) & Settings_all[["verbose"]]) {
+      cli::cli_inform(
+        "The directory (mydir) is not provided. Profile parameter names
+        not checked and the profile range not be reported. To check profile
+        information specify mydir and add verbose = TRUE to the settings list."
+      )
+    }
+    if (!is.null(mydir)) {
       check_profile_range(
         mydir = mydir,
         model_settings = Settings_all

R/get_settings_profile.R

@@ -87,7 +87,10 @@ get_settings_profile <- function(parameters = c("NatM_uniform_Fem_GP_1", "SR_BH_
     length(parameters) != length(high) |
     length(parameters) != length(step_size) |
     length(parameters) != length(param_space)) {
-    stop("Error: input vectors do match in length.")
+    cli::cli_abort(
+      "Input vectors do match in length. There were {length(parameters)} parameters,
+       {length(low)} lower bounds, {length(high)} high bounds, {length(step_size)}
+        step sizes, and {length(param_space)} parameter spaces specified.")
   }
 
   if (lifecycle::is_present(use_prior_like)) {
@@ -104,6 +107,5 @@ get_settings_profile <- function(parameters = c("NatM_uniform_Fem_GP_1", "SR_BH_
     step_size = step_size,
     param_space = param_space
   )
-
   return(out)
 }

R/rerun_profile_vals.R

@@ -67,15 +67,21 @@ rerun_profile_vals <- function(mydir,
                                run_num,
                                data_file_nm) {
   if (missing(mydir)) {
-    cli::cli_abort("Stop: Need to specify mydir.")
+    cli::cli_abort(
+      "Need to specify mydir."
+    )
   }
 
   if (missing(run_num)) {
-    cli::cli_abort("Stop: Need to specify run_num.")
+    cli::cli_abort(
+      "Need to specify run_num."
+    )
   }
 
   if (missing(para_name)) {
-    cli::cli_abort("Stop: Need to specify parameter name via parameter function input.")
+    cli::cli_abort(
+      "Need to specify parameter name via parameter function input."
+    )
   }
   para <- para_name
 
@@ -99,7 +105,7 @@ rerun_profile_vals <- function(mydir,
 
   # Use the SS_parlines function to ensure that the input parameter can be found
   check_para <- r4ss::SS_parlines(
-    ctlfile = model_settings$oldctlfile,
+    ctlfile = model_settings[["oldctlfile"]],
     dir = temp_dir,
     verbose = FALSE,
     active = FALSE
@@ -112,17 +118,17 @@ rerun_profile_vals <- function(mydir,
 
   load(file.path(profile_dir, paste0(para_name, "_profile_output.Rdata")))
   vec <- vec_unordered
-  like_check <- profilesummary$likelihoods[1, ]
+  like_check <- profilesummary[["likelihoods"]][1, ]
 
   # Change the control file name in the starter file
   starter <- r4ss::SS_readstarter(
     file.path(temp_dir, "starter.ss"),
     verbose = FALSE
   )
-  starter$jitter_fraction <- 0.01
-  starter$init_values_src <- model_settings$init_values_src
+  starter[["jitter_fraction"]] <- 0.01
+  starter[["init_values_src"]] <- model_settings[["init_values_src"]]
   # make sure the prior likelihood is calculated for non-estimated quantities
-  starter$prior_like <- 1
+  starter[["prior_like"]] <- 1
   r4ss::SS_writestarter(
     starter,
     dir = temp_dir,
@@ -132,8 +138,8 @@ rerun_profile_vals <- function(mydir,
 
   for (i in run_num) {
     r4ss::SS_changepars(
-      ctlfile = model_settings$newctlfile,
-      newctlfile = model_settings$newctlfile,
+      ctlfile = model_settings[["newctlfile"]],
+      newctlfile = model_settings[["newctlfile"]],
       strings = para,
       newvals = vec[i],
       estimate = FALSE,
@@ -148,17 +154,17 @@ rerun_profile_vals <- function(mydir,
     )
 
     mod <- r4ss::SS_output(dir = temp_dir, covar = FALSE, printstats = FALSE, verbose = FALSE)
-    like <- mod$likelihoods_used[1, 1]
+    like <- mod[["likelihoods_used"]][1, 1]
 
     # See if likelihood is lower than the original - and rerun if not
     add <- 0.01
     if (like >= like_check[i]) {
       for (ii in 1:5) {
         starter <- r4ss::SS_readstarter(file = file.path(temp_dir, "starter.ss"))
         if (ii == 1) {
-          starter$jitter_fraction <- 0.01
+          starter[["jitter_fraction"]] <- 0.01
         } else {
-          starter$jitter_fraction <- add + starter$jitter_fraction
+          starter[["jitter_fraction"]] <- add + starter[["jitter_fraction"]]
         }
         r4ss::SS_writestarter(starter, dir = temp_dir, overwrite = TRUE)
         r4ss::run(
@@ -169,7 +175,7 @@ rerun_profile_vals <- function(mydir,
           verbose = FALSE
         )
         mod <- r4ss::SS_output(dir = temp_dir, covar = FALSE, printstats = FALSE, verbose = FALSE)
-        like <- mod$likelihoods_used[1, 1]
+        like <- mod[["likelihoods_used"]][1, 1]
         if (like < like_check[i]) {
           break()
         }
@@ -227,16 +233,16 @@ rerun_profile_vals <- function(mydir,
   vec <- vec[num]
 
   profile_output <- list()
-  profile_output$mydir <- profile_dir
-  profile_output$para <- para
-  profile_output$name <- paste0("profile_", para)
-  profile_output$vec <- vec[num]
-  profile_output$model_settings <- model_settings
-  profile_output$profilemodels <- profilemodels
-  profile_output$profilesummary <- profilesummary
-  profile_output$rep <- rep
-  profile_output$vec_unordered <- vec
-  profile_output$num <- num
+  profile_output[["mydir"]] <- profile_dir
+  profile_output[["para"]] <- para
+  profile_output[["name"]] <- paste0("profile_", para)
+  profile_output[["vec"]] <- vec[num]
+  profile_output[["model_settings"]] <- model_settings
+  profile_output[["profilemodels"]] <- profilemodels
+  profile_output[["profilesummary"]] <- profilesummary
+  profile_output[["rep"]] <- rep
+  profile_output[["vec_unordered"]] <- vec
+  profile_output[["num"]] <- num
 
   save(
     profile_dir,
@@ -264,7 +270,7 @@ rerun_profile_vals <- function(mydir,
     mydir = profile_dir,
     para = para,
     vec = vec[num],
-    summary = oprofilesummary
+    summary = profilesummary
   )
 
   plot_profile(

R/run_diagnostics.R

@@ -14,7 +14,6 @@
 run_diagnostics <- function(mydir, model_settings) {
   exe <- r4ss::check_exe(exe = model_settings$exe, dir = file.path(mydir, model_settings[["base_name"]]))[["exe"]]
   model_settings[["exe"]] <- exe
-  "%>%" <- magrittr::"%>%"
 
   # Check for Report file
   model_dir <- file.path(mydir, paste0(model_settings[["base_name"]]))

R/run_profile.R

@@ -51,7 +51,6 @@ run_profile <- function(mydir, model_settings, para) {
     from = file.path(mydir, model_settings[["base_name"]], all_files),
     to = profile_dir, overwrite = TRUE
   ), file = "run_diag_warning.txt")
-  cli::cli_inform("Running profile for {para}.")
 
   # check for whether oldctlfile exists
   if (!file.exists(file.path(profile_dir, model_settings[["oldctlfile"]]))) {
@@ -66,7 +65,7 @@ run_profile <- function(mydir, model_settings, para) {
         exe = model_settings[["exe"]],
         extras = model_settings[["extras"]],
         skipfinished = FALSE,
-        verbose = model_settings[["verbose"]]
+        verbose = FALSE
       )
     } else {
       oldctlfile <- model_settings[["oldctlfile"]]
@@ -85,7 +84,7 @@ run_profile <- function(mydir, model_settings, para) {
 
   if (sum(check_para) == 0) {
     oldctlfile <- model_settings[["oldctlfile"]]
-    cli::cli_abort("The input of {para} does not match a parameter in the file {oldctlfile}")
+    cli::cli_abort("{para} does not match a parameter name in the {oldctlfile} file.")
   }
 
   # Copy oldctlfile to newctlfile before modifying it
@@ -130,6 +129,13 @@ run_profile <- function(mydir, model_settings, para) {
   }
   step_size <- model_settings[["profile_details"]][["step_size"]]
 
+  if((max(range) - min(range)) < step_size) {
+    cli::cli_abort(
+      "The step size of {step_size} appears to be set too large to
+        profile over {para} from value of {range[1]} to {range[2]}."
+    )
+  }
+
   # Create parameter vect from base down and the base up
   if (est != round_any(est, step_size, f = floor)) {
     low <- rev(seq(
@@ -150,8 +156,17 @@ run_profile <- function(mydir, model_settings, para) {
   }
 
   vec <- c(low, high)
+  if (est %in% vec) {
+    vec <- vec[!vec == est]
+  }
   num <- sort(vec, index.return = TRUE)[["ix"]]
 
+  if(model_settings[["verbose"]]) {
+    cli::cli_inform(
+      "Profiling over {para} across values of {sort(vec)}."
+    )
+  }
+
   # backup original control.ss_new file for use in second half of profile
   file.copy(file.path(profile_dir, model_settings[["oldctlfile"]]),
     file.path(profile_dir, "backup_oldctlfile.ss"),
@@ -202,7 +217,7 @@ run_profile <- function(mydir, model_settings, para) {
       whichruns = whichruns, # values set above
       prior_check = model_settings[["prior_check"]],
       exe = model_settings[["exe"]],
-      verbose = model_settings[["verbose"]],
+      verbose = FALSE,
       extras = model_settings[["extras"]]
     )
   }