From 975d40b07fdeea64534eedd0b1da8dd99a523e0a Mon Sep 17 00:00:00 2001
From: Adam Reimer <adam.reimer@alaska.gov>
Date: Mon, 9 Sep 2024 15:59:07 -0800
Subject: [PATCH] Fix tab_brood. NOAA GOA_ESA data request filled.

Using this function for a data request an noticed some errors. Fixed those but still need to work on this repository. Use cautiously.
---
 data_requests/GOA_ESA_broodtable.R | 28 ++++++++++++++++++++++++++++
 functions/table.R                  |  8 ++++----
 2 files changed, 32 insertions(+), 4 deletions(-)
 create mode 100644 data_requests/GOA_ESA_broodtable.R

diff --git a/data_requests/GOA_ESA_broodtable.R b/data_requests/GOA_ESA_broodtable.R
new file mode 100644
index 0000000..501e614
--- /dev/null
+++ b/data_requests/GOA_ESA_broodtable.R
@@ -0,0 +1,28 @@
+# Generate a brood table for a NOAA data request associated with the GOA ESA petition.
+
+# Author: Adam Reimer
+# Version: 2024-09-09
+
+# Packages
+packs <- c("tidyverse", "coda", "writexl")
+lapply(packs, require, character.only = TRUE)
+
+# Source functions
+function_files <- list.files(path=".\\functions")
+lapply(function_files, function(x) source(paste0(".\\functions\\", x)))
+  
+# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+# Read data ---------------------------------------------------------------
+post <- readRDS(".\\output\\post_1977on")
+
+#  * Format data ----------------------------------------------------------
+
+# Analysis ----------------------------------------------------------------
+
+# Results -----------------------------------------------------------------
+tbl_brood <- table_brood(stats_dat = get_summary(post$samples))
+knitr::kable(tbl_brood, escape = FALSE, align = "r")
+write_xlsx(list(
+  "Anchor" = tbl_brood),
+  ".\\data_requests\\GOA_ESA_brood.xlsx")
diff --git a/functions/table.R b/functions/table.R
index 1b070f0..b8b119c 100644
--- a/functions/table.R
+++ b/functions/table.R
@@ -75,7 +75,7 @@ table_age <- function(post_dat, node, firstyr = 1977){
 #' @return A tibble
 #'
 #' @examples
-#' table_brood(get_summary(post), 1)
+#' table_brood(get_summary(post))
 #'
 #' @export
 table_brood <- function(stats_dat,firstyr = 1977){
@@ -84,8 +84,8 @@ table_brood <- function(stats_dat,firstyr = 1977){
     tibble::rownames_to_column() %>%
     dplyr::filter(grepl(paste0("^N.ta\\[\\d+,\\d\\]"), rowname)) %>%
     dplyr::select(rowname = "rowname", mean = "Mean") %>%
-    dplyr::mutate(age_n = 2 + as.numeric(gsub("N.ta\\[\\d+,(\\d)\\]", "\\1", rowname)),
-                  year = firstyr + as.numeric(gsub("N.ta\\[(\\d+),\\d\\]", "\\1", rowname)) - age_n,
+    dplyr::mutate(age_n = 3 + as.numeric(gsub("N.ta\\[\\d+,(\\d)\\]", "\\1", rowname)),
+                  year = (firstyr - 1) + as.numeric(gsub("N.ta\\[(\\d+),\\d\\]", "\\1", rowname)) - age_n,
                   age_c = paste0("age-", age_n)) %>%
     dplyr::select(year, age_c, mean) %>%
     #tidyr::spread(age_c, mean)
@@ -97,7 +97,7 @@ table_brood <- function(stats_dat,firstyr = 1977){
     dplyr::select(rowname = "rowname", mean = "Mean") %>%
     dplyr::mutate(name = stringr::str_sub(rowname, 1, stringr::str_locate(rowname, "\\[")[, 1] - 1),
                   index = as.numeric(gsub(".\\[(\\d+)\\]", "\\1", rowname)),
-                  year = (name == "S") * (firstyr + index) + (name == "R") * (firstyr - 7 + index)) %>%
+                  year = (name == "S") * ((firstyr - 1) + index) + (name == "R") * ((firstyr - 1) - 7 + index)) %>%
     dplyr::select(year, mean, name) %>%
     tidyr::spread(name, mean) %>%
     dplyr::select(year, S, R) %>%