Merge pull request #47 from NOAA-EDAB/dev

sync dev with main

Author: jcaracappa1

.github/workflows/format-check.yaml

@@ -0,0 +1,23 @@
+# Workflow derived from https://github.com/posit-dev/setup-air/tree/main/examples
+
+on:
+  push:
+    branches: [main, dev]
+  pull_request:
+
+name: format-check.yaml
+
+permissions: read-all
+
+jobs:
+  format-check:
+    name: format-check
+    runs-on: ubuntu-latest
+    steps:
+      - uses: actions/checkout@v6
+
+      - name: Install
+        uses: posit-dev/setup-air@v1
+
+      - name: Check
+        run: air format . --check

DESCRIPTION

@@ -20,8 +20,7 @@ Authors@R:
            role = c("aut"),
            email = "Robert.Gamble@noaa.gov"),
     person(given = "Ryan",family = "Morse", role = c("aut"),
-           email = "ryan.morse@noaa.gov",
-           comment = c(ORCID = "YOUR-ORCID-ID")))
+           email = "ryan.morse@noaa.gov"))
 Description: Atlantis diagnostics functions in this package are used to determine whether the model 
     is meeting defined performance and review criteria. Processing functions are used to format the model output for 
     plotting and diagnostic tests

NAMESPACE

@@ -2,6 +2,7 @@
 
 export(compare_spatial_vars)
 export(diag_cohortBiomass)
+export(diag_combine)
 export(diag_fleet_catch)
 export(diag_footprints)
 export(diag_maxsize)
@@ -11,6 +12,7 @@ export(diag_stability)
 export(diag_temp_thresholds)
 export(get_atl_paramfiles)
 export(get_forcing_temperature)
+export(get_habitable_boxes)
 export(get_param_FXXX_SY)
 export(get_param_move_temp)
 export(get_param_recruit_hdistrib)

R/agg_custom.R

@@ -6,25 +6,33 @@
 #'
 #' @noRd
 
-
-agg_custom  <-  function(data, groups, fun, agg.scale){
+agg_custom <- function(data, groups, fun, agg.scale) {
   out = atlantistools::agg_data(data = data, groups = groups, fun = fun) %>%
-    mutate(date = as.POSIXct(time*365*86400, origin = '1964-01-01 00:00:00',tz = 'UTC'))
+    mutate(
+      date = as.POSIXct(
+        time * 365 * 86400,
+        origin = '1964-01-01 00:00:00',
+        tz = 'UTC'
+      )
+    )
 
-  if(agg.scale == 'month') {
-    out$time.agg = as.numeric(factor(format(out$date,format = '%m')))
-  }else if(agg.scale == 'year'){
+  if (agg.scale == 'month') {
+    out$time.agg = as.numeric(factor(format(out$date, format = '%m')))
+  } else if (agg.scale == 'year') {
     out$time.agg = as.numeric(factor(format(out$date, format = '%Y')))
-  }else{
-    out$time.agg = out$time*365
+  } else {
+    out$time.agg = out$time * 365
   }
 
-  match.cols = c(groups[-which(groups == 'time')],'time.agg')
+  match.cols = c(groups[-which(groups == 'time')], 'time.agg')
   out.agg = out %>%
     group_by_at(match.cols) %>%
-    dplyr::summarise(time = floor(min(time)),
-              atoutput = mean(atoutput,na.rm=T),.groups="drop")
-    dplyr::select(all_of(c(groups,'atoutput')))
+    dplyr::summarise(
+      time = floor(min(time)),
+      atoutput = mean(atoutput, na.rm = T),
+      .groups = "drop"
+    )
+  dplyr::select(all_of(c(groups, 'atoutput')))
 
   return(out.agg)
 }

R/calc_mef.R

@@ -11,21 +11,18 @@
 #'
 #'@noRd
 
-
-
 calc_mef <- function(observed, expected) {
-
   #remove NAs. Exist only in observed data
   expected <- expected[!is.na(observed)]
   observed <- observed[!is.na(observed)]
 
-  oo <- sum((observed-mean(observed))^2)
+  oo <- sum((observed - mean(observed))^2)
   po <- sum((expected - observed)^2)
 
-  mef <- (oo-po)/oo
+  mef <- (oo - po) / oo
 
   # number of data point used in calculation
   n <- length(expected)
 
-  return(list(mef=mef,n=n))
+  return(list(mef = mef, n = n))
 }

R/check_species_codes.R

@@ -11,27 +11,29 @@
 #'
 #' @noRd
 
-check_species_codes <- function(modelBiomass,speciesCodes){
-
+check_species_codes <- function(modelBiomass, speciesCodes) {
   # use default options
   atlantisCodes <- modelBiomass %>%
     dplyr::filter(!is.na(.data$code)) %>%
     dplyr::distinct(.data$code) %>%
     dplyr::pull()
   # use default options
-  if (is.null(speciesCodes)) { # select all species
+  if (is.null(speciesCodes)) {
+    # select all species
     speciesCodes <- atlantisCodes
   } else {
     # remove NA's check for codes not in atlantis
     speciesCodes <- speciesCodes[!is.na(speciesCodes)]
     # check to make sure no non atlantis codes
-    invalidCodes <- base::setdiff(speciesCodes,atlantisCodes)
+    invalidCodes <- base::setdiff(speciesCodes, atlantisCodes)
 
-    if (!(length(invalidCodes)==0)){
-      stop("Invalid Atlantis group codes: ",paste0(invalidCodes,collapse=", "))
+    if (!(length(invalidCodes) == 0)) {
+      stop(
+        "Invalid Atlantis group codes: ",
+        paste0(invalidCodes, collapse = ", ")
+      )
     }
   }
 
   return(speciesCodes)
-
 }