style and docs: run devtools::document() and styler::style_pkg()

PIFSCstockassessments · Nov 16, 2024 · 83dd51d · 83dd51d
1 parent cb35a2a
commit 83dd51d
Show file tree

Hide file tree

Showing 14 changed files with 54 additions and 60 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -20,14 +20,14 @@ Depends:
     R (>= 3.5)
 Imports:
     dplyr,
+    gh,
     gplots,
     lifecycle,
     magrittr,
     mvtnorm,
     r4ss (== 1.49.3),
     randtests,
     reshape2,
-    gh,
     rlang
 Suggests:
     knitr,

diff --git a/R/SSdeltaMVLN_old.R b/R/SSdeltaMVLN_old.R
@@ -3,7 +3,7 @@
 #' A function to generate kobe pdfs from a Multivariate Log-Normal Distribution including plotting option. This version is used for older versions of Stock Synthesis. For newer versions (v3.24 and newer), use SSdeltaMVLN().
 #'
 #'
-#' @param ss3rep from r4ss::SSgetoutput()$replist1
+#' @param ss3rep from r4ss::SSgetoutput()[["replist1"]]
 #' @param status covarying stock status quantaties to extract from Hessian
 #' @param quants additional stock quantaties to extract from Hessian
 #' @param Fref  Choice of reference point for stock SSB/XFref=c("MSY","Ftrg"),only if F_report_basis: 0 or 3

diff --git a/R/SSkobe.R b/R/SSkobe.R
@@ -2,7 +2,7 @@
 #'
 #' Generates a Kobe plot or phase plot illustrating the stock status uncertainty over SSB/SSBmsy and F/Fmsy
 #'
-#' @param kb output from SSdeltaMVLN()$kb
+#' @param kb output from SSdeltaMVLN()[["kb"]]
 #' @param joint option FALSE shows individual runs
 #' @param year option to choose year for kobe, last year is default
 #' @param posterior visualization of posterior c("points","kernel")

