Merge pull request #41 from pfmc-assessments/style-doc-code

Style code and document
pfmc-assessments · Oct 2, 2024 · 15baf17 · 15baf17
2 parents 24eda52 + 90db368
commit 15baf17
Show file tree

Hide file tree

Showing 22 changed files with 261 additions and 227 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,14 +1,14 @@
-Package: nwfscDiag
 Type: Package
+Package: nwfscDiag
 Title: Generate Standard NWFSC Assessment Diagnostics
 Version: 1.1.2
 Author: Chantel Wetzel
 Maintainer: Chantel Wetzel <chantel.wetzel@noaa.gov>
-Description: Package that can automates diagnositics for SS3 models by running jitters, retrospective, and profiles.  
+Description: Package that can automates diagnositics for SS3 models by
+    running jitters, retrospective, and profiles.
 License: GPL (>=3)
 URL: https://github.com/pfmc-assessments/nwfscDiag
 BugReports: https://github.com/pfmc-assessments/nwfscDiag/issues
-LazyData: true
 Depends:
     R (>= 3.5)
 Imports:
@@ -28,6 +28,7 @@ Suggests:
     testthat
 Remotes: 
     github::r4ss/r4ss
-RoxygenNote: 7.3.2
 Encoding: UTF-8
+LazyData: true
 Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.3.2
diff --git a/R/check_profile_range.R b/R/check_profile_range.R
@@ -10,7 +10,7 @@
 #' @export
 #'
 #'
-check_profile_range <- function(mydir, model_settings){
+check_profile_range <- function(mydir, model_settings) {
   # Read in the base model
   rep <- r4ss::SS_output(
     file.path(mydir, model_settings$base_name),
@@ -20,54 +20,54 @@ check_profile_range <- function(mydir, model_settings){
   )
 
   N <- nrow(model_settings$profile_details)
-  for (aa in 1:N){
+  for (aa in 1:N) {
     profile_details <- model_settings[["profile_details"]][aa, ]
     para <- profile_details[, "parameters"]
     est <- rep$parameters[rep$parameters$Label == para, "Value"]
 
-   # Determine the parameter range
-   if (profile_details$param_space == "relative") {
-     range <- c(
-       est + profile_details$low,
-       est + profile_details$high
-     )
-   }
-   if (profile_details$param_space == "multiplier") {
-     range <- c(
-       est - est * profile_details$low,
-       est + est * profile_details$high
-     )
-   }
-   if (profile_details$param_space == "real") {
-     range <- c(
-       profile_details$low,
-       profile_details$high
-     )
-   }
-   step_size <- profile_details$step_size
+    # Determine the parameter range
+    if (profile_details$param_space == "relative") {
+      range <- c(
+        est + profile_details$low,
+        est + profile_details$high
+      )
+    }
+    if (profile_details$param_space == "multiplier") {
+      range <- c(
+        est - est * profile_details$low,
+        est + est * profile_details$high
+      )
+    }
+    if (profile_details$param_space == "real") {
+      range <- c(
+        profile_details$low,
+        profile_details$high
+      )
+    }
+    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)) {
-     low <- rev(seq(
-       round_any(range[1], step_size, f = ceiling),
-       round_any(est, step_size, f = floor), step_size
-     ))
-   } else {
-     low <- rev(seq(
-       round_any(range[1], step_size, f = ceiling),
-       round_any(est, step_size, f = floor) - step_size, step_size
-     ))
-   }
+    # Create parameter vect from base down and the base up
+    if (est != round_any(est, step_size, f = floor)) {
+      low <- rev(seq(
+        round_any(range[1], step_size, f = ceiling),
+        round_any(est, step_size, f = floor), step_size
+      ))
+    } else {
+      low <- rev(seq(
+        round_any(range[1], step_size, f = ceiling),
+        round_any(est, step_size, f = floor) - step_size, step_size
+      ))
+    }
 
-   if (est != round_any(est, step_size, f = ceiling)) {
-     high <- c(est, seq(round_any(est, step_size, f = ceiling), range[2], step_size))
-   } else {
-     high <- c(seq(round_any(est, step_size, f = ceiling), range[2], step_size))
-   }
+    if (est != round_any(est, step_size, f = ceiling)) {
+      high <- c(est, seq(round_any(est, step_size, f = ceiling), range[2], step_size))
+    } else {
+      high <- c(seq(round_any(est, step_size, f = ceiling), range[2], step_size))
+    }
 
-   vec <- c(low, high)
-   cli::cli_inform(
-     "Profiling over {para} across values of {vec}."
-   )
+    vec <- c(low, high)
+    cli::cli_inform(
+      "Profiling over {para} across values of {vec}."
+    )
   }
 }
diff --git a/R/get_jitter_quants.R b/R/get_jitter_quants.R
@@ -58,10 +58,11 @@ get_jitter_quants <- function(mydir, model_settings, output) {
         "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."),
+        "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"))
+      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

