Merge pull request #19 from nwfsc-assess/r4ss_1.46.1

Updates based on r4ss version 1.46.1

.github/workflows/r-cmd-check.yml

@@ -0,0 +1,102 @@
+# Download the stock synthesis executable, then Run r cmd check
+
+# Name of the workflow, which will be what it is called under the "actions" tab
+name: r-cmd-check
+# on specifies the build triggers. Learn more at https://docs.github.com/en/actions/using-workflows/events-that-trigger-workflows
+on:
+  # The schedule build trigger runs the workflow at a scheduled time.
+  schedule:
+    # This should run the default branch (typically main) weekly on sunday at 2:45am UTC
+    - cron: '01 3 * * 2'
+  # The workflow_dispatch build trigger adds a button so that you can start workflows manually.
+  workflow_dispatch:
+  # 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: 
+      - main
+      - r4ss_1.46.1
+  # 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.
+    branches:
+      -main
+# jobs specifies the jobs to run. you can have multiple jobs per github actions workflow, but in this case we have only one, which is
+# named run-R-CMD-check.
+jobs:
+  run-R-CMD-check:
+    # the operating system to run on
+    runs-on: 'ubuntu-latest'
+    strategy:
+      fail-fast: false
+    # environment settings, needed for running r (first 2 settings) and downloading from github (GITHUB_PAT)
+    env:
+      R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
+      RSPM: 'https://packagemanager.rstudio.com/cran/__linux__/focal/latest'
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+
+    steps:
+      - name: Checkout github repository, in this case nwfscDiags
+        uses: actions/checkout@v2
+
+      - name: Set up R
+        uses: r-lib/actions/setup-r@master
+        with:
+          r-version: 'release'
+
+      - name: Setup pandoc, in case of vignettes in the R package
+        uses: r-lib/actions/setup-pandoc@master
+
+      - name: Query dependencies for the r package
+        run: |
+          install.packages('remotes')
+          saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2)
+          writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version")
+        shell: Rscript {0}
+
+      - name: Cache R packages to speed up future runs
+        uses: actions/cache@v2
+        with:
+          path: ${{ env.R_LIBS_USER }}
+          key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }}
+          restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-
+
+      - name: Install system dependencies for linux
+        run: |
+          while read -r cmd
+          do
+            eval sudo $cmd
+          done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))')
+          
+      - name: Install r package dependencies
+        run: |
+          remotes::install_deps(dependencies = TRUE)
+          remotes::install_cran("devtools")
+          remotes::install_cran("covr") # needed if calcing codecoverage.
+        shell: Rscript {0}
+
+      - name: Get the latest release SS3 executable and move to expected location
+        run: |
+          curl https://api.github.com/repos/nmfs-stock-synthesis/stock-synthesis/releases/latest | grep "browser_download_url" | grep -Eo 'https://[^\"]*' | grep "ss_linux" | xargs wget
+          mv ss_linux ss
+          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
+        run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "error", check_dir = "check")
+        shell: Rscript {0}
+
+      - name: Show testthat output
+        if: always()
+        run: find check -name 'testthat.Rout*' -exec cat '{}' \; || true
+        shell: bash
+
+      - name: Upload check results
+        if: failure()
+        uses: actions/upload-artifact@main
+        with:
+          name: 'linux-release-results'
+          path: check

.gitignore

@@ -2,3 +2,5 @@
 .Rhistory
 .RData
 .Ruserdata
+
+tests/test-runs-output

DESCRIPTION

@@ -1,10 +1,10 @@
 Package: nwfscDiag
 Type: Package
 Title: Generate standard NWFSC assessment diagnostics
-Version: 1.0
+Version: 1.1.0
 Author: Chantel Wetzel
 Maintainer: Chantel Wetzel <[email protected]>
-Description: Package that can create jitter runs, retrospective runs, and profiles over SS parameters.  
+Description: Package that can automates diagnositics for SS3 models by running jitters, retrospective, and profiles.  
 License: What license is it under?
 URL: https://github.com/nwfsc-assess/nwfscDiag
 BugReports: https://github.com/nwfsc-assess/nwfscDiag/issues
@@ -15,11 +15,13 @@ Imports:
   dplyr,
   kableExtra,
   knitr,
-	plyr,
 	r4ss (>= 1.38.0),
 	tidyr,
 	utils,
-	xfun
+	xfun,
+	testthat
+Suggests:
+  devtools
 Remotes: 
 	github::r4ss/r4ss
 RoxygenNote: 7.1.1

R/get_settings.R

@@ -13,86 +13,79 @@
 #'
 #' @examples
 #' get_settings(list("Njitter" = 10))