diff --git a/R/SSplotEnsemble.R b/R/SSplotEnsemble.R
@@ -236,8 +236,8 @@ SSplotEnsemble <- function(kb,
     n.quantiles <- length(quantiles)
     for (i in 1:n.quantiles) {
       exp[[i]] <- aggregate(y ~ year + run, kb, mean)
-      exp[[i]][["lower"]] <- aggregate(y ~ year + run, kb, quantile, quantiles[[i]][1])$y
-      exp[[i]][["upper"]] <- aggregate(y ~ year + run, kb, quantile, quantiles[[i]][2])$y
+      exp[[i]][["lower"]] <- aggregate(y ~ year + run, kb, quantile, quantiles[[i]][1])[["y"]]
+      exp[[i]][["upper"]] <- aggregate(y ~ year + run, kb, quantile, quantiles[[i]][2])[["y"]]
     }
 
 
@@ -444,7 +444,7 @@ ensemble_plot_index <- function(summaryoutput,
   # legendloc <- "topleft"
   # }
   # if (is.numeric(legendloc)) {
-  # Usr <- par()$usr
+  # Usr <- par()[["usr"]]
   # legendloc <- list(
   #   x = Usr[1] + legendloc[1] * (Usr[2] - Usr[1]),
   #   y = Usr[3] + legendloc[2] * (Usr[4] - Usr[3])

diff --git a/R/SSplotHCxval.R b/R/SSplotHCxval.R
@@ -247,7 +247,7 @@ SSplotHCxval <- function(retroSummary,
     # legendloc <- "topleft"
     # }
     # if (is.numeric(legendloc)) {
-    # Usr <- par()$usr
+    # Usr <- par()[["usr"]]
     # legendloc <- list(
     #   x = Usr[1] + legendloc[1] * (Usr[2] - Usr[1]),
     #   y = Usr[3] + legendloc[2] * (Usr[4] - Usr[3])
@@ -613,7 +613,7 @@ SSplotHCxval <- function(retroSummary,
           filenameprefix = filenameprefix
         )
         par(par)
-        get_mase <- plot_hcxval(indexfleets)$MASE
+        get_mase <- plot_hcxval(indexfleets)[["MASE"]]
         dev.off()
         MASE <- rbind(MASE, get_mase)
       } # End of Fleet Loop
@@ -626,7 +626,7 @@ SSplotHCxval <- function(retroSummary,
       if (fi %in% legendindex) legend <- TRUE
       indexfleets <- unique(hcruns[["indices"]][["Fleet"]])[fi]
       if (!add) (par)
-      get_mase <- plot_hcxval(indexfleets)$MASE
+      get_mase <- plot_hcxval(indexfleets)[["MASE"]]
       MASE <- rbind(MASE, get_mase)
     } # End of Fleet Loop
   }

diff --git a/R/SSplotModelcomp.R b/R/SSplotModelcomp.R
@@ -231,7 +231,7 @@ SSplotModelcomp <- function(summaryoutput,
     # legendloc <- "topleft"
     # }
     # if (is.numeric(legendloc)) {
-    # Usr <- par()$usr
+    # Usr <- par()[["usr"]]
     # legendloc <- list(
     #   x = Usr[1] + legendloc[1] * (Usr[2] - Usr[1]),
     #   y = Usr[3] + legendloc[2] * (Usr[4] - Usr[3])
@@ -510,7 +510,7 @@ SSplotModelcomp <- function(summaryoutput,
     # legendloc <- "topleft"
     # }
     # if (is.numeric(legendloc)) {
-    # Usr <- par()$usr
+    # Usr <- par()[["usr"]]
     # legendloc <- list(
     #   x = Usr[1] + legendloc[1] * (Usr[2] - Usr[1]),
     #   y = Usr[3] + legendloc[2] * (Usr[4] - Usr[3])

diff --git a/R/SSplotRetro.R b/R/SSplotRetro.R
@@ -187,7 +187,7 @@ SSplotRetro <- function(summaryoutput,
     # legendloc <- "topleft"
     # }
     # if (is.numeric(legendloc)) {
-    # Usr <- par()$usr
+    # Usr <- par()[["usr"]]
     # legendloc <- list(
     #   x = Usr[1] + legendloc[1] * (Usr[2] - Usr[1]),
     #   y = Usr[3] + legendloc[2] * (Usr[4] - Usr[3])

diff --git a/R/SSplotRunstest.R b/R/SSplotRunstest.R
@@ -198,7 +198,7 @@ SSplotRunstest <- function(ss3rep,
   }
 
   if (subplots == "len" | subplots == "age" | subplots == "size") {
-    comps <- SScompsTA1.8(ss3rep, fleet = NULL, type = subplots, plotit = FALSE)$runs_dat
+    comps <- SScompsTA1.8(ss3rep, fleet = NULL, type = subplots, plotit = FALSE)[["runs_dat"]]
     comps[["residuals"]] <- ifelse(is.na(comps[["Obs"]]), NA, log(comps[["Obs"]]) - log(comps[["Exp"]]))
     if (is.null(comps[["Fleet_name"]])) { # Deal with Version control
       comps[["Fleet_name"]] <- comps[["Name"]]
@@ -207,7 +207,7 @@ SSplotRunstest <- function(ss3rep,
   }
 
   if (subplots == "con") {
-    cond <- SScompsTA1.8(ss3rep, fleet = NULL, type = subplots, plotit = FALSE)$runs_dat
+    cond <- SScompsTA1.8(ss3rep, fleet = NULL, type = subplots, plotit = FALSE)[["runs_dat"]]
     cond[["residuals"]] <- ifelse(is.na(cond[["Obs"]]), NA, log(cond[["Obs"]]) - log(cond[["Exp"]]))
     if (is.null(cond[["Fleet_name"]])) { # Deal with Version control
       cond[["Fleet_name"]] <- cond[["Name"]]
@@ -444,7 +444,7 @@ SSrunstest <- function(ss3rep,
   }
 
   if (subplots == "len" | subplots == "age") {
-    comps <- SScompsTA1.8(ss3rep, fleet = NULL, type = subplots, plotit = FALSE)$runs_dat
+    comps <- SScompsTA1.8(ss3rep, fleet = NULL, type = subplots, plotit = FALSE)[["runs_dat"]]
     comps[["residuals"]] <- ifelse(is.na(comps[["Obs"]]), NA, log(comps[["Obs"]]) - log(comps[["Exp"]]))
     if (is.null(comps[["Fleet_name"]])) { # Deal with Version control
       comps[["Fleet_name"]] <- comps[["Name"]]
@@ -453,7 +453,7 @@ SSrunstest <- function(ss3rep,
   }
 
   if (subplots == "con") {
-    cond <- SScompsTA1.8(ss3rep, fleet = NULL, type = subplots, plotit = FALSE)$runs_dat
+    cond <- SScompsTA1.8(ss3rep, fleet = NULL, type = subplots, plotit = FALSE)[["runs_dat"]]
     cond[["residuals"]] <- ifelse(is.na(cond[["Obs"]]), NA, log(cond[["Obs"]]) - log(cond[["Exp"]]))
     if (is.null(cond[["Fleet_name"]])) { # Deal with Version control
       cond[["Fleet_name"]] <- cond[["Name"]]

diff --git a/R/SSretroComps.R b/R/SSretroComps.R
@@ -30,7 +30,7 @@ SSretroComps <- function(retroModels) {
       rep.temp <- retroModels[[paste(replist[i])]]
       rep.temp[["lendbase"]] <- rbind(rep.temp[["ghostlendbase"]], rep.temp[["lendbase"]][, 1:ncol(rep.temp[["ghostlendbase"]])])
       rep.temp[["lendbase"]] <- data.frame(rep.temp[["lendbase"]], imodel = i)
-      lencomps <- rbind(lencomps, data.frame(SScompsTA1.8(rep.temp, type = "len", plotit = F)$runs_dat, imodel = i))
+      lencomps <- rbind(lencomps, data.frame(SScompsTA1.8(rep.temp, type = "len", plotit = F)[["runs_dat"]], imodel = i))
     }
     lencomps <- lencomps[order(lencomps[["imodel"]], lencomps[["Fleet"]], lencomps[["Time"]]), ]
 
@@ -42,7 +42,7 @@ SSretroComps <- function(retroModels) {
     for (i in 1:length(replist)) {
       rep.temp <- retroModels[[paste(replist[i])]]
       rep.temp[["agedbase"]] <- rbind(rep.temp[["ghostagedbase"]], rep.temp[["agedbase"]][, 1:ncol(rep.temp[["ghostagedbase"]])])
-      agecomps <- rbind(agecomps, data.frame(SScompsTA1.8(rep.temp, type = "age", plotit = F)$runs_dat, imodel = i))
+      agecomps <- rbind(agecomps, data.frame(SScompsTA1.8(rep.temp, type = "age", plotit = F)[["runs_dat"]], imodel = i))
     }
     agecomps <- agecomps[order(agecomps[["imodel"]], agecomps[["Fleet"]], agecomps[["Time"]]), ]
     hccomps[["age"]] <- agecomps
@@ -53,7 +53,7 @@ SSretroComps <- function(retroModels) {
     for (i in 1:length(replist)) {
       rep.temp <- retroModels[[paste(replist[i])]]
       rep.temp[["condbase"]] <- rbind(rep.temp[["ghostcondbase"]], rep.temp[["condbase"]][, 1:ncol(rep.temp[["ghostcondbase"]])])
-      concomps <- rbind(concomps, data.frame(SScompsTA1.8(rep.temp, type = "con", plotit = F)$runs_dat, imodel = i))
+      concomps <- rbind(concomps, data.frame(SScompsTA1.8(rep.temp, type = "con", plotit = F)[["runs_dat"]], imodel = i))
     }
     concomps <- concomps[order(concomps[["imodel"]], concomps[["Fleet"]], concomps[["Time"]]), ]
     hccomps[["con"]] <- concomps

diff --git a/R/SSrmse.R b/R/SSrmse.R
@@ -36,7 +36,7 @@ SSrmse <- function(ss3rep, quants = c("cpue", "len", "age", "con"), seas = NULL,
   }
 
   if (quants == "len" | quants == "age" | quants == "size") {
-    comps <- SScompsTA1.8(ss3rep, fleet = NULL, type = quants, plotit = FALSE)$runs_dat
+    comps <- SScompsTA1.8(ss3rep, fleet = NULL, type = quants, plotit = FALSE)[["runs_dat"]]
     comps[["residuals"]] <- ifelse(is.na(comps[["Obs"]]), NA, log(comps[["Obs"]]) - log(comps[["Exp"]]))
     if (is.null(comps[["Fleet_name"]])) { # Deal with Version control
       comps[["Fleet_name"]] <- comps[["Name"]]
@@ -45,7 +45,7 @@ SSrmse <- function(ss3rep, quants = c("cpue", "len", "age", "con"), seas = NULL,
   }
 
   if (quants == "con") {
-    cond <- SScompsTA1.8(ss3rep, fleet = NULL, type = quants, plotit = FALSE)$runs_dat
+    cond <- SScompsTA1.8(ss3rep, fleet = NULL, type = quants, plotit = FALSE)[["runs_dat"]]
     cond[["residuals"]] <- ifelse(is.na(cond[["Obs"]]), NA, log(cond[["Obs"]]) - log(cond[["Exp"]]))
     if (is.null(cond[["Fleet_name"]])) { # Deal with Version control
       cond[["Fleet_name"]] <- cond[["Name"]]

diff --git a/R/get_ss3_exe.R b/R/get_ss3_exe.R
@@ -33,7 +33,7 @@ get_ss3_exe <- function(dir = NULL, version = NULL) {
     all_tags <- gh::gh("GET /repos/nmfs-ost/ss3-source-code/tags", .token = NA_character_)
     df_tags <- as.data.frame(do.call(rbind, all_tags))
     tags <- unlist(df_tags[["name"]])
-    
+
     if (!version %in% tags) {
       warning("The version tag that you entered is invalid or not in the right format,
               please go to https://github.com/nmfs-ost/ss3-source-code/tags
@@ -42,48 +42,43 @@ get_ss3_exe <- function(dir = NULL, version = NULL) {
       tag <- version
     }
   }
-  
+
   if (is.null(dir)) {
     dir <- getwd()
     message("No directory provided, the executable will be downloaded to the working directory")
   }
-  
+
   if (!dir.exists(dir)) {
     stop("Directory doesn't exist: ", dir)
   }
-
-  #if (.Platform[["OS.type"]] == "windows") {
-  if(R.version[["os"]] == "mingw32") {
-
+
+  # if (.Platform[["OS.type"]] == "windows") {
+  if (R.version[["os"]] == "mingw32") {
     download_location <- ss3_exe_windows(dir, tag)
-
-  } else if(substr(R.version[["os"]], 1, 6) == "darwin") {
-
+  } else if (substr(R.version[["os"]], 1, 6) == "darwin") {
     download_location <- ss3_exe_darwin(dir, tag, R.version[["arch"]])
-  } else if(R.version[["os"]] == "linux-gnu") {
-
+  } else if (R.version[["os"]] == "linux-gnu") {
     download_location <- ss3_exe_linux(dir, tag)
   } else {
-
     stop("The Stock Synthesis executable is not available for ", R.version[["os"]], ".") # nocov end
   }
-      
+
   return(invisible(download_location))
 }
 
 
 
 
 #' @rdname get_ss3_exe
-#' 
+#'
 #' @param dir Target Directory
-#' @param tag Target ss3 Version release 
-#' 
+#' @param tag Target ss3 Version release
+#'
 #' @return A string of the file path to the downloaded executable
 #'
 #' @keywords internal
-#' 
-ss3_exe_windows <- function (dir, tag) {
+#'
+ss3_exe_windows <- function(dir, tag) {
   if (.Platform[["r_arch"]] == "x32") { # nocov start
     warning(
       "Stock Synthesis binary is not available for 32-bit ",
@@ -98,7 +93,7 @@ ss3_exe_windows <- function (dir, tag) {
       suppressWarnings(utils::download.file(url, destfile = file.path(dir, "ss3.exe"), mode = "wb")),
       error = function(e) "ss3 name not right for this version, trying ss"
     )
-    
+
     if (try_ss == "ss3 name not right for this version, trying ss") {
       url <- paste0(
         "https://github.com/nmfs-ost/ss3-source-code/releases/download/",
@@ -111,7 +106,7 @@ ss3_exe_windows <- function (dir, tag) {
       "The stock synthesis executable for Windows ", tag, " was downloaded to: ",
       download_location
     ))
-    
+
     return(invisible(download_location))
   }
 }
@@ -120,18 +115,17 @@ ss3_exe_windows <- function (dir, tag) {
 #' @rdname get_ss3_exe
 #'
 #' @param dir Target Directory
-#' @param tag Target ss3 Version release 
+#' @param tag Target ss3 Version release
 #' @param arch arch
-#' 
+#'
 #' @return A string of the file path to the downloaded executable
 #'
 #' @keywords internal
-#' 
-ss3_exe_darwin <- function(dir, tag, arch = c("aarch64", "x86_64" )) {
-
+#'
+ss3_exe_darwin <- function(dir, tag, arch = c("aarch64", "x86_64")) {
   arch <- match.arg(arch)
-  
-  if(arch == "aarch64"){
+
+  if (arch == "aarch64") {
     url <- paste0(
       "https://github.com/nmfs-ost/ss3-source-code/releases/download/",
       tag, "/ss3_osx_arm64"
@@ -141,7 +135,7 @@ ss3_exe_darwin <- function(dir, tag, arch = c("aarch64", "x86_64" )) {
       error = function(e) "ss3 executable not available for macOS arm64 architecture
             computers for versions prior to v.3.30.22.1"
     )
-    
+
     if (try_arm64 == "ss3 executable not available for macOS arm64 architecture computers for
         versions prior to v.3.30.22.1") {
       print(try_arm64)
@@ -162,7 +156,7 @@ ss3_exe_darwin <- function(dir, tag, arch = c("aarch64", "x86_64" )) {
       suppressWarnings(utils::download.file(url, destfile = file.path(dir, "ss3"), mode = "wb")),
       error = function(e) "ss3 name not right for this version, trying ss"
     )
-    
+
     if (try_ss == "ss3 name not right for this version, trying ss") {
       url <- paste0(
         "https://github.com/nmfs-ost/ss3-source-code/releases/download/",
@@ -181,14 +175,14 @@ ss3_exe_darwin <- function(dir, tag, arch = c("aarch64", "x86_64" )) {
 }
 
 #' @rdname get_ss3_exe
-#' 
+#'
 #' @param dir Target Directory
-#' @param tag Target ss3 Version release 
-#' 
+#' @param tag Target ss3 Version release
+#'
 #' @return A string of the file path to the downloaded executable
 #'
 #' @keywords internal
-#' 
+#'
 ss3_exe_linux <- function(dir, tag) {
   url <- paste0(
     "https://github.com/nmfs-ost/ss3-source-code/releases/download/",
@@ -198,7 +192,7 @@ ss3_exe_linux <- function(dir, tag) {
     suppressWarnings(utils::download.file(url, destfile = file.path(dir, "ss3"), mode = "wb")),
     error = function(e) "ss3 name not right for this version, trying ss"
   )
-  
+
   if (try_ss == "ss3 name not right for this version, trying ss") {
     url <- paste0(
       "https://github.com/nmfs-ost/ss3-source-code/releases/download/",
@@ -214,4 +208,4 @@ ss3_exe_linux <- function(dir, tag) {
     download_location
   ))
   return(invisible(download_location))
-}
+}
diff --git a/man/SSdeltaMVLN_old.Rd b/man/SSdeltaMVLN_old.Rd
diff --git a/man/SSplotKobe.Rd b/man/SSplotKobe.Rd
diff --git a/tests/testthat.R b/tests/testthat.R
@@ -7,7 +7,7 @@ files_path <- system.file("extdata", package = "ss3diags")
 run_tmp <- file.path(tempdir(check = TRUE), "test-runs")
 dir.create(run_tmp, showWarnings = FALSE)
 file.copy(from = list.files(files_path, full.names = TRUE), to = run_tmp)
-#r4ss::get_ss3_exe(dir = run_tmp, version = "v3.30.21")
+# r4ss::get_ss3_exe(dir = run_tmp, version = "v3.30.21")
 ss3diags::get_ss3_exe(dir = run_tmp, version = "v3.30.21")
 ## Run retrospectives
 if (file.exists(file.path(run_tmp, "ss3")) | file.exists(file.path(run_tmp, "ss3.exe"))) {