From 058f1808a2b3e063e8cb6fa86b65bab1c2d52627 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Thu, 26 Sep 2024 09:56:23 -0700 Subject: [PATCH 1/7] add vignette --- vignettes/.gitignore | 3 + vignettes/nwfscDiag.qmd | 188 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 191 insertions(+) create mode 100644 vignettes/.gitignore create mode 100644 vignettes/nwfscDiag.qmd diff --git a/vignettes/.gitignore b/vignettes/.gitignore new file mode 100644 index 0000000..849ed1a --- /dev/null +++ b/vignettes/.gitignore @@ -0,0 +1,3 @@ +*.html +*.R +nwfscDiag_files diff --git a/vignettes/nwfscDiag.qmd b/vignettes/nwfscDiag.qmd new file mode 100644 index 0000000..d1e57d4 --- /dev/null +++ b/vignettes/nwfscDiag.qmd @@ -0,0 +1,188 @@ +--- +title: "nwfscDiag" +author: "Chantel Wetzel" +format: html +editor: visual +--- + +# nwfscDiag: Diagnostic Package for West Coast Groundfish Assessments + +The package provides the functionality to conduct model diagnostics for Stock Synthesis (SS3) models. The standard diagnostic included in this package are standard required analysis for U.S. West Coast Groundfish stock assessments managed by the Pacific Fisheries Management Council. The package was designed to perform model diagnostics and create plots and tables in a standardized format. The standardized approach will facilitate the use of these outputs in the assessment template approach. + +The diagnostics created by the package are: - jitter runs to ensure model convergence at the Maximum Likelihood Estimate (MLE), - retrospective runs to examine model sensitivity to recent data, and\ +- likelihood profiles across parameters. + +This package does not maintain backward compatibility with previous versions of Stock Synthesis. However, if needed user can download older package versions that may work with older versions (3.30.+) of Stock Synthesis. + +## Installation + +nwfscDiag can be installed via github: + +``` +install.packages("remotes") +remotes::install_github("pfmc-assessments/nwfscDiag") +``` + +## Running the code + +The package depends upon a few other packages and they should be installed upon installation of the package. The dependent packages are: + +``` +install.packages('dplyr') +remotes::install_github('r4ss/r4ss') +``` + +A new version of r4ss package was released on July 29, 2022 that included some significant changes that are required for the current version of `nwfscDiag` to run. The current version of the nwfscDiag 1.1.2 package is designed to work with the latest release of r4ss. Please see release version 1.0.1 to use earlier versions of r4ss. + +## Example: Run all diagnostics + +First, you should specify the directory where the base model is located and where the diagnostics will be run and the name of the base model folder: + +``` +library(nwfscDiag) +directory <- "C:/your directory" +base_model_name <- "base model" +``` + +Another way to do handle directory management is by using a project file and the `here` package: + +``` +directory <- here::here("models") +base_model_name <- "base model" +``` + +The `get_settings_profile()` specifies which parameters to run a profile for and the parameter ranges for each profile. The low and high values can be specified in 3 ways: + +- as a 'multiplier' where a percent where the low and high range will be specified as x% of the base parameter (i.e., (base parameter - base parameter\* x) - (base parameter + base parameter \* x)), +- in 'real' space where the low and high values are in the parameter space, and +- as 'relative' where the low and high is a specified amount relative to the base model parameter (i.e., (base parameter - x) - (base parameter + x). + +Specify the parameters to profile over along with the parameter range and step size: + +``` +profile_info <- get_settings_profile( + parameters = c("NatM_uniform_Fem_GP_1", "SR_BH_steep", "SR_LN(R0)"), + low = c(0.40, 0.25, -2), + high = c(0.40, 1.0, 2), + step_size = c(0.005, 0.05, 0.25), + param_space = c('multiplier', 'real', 'relative') + ) +``` + +The `parameters` function argument specifies the parameters to profile over where the string provided should match the string label in the SS3 control file. The `low`, `high`, `step_size`, and `param_space` inputs should be vectors of equal length to the `parameters` input. The above example will profile over female natural mortality, steepness, and $R_0$. The female natural mortality parameter profile will range from (base parameter - base parameter\* x) to (base parameter + base parameter \* x) in steps of 0.005, the steepness parameter profile will range from 0.25 to 1.0 in step size of 0.05, and the $R_0$ parameter profile will range from ($R_0$ - 0.25) to ($R_0$ + 0.25) in step size of 0.25. + +Next the settings for running the profiles, jitter, and retrospectives within `r4ss` needs to be specified using `get_settings()`: + +``` +model_settings <- get_settings( + settings = list( + base_name = base_model_name, + run = c("jitter", "profile", "retro"), + profile_details = profile_info ) + ) +``` +where the above example requests jitters, profiles, and retrospective models to be run for the model file specified above as the `base_model_name` with the profile setting set using `get_settings_profile()` above. Calling `model_settings` in the R terminal will show all default settings. + +Run all diagnostics: +``` +run_diagnostics(mydir = directory, model_settings = model_settings) +``` + +## Example: Run a single profile + +``` +library(nwfscDiag) +directory <- here::here("models") +base_model_name <- "base model" + +profile_settings <- get_settings_profile( + parameters = c("SR_BH_steep"), + low = c(0.25), + high = c(1.0), + step_size = c(0.05), + param_space = c('real') + ) + +model_settings <- get_settings( + settings = list( + base_name = base_model_name, + run = "profile", + profile_details = profile_settings) + ) + +run_diagnostics(mydir = directory, model_settings = model_settings) + +``` + +## Example: Run jitters + +``` +library(nwfscDiag) +directory <- here::here("models") +base_model_name <- "base model" + +model_settings <- get_settings( + settings = list( + base_name = base_model_name, + run = "jitter", + Njitter = 100, + jitter_fraction = 0.10) + ) + +run_diagnostics(mydir = directory, model_settings = model_settings) + +``` + +## Example: Run retrospectives + +``` +library(nwfscDiag) +directory <- here::here("models") +base_model_name <- "base model" + +model_settings <- get_settings( + settings = list( + base_name = base_model_name, + run = "retro", + retro_yrs = -1:-10) + ) + +run_diagnostics(mydir = directory, model_settings = model_settings) + +``` + +## Example: Rerun select values for a profile + +There are instances where not all models runs within a parameter profile converge. In this case one needs to rerun only select models that failed to converge in the profile. The `rerun_profile_vals()` function allows users to do this. + +``` +library(nwfscDiag) +directory <- here::here("models") +base_model_name <- "base model" +rerun_profile_vals( + mydir = file.path(model_dir, base_name), + model_settings = model_settings, + para_name = "SR_LN(R0)", + run_num = c(6, 4,3,2), + data_file_nm = "base_model_data_file.dat") +``` +where the `run_num` is the number reported in the profile_SR_LN(RO))_results.csv file under the run column. Profiles are run out from the base model parameter value to lower or higher values to improve model convergence and hence, the run number reported in the csv is not sequential from the lower to upper bounds. + +## Example: Run jitters in parrallel + +`r4ss` v1.49.3+ supports running models in parallel. This can be particularly helpful when running jitters. In order to run jitters in parallel, additional specifications are needed outside the `nwfscDiag` package and some additional R packages (`parallelly`, `future`) need to be installed: + +``` +ncores <- parallelly::availableCores(omit = 1) +future::plan(future::multisession, workers = ncores) + +model_settings <- get_settings(settings = list( + exe = "ss3", + base_name = base_model, + run = "jitter", + Njitter = 100, + jitter_fraction = 0.10)) + +run_diagnostics(mydir = dir, model_settings = model_settings) +future::plan(future::sequential) +``` From ce092321507134672ecd37b4aab91bec6fed23dd Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Thu, 26 Sep 2024 09:56:55 -0700 Subject: [PATCH 2/7] add actions for packagedown and style --- .github/.gitignore | 2 ++ .github/workflows/call-doc-and-style-r.yml | 12 ++++++++++++ .github/workflows/call-update-pkgdown.yml | 10 ++++++++++ .github/workflows/r-cmd-check.yml | 6 +++--- 4 files changed, 27 insertions(+), 3 deletions(-) create mode 100644 .github/.gitignore create mode 100644 .github/workflows/call-doc-and-style-r.yml create mode 100644 .github/workflows/call-update-pkgdown.yml diff --git a/.github/.gitignore b/.github/.gitignore new file mode 100644 index 0000000..0c817ed --- /dev/null +++ b/.github/.gitignore @@ -0,0 +1,2 @@ +*.html +*.rds diff --git a/.github/workflows/call-doc-and-style-r.yml b/.github/workflows/call-doc-and-style-r.yml new file mode 100644 index 0000000..cca942d --- /dev/null +++ b/.github/workflows/call-doc-and-style-r.yml @@ -0,0 +1,12 @@ +# document and style R code using a reusable workflow +name: call-doc-and-style-r +# on specifies the build triggers. See more info at https://docs.github.com/en/actions/learn-github-actions/events-that-trigger-workflows +on: + # workflow_dispatch requires pushing a button to run the workflow manually. uncomment the following line to add: + workflow_dispatch: + push: + branches: [main] +jobs: + call-workflow: + uses: nmfs-fish-tools/ghactions4r/.github/workflows/doc-and-style-r.yml@main + diff --git a/.github/workflows/call-update-pkgdown.yml b/.github/workflows/call-update-pkgdown.yml new file mode 100644 index 0000000..c31bd7f --- /dev/null +++ b/.github/workflows/call-update-pkgdown.yml @@ -0,0 +1,10 @@ +on: + workflow_dispatch: + push: + branches: [main] + tags: ['*'] + +name: call-update-pkgdown +jobs: + call-workflow: + uses: nmfs-fish-tools/ghactions4r/.github/workflows/update-pkgdown.yml@main diff --git a/.github/workflows/r-cmd-check.yml b/.github/workflows/r-cmd-check.yml index c407bb5..91d1be6 100644 --- a/.github/workflows/r-cmd-check.yml +++ b/.github/workflows/r-cmd-check.yml @@ -13,9 +13,9 @@ on: # The push build trigger runs jobs when new commits are pushed up to github. push: # specifying branches means the workflow will only run on pushes to the branches listed, in this case, only main - branches: + branches: - main - - r4ss_1.46.1 + - r4ss_1.50.0 # The pull_request build trigger runs jobs when a pull request is made or commits are pushed to the pull request. pull_request: # specifying branches means the workflow will only run when the pull request is to the merge into the branch listed, in this case, main. @@ -59,7 +59,7 @@ jobs: sudo chmod a+x ss cp ss inst/extdata/simple/ss rm ss - + - name: run r-cmd-check using R env: _R_CHECK_CRAN_INCOMING_REMOTE_: false From cb86da019288f2fcb830bee3e4fa011d9021c384 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Wed, 2 Oct 2024 05:36:29 -0700 Subject: [PATCH 3/7] minor text edits --- vignettes/nwfscDiag.qmd | 70 ++++++++++++++++++++++------------------- 1 file changed, 37 insertions(+), 33 deletions(-) diff --git a/vignettes/nwfscDiag.qmd b/vignettes/nwfscDiag.qmd index d1e57d4..285c751 100644 --- a/vignettes/nwfscDiag.qmd +++ b/vignettes/nwfscDiag.qmd @@ -38,7 +38,7 @@ A new version of r4ss package was released on July 29, 2022 that included some s First, you should specify the directory where the base model is located and where the diagnostics will be run and the name of the base model folder: -``` +``` library(nwfscDiag) directory <- "C:/your directory" base_model_name <- "base model" @@ -46,7 +46,7 @@ base_model_name <- "base model" Another way to do handle directory management is by using a project file and the `here` package: -``` +``` directory <- here::here("models") base_model_name <- "base model" ``` @@ -73,50 +73,53 @@ The `parameters` function argument specifies the parameters to profile over wher Next the settings for running the profiles, jitter, and retrospectives within `r4ss` needs to be specified using `get_settings()`: -``` +``` model_settings <- get_settings( settings = list( base_name = base_model_name, - run = c("jitter", "profile", "retro"), - profile_details = profile_info ) - ) + run = c("jitter", "profile", "retro"), + profile_details = profile_info ) + ) ``` + where the above example requests jitters, profiles, and retrospective models to be run for the model file specified above as the `base_model_name` with the profile setting set using `get_settings_profile()` above. Calling `model_settings` in the R terminal will show all default settings. +If `profile` is included in the run requested and `verbose = TRUE` in the `model_settings()` the values for each parameter profiled across will be printed to the screen. Reviewing this information prior to running all diagnostics can be useful to ensure the parameter range and step size was set correctly. + Run all diagnostics: -``` + +``` run_diagnostics(mydir = directory, model_settings = model_settings) ``` ## Example: Run a single profile -``` +``` library(nwfscDiag) directory <- here::here("models") base_model_name <- "base model" profile_settings <- get_settings_profile( parameters = c("SR_BH_steep"), - low = c(0.25), - high = c(1.0), - step_size = c(0.05), - param_space = c('real') - ) + low = c(0.25), + high = c(1.0), + step_size = c(0.05), + param_space = c('real') + ) model_settings <- get_settings( settings = list( base_name = base_model_name, - run = "profile", - profile_details = profile_settings) - ) + run = "profile", + profile_details = profile_settings) + ) run_diagnostics(mydir = directory, model_settings = model_settings) - ``` ## Example: Run jitters -``` +``` library(nwfscDiag) directory <- here::here("models") base_model_name <- "base model" @@ -124,18 +127,17 @@ base_model_name <- "base model" model_settings <- get_settings( settings = list( base_name = base_model_name, - run = "jitter", - Njitter = 100, - jitter_fraction = 0.10) - ) + run = "jitter", + Njitter = 100, + jitter_fraction = 0.10) + ) run_diagnostics(mydir = directory, model_settings = model_settings) - ``` ## Example: Run retrospectives -``` +``` library(nwfscDiag) directory <- here::here("models") base_model_name <- "base model" @@ -143,19 +145,18 @@ base_model_name <- "base model" model_settings <- get_settings( settings = list( base_name = base_model_name, - run = "retro", - retro_yrs = -1:-10) - ) + run = "retro", + retro_yrs = -1:-10) + ) run_diagnostics(mydir = directory, model_settings = model_settings) - ``` ## Example: Rerun select values for a profile -There are instances where not all models runs within a parameter profile converge. In this case one needs to rerun only select models that failed to converge in the profile. The `rerun_profile_vals()` function allows users to do this. +There are instances where not all models runs within a parameter profile converge. In this case one needs to rerun only select models that failed to converge in the profile. The `rerun_profile_vals()` function allows users to do this. -``` +``` library(nwfscDiag) directory <- here::here("models") base_model_name <- "base model" @@ -166,13 +167,14 @@ rerun_profile_vals( run_num = c(6, 4,3,2), data_file_nm = "base_model_data_file.dat") ``` -where the `run_num` is the number reported in the profile_SR_LN(RO))_results.csv file under the run column. Profiles are run out from the base model parameter value to lower or higher values to improve model convergence and hence, the run number reported in the csv is not sequential from the lower to upper bounds. + +where the `run_num` is the number reported in the profile_SR_LN(RO))\_results.csv file under the run column. Profiles are run out from the base model parameter value to lower or higher values to improve model convergence and hence, the run number reported in the csv is not sequential from the lower to upper bounds. ## Example: Run jitters in parrallel -`r4ss` v1.49.3+ supports running models in parallel. This can be particularly helpful when running jitters. In order to run jitters in parallel, additional specifications are needed outside the `nwfscDiag` package and some additional R packages (`parallelly`, `future`) need to be installed: +`r4ss` v1.49.3+ supports running models in parallel. This can be particularly helpful when running jitters. In order to run jitters in parallel, additional specifications are needed outside the `nwfscDiag` package and some additional R packages (`parallelly`, `future`) need to be installed: -``` +``` ncores <- parallelly::availableCores(omit = 1) future::plan(future::multisession, workers = ncores) @@ -186,3 +188,5 @@ model_settings <- get_settings(settings = list( run_diagnostics(mydir = dir, model_settings = model_settings) future::plan(future::sequential) ``` + +This same approach could be done with profiles, but is not recommended for models with convergance issues. From fccf62fb6832670b286b22680c18e0258b28b10c Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Wed, 2 Oct 2024 10:32:23 -0700 Subject: [PATCH 4/7] change text output to csv The markdown file creation was not working and moving this to a csv file output aligns it with how this information is output for retrospectives. --- R/get_jitter_quants.R | 54 ++++++++++++++++++++++--------------------- 1 file changed, 28 insertions(+), 26 deletions(-) diff --git a/R/get_jitter_quants.R b/R/get_jitter_quants.R index 8946a2d..33a92fb 100644 --- a/R/get_jitter_quants.R +++ b/R/get_jitter_quants.R @@ -37,32 +37,34 @@ get_jitter_quants <- function(mydir, model_settings, output) { # Write a md file to be included in a stock assessment document # Text was pirated from @chantelwetzel-noaa's 2021 dover assessment - file_md <- file.path(jitter_dir, "model-results-jitter.md") - sink(file_md) - on.exit(sink(), add = TRUE) - cat( - sep = "", - "Model convergence was in part based on starting the minimization process ", - "from dispersed values of the maximum likelihood estimates to determine if the ", - "estimation routine results in a smaller likelihood.\n", - "Starting parameters were jittered using the built-in functionality of ", - "Stock Synthesis, where you specify a jitter fraction.\n", - "Here we used a jitter fraction of ", - round(model_settings$jitter_fraction, 2), " and the jittering was repeated ", - xfun::numbers_to_words(model_settings$Njitter), " times.\n", - "A better, i.e., lower negative log-likelihood, fit was ", - ifelse( - sum(like - est < 0) == 0, - "not found", - paste0("found for ", xfun::numbers_to_words(sum(like - est < 0)), " fits") - ), ".\n", - "Several models resulted in similar log-likelihood values ", - "with little difference in the overall model estimates, ", - "indicating a relatively flat likelihood surface around the maximum likelihood estimate.\n", - "Through the jittering analysis performed here and ", - "the estimation of likelihood profiles, ", - "we are confident that the base model as presented represents the ", - "best fit to the data given the assumptions made.\n" + utils::write.csv( + x = data.frame( + caption = paste( + sep = "", + "Model convergence was in part based on starting the minimization process ", + "from dispersed values of the maximum likelihood estimates to determine if the ", + "estimation routine results in a smaller likelihood.", + "Starting parameters were jittered using the built-in functionality of ", + "Stock Synthesis, where you specify a jitter fraction.", + "Here we used a jitter fraction of ", + round(model_settings[["jitter_fraction"]], 2), " and the jittering was repeated ", + xfun::numbers_to_words(model_settings[["Njitter"]]), " times.", + "A better, i.e., lower negative log-likelihood, fit was ", + ifelse( + sum(like - est < 0) == 0, + "not found", + paste0("found for ", xfun::numbers_to_words(sum(like - est < 0)), " fits") + ), + "Through the jittering analysis performed here and ", + "the estimation of likelihood profiles, ", + "we are confident that the base model as presented represents the ", + "best fit to the data given the assumptions made."), + alt_caption = "Comparison of the negative log-likelihood across jitter runs", + label = c("jitter", "jitter-zoomed"), + filein = file.path("..", jitter_dir, c("jitter.png", "jitter_zoomed.png")) + ), + file = file.path(jitter_dir, "jitterfigures4doc.csv"), + row.names = FALSE ) # write tables From e5bc0a600a786eb875529b33805c114dbef791ab Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Wed, 2 Oct 2024 10:33:01 -0700 Subject: [PATCH 5/7] refactor: eliminate the usage of $ to access info in lists --- R/get_jitter_quants.R | 6 +- R/get_param_values.R | 58 +++++++++--------- R/get_retro_quants.R | 4 +- R/get_settings.R | 14 ++--- R/get_summary.R | 7 +-- R/plot_jitter.R | 6 +- R/plot_retro.R | 46 ++++++++------- R/profile_plot.R | 60 +++++++++---------- R/profile_wrapper.R | 6 +- R/run_diagnostics.R | 18 +++--- R/run_jitter.R | 48 +++++++-------- R/run_profile.R | 126 ++++++++++++++++++++-------------------- R/run_retro.R | 66 ++++++++++----------- man/get_retro_quants.Rd | 2 +- man/run_retro.Rd | 2 +- 15 files changed, 236 insertions(+), 233 deletions(-) diff --git a/R/get_jitter_quants.R b/R/get_jitter_quants.R index 33a92fb..95b0e2e 100644 --- a/R/get_jitter_quants.R +++ b/R/get_jitter_quants.R @@ -20,16 +20,16 @@ get_jitter_quants <- function(mydir, model_settings, output) { est <- output[["est"]] profilesummary <- output[["profilesummary"]] - outputs <- output$profilemodels + outputs <- output[["profilemodels"]] quants <- lapply(outputs, "[[", "derived_quants") status <- sapply(sapply(outputs, "[[", "parameters", simplify = FALSE), "[[", "Status") - bounds <- apply(status, 2, function(x) rownames(outputs[[1]]$parameters)[x %in% c("LO", "HI")]) + bounds <- apply(status, 2, function(x) rownames(outputs[[1]][["parameters"]])[x %in% c("LO", "HI")]) out <- data.frame( "run" = gsub("replist", "", names(outputs)), "likelihood" = sapply(sapply(outputs, "[[", "likelihoods_used", simplify = FALSE), "[", 1, 1), "gradient" = sapply(outputs, "[[", "maximum_gradient_component"), "SB0" = sapply(quants, "[[", "SSB_Virgin", "Value"), - "SBfinal" = sapply(quants, "[[", paste0("SSB_", profilesummary$endyrs[1]), "Value"), + "SBfinal" = sapply(quants, "[[", paste0("SSB_", profilesummary[["endyrs"]][1]), "Value"), "Nparsonbounds" = apply(status, 2, function(x) sum(x %in% c("LO", "HI"))), "Lowest NLL" = ifelse(min(like) == like, "Best Fit", 0), stringsAsFactors = FALSE diff --git a/R/get_param_values.R b/R/get_param_values.R index c426add..d1d2e6b 100644 --- a/R/get_param_values.R +++ b/R/get_param_values.R @@ -16,36 +16,36 @@ get_param_values <- function(mydir, para = NULL, vec, summary) { x <- summary - n <- x$n - endyr <- x$endyrs[1] + 1 + n <- x[["n"]] + endyr <- x[["endyrs"]][1] + 1 out <- data.frame( - totlikelihood = as.numeric(x$likelihoods[x$likelihoods$Label == "TOTAL", 1:n]), - surveylike = as.numeric(x$likelihoods[x$likelihoods$Label == "Survey", 1:n]), - discardlike = as.numeric(x$likelihoods[x$likelihoods$Label == "Discard", 1:n]), - lengthlike = as.numeric(x$likelihoods[x$likelihoods$Label == "Length_comp", 1:n]), - agelike = as.numeric(x$likelihoods[x$likelihoods$Label == "Age_comp", 1:n]), - recrlike = as.numeric(x$likelihoods[x$likelihoods$Label == "Recruitment", 1:n]), - forerecrlike = as.numeric(x$likelihoods[x$likelihoods$Label == "Forecast_Recruitment", 1:n]), - priorlike = as.numeric(x$likelihoods[x$likelihoods$Label == "Parm_priors", 1:n]), - parmlike = as.numeric(x$likelihoods[x$likelihoods$Label == "Parm_devs", 1:n]), - R0 = as.numeric(x$pars[x$pars$Label == "SR_LN(R0)", 1:n]), - SB0 = as.numeric(x$SpawnBio[x$SpawnBio$Label == "SSB_Virgin", 1:n]), - SBfinal = as.numeric(x$SpawnBio[x$SpawnBio$Label == paste0("SSB_", endyr), 1:n]), - deplfinal = as.numeric(x$Bratio[x$Bratio$Label == paste0("Bratio_", endyr), 1:n]), - yieldspr = as.numeric(x$quants[x$quants$Label == "Dead_Catch_SPR", 1:n]), - steep = as.numeric(x$pars[x$pars$Label == "SR_BH_steep", 1:n]), - mfem = as.numeric(x$pars[x$pars$Label == "NatM_uniform_Fem_GP_1", 1:n]), - lminfem = as.numeric(x$pars[x$pars$Label == "L_at_Amin_Fem_GP_1", 1:n]), - lmaxfem = as.numeric(x$pars[x$pars$Label == "L_at_Amax_Fem_GP_1", 1:n]), - kfem = as.numeric(x$pars[x$pars$Label == "VonBert_K_Fem_GP_1", 1:n]), - cv1fem = as.numeric(x$pars[grep("young_Fem_GP_1", x$pars$Label), 1:n]), - cv2fem = as.numeric(x$pars[grep("old_Fem_GP_1", x$pars$Label), 1:n]), - mmale = as.numeric(x$pars[x$pars$Label == "NatM_uniform_Mal_GP_1", 1:n]), - lminmale = as.numeric(x$pars[x$pars$Label == "L_at_Amin_Mal_GP_1", 1:n]), - lmaxmale = as.numeric(x$pars[x$pars$Label == "L_at_Amax_Mal_GP_1", 1:n]), - kmale = as.numeric(x$pars[x$pars$Label == "VonBert_K_Mal_GP_1", 1:n]), - cv1male = as.numeric(x$pars[grep("young_Mal_GP_1", x$pars$Label), 1:n]), - cv2male = as.numeric(x$pars[grep("old_Mal_GP_1", x$pars$Label), 1:n]), + totlikelihood = as.numeric(x[["likelihoods"]][x[["likelihoods"]][["Label"]] == "TOTAL", 1:n]), + surveylike = as.numeric(x[["likelihoods"]][x[["likelihoods"]][["Label"]] == "Survey", 1:n]), + discardlike = as.numeric(x[["likelihoods"]][x[["likelihoods"]][["Label"]] == "Discard", 1:n]), + lengthlike = as.numeric(x[["likelihoods"]][x[["likelihoods"]][["Label"]] == "Length_comp", 1:n]), + agelike = as.numeric(x[["likelihoods"]][x[["likelihoods"]][["Label"]] == "Age_comp", 1:n]), + recrlike = as.numeric(x[["likelihoods"]][x[["likelihoods"]][["Label"]] == "Recruitment", 1:n]), + forerecrlike = as.numeric(x[["likelihoods"]][x[["likelihoods"]][["Label"]] == "Forecast_Recruitment", 1:n]), + priorlike = as.numeric(x[["likelihoods"]][x[["likelihoods"]][["Label"]] == "Parm_priors", 1:n]), + parmlike = as.numeric(x[["likelihoods"]][x[["likelihoods"]][["Label"]] == "Parm_devs", 1:n]), + R0 = as.numeric(x[["pars"]][x[["pars"]][["Label"]] == "SR_LN(R0)", 1:n]), + SB0 = as.numeric(x[["SpawnBio"]][x[["SpawnBio"]][["Label"]] == "SSB_Virgin", 1:n]), + SBfinal = as.numeric(x[["SpawnBio"]][x[["SpawnBio"]][["Label"]] == paste0("SSB_", endyr), 1:n]), + deplfinal = as.numeric(x[["Bratio"]][x[["Bratio"]][["Label"]] == paste0("Bratio_", endyr), 1:n]), + yieldspr = as.numeric(x[["quants"]][x[["quants"]][["Label"]] == "Dead_Catch_SPR", 1:n]), + steep = as.numeric(x[["pars"]][x[["pars"]][["Label"]] == "SR_BH_steep", 1:n]), + mfem = as.numeric(x[["pars"]][x[["pars"]][["Label"]] == "NatM_uniform_Fem_GP_1", 1:n]), + lminfem = as.numeric(x[["pars"]][x[["pars"]][["Label"]] == "L_at_Amin_Fem_GP_1", 1:n]), + lmaxfem = as.numeric(x[["pars"]][x[["pars"]][["Label"]] == "L_at_Amax_Fem_GP_1", 1:n]), + kfem = as.numeric(x[["pars"]][x[["pars"]][["Label"]] == "VonBert_K_Fem_GP_1", 1:n]), + cv1fem = as.numeric(x[["pars"]][grep("young_Fem_GP_1", x[["pars"]][["Label"]]), 1:n]), + cv2fem = as.numeric(x[["pars"]][grep("old_Fem_GP_1", x[["pars"]][["Label"]]), 1:n]), + mmale = as.numeric(x[["pars"]][x[["pars"]][["Label"]] == "NatM_uniform_Mal_GP_1", 1:n]), + lminmale = as.numeric(x[["pars"]][x[["pars"]][["Label"]] == "L_at_Amin_Mal_GP_1", 1:n]), + lmaxmale = as.numeric(x[["pars"]][x[["pars"]][["Label"]] == "L_at_Amax_Mal_GP_1", 1:n]), + kmale = as.numeric(x[["pars"]][x[["pars"]][["Label"]] == "VonBert_K_Mal_GP_1", 1:n]), + cv1male = as.numeric(x[["pars"]][grep("young_Mal_GP_1", x[["pars"]][["Label"]]), 1:n]), + cv2male = as.numeric(x[["pars"]][grep("old_Mal_GP_1", x[["pars"]][["Label"]]), 1:n]), stringsAsFactors = FALSE ) diff --git a/R/get_retro_quants.R b/R/get_retro_quants.R index bb0dffc..0378462 100644 --- a/R/get_retro_quants.R +++ b/R/get_retro_quants.R @@ -23,7 +23,7 @@ #' inside of an environment with `results = "asis"` #' to include a table of Mohn's rho values in a document. #' -#' `sa4ss::read_child(file.path(paste0(params$model, "_retro"), "mohnsrho.tex"))` +#' `sa4ss::read_child(file.path(paste0(params[["model"]], "_retro"), "mohnsrho.tex"))` #' #' #' @export @@ -47,7 +47,7 @@ get_retro_quants <- function(mydir, model_settings, output) { caption = paste( "Retrospective patterns for", c("spawning stock biomass (\\emph{SSB})", "fraction unfished"), - "when up to", xfun::numbers_to_words(max(abs(model_settings$retro_yr))), + "when up to", xfun::numbers_to_words(max(abs(model_settings[["retro_yrs"]]))), "years of data were removed from the base model.", "Mohn's rho (Mohn, 1999) values were", "recalculated for each peel given the removal of another year of data.", diff --git a/R/get_settings.R b/R/get_settings.R index 887937d..c4926ce 100644 --- a/R/get_settings.R +++ b/R/get_settings.R @@ -68,24 +68,24 @@ get_settings <- function(settings = NULL, verbose = FALSE) { subplots = c(1, 3) ) - Settings_all$profile_details <- get_settings_profile() + Settings_all[["profile_details"]] <- get_settings_profile() need <- !names(Settings_all) %in% names(settings) Settings_all <- c(settings, Settings_all[need]) # Check some items - if (!is.null(Settings_all$profile_details)) { - if (length(Settings_all$profile_details[is.na(Settings_all$profile_details)]) > 0) { + if (!is.null(Settings_all[["profile_details"]])) { + if (length(Settings_all[["profile_details"]][is.na(Settings_all[["profile_details"]])]) > 0) { cli::cli_abort( "Missing entry in the get_settings_profile data frame." ) } - if (!is.numeric(Settings_all$profile_details$low) & - !is.numeric(Settings_all$profile_details$high) & - !is.numeric(Settings_all$profile_details$step_size)) { + if (!is.numeric(Settings_all[["profile_details"]][["low"]]) & + !is.numeric(Settings_all[["profile_details"]][["high"]]) & + !is.numeric(Settings_all[["profile_details"]][["step_size"]])) { cli::cli_abort("There is a non-numeric value in the low, high, or step size field of the get_settings_profile data frame.") } - if (sum(!Settings_all$profile_details$param_space %in% c("real", "relative", "multiplier")) > 0) { + if (sum(!Settings_all[["profile_details"]][["param_space"]] %in% c("real", "relative", "multiplier")) > 0) { cli::cli_abort("The param_space column should be either real or relative in the get_settings_profile data frame.") } } diff --git a/R/get_summary.R b/R/get_summary.R index 8c6b07e..e80847c 100644 --- a/R/get_summary.R +++ b/R/get_summary.R @@ -22,7 +22,7 @@ get_summary <- function(mydir, para, vec, profilemodels, profilesummary) { outputs <- profilemodels quants <- lapply(outputs, "[[", "derived_quants") status <- sapply(sapply(outputs, "[[", "parameters", simplify = FALSE), "[[", "Status") - bounds <- apply(status, 2, function(x) rownames(outputs[[1]]$parameters)[x %in% c("LO", "HI")]) + bounds <- apply(status, 2, function(x) rownames(outputs[[1]][["parameters"]])[x %in% c("LO", "HI")]) out <- data.frame( "run" = gsub("replist", "", names(outputs)), @@ -31,9 +31,8 @@ get_summary <- function(mydir, para, vec, profilemodels, profilesummary) { "likelihood" = sapply(sapply(outputs, "[[", "likelihoods_used", simplify = FALSE), "[", 1, 1), "gradient" = sapply(outputs, "[[", "maximum_gradient_component"), "SB0" = sapply(quants, "[[", "SSB_Virgin", "Value"), - "SBfinal" = sapply(quants, "[[", paste0("SSB_", outputs[[1]]$endyr + 1), "Value"), - "Deplfinal" = sapply(quants, "[[", paste0("Bratio_", outputs[[1]]$endyr + 1), "Value"), - # "Fmsy" = sapply(quants, "[[", "annF_MSY", "Value"), + "SBfinal" = sapply(quants, "[[", paste0("SSB_", outputs[[1]][["endyr"]] + 1), "Value"), + "Deplfinal" = sapply(quants, "[[", paste0("Bratio_", outputs[[1]][["endyr"]] + 1), "Value"), "Nparsonbounds" = apply(status, 2, function(x) sum(x %in% c("LO", "HI"))), stringsAsFactors = FALSE ) diff --git a/R/plot_jitter.R b/R/plot_jitter.R index a18fd45..aef6e20 100644 --- a/R/plot_jitter.R +++ b/R/plot_jitter.R @@ -19,11 +19,11 @@ plot_jitter <- function(mydir, model_settings, output) { est <- output[["est"]] profilesummary <- output[["profilesummary"]] - ymax <- as.numeric(stats::quantile(unlist(profilesummary$likelihoods[1, keys]), 0.80)) + ymax <- as.numeric(stats::quantile(unlist(profilesummary[["likelihoods"]][1, keys]), 0.80)) ymin <- min(like - est) + 1 ylab <- "Change in negative log-likelihood" xlab <- "Iteration" - pngfun(wd = jitter_dir, file = paste0("Jitter_", model_settings$jitter_fraction, ".png"), h = 12, w = 9) + pngfun(wd = jitter_dir, file = "jitter.png", h = 12, w = 9) on.exit(grDevices::dev.off(), add = TRUE) plot(keys, like - est, ylim = c(ymin, ymax), cex.axis = 1.25, cex.lab = 1.25, @@ -48,7 +48,7 @@ plot_jitter <- function(mydir, model_settings, output) { ) if (ymax > 100) { - pngfun(wd = jitter_dir, file = paste0("Jitter_Zoomed_SubPlot_", model_settings$jitter_fraction, ".png"), h = 12, w = 9) + pngfun(wd = jitter_dir, file = "jitter_zoomed.png", h = 12, w = 9) on.exit(grDevices::dev.off(), add = TRUE) plot(keys, like - est, ylim = c(ymin, 100), cex.axis = 1.25, cex.lab = 1.25, diff --git a/R/plot_retro.R b/R/plot_retro.R index 0b04c7d..a7960d3 100644 --- a/R/plot_retro.R +++ b/R/plot_retro.R @@ -31,18 +31,19 @@ plot_retro <- function(mydir, model_settings, output) { legendlabels = c( "Base Model", sprintf("Data %.0f year%s", - model_settings$retro_yrs, - ifelse(abs(model_settings$retro_yrs) == 1, "", "s") + model_settings[["retro_yrs"]], + ifelse(abs(model_settings[["retro_yrs"]]) == 1, "", "s") ) ), - btarg = model_settings$btarg, - minbthresh = model_settings$minbthresh, + btarg = model_settings[["btarg"]], + minbthresh = model_settings[["minbthresh"]], ylimAdj = 1.2, plotdir = retro_dir, legendloc = "topright", print = TRUE, plot = FALSE, - pdf = FALSE + pdf = FALSE, + verbose = model_settings[["verbose"]] ) savedplotinfo <- mapply( FUN = r4ss::SSplotComparisons, @@ -52,9 +53,10 @@ plot_retro <- function(mydir, model_settings, output) { legendloc = "topleft", plotdir = retro_dir, ylimAdj = 1.2, - btarg = model_settings$btarg, - minbthresh = model_settings$minbthresh, - print = TRUE, plot = FALSE, pdf = FALSE + btarg = model_settings[["btarg"]], + minbthresh = model_settings[["minbthresh"]], + print = TRUE, plot = FALSE, pdf = FALSE, + verbose = model_settings[["verbose"]] ), subplot = c(8, 10), legendlabels = lapply( @@ -63,8 +65,8 @@ plot_retro <- function(mydir, model_settings, output) { c( "Base Model", sprintf("Data %.0f year%s (Revised Mohn's rho %.2f)", - model_settings$retro_yrs, - ifelse(abs(model_settings$retro_yrs) == 1, "", "s"), + model_settings[["retro_yrs"]], + ifelse(abs(model_settings[["retro_yrs"]]) == 1, "", "s"), rhosall[rownames(rhosall) == x, ] ) ) @@ -77,19 +79,20 @@ plot_retro <- function(mydir, model_settings, output) { legendlabels = c( "Base Model", sprintf("Data %.0f year%s", - model_settings$retro_yrs, - ifelse(abs(model_settings$retro_yrs) == 1, "", "s") + model_settings[["retro_yrs"]], + ifelse(abs(model_settings[["retro_yrs"]]) == 1, "", "s") ) ), - btarg = model_settings$btarg, - minbthresh = model_settings$minbthresh, + btarg = model_settings[["btarg"]], + minbthresh = model_settings[["minbthresh"]], subplot = c(2, 4), ylimAdj = 1.2, plotdir = retro_dir, legendloc = "topright", print = TRUE, plot = FALSE, - pdf = FALSE + pdf = FALSE, + verbose = model_settings[["verbose"]] ) savedplotinfo <- mapply( FUN = r4ss::SSplotComparisons, @@ -99,9 +102,10 @@ plot_retro <- function(mydir, model_settings, output) { legendloc = "topright", ylimAdj = 1.2, plotdir = retro_dir, - btarg = model_settings$btarg, - minbthresh = model_settings$minbthresh, - print = TRUE, plot = FALSE, pdf = FALSE + btarg = model_settings[["btarg"]], + minbthresh = model_settings[["minbthresh"]], + print = TRUE, plot = FALSE, pdf = FALSE, + verbose = model_settings[["verbose"]] ), subplot = c(2, 4), legendlabels = lapply( @@ -110,8 +114,8 @@ plot_retro <- function(mydir, model_settings, output) { c( "Base Model", sprintf("Data %.0f year%s (Revised Mohn's rho %.2f)", - model_settings$retro_yrs, - ifelse(abs(model_settings$retro_yrs) == 1, "", "s"), + model_settings[["retro_yrs"]], + ifelse(abs(model_settings[["retro_yrs"]]) == 1, "", "s"), rhosall[rownames(rhosall) == x, ] ) ) @@ -178,7 +182,7 @@ plot_retro <- function(mydir, model_settings, output) { df_out <- NULL y <- years for (a in 1:n){ - col_name <- paste0("per_diff_model", 1:n) + col_name <- paste0("per_diff_model", a) df_out <- rbind(df_out, df[df[["Yr"]] %in% y & df[["model"]] %in% col_name, ]) if (a == 1){ df_out[["model"]][df_out[["model"]] == col_name] <- "Base Model" diff --git a/R/profile_plot.R b/R/profile_plot.R index 9acf108..374a784 100644 --- a/R/profile_plot.R +++ b/R/profile_plot.R @@ -41,17 +41,17 @@ plot_profile <- function(mydir, rep, para, profilesummary) { exact <- TRUE } - n <- 1:profilesummary$n + n <- 1:profilesummary[["n"]] - like_comp <- unique(profilesummary$likelihoods_by_fleet$Label[ + like_comp <- unique(profilesummary[["likelihoods_by_fleet"]][["Label"]][ c( - -grep("_lambda", profilesummary$likelihoods_by_fleet$Label), - -grep("_N_use", profilesummary$likelihoods_by_fleet$Label), - -grep("_N_skip", profilesummary$likelihoods_by_fleet$Label) + -grep("_lambda", profilesummary[["likelihoods_by_fleet"]][["Label"]]), + -grep("_N_use", profilesummary[["likelihoods_by_fleet"]][["Label"]]), + -grep("_N_skip", profilesummary[["likelihoods_by_fleet"]][["Label"]]) ) ]) - ii <- which(profilesummary$likelihoods_by_fleet$Label %in% like_comp) - check <- stats::aggregate(ALL ~ Label, profilesummary$likelihoods_by_fleet[ii, ], FUN = sum) + ii <- which(profilesummary[["likelihoods_by_fleet"]][["Label"]] %in% like_comp) + check <- stats::aggregate(ALL ~ Label, profilesummary[["likelihoods_by_fleet"]][ii, ], FUN = sum) use <- check[which(check$ALL != 0), "Label"] # If present remove the likes that we don't typically show use <- use[which(!use %in% c("Disc_like", "Catch_like", "mnwt_like"))] @@ -71,7 +71,7 @@ plot_profile <- function(mydir, rep, para, profilesummary) { } # Determine the y-axis for the profile plot for all data types together - ymax1 <- max(profilesummary$likelihoods[1, n]) - min(profilesummary$likelihoods[1, n]) + ymax1 <- max(profilesummary[["likelihoods"]][1, n]) - min(profilesummary[["likelihoods"]][1, n]) if (ymax1 > 70) { ymax1 <- 70 } @@ -80,9 +80,9 @@ plot_profile <- function(mydir, rep, para, profilesummary) { } # Determine the y-axis for the piner profile plots by each data type - lab.row <- ncol(profilesummary$likelihoods) - ymax2 <- max(apply(profilesummary$likelihoods[-1, -lab.row], 1, max) - - apply(profilesummary$likelihoods[-1, -lab.row], 1, min)) + lab.row <- ncol(profilesummary[["likelihoods"]]) + ymax2 <- max(apply(profilesummary[["likelihoods"]][-1, -lab.row], 1, max) - + apply(profilesummary[["likelihoods"]][-1, -lab.row], 1, min)) if (ymax2 > 70) { ymax2 <- 70 } @@ -131,30 +131,30 @@ plot_profile <- function(mydir, rep, para, profilesummary) { ) } - maxyr <- min(profilesummary$endyrs + 1) - minyr <- max(profilesummary$startyrs) - est <- rep$parameters[rep$parameters$Label == para, "Value", 2] - sb0_est <- rep$derived_quants[rep$derived_quants$Label == "SSB_Virgin", "Value"] - sbf_est <- rep$derived_quants[rep$derived_quants$Label == paste0("SSB_", maxyr), "Value"] - depl_est <- rep$derived_quants[rep$derived_quants$Label == paste0("Bratio_", maxyr), "Value"] + maxyr <- min(profilesummary[["endyrs"]] + 1) + minyr <- max(profilesummary[["startyrs"]]) + est <- rep[["parameters"]][rep[["parameters"]][["Label"]] == para, "Value", 2] + sb0_est <- rep[["derived_quants"]][rep[["derived_quants"]][["Label"]] == "SSB_Virgin", "Value"] + sbf_est <- rep[["derived_quants"]][rep[["derived_quants"]][["Label"]] == paste0("SSB_", maxyr), "Value"] + depl_est <- rep[["derived_quants"]][rep[["derived_quants"]][["Label"]] == paste0("Bratio_", maxyr), "Value"] - x <- as.numeric(profilesummary$pars[profilesummary$pars$Label == para, n]) + x <- as.numeric(profilesummary[["pars"]][profilesummary[["pars"]][["Label"]] == para, n]) # determine whether to include the prior likelihood component in the likelihood profile starter <- r4ss::SS_readstarter(file = file.path(mydir, "starter.ss")) - like <- as.numeric(profilesummary$likelihoods[profilesummary$likelihoods$Label == "TOTAL", n] - - ifelse(starter$prior_like == 0, - profilesummary$likelihoods[profilesummary$likelihoods$Label == "Parm_priors", n], + like <- as.numeric(profilesummary[["likelihoods"]][profilesummary[["likelihoods"]][["Label"]] == "TOTAL", n] - + ifelse(starter[["prior_like"]] == 0, + profilesummary[["likelihoods"]][profilesummary[["likelihoods"]][["Label"]] == "Parm_priors", n], 0) - - rep$likelihoods_used[1, 1]) + rep[["likelihoods_used"]][1, 1]) ylike <- c(min(like) + ifelse(min(like) != 0, -0.5, 0), max(like)) - sb0 <- as.numeric(profilesummary$SpawnBio[stats::na.omit(profilesummary$SpawnBio$Label) == "SSB_Virgin", n]) - sbf <- as.numeric(profilesummary$SpawnBio[stats::na.omit(profilesummary$SpawnBio$Yr) == maxyr, n]) - depl <- as.numeric(profilesummary$Bratio[stats::na.omit(profilesummary$Bratio$Yr) == maxyr, n]) + sb0 <- as.numeric(profilesummary[["SpawnBio"]][stats::na.omit(profilesummary[["SpawnBio"]][["Label"]]) == "SSB_Virgin", n]) + sbf <- as.numeric(profilesummary[["SpawnBio"]][stats::na.omit(profilesummary[["SpawnBio"]][["Yr"]]) == maxyr, n]) + depl <- as.numeric(profilesummary[["Bratio"]][stats::na.omit(profilesummary[["Bratio"]][["Yr"]]) == maxyr, n]) # Get the relative management targets - only grab the first element since the targets should be the same - btarg <- as.numeric(profilesummary$btarg[1]) - thresh <- as.numeric(profilesummary$minbthresh[1]) # ifelse(btarg == 0.40, 0.25, ifelse(btarg == 0.25, 0.125, -1)) + btarg <- as.numeric(profilesummary[["btargs"]][1]) + thresh <- as.numeric(profilesummary[["minbthreshs"]][1]) pngfun(wd = mydir, file = paste0("parameter_panel_", para, ".png"), h = 7, w = 7) on.exit(grDevices::dev.off(), add = TRUE) @@ -181,13 +181,13 @@ plot_profile <- function(mydir, rep, para, profilesummary) { # parameter vs. SB0 plot(x, sb0, type = "l", lwd = 2, xlab = label, - ylab = ifelse(profilesummary$SpawnOutputUnits[1] == "numbers", + ylab = ifelse(profilesummary[["SpawnOutputUnits"]][1] == "numbers", expression(SO[0]), expression(SB[0])), ylim = c(0, max(sb0))) points(est, sb0_est, pch = 21, col = "black", bg = "blue", cex = 1.5) # parameter vs. SBfinal plot(x, sbf, type = "l", lwd = 2, xlab = label, - ylab = ifelse(profilesummary$SpawnOutputUnits[1] == "numbers", + ylab = ifelse(profilesummary[["SpawnOutputUnits"]][1] == "numbers", expression(SO[final]), expression(SB[final])), ylim = c(0, max(sbf))) points(est, sbf_est, pch = 21, col = "black", bg = "blue", cex = 1.5) @@ -217,7 +217,7 @@ plot_profile <- function(mydir, rep, para, profilesummary) { btarg = btarg, minbthresh = thresh, plotdir = mydir, - subplots = profilesummary$subplots, + subplots = profilesummary[["subplots"]], pdf = FALSE, print = TRUE, plot = FALSE, filenameprefix = paste0(para, "_trajectories_") ) diff --git a/R/profile_wrapper.R b/R/profile_wrapper.R index 062f280..0b3ea26 100644 --- a/R/profile_wrapper.R +++ b/R/profile_wrapper.R @@ -48,9 +48,9 @@ profile_wrapper <- function(mydir, model_settings) { get_summary( mydir = output[["mydir"]], para = para, - vec = output$profilesummary$pars %>% - dplyr::filter(Label == para) %>% - dplyr::select(dplyr::starts_with("rep")) %>% + vec = output[["profilesummary"]][["pars"]] |> + dplyr::filter(Label == para) |> + dplyr::select(dplyr::starts_with("rep")) |> as.vector(), profilemodels = output[["profilemodels"]], profilesummary = output[["profilesummary"]] diff --git a/R/run_diagnostics.R b/R/run_diagnostics.R index 4e722b5..dd2d4fe 100644 --- a/R/run_diagnostics.R +++ b/R/run_diagnostics.R @@ -13,12 +13,12 @@ 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 + 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)) + model_dir <- file.path(mydir, paste0(model_settings[["base_name"]])) if (!file.exists(file.path(model_dir, "Report.sso"))) { orig_dir <- getwd() @@ -26,23 +26,23 @@ run_diagnostics <- function(mydir, model_settings) { cli::cli_info("Running model in directory: {getwd()}") r4ss::run( dir = model_dir, - exe = model_settings$exe, - extras = model_settings$extras, + exe = model_settings[["exe"]], + extras = model_settings[["extras"]], skipfinished = FALSE, - verbose = model_settings$verbose + verbose = model_settings[["verbose"]] ) setwd(orig_dir) } - if ("retro" %in% model_settings$run) { + if ("retro" %in% model_settings[["run"]]) { retro_wrapper(mydir = mydir, model_settings = model_settings) } - if ("profile" %in% model_settings$run) { + if ("profile" %in% model_settings[["run"]]) { profile_wrapper(mydir = mydir, model_settings = model_settings) } - if ("jitter" %in% model_settings$run) { + if ("jitter" %in% model_settings[["run"]]) { jitter_wrapper(mydir = mydir, model_settings = model_settings) } } diff --git a/R/run_jitter.R b/R/run_jitter.R index 8bcbb16..70c2474 100644 --- a/R/run_jitter.R +++ b/R/run_jitter.R @@ -15,18 +15,18 @@ #' @export run_jitter <- function(mydir, model_settings) { - if (!file.exists(file.path(mydir, model_settings$base_name, "Report.sso"))) { + if (!file.exists(file.path(mydir, model_settings[["base_name"]], "Report.sso"))) { + base <- model_settings[["base_name"]] cli::cli_abort("There is no Report.sso file in the base model directory: - {file.path(mydir, model_settings$base_name}") - + {file.path(mydir, base}") } # Create a jitter folder with the same naming structure as the base model - jitter_dir <- file.path(mydir, paste0(model_settings$base_name, "_jitter_", model_settings$jitter_fraction)) + jitter_dir <- file.path(mydir, paste0(model_settings[["base_name"]], "_jitter_", model_settings[["jitter_fraction"]])) dir.create(jitter_dir, showWarnings = FALSE) - all_files <- list.files(file.path(mydir, model_settings$base_name)) + all_files <- list.files(file.path(mydir, model_settings[["base_name"]])) utils::capture.output(file.copy( - from = file.path(mydir, model_settings$base_name, all_files), + from = file.path(mydir, model_settings[["base_name"]], all_files), to = jitter_dir, overwrite = TRUE ), file = "run_diag_warning.txt") @@ -34,23 +34,23 @@ run_jitter <- function(mydir, model_settings) { r4ss::jitter( dir = jitter_dir, - exe = model_settings$exe, - Njitter = model_settings$Njitter, - printlikes = model_settings$printlikes, - verbose = model_settings$verbose, - jitter_fraction = model_settings$jitter_fraction, - init_values_src = model_settings$jitter_init_values_src, - extras = model_settings$extras + exe = model_settings[["exe"]], + Njitter = model_settings[["Njitter"]], + printlikes = model_settings[["printlikes"]], + verbose = model_settings[["verbose"]], + jitter_fraction = model_settings[["jitter_fraction"]], + init_values_src = model_settings[["jitter_init_values_src"]], + extras = model_settings[["extras"]] ) #### Read in results using other r4ss functions - keys <- 1:model_settings$Njitter + keys <- 1:model_settings[["Njitter"]] profilemodels <- r4ss::SSgetoutput( dirvec = jitter_dir, keyvec = keys, getcovar = FALSE, forecast = FALSE, - verbose = FALSE, + verbose = model_settings[["verbose"]], listlists = TRUE, underscore = FALSE, save.lists = FALSE @@ -68,18 +68,18 @@ run_jitter <- function(mydir, model_settings) { ) est <- base$likelihoods_used[1, 1] - like <- as.numeric(profilesummary$likelihoods[1, keys]) - ymax <- as.numeric(stats::quantile(unlist(profilesummary$likelihoods[1, keys]), 0.80)) + like <- as.numeric(profilesummary[["likelihoods"]][1, keys]) + ymax <- as.numeric(stats::quantile(unlist(profilesummary[["likelihoods"]][1, keys]), 0.80)) ymin <- min(like - est) + 1 jitter_output <- list() - jitter_output$plotdir <- jitter_dir - jitter_output$est <- est - jitter_output$keys <- keys - jitter_output$like <- like - jitter_output$model_settings <- model_settings - jitter_output$profilesummary <- profilesummary - jitter_output$profilemodels <- profilemodels + jitter_output[["plotdir"]] <- jitter_dir + jitter_output[["est"]] <- est + jitter_output[["keys"]] <- keys + jitter_output[["like"]] <- like + jitter_output[["model_settings"]] <- model_settings + jitter_output[["profilesummary"]] <- profilesummary + jitter_output[["profilemodels"]] <- profilemodels save( jitter_dir, diff --git a/R/run_profile.R b/R/run_profile.R index 708af97..d0916a8 100644 --- a/R/run_profile.R +++ b/R/run_profile.R @@ -38,28 +38,28 @@ run_profile <- function(mydir, model_settings, para) { # Create a profile folder with the same naming structure as the base model # Add a label to show if prior was used or not - profile_dir <- file.path(mydir, paste0(model_settings$base_name, "_profile_", para)) + profile_dir <- file.path(mydir, paste0(model_settings[["base_name"]], "_profile_", para)) dir.create(profile_dir, showWarnings = FALSE) # Check for existing files and delete - if (model_settings$remove_files & length(list.files(profile_dir)) != 0) { + if (model_settings[["remove_files"]] & length(list.files(profile_dir)) != 0) { remove <- list.files(profile_dir) file.remove(file.path(profile_dir, remove)) } - all_files <- list.files(file.path(mydir, model_settings$base_name)) + all_files <- list.files(file.path(mydir, model_settings[["base_name"]])) utils::capture.output(file.copy( - from = file.path(mydir, model_settings$base_name, all_files), + 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))) { + if (!file.exists(file.path(profile_dir, model_settings[["oldctlfile"]]))) { # if the oldctlfile is control.ss_new, and doesn't exist, # run the model to create it - if (model_settings$oldctlfile == "control.ss_new") { - if (model_settings$verbose) { + if (model_settings[["oldctlfile"]] == "control.ss_new") { + if (model_settings[["verbose"]]) { message("running model to get control.ss_new file") } r4ss::run( @@ -70,64 +70,64 @@ run_profile <- function(mydir, model_settings, para) { verbose = model_settings[["verbose"]] ) } else { - cli::cli_abort("Can not find {model_settings$oldctlfile}") + oldctlfile <- model_settings[["oldctlfile"]] + cli::cli_abort("Can not find {ctl_file}") } } # 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 = profile_dir, verbose = FALSE, - version = model_settings$version, + version = model_settings[["version"]], active = FALSE )$Label == para if (sum(check_para) == 0) { - print(para) - cli::cli_abort("The input profile_custom does not match a parameter in the file - {model_settings$oldctlfile}") + oldctlfile <- model_settings[["oldctlfile"]] + cli::cli_abort("The input of {para} does not match a parameter in the file {oldctlfile}") } # Copy oldctlfile to newctlfile before modifying it - file.copy(file.path(profile_dir, model_settings$oldctlfile), - file.path(profile_dir, model_settings$newctlfile)) + file.copy(file.path(profile_dir, model_settings[["oldctlfile"]]), + file.path(profile_dir, model_settings[["newctlfile"]])) # Change the control file name in the starter file starter <- r4ss::SS_readstarter(file = file.path(profile_dir, "starter.ss")) - starter$ctlfile <- model_settings$newctlfile - starter$init_values_src <- model_settings$init_values_src + starter[["ctlfile"]] <- model_settings[["newctlfile"]] + starter[["init_values_src"]] <- model_settings[["init_values_src"]] r4ss::SS_writestarter(mylist = starter, dir = profile_dir, overwrite = TRUE) # 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 ) - est <- rep$parameters[rep$parameters$Label == para, "Value"] + est <- rep[["parameters"]][rep[["parameters"]][["Label"]] == para, "Value"] # Determine the parameter range - if (model_settings$profile_details$param_space == "relative") { + if (model_settings[["profile_details"]][["param_space"]] == "relative") { range <- c( - est + model_settings$profile_details$low, - est + model_settings$profile_details$high + est + model_settings[["profile_details"]][["low"]], + est + model_settings[["profile_details"]][["high"]] ) } - if (model_settings$profile_details$param_space == "multiplier") { + if (model_settings[["profile_details"]][["param_space"]] == "multiplier") { range <- c( - est - est * model_settings$profile_details$low, - est + est * model_settings$profile_details$high + est - est * model_settings[["profile_details"]][["low"]], + est + est * model_settings[["profile_details"]][["high"]] ) } - if (model_settings$profile_details$param_space == "real") { + if (model_settings[["profile_details"]][["param_space"]] == "real") { range <- c( - model_settings$profile_details$low, - model_settings$profile_details$high + model_settings[["profile_details"]][["low"]], + model_settings[["profile_details"]][["high"]] ) } - step_size <- model_settings$profile_details$step_size + step_size <- model_settings[["profile_details"]][["step_size"]] # Create parameter vect from base down and the base up if (est != round_any(est, step_size, f = floor)) { @@ -149,51 +149,51 @@ run_profile <- function(mydir, model_settings, para) { } vec <- c(low, high) - num <- sort(vec, index.return = TRUE)$ix + num <- sort(vec, index.return = TRUE)[["ix"]] # backup original control.ss_new file for use in second half of profile - file.copy(file.path(profile_dir, model_settings$oldctlfile), + file.copy(file.path(profile_dir, model_settings[["oldctlfile"]]), file.path(profile_dir, "backup_oldctlfile.ss"), overwrite = model_settings$overwrite) # backup original par file for use in second half of profile # if usepar = TRUE file.copy(file.path(profile_dir, "ss.par"), file.path(profile_dir, "backup_ss.par"), - overwrite = model_settings$overwrite) + overwrite = model_settings[["overwrite"]]) # loop over down, then up for (iprofile in 1:2) { whichruns <- which(vec %in% if(iprofile == 1){low} else {high}) - if (!is.null(model_settings$whichruns)) { - whichruns <- intersect(model_settings$whichruns, whichruns) + if (!is.null(model_settings[["whichruns"]])) { + whichruns <- intersect(model_settings[["whichruns"]], whichruns) } if (iprofile == 2) { # copy backup back to use in second half of profile file.copy(file.path(profile_dir, "backup_oldctlfile.ss"), - file.path(profile_dir, model_settings$oldctlfile)) + file.path(profile_dir, model_settings[["oldctlfile"]])) # copy backup back to use in second half of profile file.copy(file.path(profile_dir, "backup_ss.par"), file.path(profile_dir, "ss.par"), - overwrite = model_settings$overwrite) + overwrite = model_settings[["overwrite"]]) } profile <- r4ss::profile( dir = profile_dir, - oldctlfile = model_settings$oldctlfile, - newctlfile = model_settings$newctlfile, - linenum = model_settings$linenum, + oldctlfile = model_settings[["oldctlfile"]], + newctlfile = model_settings[["newctlfile"]], + linenum = model_settings[["linenum"]], string = para, profilevec = vec, - usepar = model_settings$usepar, - globalpar = model_settings$globalpar, - parlinenum = model_settings$parlinenum, - parstring = model_settings$parstring, - saveoutput = model_settings$saveoutput, - overwrite = model_settings$overwrite, + usepar = model_settings[["usepar"]], + globalpar = model_settings[["globalpar"]], + parlinenum = model_settings[["parlinenum"]], + parstring = model_settings[["parstring"]], + saveoutput = model_settings[["saveoutput"]], + overwrite = model_settings[["overwrite"]], whichruns = whichruns, # values set above - prior_check = model_settings$prior_check, - exe = model_settings$exe, - verbose = model_settings$verbose, - extras = model_settings$extras + prior_check = model_settings[["prior_check"]], + exe = model_settings[["exe"]], + verbose = model_settings[["verbose"]], + extras = model_settings[["extras"]] ) } @@ -204,23 +204,23 @@ run_profile <- function(mydir, model_settings, para) { profilemodels <- r4ss::SSgetoutput(dirvec = profile_dir, keyvec = num) profilesummary <- r4ss::SSsummarize(biglist = profilemodels) - if(!is.null(model_settings$btarg)){ - profilesummary$btarg <- model_settings$btarg - profilesummary$minbthresh <- model_settings$minbthresh + if(!is.null(model_settings[["btarg"]])){ + profilesummary[["btarg"]] <- model_settings[["btarg"]] + profilesummary[["minbthresh"]] <- model_settings[["minbthresh"]] } - profilesummary$subplots <- model_settings$subplots + profilesummary[["subplots"]] <- model_settings[["subplots"]] 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, diff --git a/R/run_retro.R b/R/run_retro.R index 2ecd7a0..9f8a475 100644 --- a/R/run_retro.R +++ b/R/run_retro.R @@ -34,7 +34,7 @@ #' inside of an environment with `results = "asis"` #' to include a table of Mohn's rho values in a document. #' -#' `sa4ss::read_child(file.path(paste0(params$model, "_retro"), "mohnsrho.tex"))` +#' `sa4ss::read_child(file.path(paste0(params[["model"]], "_retro"), "mohnsrho.tex"))` #' #' * `retro_output.Rdata` with a list of R objects. #' @@ -42,18 +42,17 @@ run_retro <- function(mydir, model_settings) { - if(!file.exists(file.path(mydir, model_settings$base_name, "Report.sso"))) { - cli::cli_abort("There is no Report.sso file in the base model directory - {file.path(mydir, model_settings$base_name)}") - + if(!file.exists(file.path(mydir, model_settings[["base_name"]], "Report.sso"))) { + base <- model_settings[["base_name"]] + cli::cli_abort("There is no Report.sso file in the base model directory {file.path(mydir, base}") } # Create a jitter folder with the same naming structure as the base model - retro_dir <- file.path(mydir, paste0(model_settings$base_name, "_retro_", length(model_settings$retro_yrs), "_yr_peel")) + retro_dir <- file.path(mydir, paste0(model_settings[["base_name"]], "_retro_", length(model_settings[["retro_yrs"]]), "_yr_peel")) dir.create(retro_dir, showWarnings = FALSE) - all_files = list.files(file.path(mydir, model_settings$base_name)) + all_files = list.files(file.path(mydir, model_settings[["base_name"]])) ignore <- file.copy( - from = file.path(mydir, model_settings$base_name, all_files), + from = file.path(mydir, model_settings[["base_name"]], all_files), to = retro_dir, overwrite = TRUE ) @@ -61,29 +60,30 @@ run_retro <- function(mydir, model_settings) { r4ss::retro( dir = retro_dir, - oldsubdir = model_settings$oldsubdir, - newsubdir = model_settings$newsubdir, - years = model_settings$retro_yrs, - overwrite = model_settings$overwrite, - exe = model_settings$exe, - extras = model_settings$extras, - show_in_console = model_settings$show_in_console + oldsubdir = model_settings[["oldsubdir"]], + newsubdir = model_settings[["newsubdir"]], + years = model_settings[["retro_yrs"]], + overwrite = model_settings[["overwrite"]], + exe = model_settings[["exe"]], + extras = model_settings[["extras"]], + show_in_console = model_settings[["show_in_console"]], + verbose = model_settings[["verbose"]] ) ignore <- file.remove(from = file.path(retro_dir, all_files)) runs <- list() - for(aa in 1:(length(model_settings$retro_yrs) + 1)) { + for(aa in 1:(length(model_settings[["retro_yrs"]]) + 1)) { if (aa == 1) { - runs[[aa]] <- r4ss::SS_output(dir = file.path(mydir, model_settings$base_name), verbose = FALSE, printstats = FALSE) + runs[[aa]] <- r4ss::SS_output(dir = file.path(mydir, model_settings[["base_name"]]), verbose = FALSE, printstats = FALSE) } else { - tmp = file.path(retro_dir, model_settings$newsubdir, paste0("retro", model_settings$retro_yrs[aa-1])) + tmp = file.path(retro_dir, model_settings[["newsubdir"]], paste0("retro", model_settings[["retro_yrs"]][aa-1])) runs[[aa]] <- r4ss::SS_output(dir = tmp, verbose = FALSE, printstats = FALSE) } } - retroSummary <- r4ss::SSsummarize(biglist = runs, verbose = FALSE) - endyrvec <- c(retroSummary$endyrs[1], retroSummary$endyrs[1] + model_settings$retro_yrs) + retroSummary <- r4ss::SSsummarize(biglist = runs, verbose = model_settings[["verbose"]]) + endyrvec <- c(retroSummary[["endyrs"]][1], retroSummary[["endyrs"]][1] + model_settings[["retro_yrs"]]) # Calculate Mohn's rho rhosall <- mapply( @@ -92,13 +92,13 @@ run_retro <- function(mydir, model_settings) { seq_along(runs)[-1], function(x) r4ss::SSsummarize(runs[1:x], verbose = FALSE) ), - endyrvec = mapply(seq,from=endyrvec[1], to= endyrvec[-1]) + verbose = model_settings[["verbose"]], + endyrvec = mapply(seq, from = endyrvec[1], to = endyrvec[-1]) ) - rhos <- rhosall %>% - data.frame %>% - dplyr::select(values = NCOL(rhosall)) %>% - tibble::rownames_to_column("ind") %>% + rhos <- data.frame(rhosall) |> + dplyr::select(values = NCOL(rhosall)) |> + tibble::rownames_to_column("ind") |> dplyr::mutate( ind = gsub("\\.all$", "", ind), Quantity = gsub("[A-Za-z_]+_([A-Za-z]+$)|(^[A-Za-z]+$)", "\\1\\2", ind), @@ -108,8 +108,8 @@ run_retro <- function(mydir, model_settings) { ind = gsub("^$", "Mohn", ind), ind = gsub("WoodHole", "NEFSC", ind), ind = gsub("_Hurtado", "", ind), - ) %>% - dplyr::rename(type = "ind") %>% + ) |> + dplyr::rename(type = "ind") |> dplyr::select(type, Quantity, values) utils::write.csv( x = as.matrix(rhos), @@ -118,12 +118,12 @@ run_retro <- function(mydir, model_settings) { ) retro_output <- list() - retro_output$plotdir <- retro_dir - retro_output$endyrvec <- endyrvec - retro_output$retroSummary <- retroSummary - retro_output$model_settings <- model_settings - retro_output$rhosall <- rhosall - retro_output$rhos <- rhos + retro_output[["plotdir"]] <- retro_dir + retro_output[["endyrvec"]] <- endyrvec + retro_output[["retroSummary"]] <- retroSummary + retro_output[["model_settings"]] <- model_settings + retro_output[["rhosall"]] <- rhosall + retro_output[["rhos"]] <- rhos save( retro_dir, diff --git a/man/get_retro_quants.Rd b/man/get_retro_quants.Rd index dd2d4d0..9a05aba 100644 --- a/man/get_retro_quants.Rd +++ b/man/get_retro_quants.Rd @@ -39,7 +39,7 @@ The following objects are saved to the disk. inside of an environment with \code{results = "asis"} to include a table of Mohn's rho values in a document. -\code{sa4ss::read_child(file.path(paste0(params$model, "_retro"), "mohnsrho.tex"))} +\code{sa4ss::read_child(file.path(paste0(params[["model"]], "_retro"), "mohnsrho.tex"))} } } \description{ diff --git a/man/run_retro.Rd b/man/run_retro.Rd index 7d38abe..f41caf5 100644 --- a/man/run_retro.Rd +++ b/man/run_retro.Rd @@ -41,7 +41,7 @@ complete with captions and alternative text. inside of an environment with \code{results = "asis"} to include a table of Mohn's rho values in a document. -\code{sa4ss::read_child(file.path(paste0(params$model, "_retro"), "mohnsrho.tex"))} +\code{sa4ss::read_child(file.path(paste0(params[["model"]], "_retro"), "mohnsrho.tex"))} \item \code{retro_output.Rdata} with a list of R objects. } } From 6a1455eb03f2a50d645e9595829428cfb1d9d537 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Wed, 2 Oct 2024 10:39:19 -0700 Subject: [PATCH 6/7] refactor: switch to dplyr::case_when and dplyr::if_else --- R/get_jitter_quants.R | 6 +++--- R/profile_plot.R | 13 +++++-------- 2 files changed, 8 insertions(+), 11 deletions(-) diff --git a/R/get_jitter_quants.R b/R/get_jitter_quants.R index 95b0e2e..bb7d54d 100644 --- a/R/get_jitter_quants.R +++ b/R/get_jitter_quants.R @@ -50,10 +50,10 @@ get_jitter_quants <- function(mydir, model_settings, output) { round(model_settings[["jitter_fraction"]], 2), " and the jittering was repeated ", xfun::numbers_to_words(model_settings[["Njitter"]]), " times.", "A better, i.e., lower negative log-likelihood, fit was ", - ifelse( + dplyr::if_else( sum(like - est < 0) == 0, - "not found", - paste0("found for ", xfun::numbers_to_words(sum(like - est < 0)), " fits") + true = "not found", + false = paste0("found for ", xfun::numbers_to_words(sum(like - est < 0)), " fits") ), "Through the jittering analysis performed here and ", "the estimation of likelihood profiles, ", diff --git a/R/profile_plot.R b/R/profile_plot.R index 374a784..22f7c13 100644 --- a/R/profile_plot.R +++ b/R/profile_plot.R @@ -193,14 +193,11 @@ plot_profile <- function(mydir, rep, para, profilesummary) { # Create the sb and depl trajectories plot # Figure out what the base model parameter is in order to label that in the plot - get <- ifelse(para == "SR_LN(R0)", "log(R0)", - ifelse(para %in% c("NatM_uniform_Fem_GP_1", "NatM_p_1_Fem_GP_1"), "M (f)", - ifelse(para %in% c("NatM_uniform_Mal_GP_1", "NatM_p_1_Mal_GP_1"), "M (m)", - ifelse(para == "SR_BH_steep", "h", - para - ) - ) - ) + get <- dplyr::case_when( + para == "SR_LN(R0)" ~ "log(R0)", + para %in% c("NatM_uniform_Fem_GP_1", "NatM_p_1_Fem_GP_1") ~ "M (f)", + para %in% c("NatM_uniform_Mal_GP_1", "NatM_p_1_Mal_GP_1") ~ "M (m)", + para == "SR_BH_steep" ~ "h" ) r4ss::SSplotComparisons( From c908e2ef9abd59c842948297dcd7f9cabd15d625 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Wed, 2 Oct 2024 10:46:56 -0700 Subject: [PATCH 7/7] minor text edit --- vignettes/nwfscDiag.qmd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/vignettes/nwfscDiag.qmd b/vignettes/nwfscDiag.qmd index 285c751..86bb5d6 100644 --- a/vignettes/nwfscDiag.qmd +++ b/vignettes/nwfscDiag.qmd @@ -84,7 +84,7 @@ model_settings <- get_settings( where the above example requests jitters, profiles, and retrospective models to be run for the model file specified above as the `base_model_name` with the profile setting set using `get_settings_profile()` above. Calling `model_settings` in the R terminal will show all default settings. -If `profile` is included in the run requested and `verbose = TRUE` in the `model_settings()` the values for each parameter profiled across will be printed to the screen. Reviewing this information prior to running all diagnostics can be useful to ensure the parameter range and step size was set correctly. +If `profile` is included in the run requested and `verbose = TRUE` in the `model_settings()` the values for each parameter profiled across will be printed to the screen. Reviewing this information prior to running all diagnostics can be useful to ensure the parameter range and step size was set correctly. Run all diagnostics: @@ -189,4 +189,4 @@ run_diagnostics(mydir = dir, model_settings = model_settings) future::plan(future::sequential) ``` -This same approach could be done with profiles, but is not recommended for models with convergance issues. +This same approach could be done with profiles, but is not recommended for models with convergence issues.