diff --git a/R/get_param_values.R b/R/get_param_values.R
@@ -14,7 +14,6 @@
 #' @export
 
 get_param_values <- function(mydir, para = NULL, vec, summary) {
-
   x <- summary
   n <- x[["n"]]
   endyr <- x[["endyrs"]][1] + 1
@@ -52,20 +51,20 @@ get_param_values <- function(mydir, para = NULL, vec, summary) {
   out <- t(out)
   colnames(out) <- vec
 
-  if(!is.null(para)) {
-  	name <- para
-  	if (para == "SR_LN(R0)") {
-  	  colnames(out) <- paste0("R0 ", vec)
-  	}
-  	if (para == "NatM_uniform_Fem_GP_1") {
-  	  colnames(out) <- paste0("M_f ", vec)
-  	}
-  	if (para == "NatM_uniform_Mal_GP_1") {
-  	  colnames(out) <- paste0("M_m ", vec)
-  	}
-  	if (para == "SR_BH_steep") {
-  	  colnames(out) <- paste0("h ", vec)
-  	}
+  if (!is.null(para)) {
+    name <- para
+    if (para == "SR_LN(R0)") {
+      colnames(out) <- paste0("R0 ", vec)
+    }
+    if (para == "NatM_uniform_Fem_GP_1") {
+      colnames(out) <- paste0("M_f ", vec)
+    }
+    if (para == "NatM_uniform_Mal_GP_1") {
+      colnames(out) <- paste0("M_m ", vec)
+    }
+    if (para == "SR_BH_steep") {
+      colnames(out) <- paste0("h ", vec)
+    }
   }
 
   utils::write.csv(x = out, file = file.path(mydir, paste0(name, "_quant_table.csv")), row.names = TRUE)

diff --git a/R/get_retro_quants.R b/R/get_retro_quants.R
@@ -28,7 +28,7 @@
 #'
 #' @export
 
-get_retro_quants <- function(mydir,  model_settings, output) {
+get_retro_quants <- function(mydir, model_settings, output) {
   retro_dir <- output[["plotdir"]]
   endyrvec <- output[["endyrvec"]]
   retroSummary <- output[["retroSummary"]]
@@ -38,7 +38,7 @@ get_retro_quants <- function(mydir,  model_settings, output) {
   get_param_values(
     mydir = retro_dir,
     para = "retro",
-    vec = c("Base Model", paste0("Retro -", 1:(length(endyrvec)-1))),
+    vec = c("Base Model", paste0("Retro -", 1:(length(endyrvec) - 1))),
     summary = retroSummary
   )
 
@@ -53,11 +53,12 @@ get_retro_quants <- function(mydir,  model_settings, output) {
         "recalculated for each peel given the removal of another year of data.",
         "See Table \\ref{tab:RetroMohnsrho} for other derivations of Mohn's rho."
       ),
-      alt_caption = sprintf("Each successive peel of data led to a Mohn's rho of %s for %s.",
-                            lapply(c("SSB", "Bratio"), function(x) {
-                              knitr::combine_words(sprintf("%.2f", (rhosall[rownames(rhosall) == x, ])))
-                            }),
-                            c("SSB", "fraction unfished")
+      alt_caption = sprintf(
+        "Each successive peel of data led to a Mohn's rho of %s for %s.",
+        lapply(c("SSB", "Bratio"), function(x) {
+          knitr::combine_words(sprintf("%.2f", (rhosall[rownames(rhosall) == x, ])))
+        }),
+        c("SSB", "fraction unfished")
       ),
       label = c("RetroSsb", "RetroFractionunfished"),
       filein = file.path("..", retro_dir, c("compare2_spawnbio_uncertainty.png", "compare4_Bratio_uncertainty.png"))

diff --git a/R/get_settings.R b/R/get_settings.R
@@ -17,7 +17,6 @@
 #' get_settings(list("Njitter" = 10))
 #'
 get_settings <- function(settings = NULL, verbose = FALSE) {
-
   if (is.vector(settings)) settings <- as.list(settings)
 
   Settings_all <- list(
@@ -91,10 +90,11 @@ get_settings <- function(settings = NULL, verbose = FALSE) {
   }
 
   if ("profile" %in% Settings_all[["run"]]) {
-    if (Settings_all[["verbose"]]){
+    if (Settings_all[["verbose"]]) {
       check_profile_range(
         mydir = mydir,
-        model_settings = Settings_all)
+        model_settings = Settings_all
+      )
     }
   }
 

diff --git a/R/get_settings_profile.R b/R/get_settings_profile.R
@@ -61,10 +61,10 @@
 #' # Define each parameter in real space
 #' get_settings_profile(
 #'   parameters = c("NatM_uniform_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')
+#'   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")
 #' )
 #'
 #' # Example 2: Run a profile for natural mortality one with the prior likelihood and one without
@@ -83,7 +83,6 @@ get_settings_profile <- function(parameters = c("NatM_uniform_Fem_GP_1", "SR_BH_
                                  step_size = c(0.01, 0.05, 0.25),
                                  param_space = c("multiplier", "real", "relative"),
                                  use_prior_like = lifecycle::deprecated()) {
-
   if (length(parameters) != length(low) |
     length(parameters) != length(high) |
     length(parameters) != length(step_size) |

diff --git a/R/get_summary.R b/R/get_summary.R
@@ -15,7 +15,6 @@
 #' @export
 
 get_summary <- function(mydir, para, vec, profilemodels, profilesummary) {
-
   # Need to identify a way to determine if a model estimates male growth parameters as offsets from females
 
   # get output

diff --git a/R/jitter_wrapper.R b/R/jitter_wrapper.R
@@ -20,7 +20,8 @@
 jitter_wrapper <- function(mydir, model_settings) {
   output <- run_jitter(
     mydir = mydir,
-    model_settings = model_settings)
+    model_settings = model_settings
+  )
   plot_jitter(
     mydir = mydir,
     model_settings = model_settings,

diff --git a/R/plot_jitter.R b/R/plot_jitter.R
@@ -26,8 +26,8 @@ plot_jitter <- function(mydir, model_settings, output) {
   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,
-       ylab = ylab, xlab = xlab
+    ylim = c(ymin, ymax), cex.axis = 1.25, cex.lab = 1.25,
+    ylab = ylab, xlab = xlab
   )
   graphics::abline(h = 0, col = "darkgrey", lwd = 2)
   find <- which(est == like)
@@ -43,16 +43,16 @@ plot_jitter <- function(mydir, model_settings, output) {
     )
   }
   graphics::legend("topleft",
-                   legend = c("Base Model Likelihood", "Higher Likelihood", "Lower Likelihood"),
-                   bty = "n", pch = 16, col = c("green3", "blue", "red")
+    legend = c("Base Model Likelihood", "Higher Likelihood", "Lower Likelihood"),
+    bty = "n", pch = 16, col = c("green3", "blue", "red")
   )
 
   if (ymax > 100) {
     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,
-         ylab = ylab, xlab = xlab
+      ylim = c(ymin, 100), cex.axis = 1.25, cex.lab = 1.25,
+      ylab = ylab, xlab = xlab
     )
     graphics::abline(h = 0, col = "darkgrey", lwd = 2)
     find <- which(est == like)
@@ -68,8 +68,8 @@ plot_jitter <- function(mydir, model_settings, output) {
       )
     }
     graphics::legend("topleft",
-                     legend = c("Base Model Likelihood", "Higher Likelihood", "Lower Likelihood"),
-                     bty = "n", pch = 16, col = c("green3", "blue", "red")
+      legend = c("Base Model Likelihood", "Higher Likelihood", "Lower Likelihood"),
+      bty = "n", pch = 16, col = c("green3", "blue", "red")
     )
   }
 }