-#' 
+#'
 #' settings <- list()
-
+#'
 get_settings <- function(settings = NULL, verbose = FALSE) {
-
   if (is.vector(settings)) settings <- as.list(settings)
 
-  Settings_all = list(
-    base_name = "model", 
+  Settings_all <- list(
+    base_name = "model",
     para_offset = FALSE,
     run = c("jitter", "profile", "retro"),
     profile_details = NULL,
+    version = "3.30",
+    exe = "ss",
+    verbose = FALSE,
 
-  	# Jitter Settings
-    model = "ss",
+    # Jitter Settings
     extras = "-nohess",
     Njitter = 100,
-    Intern = TRUE,
-    systemcmd = FALSE,
+    show_in_console = TRUE,
     printlikes = FALSE,
-    verbose = FALSE,
     jitter_fraction = 0.05,
     jitter_init_values_src = NULL,
-    
+
     # Retrospective Settings
     oldsubdir = "",
-    newsubdir = 'retro',
+    newsubdir = "retro",
     retro_yrs = -1:-5,
     overwrite = TRUE,
-    intern = FALSE,
-    CallType = "system",
-    RemoveBlocks = FALSE,
-
+    show_in_console = FALSE,
+
     # Profile Settings
     remove_files = TRUE,
-    newctlfile = "control_modified.ss", 
-    profile_init_values_src = 0, 
-    #prior_like = 0, # turn off the prior contribution to likelihood
-    linenum = NULL, 
-    string = NULL, 
+    newctlfile = "control_modified.ss",
+    linenum = NULL,
+    string = NULL,
     profilevec = NULL,
-    usepar = FALSE, 
-    globalpar = FALSE, 
-    parfile = "ss.par",
-    parlinenum = NULL, 
+    usepar = FALSE,
+    globalpar = FALSE,
+    parlinenum = NULL,
     parstring = NULL,
-    dircopy = TRUE, 
-    exe.delete = FALSE,
     saveoutput = TRUE,
-    whichruns = NULL, 
-    SSversion = "3.30", 
+    overwrite = TRUE,
+    whichruns = NULL,
     prior_check = FALSE,
-    read_like = TRUE
+    read_like = TRUE,
+    init_values_src = 0
   )
 
-  Settings_all$profile_details = get_settings_profile()
+  Settings_all$profile_details <- get_settings_profile()
 
   need <- !names(Settings_all) %in% names(settings)
   if (verbose) {
     message("Adding the following objects to settings:\n",
       paste(names(Settings_all[need]), collapse = "\n"), "\n",
-      appendLF = TRUE)
+      appendLF = TRUE
+    )
   }
   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) {
       stop("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)){
+      !is.numeric(Settings_all$profile_details$high) &
+      !is.numeric(Settings_all$profile_details$step_size)) {
       stop("There is a non-numeric value in the low, high, or step size fiedl 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) {
       stop("The param_space column should be either real or relative in the get_settings_profile data frame.")
     }
-
   }
 
   return(Settings_all)
-}
+}

R/get_settings_profile.R

@@ -1,19 +1,19 @@
 #' Get Default Settings For Profiles
-#' 
+#'
 #' Create a matrix of default values for profiling over
 #' the typical parameters given results will be presented to the
 #' Pacific Fisheries Management Council.
-#' 
+#'
 #' The column titled 'param_space' indicated where the range of of the profile parameter
 #' should be interpretted as relative to the base model estimate vs. across a pre-specified range.
 #' An example is for R0 where the default setting below indicates that the param_space is relative
 #' where the low bound for the profile is set = base model log(R0) - 2 and high = base model log(R0) + 2.
-#' The default range for M is set as a multiplier to explore a range of (M - 0.40 * M) - (M + 0.40 * M) 
+#' The default range for M is set as a multiplier to explore a range of (M - 0.40 * M) - (M + 0.40 * M)
 #' at a step size of 0.005. This range may be too large (or small) with a step size too large (or too small)
 #' and should be considered if the default settings are appropriate for your specific model. The default setting
-#' for steepness is in 'real' space which means that the low and high is in the same parameter space as the 
-#' parameter. A user can select any of the options for specifying a parameter range for any parameter. 
-#' 
+#' for steepness is in 'real' space which means that the low and high is in the same parameter space as the
+#' parameter. A user can select any of the options for specifying a parameter range for any parameter.
+#'
 #' @param parameters vector of SS parameter names to conduct a profile for
 #' @param low a vector of low paramater bounds for the profile
 #' @param high a vector of upper parameter bounds for the profile
