From 6c428e2bad713c2469d7391e0ece4eef496d0bce Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Thu, 3 Oct 2024 08:28:16 -0700 Subject: [PATCH 1/4] refactor: add additional checks for profiles --- R/check_profile_range.R | 49 +++++++++++++++++++++++++++------------- R/get_settings_profile.R | 6 +++-- R/run_diagnostics.R | 1 - 3 files changed, 37 insertions(+), 19 deletions(-) diff --git a/R/check_profile_range.R b/R/check_profile_range.R index b55cd32..3cc3284 100644 --- a/R/check_profile_range.R +++ b/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)}." + ) + } } } diff --git a/R/get_settings_profile.R b/R/get_settings_profile.R index 6b01c59..f221f05 100644 --- a/R/get_settings_profile.R +++ b/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) } diff --git a/R/run_diagnostics.R b/R/run_diagnostics.R index 758d051..f0adfea 100644 --- a/R/run_diagnostics.R +++ b/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"]])) From 7748cfd0bf2e7e7428b2111a180f1332411afa35 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Thu, 3 Oct 2024 08:30:07 -0700 Subject: [PATCH 2/4] revise function inputs and example --- R/get_settings.R | 22 ++++++++++++++++------ man/get_settings.Rd | 16 +++++++++++----- 2 files changed, 27 insertions(+), 11 deletions(-) diff --git a/R/get_settings.R b/R/get_settings.R index 13a2b94..0cad5a7 100644 --- a/R/get_settings.R +++ b/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 diff --git a/man/get_settings.Rd b/man/get_settings.Rd index c3a5f21..bca1d7c 100644 --- a/man/get_settings.Rd +++ b/man/get_settings.Rd @@ -4,16 +4,18 @@ \alias{get_settings} \title{Check that all of the settings are in the list} \usage{ -get_settings(settings = NULL, verbose = FALSE) +get_settings(mydir = NULL, settings = NULL) } \arguments{ +\item{mydir}{Directory where model files are located. +There is no default entry for \code{mydir}. +An example of user input could be +\code{mydir = file.path("C:/my_models", "base_model")}.} + \item{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.} - -\item{verbose}{A logical value specifying if the message should be output to -the screen or not.} } \value{ A list of settings for running model diagnostics. @@ -22,7 +24,11 @@ A list of settings for running model diagnostics. Check that all of the settings are in the list } \examples{ -get_settings(list("Njitter" = 10)) +\dontrun{ + get_settings( + mydir = "directory" + settings = list("Njitter" = 10)) +} } \author{ From cad92eea9b60f73dbd4cb8a55bfbea96e5d6bc76 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Thu, 3 Oct 2024 08:30:55 -0700 Subject: [PATCH 3/4] refactor: add messages --- R/run_profile.R | 23 +++++++++++++++++++---- 1 file changed, 19 insertions(+), 4 deletions(-) diff --git a/R/run_profile.R b/R/run_profile.R index 4bc8550..cd3ee1b 100644 --- a/R/run_profile.R +++ b/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"]] ) } From 0ce45666b770eec1ea693eaa71ade7b199fea9be Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Thu, 3 Oct 2024 08:31:11 -0700 Subject: [PATCH 4/4] refactor: replace $ with [[]] --- R/rerun_profile_vals.R | 56 +++++++++++++++++++++++------------------- 1 file changed, 31 insertions(+), 25 deletions(-) diff --git a/R/rerun_profile_vals.R b/R/rerun_profile_vals.R index 0718c59..10af79c 100644 --- a/R/rerun_profile_vals.R +++ b/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,7 +154,7 @@ 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 @@ -156,9 +162,9 @@ rerun_profile_vals <- function(mydir, 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(