@@ -22,9 +22,9 @@
 #' real indicates bounds in the parameter space, relative indicates how far to go from the base parameter, and
 #' multiplier indicates that low and high bounds are set at x\% above and below the base parameter.
 #' @param use_prior_like options: Option to include or exclude the prior likelihoods in the likelihood
-#' profiles. A value of 0 corresponds to the Stock Sythesis were this would exclude 
-#' and a value of 1 would include the prior likelihood contribution. Parameters with priors used for estimation 
-#' (e.g., natural mortality, steepness) are often profiled across and including or excluding the prior likelihood 
+#' profiles. A value of 0 corresponds to the Stock Sythesis were this would exclude
+#' and a value of 1 would include the prior likelihood contribution. Parameters with priors used for estimation
+#' (e.g., natural mortality, steepness) are often profiled across and including or excluding the prior likelihood
 #' contribution may be wanted in specific instances.  The default setting excludes the prior likelihood contributions.
 #'
 #' @return A matrix of low, high, and step size values for the default parameters
@@ -34,53 +34,53 @@
 #'
 #' @author Chantel Wetzel & Kelli Johnson
 #' @export
-#' 
+#'
 #' @examples
 #' \dontrun{
-#' 
+#'
 #' # Define each parameter in real space
-#' get_settings_profile( parameters =  c("NatM_p_1_Fem_GP_1", "SR_BH_steep", "SR_LN(R0)"),
-#						 low =  c(0.02, 0.25, 8),
-#						 high = c(0.07, 1.0,  11),
-#						 step_size = c(0.005, 0.05, 0.25),
-#						 param_space = c('real', 'real', 'real'),
-#'						 use_prior_like = c(1, 1, 0)) 
-#' 
+#' get_settings_profile(
+#'   parameters = c("NatM_p_1_Fem_GP_1", "SR_BH_steep", "SR_LN(R0)"),
+#'   # 						 low =  c(0.02, 0.25, 8),
+#'   # 						 high = c(0.07, 1.0,  11),
+#'   # 						 step_size = c(0.005, 0.05, 0.25),
+#'   # 						 param_space = c('real', 'real', 'real'),
+#'   use_prior_like = c(1, 1, 0)
+#' )
+#'
 #' # Example 2: Run a profile for natural mortality one with the prior likelihood and one without
-#' get_settings_profile( parameters =  c("NatM_p_1_Fem_GP_1","NatM_p_1_Fem_GP_1"),
-#'						 low =  c(0.40, 0.40),
-#'						 high = c(0.40, 0.40),
-#'						 step_size = c(0.005, 0.005),
-#'						 param_space = c('multiplier', 'multiplier'),
-#'						 use_prior_like = c(0, 1)) 
-#'}
+#' get_settings_profile(
+#'   parameters = c("NatM_p_1_Fem_GP_1", "NatM_p_1_Fem_GP_1"),
+#'   low = c(0.40, 0.40),
+#'   high = c(0.40, 0.40),
+#'   step_size = c(0.005, 0.005),
+#'   param_space = c("multiplier", "multiplier"),
+#'   use_prior_like = c(0, 1)
+#' )
+#' }
 #'
-get_settings_profile <- function( parameters =  c("NatM_p_1_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.01, 0.05, 0.25),
-								  param_space = c('multiplier', 'real', 'relative'),
-								  use_prior_like = c(0, 0, 0)) 
-{
-
-	if (length(parameters) != length(low) | 
-	    length(parameters) != length(high) |
-	    length(parameters) != length(step_size) |
-	    length(parameters) != length(param_space) |
-		length(parameters) != length(use_prior_like) ){
-	   	stop("Error: input vectors do match in length.")
-	}
+get_settings_profile <- function(parameters = c("NatM_p_1_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.01, 0.05, 0.25),
+                                 param_space = c("multiplier", "real", "relative"),
+                                 use_prior_like = c(0, 0, 0)) {
+  if (length(parameters) != length(low) |
+    length(parameters) != length(high) |
+    length(parameters) != length(step_size) |
+    length(parameters) != length(param_space) |
+    length(parameters) != length(use_prior_like)) {
+    stop("Error: input vectors do match in length.")
+  }
 
-	out = data.frame( parameters = parameters,
-					  low = low, 
-					  high = high, 
-					  step_size = step_size, 
-					  param_space = param_space,
-					  use_prior_like = use_prior_like)
+  out <- data.frame(
+    parameters = parameters,
+    low = low,
+    high = high,
+    step_size = step_size,
+    param_space = param_space,
+    use_prior_like = use_prior_like
+  )
 
-  	return(out)
+  return(out)
 }
-
-
-
-