From 7063c9d8eed44dab370cf8c25578b509272b6aa3 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Mon, 23 Feb 2026 12:34:24 -0500 Subject: [PATCH 01/21] add spot for Rceattle in converter --- R/convert_output.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/convert_output.R b/R/convert_output.R index 63c8d17b..8ba65f8e 100644 --- a/R/convert_output.R +++ b/R/convert_output.R @@ -1764,6 +1764,8 @@ convert_output <- function( } fims_output[setdiff(tolower(names(out_new)), tolower(names(fims_output)))] <- NA out_new <- fims_output + } else if (model == "rceattle") { + } else { cli::cli_abort(c( message = "Output file not compatible.", From db8202616533ee58c1aeff8a0827d0c69bd17e07 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Mon, 23 Feb 2026 12:47:04 -0500 Subject: [PATCH 02/21] add more info for rceattle into converter from previous effort --- R/convert_output.R | 73 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 73 insertions(+) diff --git a/R/convert_output.R b/R/convert_output.R index 8ba65f8e..0921eb6f 100644 --- a/R/convert_output.R +++ b/R/convert_output.R @@ -1766,6 +1766,79 @@ convert_output <- function( out_new <- fims_output } else if (model == "rceattle") { +<<<<<<< Updated upstream +======= + #### Read Rceattle #### + # TODO: Do we want users to input the saved file or already loaded into the R environment? + if (is.character(file)) { + dat <- readRDS(file) + } else { + dat <- file + } + + # estimates + # Which parts of the data need extraction? + # Is there a list of quantities or inputs? + quantities <- dat$quantities + estimates <- dat$estimated_params + + #### Initialize year vector for timeseries #### + str_yr <- GOApollock$styr + end_yr <- GOApollock$endyr + yrs <- str_yr:end_yr + + #### spawning biomass #### + sb <- as.data.frame(t(as.matrix(quantities$ssb))) |> + tibble::rownames_to_column() |> + dplyr::mutate( + label = "spawning_biomass", + era = dplyr::case_when( + year > end_yr ~ "fore", + year < str_yr ~ "early", + TRUE ~ "time" + ) + ) + colnames(sb) <- c("year", "estimate", "label") + sb[setdiff(tolower(names(out_new)), tolower(names(sb)))] <- NA + out_new <- rbind(out_new, sb) + + #### biomass #### + b <- as.data.frame(t(as.matrix(quantities$biomass))) |> + tibble::rownames_to_column() |> + dplyr::mutate( + label = "biomass"era = dplyr::case_when( + year > end_yr ~ "fore", + year < str_yr ~ "early", + TRUE ~ "time" + ) + ) + colnames(b) <- c("year", "estimate", "label") + b[setdiff(tolower(names(out_new)), tolower(names(b)))] <- NA + out_new <- rbind(out_new, b) + + #### catch #### + # did not find landings atm + catch <- input$catch_data |> + dplyr::rename_with(tolower) |> + dplyr::mutate( + label = "catch", + era = dplyr::case_when( + year > end_yr ~ "fore", + year < str_yr ~ "early", + TRUE ~ "time" + ), + fleet = dplyr::case_when( + unique(.data$Fleet_name) == 1 ~ NA, + TRUE ~ Fleet_name + ) + ) |> + dplyr::left_join( + input$fleet_control |> + dplyr::select(Fleet_name, Fleet_code), + by = c("Fleet_name"="Fleet_code") + ) + +>>>>>>> Stashed changes } else { cli::cli_abort(c( message = "Output file not compatible.", From 8f921e9707cbaeaa5b89c69fbc83022d4dc525d2 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Thu, 26 Feb 2026 17:09:44 -0500 Subject: [PATCH 03/21] add in changes for Rceattle that were stashed --- R/convert_output.R | 3 --- 1 file changed, 3 deletions(-) diff --git a/R/convert_output.R b/R/convert_output.R index 0921eb6f..c18ccd24 100644 --- a/R/convert_output.R +++ b/R/convert_output.R @@ -1766,8 +1766,6 @@ convert_output <- function( out_new <- fims_output } else if (model == "rceattle") { -<<<<<<< Updated upstream -======= #### Read Rceattle #### # TODO: Do we want users to input the saved file or already loaded into the R environment? if (is.character(file)) { @@ -1838,7 +1836,6 @@ convert_output <- function( by = c("Fleet_name"="Fleet_code") ) ->>>>>>> Stashed changes } else { cli::cli_abort(c( message = "Output file not compatible.", From 8e341a4a60ea19e480d8f43b404bbb4d2147330d Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Fri, 27 Feb 2026 14:10:56 -0500 Subject: [PATCH 04/21] add navigation for develpment --- R/convert_output.R | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/R/convert_output.R b/R/convert_output.R index c18ccd24..d3b2eae3 100644 --- a/R/convert_output.R +++ b/R/convert_output.R @@ -1764,9 +1764,9 @@ convert_output <- function( } fims_output[setdiff(tolower(names(out_new)), tolower(names(fims_output)))] <- NA out_new <- fims_output + #### Rceattle #### } else if (model == "rceattle") { - #### Read Rceattle #### # TODO: Do we want users to input the saved file or already loaded into the R environment? if (is.character(file)) { dat <- readRDS(file) @@ -1780,12 +1780,12 @@ convert_output <- function( quantities <- dat$quantities estimates <- dat$estimated_params - #### Initialize year vector for timeseries #### + ##### Initialize year vector for timeseries ##### str_yr <- GOApollock$styr end_yr <- GOApollock$endyr yrs <- str_yr:end_yr - #### spawning biomass #### + ##### spawning biomass #### sb <- as.data.frame(t(as.matrix(quantities$ssb))) |> tibble::rownames_to_column() |> dplyr::mutate( @@ -1800,11 +1800,12 @@ convert_output <- function( sb[setdiff(tolower(names(out_new)), tolower(names(sb)))] <- NA out_new <- rbind(out_new, sb) - #### biomass #### + ###### biomass #### b <- as.data.frame(t(as.matrix(quantities$biomass))) |> tibble::rownames_to_column() |> dplyr::mutate( - label = "biomass"era = dplyr::case_when( + label = "biomass", + era = dplyr::case_when( year > end_yr ~ "fore", year < str_yr ~ "early", TRUE ~ "time" @@ -1814,7 +1815,7 @@ convert_output <- function( b[setdiff(tolower(names(out_new)), tolower(names(b)))] <- NA out_new <- rbind(out_new, b) - #### catch #### + ##### catch #### # did not find landings atm catch <- input$catch_data |> dplyr::rename_with(tolower) |> From fb6e68c6093d131959f3556445816e9e00955ebb Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Fri, 27 Feb 2026 16:14:02 -0500 Subject: [PATCH 05/21] lay foundation for extracting based on type within list --- R/convert_output.R | 234 +++++++++++++++++++++++++++++++++------------ 1 file changed, 175 insertions(+), 59 deletions(-) diff --git a/R/convert_output.R b/R/convert_output.R index d3b2eae3..b06b9183 100644 --- a/R/convert_output.R +++ b/R/convert_output.R @@ -1774,68 +1774,184 @@ convert_output <- function( dat <- file } - # estimates - # Which parts of the data need extraction? - # Is there a list of quantities or inputs? - quantities <- dat$quantities - estimates <- dat$estimated_params - - ##### Initialize year vector for timeseries ##### - str_yr <- GOApollock$styr - end_yr <- GOApollock$endyr - yrs <- str_yr:end_yr + factors <- c("year", "fleet", "fleet_name", "age", "sex", "area", "seas", "season", "time", "era", "subseas", "subseason", "platoon", "platoo", "growth_pattern", "gp", "nsim", "age_a") + errors <- c("StdDev", "sd", "se", "SE", "cv", "CV", "stddev") + # units <- c("mt", "lbs", "eggs") - ##### spawning biomass #### - sb <- as.data.frame(t(as.matrix(quantities$ssb))) |> - tibble::rownames_to_column() |> - dplyr::mutate( - label = "spawning_biomass", - era = dplyr::case_when( - year > end_yr ~ "fore", - year < str_yr ~ "early", - TRUE ~ "time" - ) - ) - colnames(sb) <- c("year", "estimate", "label") - sb[setdiff(tolower(names(out_new)), tolower(names(sb)))] <- NA - out_new <- rbind(out_new, sb) + for (p in 2:length(dat)) { + extract <- dat[p] + module_name <- names(extract) + cli::cli_alert_info(glue::glue("Processing {names(extract)}")) + if (is.vector(extract[[1]])) { + if (is.list(extract[[1]])) { # indicates vector and list + if (any(vapply(extract[[1]], is.matrix, FUN.VALUE = logical(1)))) { + extract_list <- list() + for (i in seq_along(extract[[1]])) { + if (is.vector(extract[[1]][[i]])) { + df <- as.data.frame(extract[[1]][i]) |> + tibble::rownames_to_column(var = "age") |> + tidyr::pivot_longer( + cols = -age, + values_to = "estimate", + names_to = "label" + ) |> + dplyr::mutate( + label = names(extract[[1]][i]), + # label_init = names(extract[[1]][i]), + fleet = dplyr::case_when( + grepl(paste(fleet_names, collapse = "|"), label) ~ stringr::str_extract(label, paste(fleet_names, collapse = "|")), + TRUE ~ NA + ), + module_name = names(extract), + label = dplyr::case_when( + grepl(paste(fleet_names, collapse = "|"), label) ~ stringr::str_replace(label, paste(".", fleet_names, sep = "", collapse = "|"), ""), + TRUE ~ label + ) + ) + df[setdiff(tolower(names(out_new)), tolower(names(df)))] <- NA + extract_list[[names(extract[[1]][i])]] <- df + } else { + df <- as.data.frame(extract[[1]][[i]]) |> + tibble::rownames_to_column(var = "year") + df <- df |> + dplyr::rename_with( + ~ ifelse(max(as.numeric(df$year)) < 50, + c("age_a"), c("year") + ), + year + ) + if (grepl("lcomp", names(extract[[1]][i]))) { + namesto <- "len_bins" + } else if (grepl("acomp", names(extract[[1]][i]))) { + namesto <- "age" + } else { + # Default + namesto <- "age" + } + df2 <- df |> + tidyr::pivot_longer( + cols = -intersect(colnames(df), c("year", "age_a")), + names_to = namesto, + values_to = "estimate" + ) |> + dplyr::mutate( + module_name = names(extract), + label = names(extract[[1]][i]), + fleet = dplyr::case_when( + grepl(paste(fleet_names, collapse = "|"), tolower(label)) ~ stringr::str_extract(tolower(label), paste(fleet_names, collapse = "|")), + TRUE ~ NA + ), # stringr::str_extract(module_name, "(?<=\\.)\\w+(?=\\.)"), + label = dplyr::case_when( + grepl(paste0(fleet_names, collapse = "|"), tolower(label)) ~ stringr::str_replace(tolower(label), paste0(".", fleet_names, collapse = "|"), ""), + TRUE ~ names(extract[[1]][i]) + ) + # label_init = names(extract[[1]][i]), + + # label = dplyr::case_when( + # is.na(fleet) ~ names(extract[[1]][i]), + # TRUE ~ stringr::str_replace(tolower(label), paste(".", fleet_names, sep = "", collapse = "|"), "") + # ) + ) # stringr::str_replace(module_name, "\\.[^.]+\\.", ".")) + df2[setdiff(tolower(names(out_new)), tolower(names(df2)))] <- NA + extract_list[[names(extract[[1]][i])]] <- df2 + } # close if statement + } # close for loop + new_df <- Reduce(rbind, extract_list) + out_list[[names(extract)]] <- new_df + } else if (any(vapply(extract[[1]], is.vector, FUN.VALUE = logical(1)))) { + df <- extract[[1]] + # go through all elements of df + + # if (length(intersect(colnames(df), c(factors, errors))) > 0) { + # df2 <- df |> + # tidyr::pivot_longer( + # cols = -intersect(colnames(df), c(factors, errors)), + # names_to = "label", + # values_to = "estimate" + # ) |> + # dplyr::mutate(module_name = names(extract)) + # } else { + # df2 <- df |> + # tidyr::pivot_longer( + # cols = tidyselect::everything(), + # names_to = "label", + # values_to = "estimate" + # ) |> + # dplyr::mutate(module_name = names(extract)) + # } + # if (any(grepl(paste(fleet_names, collapse = "|"), unique(df2$label)))) { + # df2 <- df2 |> + # dplyr::mutate( + # fleet = dplyr::case_when( + # grepl(paste(fleet_names, collapse = "|"), label) ~ stringr::str_extract(label, paste(fleet_names, collapse = "|")), + # # grepl(paste(fleet_names, collapse = "|"), label) ~ stringr::str_extract(ex, paste(fleet_names,collapse="|")), + # TRUE ~ NA + # ), + # # Number after fleet name is what? variable among df? + # age = dplyr::case_when( + # module_name != "parms" & grepl(".Age[0-9]+.", label) ~ stringr::str_extract(label, "(?<=.Age?)[0-9]+"), + # module_name != "parms" & grepl("[0-9]+$", label) & as.numeric(stringr::str_extract(label, "[0-9]+$")) < 30 ~ stringr::str_extract(label, "[0-9]+$"), + # TRUE ~ NA + # ), + # label = dplyr::case_when( + # # below will only work properly if there are age varying parameters without fleet names in it + # module_name == "parms" & !grepl(paste(".", fleet_names, sep = "", collapse = "|"), tolower(label)) ~ label, + # grepl(paste(".", fleet_names, "d[0-9]+", sep = "", collapse = "|"), tolower(label)) ~ stringr::str_replace(tolower(label), paste(".", fleet_names, "d[0-9]+", sep = "", collapse = "|"), ".d"), + # grepl(paste(".", fleet_names, "[0-9]+$", sep = "", collapse = "|"), tolower(label)) ~ stringr::str_replace(tolower(label), paste(fleet_names, sep = "", collapse = "|"), ""), # "[0-9]+", + # grepl(paste(".", fleet_names, "$", sep = "", collapse = "|"), tolower(label)) ~ stringr::str_replace(tolower(label), paste(".", fleet_names, sep = "", collapse = "|"), ""), + # grepl(paste(".", fleet_names, ".d$", sep = "", collapse = "|"), tolower(label)) ~ stringr::str_replace(tolower(label), paste(".", fleet_names, sep = "", collapse = "|"), ""), + # grepl(".Age[0-9]+.[a-z]+", label) ~ stringr::str_replace(label, ".Age[0-9]+.[a-z]+", ""), + # grepl("[0-9]+$", label) ~ stringr::str_replace(label, "[0-9]+$", ""), + # # !is.na(fleet) | !is.na(age) ~ stringr::str_replace(label, paste(c(paste(".", fleet_names, "[0-9]+", sep = ""), ".Age[0-9]+.[a-z]+", "[0-9]+$"), collapse = "|"), ""), + # # as.numeric(stringr::str_extract(label, "[0-9]+$")) == 0 ~ label, + # # as.numeric(stringr::str_extract(label, "[0-9]+$")) < 30 ~ stringr::str_remove(label, "[0-9]+$"), + # TRUE ~ label + # ) + # ) + # } else if (any(grepl("[0-9]$", unique(df2$label)))) { + # df2 <- df2 |> + # dplyr::mutate( + # fleet = NA, + # # Number after fleet name is what? variable among df? + # age = dplyr::case_when( + # grepl("[0-9]+$", label) & stringr::str_extract(label, "[0-9]+$") < 30 ~ stringr::str_extract(label, "[0-9]+$"), + # TRUE ~ NA + # ), + # # label_init = label, + # label = dplyr::case_when( + # as.numeric(stringr::str_extract(label, "[0-9]+$")) == 0 ~ label, + # as.numeric(stringr::str_extract(label, "[0-9]+$")) < 30 ~ stringr::str_remove(label, "[0-9]+$"), + # TRUE ~ label + # ) + # ) + # } else { + # df2 <- df2 |> + # dplyr::mutate( + # fleet = ifelse("age" %in% colnames(df2), fleet, NA), + # age = ifelse("age" %in% colnames(df2), age, NA), + # label = label, + # module_name = names(extract) + # ) + # } + # df2[setdiff(tolower(names(out_new)), tolower(names(df2)))] <- NA + # out_list[[names(extract)]] <- df2 + } else { + cli::cli_alert_warning("Not compatible.") + } + } else { + } + } else if (is.list(extract[[1]])) { # list only + } else if (is.matrix(extract[[1]])) { # matrix only + } else { + cli::cli_alert_warning(paste(names(extract), " not compatible.", sep = "")) + } # close if statement + } # close loop over objects listed in dat file + # Want to extract and set values from: + # quantities, sdrep, and estimated_params + # take similar approach to SS3 when only some keywords were converted + # can late take approach like BAM? - ###### biomass #### - b <- as.data.frame(t(as.matrix(quantities$biomass))) |> - tibble::rownames_to_column() |> - dplyr::mutate( - label = "biomass", - era = dplyr::case_when( - year > end_yr ~ "fore", - year < str_yr ~ "early", - TRUE ~ "time" - ) - ) - colnames(b) <- c("year", "estimate", "label") - b[setdiff(tolower(names(out_new)), tolower(names(b)))] <- NA - out_new <- rbind(out_new, b) - ##### catch #### - # did not find landings atm - catch <- input$catch_data |> - dplyr::rename_with(tolower) |> - dplyr::mutate( - label = "catch", - era = dplyr::case_when( - year > end_yr ~ "fore", - year < str_yr ~ "early", - TRUE ~ "time" - ), - fleet = dplyr::case_when( - unique(.data$Fleet_name) == 1 ~ NA, - TRUE ~ Fleet_name - ) - ) |> - dplyr::left_join( - input$fleet_control |> - dplyr::select(Fleet_name, Fleet_code), - by = c("Fleet_name"="Fleet_code") - ) } else { cli::cli_abort(c( From ef74c12e99a5dd1da11ee2c6b6ca96d4eb32fb9e Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Mon, 2 Mar 2026 14:01:50 -0500 Subject: [PATCH 06/21] work on converter for rceattle and clean --- R/convert_output.R | 45 +++++++++++++++++++++++++++++++++------------ 1 file changed, 33 insertions(+), 12 deletions(-) diff --git a/R/convert_output.R b/R/convert_output.R index b06b9183..18322853 100644 --- a/R/convert_output.R +++ b/R/convert_output.R @@ -1774,6 +1774,12 @@ convert_output <- function( dat <- file } + # Extract or use fleet names + if (is.null(fleet_names)) { + # TODO: as if there is a better way to id fleet names + fleet_names <- names(dat$estimated_params$index_ln_q) + } + factors <- c("year", "fleet", "fleet_name", "age", "sex", "area", "seas", "season", "time", "era", "subseas", "subseason", "platoon", "platoo", "growth_pattern", "gp", "nsim", "age_a") errors <- c("StdDev", "sd", "se", "SE", "cv", "CV", "stddev") # units <- c("mt", "lbs", "eggs") @@ -1789,25 +1795,40 @@ convert_output <- function( for (i in seq_along(extract[[1]])) { if (is.vector(extract[[1]][[i]])) { df <- as.data.frame(extract[[1]][i]) |> - tibble::rownames_to_column(var = "age") |> tidyr::pivot_longer( - cols = -age, + cols = tidyselect::everything(), values_to = "estimate", names_to = "label" ) |> + # 1. Split into generic parts first + tidyr::separate_wider_delim( + cols = label, + delim = ".", + names = paste0("part", 1:5), # Creates part1, part2, etc. + cols_remove = FALSE + ) |> + # 2. Reshape to long to find the keywords + tidyr::pivot_longer( + cols = starts_with("part"), + names_to = "original_pos", + values_to = "temp_value" + ) |> + # 3. Create the conditional logic dplyr::mutate( - label = names(extract[[1]][i]), - # label_init = names(extract[[1]][i]), - fleet = dplyr::case_when( - grepl(paste(fleet_names, collapse = "|"), label) ~ stringr::str_extract(label, paste(fleet_names, collapse = "|")), - TRUE ~ NA - ), - module_name = names(extract), - label = dplyr::case_when( - grepl(paste(fleet_names, collapse = "|"), label) ~ stringr::str_replace(label, paste(".", fleet_names, sep = "", collapse = "|"), ""), - TRUE ~ label + category = case_when( + str_detect(temp_value, "Age") ~ "age_col", + str_detect(temp_value, "Sex") ~ "sex_col", + str_detect(temp_value, "upper|lower") ~ "boundary", + TRUE ~ "other" ) + ) |> + # 4. Pivot back to wide format + tidyr::pivot_wider( + names_from = category, + values_from = temp_value ) + + df[setdiff(tolower(names(out_new)), tolower(names(df)))] <- NA extract_list[[names(extract[[1]][i])]] <- df } else { From 1204ccd24eac8efd22dc9742b9abdecce511c2df Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Mon, 2 Mar 2026 14:02:15 -0500 Subject: [PATCH 07/21] start function to rework data once out of a list --- R/utils.R | 41 ++++++++++++++++++++++++++++++++++------- 1 file changed, 34 insertions(+), 7 deletions(-) diff --git a/R/utils.R b/R/utils.R index c174f416..cf98ba2d 100644 --- a/R/utils.R +++ b/R/utils.R @@ -2,10 +2,6 @@ # General utility functions # @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -# @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -# General utility functions -# @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ - # Check end_year isn't past current year for non-projections plots # make year character if not null check_year <- function( @@ -54,7 +50,8 @@ get_ncol <- function(file, skip = 0) { nummax } -#---- SS3_extract_df ---- +#------------------------------------------------------------------------------ + # Helper for SS3 output converter # Function to extract rows, identify the dfs, and clean them up # SS3_extract_df <- function(dat, label) { @@ -126,7 +123,8 @@ SS3_extract_df <- function(dat, label) { as.data.frame(clean_dt) } -#---- SS3_extract_fleet ---- +#------------------------------------------------------------------------------ + SS3_extract_fleet <- function(dat, vers) { # Determine where fleet names are located base on model version # TODO: test other SS3 models and/or write converter based on r4ss::ss_output @@ -183,7 +181,7 @@ SS3_extract_fleet <- function(dat, vers) { fleets } -#---------------------------------------------------------- +#------------------------------------------------------------------------------ # # Baseline units for models # baseline_units <- function() { @@ -194,3 +192,32 @@ SS3_extract_fleet <- function(dat, vers) { # "weight" # ) # } + +#------------------------------------------------------------------------------ + +#' @param x unlisted object from model output + +expand_vector <- function(x) { + df <- as.data.frame(x) |> + tidyr::pivot_longer( + cols = tidyselect::everything(), + values_to = "estimate", + names_to = "label_init" + ) |> + dplyr::mutate( + label = stringr::str_extract(label_init, "^[^\\.]+"), + label_init = stringr::str_remove(label_init, "^[^\\.]+\\."), + label = dplyr::case_when( + label == "rec_pars" ~ label_init, + TRUE ~ label + ), + label_init = dplyr::case_when( + label == label_init ~ NA, + TRUE ~ label_init + ) + ) + + # suppressWarnings() + +} + From b398cb9c9a5286d7b7e6e35d19ff40d9a6a9620e Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Mon, 2 Mar 2026 17:14:06 -0500 Subject: [PATCH 08/21] improve function so it does processing on final extracted list rather than if else nested --- R/convert_output.R | 192 ++++++++------------------------------------- R/utils.R | 23 +++++- 2 files changed, 51 insertions(+), 164 deletions(-) diff --git a/R/convert_output.R b/R/convert_output.R index 18322853..30413893 100644 --- a/R/convert_output.R +++ b/R/convert_output.R @@ -1780,6 +1780,12 @@ convert_output <- function( fleet_names <- names(dat$estimated_params$index_ln_q) } + # Output fleet names in console + cli::cli_alert_info("Identified fleet names:") + cli::cli_alert_info("{fleet_names}") + # Create list for morphed dfs to go into (for rbind later) + out_list <- list() + factors <- c("year", "fleet", "fleet_name", "age", "sex", "area", "seas", "season", "time", "era", "subseas", "subseason", "platoon", "platoo", "growth_pattern", "gp", "nsim", "age_a") errors <- c("StdDev", "sd", "se", "SE", "cv", "CV", "stddev") # units <- c("mt", "lbs", "eggs") @@ -1791,171 +1797,35 @@ convert_output <- function( if (is.vector(extract[[1]])) { if (is.list(extract[[1]])) { # indicates vector and list if (any(vapply(extract[[1]], is.matrix, FUN.VALUE = logical(1)))) { + ############################################################## + if (module_name == "quantities") { + extract_list <- extract[[1]][!(names(extract[[1]]) %in% c("a", "c"))] + } else { + extract_list <- extract[[1]] + } + df <- extract_list |> + expand_vector() |> + dplyr::mutate( + module_name = module_name + ) + out_list[[names(extract)]] <- df + } else if (any(vapply(extract[[1]], is.vector, FUN.VALUE = logical(1)))) { # all must be a vector to work - so there must be conditions for dfs with a mix extract_list <- list() + mod_name1 <- names(extract) for (i in seq_along(extract[[1]])) { - if (is.vector(extract[[1]][[i]])) { - df <- as.data.frame(extract[[1]][i]) |> - tidyr::pivot_longer( - cols = tidyselect::everything(), - values_to = "estimate", - names_to = "label" - ) |> - # 1. Split into generic parts first - tidyr::separate_wider_delim( - cols = label, - delim = ".", - names = paste0("part", 1:5), # Creates part1, part2, etc. - cols_remove = FALSE - ) |> - # 2. Reshape to long to find the keywords - tidyr::pivot_longer( - cols = starts_with("part"), - names_to = "original_pos", - values_to = "temp_value" - ) |> - # 3. Create the conditional logic - dplyr::mutate( - category = case_when( - str_detect(temp_value, "Age") ~ "age_col", - str_detect(temp_value, "Sex") ~ "sex_col", - str_detect(temp_value, "upper|lower") ~ "boundary", - TRUE ~ "other" - ) - ) |> - # 4. Pivot back to wide format - tidyr::pivot_wider( - names_from = category, - values_from = temp_value - ) - - - df[setdiff(tolower(names(out_new)), tolower(names(df)))] <- NA - extract_list[[names(extract[[1]][i])]] <- df - } else { - df <- as.data.frame(extract[[1]][[i]]) |> - tibble::rownames_to_column(var = "year") - df <- df |> - dplyr::rename_with( - ~ ifelse(max(as.numeric(df$year)) < 50, - c("age_a"), c("year") - ), - year - ) - if (grepl("lcomp", names(extract[[1]][i]))) { - namesto <- "len_bins" - } else if (grepl("acomp", names(extract[[1]][i]))) { - namesto <- "age" - } else { - # Default - namesto <- "age" - } - df2 <- df |> - tidyr::pivot_longer( - cols = -intersect(colnames(df), c("year", "age_a")), - names_to = namesto, - values_to = "estimate" - ) |> - dplyr::mutate( - module_name = names(extract), - label = names(extract[[1]][i]), - fleet = dplyr::case_when( - grepl(paste(fleet_names, collapse = "|"), tolower(label)) ~ stringr::str_extract(tolower(label), paste(fleet_names, collapse = "|")), - TRUE ~ NA - ), # stringr::str_extract(module_name, "(?<=\\.)\\w+(?=\\.)"), - label = dplyr::case_when( - grepl(paste0(fleet_names, collapse = "|"), tolower(label)) ~ stringr::str_replace(tolower(label), paste0(".", fleet_names, collapse = "|"), ""), - TRUE ~ names(extract[[1]][i]) - ) - # label_init = names(extract[[1]][i]), - - # label = dplyr::case_when( - # is.na(fleet) ~ names(extract[[1]][i]), - # TRUE ~ stringr::str_replace(tolower(label), paste(".", fleet_names, sep = "", collapse = "|"), "") - # ) - ) # stringr::str_replace(module_name, "\\.[^.]+\\.", ".")) - df2[setdiff(tolower(names(out_new)), tolower(names(df2)))] <- NA - extract_list[[names(extract[[1]][i])]] <- df2 - } # close if statement - } # close for loop + mod_name2 <- glue::glue("{mod_name1}_{names(extract[[1]][i])}") + df <- extract[[1]][i][[1]] |> + expand_vector() |> + dplyr::mutate( + module_name = mod_name2 + ) # |> + # suppressWarnings() + + df[setdiff(tolower(names(out_new)), tolower(names(df)))] <- NA + extract_list[[names(extract[[1]][i])]] <- df + } new_df <- Reduce(rbind, extract_list) out_list[[names(extract)]] <- new_df - } else if (any(vapply(extract[[1]], is.vector, FUN.VALUE = logical(1)))) { - df <- extract[[1]] - # go through all elements of df - - # if (length(intersect(colnames(df), c(factors, errors))) > 0) { - # df2 <- df |> - # tidyr::pivot_longer( - # cols = -intersect(colnames(df), c(factors, errors)), - # names_to = "label", - # values_to = "estimate" - # ) |> - # dplyr::mutate(module_name = names(extract)) - # } else { - # df2 <- df |> - # tidyr::pivot_longer( - # cols = tidyselect::everything(), - # names_to = "label", - # values_to = "estimate" - # ) |> - # dplyr::mutate(module_name = names(extract)) - # } - # if (any(grepl(paste(fleet_names, collapse = "|"), unique(df2$label)))) { - # df2 <- df2 |> - # dplyr::mutate( - # fleet = dplyr::case_when( - # grepl(paste(fleet_names, collapse = "|"), label) ~ stringr::str_extract(label, paste(fleet_names, collapse = "|")), - # # grepl(paste(fleet_names, collapse = "|"), label) ~ stringr::str_extract(ex, paste(fleet_names,collapse="|")), - # TRUE ~ NA - # ), - # # Number after fleet name is what? variable among df? - # age = dplyr::case_when( - # module_name != "parms" & grepl(".Age[0-9]+.", label) ~ stringr::str_extract(label, "(?<=.Age?)[0-9]+"), - # module_name != "parms" & grepl("[0-9]+$", label) & as.numeric(stringr::str_extract(label, "[0-9]+$")) < 30 ~ stringr::str_extract(label, "[0-9]+$"), - # TRUE ~ NA - # ), - # label = dplyr::case_when( - # # below will only work properly if there are age varying parameters without fleet names in it - # module_name == "parms" & !grepl(paste(".", fleet_names, sep = "", collapse = "|"), tolower(label)) ~ label, - # grepl(paste(".", fleet_names, "d[0-9]+", sep = "", collapse = "|"), tolower(label)) ~ stringr::str_replace(tolower(label), paste(".", fleet_names, "d[0-9]+", sep = "", collapse = "|"), ".d"), - # grepl(paste(".", fleet_names, "[0-9]+$", sep = "", collapse = "|"), tolower(label)) ~ stringr::str_replace(tolower(label), paste(fleet_names, sep = "", collapse = "|"), ""), # "[0-9]+", - # grepl(paste(".", fleet_names, "$", sep = "", collapse = "|"), tolower(label)) ~ stringr::str_replace(tolower(label), paste(".", fleet_names, sep = "", collapse = "|"), ""), - # grepl(paste(".", fleet_names, ".d$", sep = "", collapse = "|"), tolower(label)) ~ stringr::str_replace(tolower(label), paste(".", fleet_names, sep = "", collapse = "|"), ""), - # grepl(".Age[0-9]+.[a-z]+", label) ~ stringr::str_replace(label, ".Age[0-9]+.[a-z]+", ""), - # grepl("[0-9]+$", label) ~ stringr::str_replace(label, "[0-9]+$", ""), - # # !is.na(fleet) | !is.na(age) ~ stringr::str_replace(label, paste(c(paste(".", fleet_names, "[0-9]+", sep = ""), ".Age[0-9]+.[a-z]+", "[0-9]+$"), collapse = "|"), ""), - # # as.numeric(stringr::str_extract(label, "[0-9]+$")) == 0 ~ label, - # # as.numeric(stringr::str_extract(label, "[0-9]+$")) < 30 ~ stringr::str_remove(label, "[0-9]+$"), - # TRUE ~ label - # ) - # ) - # } else if (any(grepl("[0-9]$", unique(df2$label)))) { - # df2 <- df2 |> - # dplyr::mutate( - # fleet = NA, - # # Number after fleet name is what? variable among df? - # age = dplyr::case_when( - # grepl("[0-9]+$", label) & stringr::str_extract(label, "[0-9]+$") < 30 ~ stringr::str_extract(label, "[0-9]+$"), - # TRUE ~ NA - # ), - # # label_init = label, - # label = dplyr::case_when( - # as.numeric(stringr::str_extract(label, "[0-9]+$")) == 0 ~ label, - # as.numeric(stringr::str_extract(label, "[0-9]+$")) < 30 ~ stringr::str_remove(label, "[0-9]+$"), - # TRUE ~ label - # ) - # ) - # } else { - # df2 <- df2 |> - # dplyr::mutate( - # fleet = ifelse("age" %in% colnames(df2), fleet, NA), - # age = ifelse("age" %in% colnames(df2), age, NA), - # label = label, - # module_name = names(extract) - # ) - # } - # df2[setdiff(tolower(names(out_new)), tolower(names(df2)))] <- NA - # out_list[[names(extract)]] <- df2 } else { cli::cli_alert_warning("Not compatible.") } diff --git a/R/utils.R b/R/utils.R index cf98ba2d..e33706ad 100644 --- a/R/utils.R +++ b/R/utils.R @@ -214,10 +214,27 @@ expand_vector <- function(x) { label_init = dplyr::case_when( label == label_init ~ NA, TRUE ~ label_init + ), + age = dplyr::case_when( + grepl("Age[0-9]+", label_init) ~ as.numeric(stringr::str_extract(label_init, "[0-9]+")), + TRUE ~ NA_real_ + ), + sex = dplyr::case_when( + grepl("Sex.combined", label_init) ~ "combined", + grepl("Sex.female", label_init) ~ "female", # check! haven't seen example yet of this + grepl("Sex.male", label_init) ~ "male", # check! haven't seen example yet of this + TRUE ~ NA_character_ + ), + year = dplyr::case_when( + grepl("[0-9]{4}", label_init) ~ as.numeric(stringr::str_extract(label_init, "[0-9]{4}")), + TRUE ~ NA_real_ + ), + fleet = case_when( + grepl(paste0(fleet_names, collapse = "|"), label_init) ~ stringr::str_extract(label_init, paste0(fleet_names, collapse = "|")), + TRUE ~ NA_character_ ) - ) - + ) |> + dplyr::select(-label_init) # |> # suppressWarnings() - } From 1b913dc2e2375ddc5a59c69981d82ace1869a7eb Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Tue, 3 Mar 2026 16:41:24 -0500 Subject: [PATCH 09/21] adjust utility fxn for rceattle to work with multidimensional elements of list --- R/convert_output.R | 12 ++--- R/utils.R | 107 ++++++++++++++++++++++++++++----------------- 2 files changed, 72 insertions(+), 47 deletions(-) diff --git a/R/convert_output.R b/R/convert_output.R index 30413893..2d428175 100644 --- a/R/convert_output.R +++ b/R/convert_output.R @@ -1798,24 +1798,20 @@ convert_output <- function( if (is.list(extract[[1]])) { # indicates vector and list if (any(vapply(extract[[1]], is.matrix, FUN.VALUE = logical(1)))) { ############################################################## - if (module_name == "quantities") { - extract_list <- extract[[1]][!(names(extract[[1]]) %in% c("a", "c"))] - } else { - extract_list <- extract[[1]] - } - df <- extract_list |> - expand_vector() |> + df <- extract[[1]] |> + expand_element(fleet_names = fleet_names) |> dplyr::mutate( module_name = module_name ) out_list[[names(extract)]] <- df + } else if (any(vapply(extract[[1]], is.vector, FUN.VALUE = logical(1)))) { # all must be a vector to work - so there must be conditions for dfs with a mix extract_list <- list() mod_name1 <- names(extract) for (i in seq_along(extract[[1]])) { mod_name2 <- glue::glue("{mod_name1}_{names(extract[[1]][i])}") df <- extract[[1]][i][[1]] |> - expand_vector() |> + expand_element(fleet_names = fleet_names) |> dplyr::mutate( module_name = mod_name2 ) # |> diff --git a/R/utils.R b/R/utils.R index e33706ad..3d1e704f 100644 --- a/R/utils.R +++ b/R/utils.R @@ -197,44 +197,73 @@ SS3_extract_fleet <- function(dat, vers) { #' @param x unlisted object from model output -expand_vector <- function(x) { - df <- as.data.frame(x) |> - tidyr::pivot_longer( - cols = tidyselect::everything(), - values_to = "estimate", - names_to = "label_init" - ) |> - dplyr::mutate( - label = stringr::str_extract(label_init, "^[^\\.]+"), - label_init = stringr::str_remove(label_init, "^[^\\.]+\\."), - label = dplyr::case_when( - label == "rec_pars" ~ label_init, - TRUE ~ label - ), - label_init = dplyr::case_when( - label == label_init ~ NA, - TRUE ~ label_init - ), - age = dplyr::case_when( - grepl("Age[0-9]+", label_init) ~ as.numeric(stringr::str_extract(label_init, "[0-9]+")), - TRUE ~ NA_real_ - ), - sex = dplyr::case_when( - grepl("Sex.combined", label_init) ~ "combined", - grepl("Sex.female", label_init) ~ "female", # check! haven't seen example yet of this - grepl("Sex.male", label_init) ~ "male", # check! haven't seen example yet of this - TRUE ~ NA_character_ - ), - year = dplyr::case_when( - grepl("[0-9]{4}", label_init) ~ as.numeric(stringr::str_extract(label_init, "[0-9]{4}")), - TRUE ~ NA_real_ - ), - fleet = case_when( - grepl(paste0(fleet_names, collapse = "|"), label_init) ~ stringr::str_extract(label_init, paste0(fleet_names, collapse = "|")), - TRUE ~ NA_character_ - ) - ) |> - dplyr::select(-label_init) # |> - # suppressWarnings() +expand_element <- function(input_list, fleet_names = "Pollock") { + + # Use map_dfr to iterate over each element of the list + # .id = "origin_var" keeps track of which list element the data came from + purrr::imap_dfr(input_list, function(x, name) { + + # Skip empty/null elements immediately + if (length(x) == 0 || is.null(x)) return(NULL) + + # Standardize current element 'x' to a Long Data Frame + if (!is.null(dim(x)) && length(dim(x)) > 1) { + # Handles Arrays/Matrices + df <- as.data.frame.table(x, responseName = "estimate") |> + # Unite all Var columns into one string, e.g., "Pollock.Sex combined.Age1" + tidyr::unite("dim_info", tidyselect::matches("^Var"), sep = ".", na.rm = TRUE) |> + # Prepend the element name: "M1_at_age.Pollock.Sex combined.Age1" + dplyr::mutate(label_init = paste0(name, ".", dim_info)) |> + dplyr::select(-dim_info) + } else { + # Handles Vectors/Named Vectors + df <- tibble::enframe(x, name = "dim_info", value = "estimate") |> + dplyr::mutate(label_init = dplyr::case_when( + is.na(dim_info) | dim_info == "" ~ as.character(name), + TRUE ~ paste0(name, ".", dim_info) + )) |> + dplyr::select(-dim_info) + } + + # Process the labels + df |> + dplyr::mutate( + label_init = as.character(label_init), + + # Pull parameter name + label = stringr::str_extract(label_init, "^[^\\.]+"), + + # Extract Age + age = dplyr::case_when( + grepl("age", label_init, ignore.case = TRUE) ~ + as.numeric(stringr::str_extract(label_init, "[0-9]+")), + TRUE ~ NA_real_ + ), + + # Extract Sex + sex = dplyr::case_when( + grepl("Sex.combined|combined", label_init, ignore.case = TRUE) ~ "combined", + grepl("female", label_init, ignore.case = TRUE) ~ "female", # check havent seen example of this! + grepl("male", label_init, ignore.case = TRUE) ~ "male", # check havent seen example of this! + TRUE ~ NA_character_ + ), + + # Extract Year (4 digits) + year = dplyr::case_when( + grepl("[0-9]{4}", label_init) ~ as.numeric(stringr::str_extract(label_init, "[0-9]{4}")), + TRUE ~ NA_real_ + ), + + # Extract Fleet + fleet = dplyr::case_when( + grepl(paste0(fleet_names, collapse = "|"), label_init) ~ + stringr::str_extract(label_init, paste0(fleet_names, collapse = "|")), + TRUE ~ NA_character_ + ) + ) |> + # Ensure 'estimate' is numeric and clean up temp columns + dplyr::mutate(estimate = as.numeric(estimate)) |> + dplyr::select(-label_init) + }) } From 7b8cd6fdb39d934329d7bc63c8526304ccf701e5 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Wed, 4 Mar 2026 14:03:30 -0500 Subject: [PATCH 10/21] minor updates on supporting function to run rceattle through converter --- R/convert_output.R | 19 ++++++++++--------- R/utils.R | 7 +++++-- 2 files changed, 15 insertions(+), 11 deletions(-) diff --git a/R/convert_output.R b/R/convert_output.R index 2d428175..a4760934 100644 --- a/R/convert_output.R +++ b/R/convert_output.R @@ -1793,8 +1793,8 @@ convert_output <- function( for (p in 2:length(dat)) { extract <- dat[p] module_name <- names(extract) - cli::cli_alert_info(glue::glue("Processing {names(extract)}")) - if (is.vector(extract[[1]])) { + cli::cli_alert_info("Processing {module_name}") + # if (is.vector(extract[[1]])) { if (is.list(extract[[1]])) { # indicates vector and list if (any(vapply(extract[[1]], is.matrix, FUN.VALUE = logical(1)))) { ############################################################## @@ -1807,9 +1807,9 @@ convert_output <- function( } else if (any(vapply(extract[[1]], is.vector, FUN.VALUE = logical(1)))) { # all must be a vector to work - so there must be conditions for dfs with a mix extract_list <- list() - mod_name1 <- names(extract) + # mod_name1 <- names(extract) for (i in seq_along(extract[[1]])) { - mod_name2 <- glue::glue("{mod_name1}_{names(extract[[1]][i])}") + mod_name2 <- glue::glue("{module_name}_{names(extract[[1]][i])}") df <- extract[[1]][i][[1]] |> expand_element(fleet_names = fleet_names) |> dplyr::mutate( @@ -1826,12 +1826,13 @@ convert_output <- function( cli::cli_alert_warning("Not compatible.") } } else { + cli::cli_alert_warning("Not compatible yet.") } - } else if (is.list(extract[[1]])) { # list only - } else if (is.matrix(extract[[1]])) { # matrix only - } else { - cli::cli_alert_warning(paste(names(extract), " not compatible.", sep = "")) - } # close if statement + # } else if (is.list(extract[[1]])) { # list only + # } else if (is.matrix(extract[[1]])) { # matrix only + # } else { + # cli::cli_alert_warning(paste(names(extract), " not compatible.", sep = "")) + # } # close if statement } # close loop over objects listed in dat file # Want to extract and set values from: # quantities, sdrep, and estimated_params diff --git a/R/utils.R b/R/utils.R index 3d1e704f..d766ee1c 100644 --- a/R/utils.R +++ b/R/utils.R @@ -231,12 +231,15 @@ expand_element <- function(input_list, fleet_names = "Pollock") { label_init = as.character(label_init), # Pull parameter name - label = stringr::str_extract(label_init, "^[^\\.]+"), + label = dplyr::case_when( + stringr::str_extract(label_init, "^[^\\.]+") == "rec_pars" ~ stringr::str_extract(label_init, "[^\\.]+$"), + TRUE ~ stringr::str_extract(label_init, "^[^\\.]+") + ), # Extract Age age = dplyr::case_when( grepl("age", label_init, ignore.case = TRUE) ~ - as.numeric(stringr::str_extract(label_init, "[0-9]+")), + as.numeric(stringr::str_extract(label_init, "(?<=\\.[Aa]ge)[0-9]+(?=\\.|$)")), TRUE ~ NA_real_ ), From c2529716b384297c10e0eb0c1028a4e4fbae596f Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Wed, 4 Mar 2026 14:05:24 -0500 Subject: [PATCH 11/21] add note on where you left off --- R/convert_output.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/convert_output.R b/R/convert_output.R index a4760934..5f304b64 100644 --- a/R/convert_output.R +++ b/R/convert_output.R @@ -1791,6 +1791,7 @@ convert_output <- function( # units <- c("mt", "lbs", "eggs") for (p in 2:length(dat)) { + # last tested through p=6 extract <- dat[p] module_name <- names(extract) cli::cli_alert_info("Processing {module_name}") From 87e4eef8ffcf81774840db01fb01203750479e0f Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Fri, 6 Mar 2026 16:37:25 -0500 Subject: [PATCH 12/21] additional progress and testing up through element 9 --- R/convert_output.R | 53 ++++++++++++++++++++++++++++------------------ 1 file changed, 32 insertions(+), 21 deletions(-) diff --git a/R/convert_output.R b/R/convert_output.R index 5f304b64..764f360d 100644 --- a/R/convert_output.R +++ b/R/convert_output.R @@ -4,7 +4,7 @@ #' #' @param file Assessment model output file path #' @param model Assessment model used in evaluation ("ss3", "bam", -#' "fims"). +#' "fims", "rceattle). #' @param fleet_names Names of fleets in the assessment model as #' shortened in the output file. If fleet names are not properly read, then #' indicate the fleets names as an acronym in a vector @@ -97,17 +97,19 @@ convert_output <- function( out_new <- out_new[-1, ] # Check if path links to a valid file - url_pattern <- "^(https?|ftp|file):\\/\\/[-A-Za-z0-9+&@#\\/%?=~_|!:,.;]*[-A-Za-z0-9+&@#\\/%=~_|]$" - if (grepl(url_pattern, file)) { - check <- httr::HEAD(file) - url <- httr::status_code(check) - if (url == 404) cli::cli_abort(c(message = "Invalid URL.")) - } else { - if (!file.exists(file)) { - cli::cli_abort(c( - message = "`file` not found.", - "i" = "`file` entered as {file}" - )) + if (is.character(file)) { + url_pattern <- "^(https?|ftp|file):\\/\\/[-A-Za-z0-9+&@#\\/%?=~_|!:,.;]*[-A-Za-z0-9+&@#\\/%=~_|]$" + if (grepl(url_pattern, file)) { + check <- httr::HEAD(file) + url <- httr::status_code(check) + if (url == 404) cli::cli_abort(c(message = "Invalid URL.")) + } else { + if (!file.exists(file)) { + cli::cli_abort(c( + message = "`file` not found.", + "i" = "`file` entered as {file}" + )) + } } } @@ -1790,8 +1792,8 @@ convert_output <- function( errors <- c("StdDev", "sd", "se", "SE", "cv", "CV", "stddev") # units <- c("mt", "lbs", "eggs") - for (p in 2:length(dat)) { - # last tested through p=6 + for (p in (2:length(dat))[-6]) { + # last tested through p=9 (data_list) extract <- dat[p] module_name <- names(extract) cli::cli_alert_info("Processing {module_name}") @@ -1810,14 +1812,23 @@ convert_output <- function( extract_list <- list() # mod_name1 <- names(extract) for (i in seq_along(extract[[1]])) { - mod_name2 <- glue::glue("{module_name}_{names(extract[[1]][i])}") - df <- extract[[1]][i][[1]] |> - expand_element(fleet_names = fleet_names) |> - dplyr::mutate( - module_name = mod_name2 - ) # |> + # need to add condition or something in expand_element to account for data thats formatted differently but is still a list i.e. p=9 + if (is.list(extract[[1]][i][[1]])) { + mod_name2 <- glue::glue("{module_name}_{names(extract[[1]][i])}") + + df <- extract[[1]][i][[1]] |> + expand_element(fleet_names = fleet_names) |> + dplyr::mutate( + module_name = mod_name2 + ) # |> # suppressWarnings() - + } else { + df <- data.frame( + estimate = extract[[1]][[i]][[1]], + label = names(extract[[1]][i]), + module_name = module_name + ) + } df[setdiff(tolower(names(out_new)), tolower(names(df)))] <- NA extract_list[[names(extract[[1]][i])]] <- df } From 8cc30ee93afc97aac2ef7a1dc411292b7d3e7aad Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Mon, 9 Mar 2026 16:27:10 -0400 Subject: [PATCH 13/21] fix issues with some reps in loop and manually adjust values that are needed in if statemnet --- R/convert_output.R | 123 +++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 113 insertions(+), 10 deletions(-) diff --git a/R/convert_output.R b/R/convert_output.R index 764f360d..a53506b2 100644 --- a/R/convert_output.R +++ b/R/convert_output.R @@ -1768,7 +1768,10 @@ convert_output <- function( out_new <- fims_output #### Rceattle #### } else if (model == "rceattle") { - + # Want to extract and set values from: + # quantities, sdrep, and estimated_params + # take similar approach to SS3 when only some keywords were converted + # can late take approach like BAM? # TODO: Do we want users to input the saved file or already loaded into the R environment? if (is.character(file)) { dat <- readRDS(file) @@ -1792,13 +1795,109 @@ convert_output <- function( errors <- c("StdDev", "sd", "se", "SE", "cv", "CV", "stddev") # units <- c("mt", "lbs", "eggs") - for (p in (2:length(dat))[-6]) { + for (p in (2:length(dat))[-c(6, 8, 9, 10)]) { + # might need to manually add the removed above # last tested through p=9 (data_list) extract <- dat[p] module_name <- names(extract) cli::cli_alert_info("Processing {module_name}") - # if (is.vector(extract[[1]])) { - if (is.list(extract[[1]])) { # indicates vector and list + if (module_name == "sdrep") { + # this does not include all elements from sdrep list + df <- extract[[1]] + # Extract values from sdrep element in listdrep + values <- data.frame( + label = names(extract[[1]]$value), + estimate = extract[[1]]$value, + uncertainty = extract[[1]]$sd, + uncertainty_label = "sd" + ) + # values_count <- values |> + # dplyr::group_by(label) |> + # dplyr::count() + values <- values |> + dplyr::left_join( + { + values |> dplyr::group_by(label) |> dplyr::count() + }, + by = "label" + ) + # make year column + year_col <- rep( + file[["data_list"]]$styr:file[["data_list"]]$projyr, + length(unique( + dplyr::filter(values_count, n == length(file[["data_list"]]$styr:file[["data_list"]]$projyr)) |> + dplyr::pull(label) + )) + ) + + df2 <- values |> + dplyr::filter(n == length(file[["data_list"]]$styr:file[["data_list"]]$projyr)) |> + dplyr::mutate(year = year_col) |> + rbind( + { + values |> + dplyr::filter( + n != length(file[["data_list"]]$styr:file[["data_list"]]$projyr) + ) |> + dplyr::mutate(year = NA) + } + ) + + # Extract parameter values ts + par_fixes <- data.frame( + label = names(extract[[1]]$par.fixed), + estimate = extract[[1]]$par.fixed + ) + # par_fixes |> + # dplyr::group_by(label) |> + # dplyr::count() + par_fixes <- par_fixes |> + dplyr::left_join( + { + par_fixes |> + dplyr::group_by(label) |> + dplyr::count() + }, + by = "label" + ) + + year_col_par_fix <- rep( + file[["data_list"]]$styr:file[["data_list"]]$endyr, + length(unique( + dplyr::filter(par_fixes_count, n == length(file[["data_list"]]$styr:file[["data_list"]]$endyr)) |> + dplyr::pull(label) + )) + ) + + df3 <- par_fixes |> + dplyr::filter(n == length(file[["data_list"]]$styr:file[["data_list"]]$endyr)) |> + dplyr::mutate(year = year_col_par_fix) |> + rbind( + { + par_fixes |> + dplyr::filter( + n != length(file[["data_list"]]$styr:file[["data_list"]]$endyr) + ) |> + dplyr::mutate(year = NA) + } + ) |> + dplyr::mutate( + uncertainty = NA, + uncertainty_label = NA + ) + # not sure how pop_scalar is indexed + # not sure how log_index_hat is indexes + # Did not use r_sd for the error in rec bc used it from the other element in the list + + df4 <- rbind(df2, df3) |> + dplyr::select(-n) |> + dplyr::mutate( + module_name = module_name + ) + + df4[setdiff(tolower(names(out_new)), tolower(names(df4)))] <- NA + out_list[[names(extract)]] <- df4 + } else if (is.list(extract[[1]])) { # indicates vector and list if (any(vapply(extract[[1]], is.matrix, FUN.VALUE = logical(1)))) { ############################################################## df <- extract[[1]] |> @@ -1806,6 +1905,7 @@ convert_output <- function( dplyr::mutate( module_name = module_name ) + df[setdiff(tolower(names(out_new)), tolower(names(df)))] <- NA out_list[[names(extract)]] <- df } else if (any(vapply(extract[[1]], is.vector, FUN.VALUE = logical(1)))) { # all must be a vector to work - so there must be conditions for dfs with a mix @@ -1815,6 +1915,8 @@ convert_output <- function( # need to add condition or something in expand_element to account for data thats formatted differently but is still a list i.e. p=9 if (is.list(extract[[1]][i][[1]])) { mod_name2 <- glue::glue("{module_name}_{names(extract[[1]][i])}") + # comment out message once finished development + cli::cli_alert_info("Processing {names(extract[[1]][i])}") df <- extract[[1]][i][[1]] |> expand_element(fleet_names = fleet_names) |> @@ -1846,12 +1948,13 @@ convert_output <- function( # cli::cli_alert_warning(paste(names(extract), " not compatible.", sep = "")) # } # close if statement } # close loop over objects listed in dat file - # Want to extract and set values from: - # quantities, sdrep, and estimated_params - # take similar approach to SS3 when only some keywords were converted - # can late take approach like BAM? - - + # Finish out df + out_new <- Reduce(rbind, out_list) |> + # Add era as factor into BAM conout + dplyr::mutate( + # TODO: replace all periods with underscore if naming convention is different + label = tolower(label) + ) } else { cli::cli_abort(c( From 27d2061c03ecfee0c70da81d391bf82105441015 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Mon, 9 Mar 2026 16:33:43 -0400 Subject: [PATCH 14/21] add change to standard naming conventions --- R/convert_output.R | 5 +- R/utils.R | 1 + inst/resources/rceattle_var_names.csv | 176 ++++++++++++++++++++++++++ 3 files changed, 181 insertions(+), 1 deletion(-) create mode 100644 inst/resources/rceattle_var_names.csv diff --git a/R/convert_output.R b/R/convert_output.R index a53506b2..1abed3c4 100644 --- a/R/convert_output.R +++ b/R/convert_output.R @@ -2007,7 +2007,10 @@ convert_output <- function( } else if (tolower(model) == "fims") { con_file <- system.file("resources", "fims_var_names.csv", package = "stockplotr", mustWork = TRUE) var_names_sheet <- utils::read.csv(con_file, na.strings = "") - } + } else if (tolower(model) == "rceattle") { + con_file <- system.file("resources", "rceattle_var_names.csv", package = "stockplotr", mustWork = TRUE) + var_names_sheet <- utils::read.csv(con_file, na.strings = "") + }) if (file.exists(con_file)) { # Remove 'X' column if it exists diff --git a/R/utils.R b/R/utils.R index d766ee1c..3da25705 100644 --- a/R/utils.R +++ b/R/utils.R @@ -220,6 +220,7 @@ expand_element <- function(input_list, fleet_names = "Pollock") { df <- tibble::enframe(x, name = "dim_info", value = "estimate") |> dplyr::mutate(label_init = dplyr::case_when( is.na(dim_info) | dim_info == "" ~ as.character(name), + # grepl("//.", dim_info) ~ dim_info, # condition where the name is the only thing in the label TRUE ~ paste0(name, ".", dim_info) )) |> dplyr::select(-dim_info) diff --git a/inst/resources/rceattle_var_names.csv b/inst/resources/rceattle_var_names.csv new file mode 100644 index 00000000..c8307836 --- /dev/null +++ b/inst/resources/rceattle_var_names.csv @@ -0,0 +1,176 @@ +alt_label,label,module_name +,beta_rec_pars,estimated_paramters +ln_catch_sd,catch_ln_sd,estimated_paramters +composition_weights,comp_weights,estimated_paramters +diet_composition_weights,diet_comp_weights,estimated_paramters +,dummy,estimated_paramters +,index_ln_q,estimated_paramters +,index_ln_sd,estimated_paramters +,index_q_beta,estimated_paramters +,index_q_dev,estimated_paramters +,index_q_dev_ln_sd,estimated_paramters +,index_q_ln_sd,estimated_paramters +,index_q_rho,estimated_paramters +,init_dev,estimated_paramters +ln_fishing_mortality,ln_F,estimated_paramters +ln_fishing_mortality_initial,ln_Finit,estimated_paramters +ln_fishing_mortality_limit,ln_Flimit,estimated_paramters +ln_fishing_mortality_target,ln_Ftarget,estimated_paramters +ln_natural_mortality,ln_M1,estimated_paramters +ln_natural_mortality_deviations,ln_M1_dev,estimated_paramters +,ln_pop_scalar,estimated_paramters +,ln_sel_slp,estimated_paramters +,ln_sel_slp_dev,estimated_paramters +,log_gam_a,estimated_paramters +,log_gam_b,estimated_paramters +,log_phi,estimated_paramters +,M1_beta,estimated_paramters +,M1_dev_ln_sd,estimated_paramters +,M1_rho,estimated_paramters +fishing_mortality_proportion,proj_F_prop,estimated_paramters +recruitment_deviations_sd,R_ln_sd,estimated_paramters +recruitment_deviations,rec_dev,estimated_paramters +recruitment_parameters,rec_pars,estimated_paramters +,sel_coff,estimated_paramters +,sel_coff_dev,estimated_paramters +,sel_curve_pen,estimated_paramters +,sel_dev_ln_sd,estimated_paramters +,sel_inf,estimated_paramters +,sel_inf_dev,estimated_paramters +catch,age_hat,quantities +catch_adjusted,age_obs_hat,quantities +,avail_food,quantities +revcruitment,avg_R,quantities +selectivity,avg_sel,quantities +abundance,avgN_at_age,quantities +,B_eaten,quantities +,B_eaten_as_pred,quantities +,B_eaten_as_prey,quantities +biomass_unfished,B0,quantities +,biomass,quantities +biomass,biomass_at_age,quantities +biomass_biomass_unfished,biomass_depletion,quantities +landings,catch_hat,quantities +,comp_hat,quantities +,consumption_at_age,quantities +diet_proportion,diet_prop,quantities +,diet_prop_hat,quantities +biomass,DynamicB0,quantities +spawning_biomass,DynamicSB0,quantities +spawning_biomass,DynamicSBF,quantities +fishing_mortality,F_at_age,quantities +fishing_mortality,F_flt,quantities +fishing_mortality,F_flt_age,quantities +fishing_mortality,F_spp,quantities +fishing_mortality_limit,Flimit,quantities +,fT,quantities +fishing_mortality_target,Ftarget,quantities +,gam_a,quantities +,gam_b,quantities +,index_hat,quantities +,index_q,quantities +,jnll,quantities +,jnll_comp,quantities +,ln_catch_sd,quantities +,ln_index_sd,quantities +,log_index_hat,quantities +log_spawning_biomass,log_ssb,quantities +natural_mortality,M_at_age,quantities +M1,M1_at_age,quantities +M2,M2_at_age,quantities +M2_proportion,M2_prop,quantities +,NByage0,quantities +,NByageF,quantities +,NbyageSPR,quantities +,non_par_sel,quantities +,other_food_diet_prop,quantities +,pop_scalar,quantities +fishing_mortality,proj_F,quantities +recruitment,R,quantities +recruitment_hat,R_hat,quantities +recruitment_initial,R_init,quantities +recruitment_sd,R_sd,quantities +R0,R0,quantities +,ration,quantities +spawning_biomass_f0,SB0,quantities +spawning_biomass_f_target,SBF,quantities +selectivity,sel,quantities +,sel_curve_pen,quantities +,SPR0,quantities +SPR_initial,SPRFinit,quantities +SPR_limit,SPRlimit,quantities +SPR_target,SPRtarget,quantities +spawning_biomass,ssb,quantities +spawning_biomass_depletion,ssb_depletion,quantities +,steepness,quantities +,suit_other,quantities +,suitability,quantities +,true_age_comp_hat,quantities +,unweighted_jnll_comp,quantities +,vulnerability,quantities +,vulnerability_other,quantities +total_mortality,Z_at_age,quantities +,nspp,data_list +start_year,styr,data_list +end_year,endyr,data_list +projection_year,projyr,data_list +species_name,spnames,data_list +number_sex,nsex,data_list +spawning_month,spawn_month,data_list +number_ages,nages,data_list +,minage,data_list +,nlengths,data_list +,pop_wt_index,data_list +,ssb_wt_index,data_list +,pop_age_transition_index,data_list +,sigma_rec_prior,data_list +,other_food,data_list +,estDynamics,data_list +,est_M1,data_list +,fleet_control,data_list +,comp_data,data_list +,emp_sel,data_list +,NByageFixed,data_list +,age_trans_matrix,data_list +,age_error,data_list +,sex_ratio,data_list +,M1_base,data_list +,Ceq,data_list +,Cindex,data_list +,Pvalue,data_list +,fday,data_list +,CA,data_list +,CB,data_list +,Qc,data_list +,Tco,data_list +,Tcm,data_list +,Tcl,data_list +,CK1,data_list +,CK4,data_list +,env_data,data_list +catch,catch_data,data_list +indices,index_data,data_list +,maturity,data_list +weight,weight,data_list +,diet_data,data_list +,Diet_comp_weights,data_list +,ration_data,data_list +,MSSB0,data_list +,MSB0,data_list +,random_rec,data_list +,estimateMode,data_list +,niter,data_list +,avgnMode,data_list +,initMode,data_list +,msmMode,data_list +,HCR,data_list +,DynamicHCR,data_list +fishing_mortality_target,Ftarget,data_list +fishing_mortality_limit,Flimit,data_list +,Ptarget,data_list +,Plimit,data_list +,Alpha,data_list +,Pstar,data_list +,Sigma,data_list +,Fmult,data_list +,QnormHCR,data_list \ No newline at end of file From 996ae4155264362b75ebc3e6f00080558344c831 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Mon, 9 Mar 2026 16:54:34 -0400 Subject: [PATCH 15/21] adjustment to brackets and parantheses --- R/convert_output.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/R/convert_output.R b/R/convert_output.R index 1abed3c4..35602a5d 100644 --- a/R/convert_output.R +++ b/R/convert_output.R @@ -1811,9 +1811,9 @@ convert_output <- function( uncertainty = extract[[1]]$sd, uncertainty_label = "sd" ) - # values_count <- values |> - # dplyr::group_by(label) |> - # dplyr::count() + values_count <- values |> + dplyr::group_by(label) |> + dplyr::count() values <- values |> dplyr::left_join( { @@ -1848,9 +1848,9 @@ convert_output <- function( label = names(extract[[1]]$par.fixed), estimate = extract[[1]]$par.fixed ) - # par_fixes |> - # dplyr::group_by(label) |> - # dplyr::count() + par_fixes_count <- par_fixes |> + dplyr::group_by(label) |> + dplyr::count() par_fixes <- par_fixes |> dplyr::left_join( { @@ -2010,7 +2010,7 @@ convert_output <- function( } else if (tolower(model) == "rceattle") { con_file <- system.file("resources", "rceattle_var_names.csv", package = "stockplotr", mustWork = TRUE) var_names_sheet <- utils::read.csv(con_file, na.strings = "") - }) + } if (file.exists(con_file)) { # Remove 'X' column if it exists From 818a268ee44f5ae5bd31747dea63791ec72ac071 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Fri, 13 Mar 2026 16:33:20 -0400 Subject: [PATCH 16/21] recognize model as rceattle object; make reading in ifelse for naming csv more efficient; remove mod-name2 and keep as just module name --- R/convert_output.R | 88 ++++++++++++++++++++++++++++------------------ 1 file changed, 54 insertions(+), 34 deletions(-) diff --git a/R/convert_output.R b/R/convert_output.R index 35602a5d..f1d98830 100644 --- a/R/convert_output.R +++ b/R/convert_output.R @@ -114,27 +114,43 @@ convert_output <- function( } # Recognize model through file extension - if (is.null(model)) { - model <- switch(stringr::str_extract(file, "\\.([^.]+)$"), - ".sso" = { - cli::cli_alert_info("Processing Stock Synthesis output file...") - "ss3" - }, - ".rdat" = { - cli::cli_alert_info("Processing BAM output file...") - "bam" - }, - ".rds" = { - cli::cli_alert_info("Processing WHAM output file...") - "wham" - }, - ".RDS" = { + if (is.character(file)) { + if (is.null(model)) { + model <- switch(stringr::str_extract(file, "\\.([^.]+)$"), + ".sso" = { + cli::cli_alert_info("Processing Stock Synthesis output file...") + "ss3" + }, + ".rdat" = { + cli::cli_alert_info("Processing BAM output file...") + "bam" + }, + ".rds" = { + cli::cli_alert_info("Processing WHAM output file...") + "wham" + }, + ".RDS" = { + cli::cli_alert_info("Processing FIMS output file...") + "fims" + }, + + cli::cli_abort("Unknown file type. Please indicate model.") + ) + } + } else { + model <- switch (class(file)[1], + "fims" = { cli::cli_alert_info("Processing FIMS output file...") "fims" }, + "Rceattle" = { + cli::cli_alert_info("Processing Rceattle output file...") + "rceattle" + }, cli::cli_abort("Unknown file type. Please indicate model.") ) } + #### SS3 #### # Convert SS3 output Report.sso file @@ -1914,14 +1930,14 @@ convert_output <- function( for (i in seq_along(extract[[1]])) { # need to add condition or something in expand_element to account for data thats formatted differently but is still a list i.e. p=9 if (is.list(extract[[1]][i][[1]])) { - mod_name2 <- glue::glue("{module_name}_{names(extract[[1]][i])}") + # mod_name2 <- glue::glue("{module_name}_{names(extract[[1]][i])}") # comment out message once finished development cli::cli_alert_info("Processing {names(extract[[1]][i])}") df <- extract[[1]][i][[1]] |> expand_element(fleet_names = fleet_names) |> dplyr::mutate( - module_name = mod_name2 + module_name = module_name # mod_name2 ) # |> # suppressWarnings() } else { @@ -1995,23 +2011,27 @@ convert_output <- function( ) ) |> suppressWarnings() - if (tolower(model) == "ss3") { - con_file <- system.file("resources", "ss3_var_names.csv", package = "stockplotr", mustWork = TRUE) - var_names_sheet <- utils::read.csv(con_file, na.strings = "") - } else if (tolower(model) == "bam") { - con_file <- system.file("resources", "bam_var_names.csv", package = "stockplotr", mustWork = TRUE) - var_names_sheet <- utils::read.csv(con_file, na.strings = "") |> - dplyr::mutate( - label = tolower(label) - ) - } else if (tolower(model) == "fims") { - con_file <- system.file("resources", "fims_var_names.csv", package = "stockplotr", mustWork = TRUE) - var_names_sheet <- utils::read.csv(con_file, na.strings = "") - } else if (tolower(model) == "rceattle") { - con_file <- system.file("resources", "rceattle_var_names.csv", package = "stockplotr", mustWork = TRUE) - var_names_sheet <- utils::read.csv(con_file, na.strings = "") - } - + # if (tolower(model) == "ss3") { + # con_file <- system.file("resources", "ss3_var_names.csv", package = "stockplotr", mustWork = TRUE) + # var_names_sheet <- utils::read.csv(con_file, na.strings = "") + # } else if (tolower(model) == "bam") { + # con_file <- system.file("resources", "bam_var_names.csv", package = "stockplotr", mustWork = TRUE) + # var_names_sheet <- utils::read.csv(con_file, na.strings = "") |> + # dplyr::mutate( + # label = tolower(label) + # ) + # } else if (tolower(model) == "fims") { + # con_file <- system.file("resources", "fims_var_names.csv", package = "stockplotr", mustWork = TRUE) + # var_names_sheet <- utils::read.csv(con_file, na.strings = "") + # } else if (tolower(model) == "rceattle") { + # con_file <- system.file("resources", "rceattle_var_names.csv", package = "stockplotr", mustWork = TRUE) + # var_names_sheet <- utils::read.csv(con_file, na.strings = "") + # } + + # edit: here is a different way of loading in the csv sheets + con_file <- system.file("resources", glue::glue("{model}_var_names.csv"), package = "stockplotr", mustWork = TRUE) + var_names_sheet <- utils::read.csv(con_file, na.strings = "") + if (file.exists(con_file)) { # Remove 'X' column if it exists var_names_sheet <- var_names_sheet |> From 80eee1e7551e400f88a90f6358b65f7a2103093d Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Fri, 13 Mar 2026 16:33:43 -0400 Subject: [PATCH 17/21] update module names and expand naming conventions for other labels --- inst/resources/rceattle_var_names.csv | 378 ++++++++++++++------------ 1 file changed, 202 insertions(+), 176 deletions(-) diff --git a/inst/resources/rceattle_var_names.csv b/inst/resources/rceattle_var_names.csv index c8307836..7feff877 100644 --- a/inst/resources/rceattle_var_names.csv +++ b/inst/resources/rceattle_var_names.csv @@ -1,176 +1,202 @@ -alt_label,label,module_name -,beta_rec_pars,estimated_paramters -ln_catch_sd,catch_ln_sd,estimated_paramters -composition_weights,comp_weights,estimated_paramters -diet_composition_weights,diet_comp_weights,estimated_paramters -,dummy,estimated_paramters -,index_ln_q,estimated_paramters -,index_ln_sd,estimated_paramters -,index_q_beta,estimated_paramters -,index_q_dev,estimated_paramters -,index_q_dev_ln_sd,estimated_paramters -,index_q_ln_sd,estimated_paramters -,index_q_rho,estimated_paramters -,init_dev,estimated_paramters -ln_fishing_mortality,ln_F,estimated_paramters -ln_fishing_mortality_initial,ln_Finit,estimated_paramters -ln_fishing_mortality_limit,ln_Flimit,estimated_paramters -ln_fishing_mortality_target,ln_Ftarget,estimated_paramters -ln_natural_mortality,ln_M1,estimated_paramters -ln_natural_mortality_deviations,ln_M1_dev,estimated_paramters -,ln_pop_scalar,estimated_paramters -,ln_sel_slp,estimated_paramters -,ln_sel_slp_dev,estimated_paramters -,log_gam_a,estimated_paramters -,log_gam_b,estimated_paramters -,log_phi,estimated_paramters -,M1_beta,estimated_paramters -,M1_dev_ln_sd,estimated_paramters -,M1_rho,estimated_paramters -fishing_mortality_proportion,proj_F_prop,estimated_paramters -recruitment_deviations_sd,R_ln_sd,estimated_paramters -recruitment_deviations,rec_dev,estimated_paramters -recruitment_parameters,rec_pars,estimated_paramters -,sel_coff,estimated_paramters -,sel_coff_dev,estimated_paramters -,sel_curve_pen,estimated_paramters -,sel_dev_ln_sd,estimated_paramters -,sel_inf,estimated_paramters -,sel_inf_dev,estimated_paramters -catch,age_hat,quantities -catch_adjusted,age_obs_hat,quantities -,avail_food,quantities -revcruitment,avg_R,quantities -selectivity,avg_sel,quantities -abundance,avgN_at_age,quantities -,B_eaten,quantities -,B_eaten_as_pred,quantities -,B_eaten_as_prey,quantities -biomass_unfished,B0,quantities -,biomass,quantities -biomass,biomass_at_age,quantities -biomass_biomass_unfished,biomass_depletion,quantities -landings,catch_hat,quantities -,comp_hat,quantities -,consumption_at_age,quantities -diet_proportion,diet_prop,quantities -,diet_prop_hat,quantities -biomass,DynamicB0,quantities -spawning_biomass,DynamicSB0,quantities -spawning_biomass,DynamicSBF,quantities -fishing_mortality,F_at_age,quantities -fishing_mortality,F_flt,quantities -fishing_mortality,F_flt_age,quantities -fishing_mortality,F_spp,quantities -fishing_mortality_limit,Flimit,quantities -,fT,quantities -fishing_mortality_target,Ftarget,quantities -,gam_a,quantities -,gam_b,quantities -,index_hat,quantities -,index_q,quantities -,jnll,quantities -,jnll_comp,quantities -,ln_catch_sd,quantities -,ln_index_sd,quantities -,log_index_hat,quantities -log_spawning_biomass,log_ssb,quantities -natural_mortality,M_at_age,quantities -M1,M1_at_age,quantities -M2,M2_at_age,quantities -M2_proportion,M2_prop,quantities -,NByage0,quantities -,NByageF,quantities -,NbyageSPR,quantities -,non_par_sel,quantities -,other_food_diet_prop,quantities -,pop_scalar,quantities -fishing_mortality,proj_F,quantities -recruitment,R,quantities -recruitment_hat,R_hat,quantities -recruitment_initial,R_init,quantities -recruitment_sd,R_sd,quantities -R0,R0,quantities -,ration,quantities -spawning_biomass_f0,SB0,quantities -spawning_biomass_f_target,SBF,quantities -selectivity,sel,quantities -,sel_curve_pen,quantities -,SPR0,quantities -SPR_initial,SPRFinit,quantities -SPR_limit,SPRlimit,quantities -SPR_target,SPRtarget,quantities -spawning_biomass,ssb,quantities -spawning_biomass_depletion,ssb_depletion,quantities -,steepness,quantities -,suit_other,quantities -,suitability,quantities -,true_age_comp_hat,quantities -,unweighted_jnll_comp,quantities -,vulnerability,quantities -,vulnerability_other,quantities -total_mortality,Z_at_age,quantities -,nspp,data_list -start_year,styr,data_list -end_year,endyr,data_list -projection_year,projyr,data_list -species_name,spnames,data_list -number_sex,nsex,data_list -spawning_month,spawn_month,data_list -number_ages,nages,data_list -,minage,data_list -,nlengths,data_list -,pop_wt_index,data_list -,ssb_wt_index,data_list -,pop_age_transition_index,data_list -,sigma_rec_prior,data_list -,other_food,data_list -,estDynamics,data_list -,est_M1,data_list -,fleet_control,data_list -,comp_data,data_list -,emp_sel,data_list -,NByageFixed,data_list -,age_trans_matrix,data_list -,age_error,data_list -,sex_ratio,data_list -,M1_base,data_list -,Ceq,data_list -,Cindex,data_list -,Pvalue,data_list -,fday,data_list -,CA,data_list -,CB,data_list -,Qc,data_list -,Tco,data_list -,Tcm,data_list -,Tcl,data_list -,CK1,data_list -,CK4,data_list -,env_data,data_list -catch,catch_data,data_list -indices,index_data,data_list -,maturity,data_list -weight,weight,data_list -,diet_data,data_list -,Diet_comp_weights,data_list -,ration_data,data_list -,MSSB0,data_list -,MSB0,data_list -,random_rec,data_list -,estimateMode,data_list -,niter,data_list -,avgnMode,data_list -,initMode,data_list -,msmMode,data_list -,HCR,data_list -,DynamicHCR,data_list -fishing_mortality_target,Ftarget,data_list -fishing_mortality_limit,Flimit,data_list -,Ptarget,data_list -,Plimit,data_list -,Alpha,data_list -,Pstar,data_list -,Sigma,data_list -,Fmult,data_list -,QnormHCR,data_list \ No newline at end of file +module_name,label,alt_label +initial_params,ln_finit, +initial_params,ln_flimit,ln_fishing_mortality_limit +initial_params,ln_ftarget,ln_fishing_mortality_target +initial_params,ln_m1, +initial_params,ln_m1_dev, +initial_params,ln_pop_scalar, +initial_params,ln_sel_slp, +initial_params,ln_sel_slp_dev, +initial_params,log_gam_a, +initial_params,log_gam_b, +initial_params,log_phi, +initial_params,m1_beta, +initial_params,m1_dev_ln_sd, +initial_params,m1_rho, +initial_params,proj_f_prop, +initial_params,r0, +initial_params,r_ln_sd, +initial_params,rec_dev,recruitment_deviations +initial_params,sel_coff, +initial_params,sel_coff_dev, +initial_params,sel_curve_pen, +initial_params,sel_curve_pen, +initial_params,sel_dev_ln_sd, +initial_params,sel_inf, +initial_params,sel_inf_dev, +map,1, +map,2, +map,3, +map,alpha, +map,beta, +map,beta_rec_pars, +map,catch_ln_sd,ln_catch_sd +map,comp_weights,composition_weights +map,diet_comp_weights,diet_composition_weights +map,dummy, +map,index_ln_q, +map,index_ln_sd, +map,index_q_beta, +map,index_q_dev, +map,index_q_dev_ln_sd, +map,index_q_ln_sd, +map,index_q_rho, +map,init_dev, +map,ln_f,ln_fishing_mortality +map,ln_finit,ln_fishing_mortality_initial +map,ln_flimit,ln_fishing_mortality_limit +map,ln_ftarget,ln_fishing_mortality_target +map,ln_m1, +map,ln_m1_dev, +map,ln_pop_scalar, +map,ln_sel_slp, +map,ln_sel_slp_dev, +map,log_gam_a, +map,log_gam_b, +map,log_phi, +map,m1_beta, +map,m1_dev_ln_sd, +map,m1_rho, +map,proj_f_prop, +map,r0, +map,r_ln_sd, +map,rec_dev,recruitment_deviations +map,sel_coff, +map,sel_coff_dev, +map,sel_curve_pen, +map,sel_curve_pen, +map,sel_dev_ln_sd, +map,sel_inf, +map,sel_inf_dev, +phase_params,alpha, +phase_params,beta, +phase_params,beta_rec_pars, +phase_params,catch_ln_sd,ln_catch_sd +phase_params,comp_weights,composition_weights +phase_params,diet_comp_weights,diet_composition_weights +phase_params,dummy, +phase_params,index_ln_q, +phase_params,index_ln_sd, +phase_params,index_q_beta, +phase_params,index_q_dev, +phase_params,index_q_dev_ln_sd, +phase_params,index_q_ln_sd, +phase_params,index_q_rho, +phase_params,init_dev, +phase_params,ln_f,ln_fishing_mortality +phase_params,ln_finit,ln_fishing_mortality_initial +phase_params,ln_flimit,ln_fishing_mortality_limit +phase_params,ln_ftarget,ln_fishing_mortality_target +phase_params,ln_m1, +phase_params,ln_m1_dev, +phase_params,ln_pop_scalar, +phase_params,ln_sel_slp, +phase_params,ln_sel_slp_dev, +phase_params,log_gam_a, +phase_params,log_gam_b, +phase_params,log_phi, +phase_params,m1_beta, +phase_params,m1_dev_ln_sd, +phase_params,m1_rho, +phase_params,proj_f_prop, +phase_params,r0, +phase_params,r_ln_sd, +phase_params,rec_dev,recruitment_deviations +phase_params,sel_coff, +phase_params,sel_coff_dev, +phase_params,sel_curve_pen, +phase_params,sel_curve_pen, +phase_params,sel_dev_ln_sd, +phase_params,sel_inf, +phase_params,sel_inf_dev, +quantities,age_hat,catch +quantities,age_obs_hat,catch_adjusted +quantities,avail_food, +quantities,avg_r,recruitment_mean +quantities,avgn_at_age,abundance_average +quantities,b0, +quantities,b_eaten, +quantities,b_eaten_as_prey, +quantities,biomass, +quantities,biomass_at_age,biomass +quantities,biomass_depletion,biomass_biomass_unfished +quantities,catch_hat,landings +quantities,comp_hat, +quantities,comp_n, +quantities,comp_obs, +quantities,consumption_at_age, +quantities,diet_hat, +quantities,diet_obs, +quantities,dynamicb0, +quantities,dynamicsb0, +quantities,dynamicsbf, +quantities,exploitable_biomass, +quantities,f_at_age,fishing_mortality +quantities,f_flt,fishing_mortality +quantities,f_flt_age,fishing_mortality +quantities,f_spp,fishing_mortality +quantities,flimit,fishing_mortality_target +quantities,flt_sel_maxage, +quantities,ft, +quantities,ftarget,fishing_mortality_limit +quantities,gam_a, +quantities,gam_b, +quantities,index_hat, +quantities,index_q, +quantities,jnll, +quantities,jnll_comp, +quantities,ln_catch_sd, +quantities,ln_index_sd, +quantities,log_index_hat, +quantities,log_ssb,log_spawning_biomass +quantities,m1_at_age,m1 +quantities,m2_at_age,m2 +quantities,m2_prop,proportion_m2 +quantities,m_at_age,natural_mortality +quantities,max_catch_hat, +quantities,n_at_age,abundance +quantities,nbyage0,abundance_rec_hat_f0 +quantities,nbyagef,abundance_rec_hat_f_target +quantities,nbyagespr,abundance_spr +quantities,pop_scalar, +quantities,proj_f,fishing_mortality +quantities,r,recruitment +quantities,r0, +quantities,r_hat, +quantities,r_init,recruitment_initial +quantities,r_sd,recruitment_sd +quantities,ration, +quantities,sb0,spawning_biomass_0 +quantities,sbf,spawning_biomass_target +quantities,sel,selectivity +quantities,spr0, +quantities,sprfinit,spr_initial +quantities,sprlimit,spr_limit +quantities,sprtarget,spr_target +quantities,ssb,spawning_biomass +quantities,ssb_depletion,spawning_biomass_depletion +quantities,steepness, +quantities,stom_div_bio, +quantities,suit_other, +quantities,suitability, +quantities,true_age_comp_hat, +quantities,unweighted_jnll_comp, +quantities,vulnerability, +quantities,vulnerability_other, +quantities,z_at_age,total+mortality +sdrep,biomass, +sdrep,index_ln_q, +sdrep,init_dev, +sdrep,ln_f, +sdrep,ln_sel_slp, +sdrep,ln_sel_slp_dev, +sdrep,log_index_hat, +sdrep,log_ssb,log_spawning_biomass +sdrep,pop_scalar, +sdrep,r,recruitment +sdrep,r_sd,recruitment_sd +sdrep,rec_dev,recruitment_deviations +sdrep,rec_pars,recruitment_parameters +sdrep,sel_inf, +sdrep,sel_inf_dev, +sdrep,ssb,spawning_biomass From 3fc2790516fac2085b993b628c3b697bf701e578 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Tue, 17 Mar 2026 09:22:33 -0400 Subject: [PATCH 18/21] line that gets commented in and out for testing purposes --- R/convert_output.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/convert_output.R b/R/convert_output.R index f1d98830..0c12ae25 100644 --- a/R/convert_output.R +++ b/R/convert_output.R @@ -2030,6 +2030,8 @@ convert_output <- function( # edit: here is a different way of loading in the csv sheets con_file <- system.file("resources", glue::glue("{model}_var_names.csv"), package = "stockplotr", mustWork = TRUE) + # temporarily add call to local csv so I can test + # con_file <- glue::glue("~/GitHub/stockplotr/inst/resources/{model}_var_names.csv") var_names_sheet <- utils::read.csv(con_file, na.strings = "") if (file.exists(con_file)) { From 4daf371a64e800cfd2259b7cab569c0429a653d6 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Tue, 17 Mar 2026 17:29:46 -0400 Subject: [PATCH 19/21] add era column for year --- R/convert_output.R | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/R/convert_output.R b/R/convert_output.R index 0c12ae25..92e472e5 100644 --- a/R/convert_output.R +++ b/R/convert_output.R @@ -1969,7 +1969,13 @@ convert_output <- function( # Add era as factor into BAM conout dplyr::mutate( # TODO: replace all periods with underscore if naming convention is different - label = tolower(label) + label = tolower(label), + # set era + era = dplyr::if_else( + year > dat$data_list$endyr, + "fore", + "time" + ) ) } else { @@ -2029,9 +2035,9 @@ convert_output <- function( # } # edit: here is a different way of loading in the csv sheets - con_file <- system.file("resources", glue::glue("{model}_var_names.csv"), package = "stockplotr", mustWork = TRUE) + # con_file <- system.file("resources", glue::glue("{model}_var_names.csv"), package = "stockplotr", mustWork = TRUE) # temporarily add call to local csv so I can test - # con_file <- glue::glue("~/GitHub/stockplotr/inst/resources/{model}_var_names.csv") + con_file <- glue::glue("~/GitHub/stockplotr/inst/resources/{model}_var_names.csv") var_names_sheet <- utils::read.csv(con_file, na.strings = "") if (file.exists(con_file)) { From a7c8632516009134b5b25409106960c5490f279e Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Tue, 17 Mar 2026 17:47:35 -0400 Subject: [PATCH 20/21] comment out testing line to check tests --- R/convert_output.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/convert_output.R b/R/convert_output.R index 92e472e5..2878e7c8 100644 --- a/R/convert_output.R +++ b/R/convert_output.R @@ -2035,9 +2035,9 @@ convert_output <- function( # } # edit: here is a different way of loading in the csv sheets - # con_file <- system.file("resources", glue::glue("{model}_var_names.csv"), package = "stockplotr", mustWork = TRUE) + con_file <- system.file("resources", glue::glue("{model}_var_names.csv"), package = "stockplotr", mustWork = TRUE) # temporarily add call to local csv so I can test - con_file <- glue::glue("~/GitHub/stockplotr/inst/resources/{model}_var_names.csv") + # con_file <- glue::glue("~/GitHub/stockplotr/inst/resources/{model}_var_names.csv") var_names_sheet <- utils::read.csv(con_file, na.strings = "") if (file.exists(con_file)) { From 686cc93b961fab9061294de49ef364f8e8e9ad3e Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Wed, 18 Mar 2026 10:19:11 -0400 Subject: [PATCH 21/21] make adjustments to sdrep element which was missing output --- R/convert_output.R | 38 +++++++++++++------------------------- 1 file changed, 13 insertions(+), 25 deletions(-) diff --git a/R/convert_output.R b/R/convert_output.R index 2878e7c8..e5652322 100644 --- a/R/convert_output.R +++ b/R/convert_output.R @@ -1797,7 +1797,6 @@ convert_output <- function( # Extract or use fleet names if (is.null(fleet_names)) { - # TODO: as if there is a better way to id fleet names fleet_names <- names(dat$estimated_params$index_ln_q) } @@ -1812,8 +1811,6 @@ convert_output <- function( # units <- c("mt", "lbs", "eggs") for (p in (2:length(dat))[-c(6, 8, 9, 10)]) { - # might need to manually add the removed above - # last tested through p=9 (data_list) extract <- dat[p] module_name <- names(extract) cli::cli_alert_info("Processing {module_name}") @@ -1848,16 +1845,14 @@ convert_output <- function( df2 <- values |> dplyr::filter(n == length(file[["data_list"]]$styr:file[["data_list"]]$projyr)) |> - dplyr::mutate(year = year_col) |> - rbind( - { - values |> + dplyr::mutate(year = year_col) + + df2 <- values |> dplyr::filter( n != length(file[["data_list"]]$styr:file[["data_list"]]$projyr) ) |> - dplyr::mutate(year = NA) - } - ) + dplyr::mutate(year = NA) |> + rbind(df2) # Extract parameter values ts par_fixes <- data.frame( @@ -1869,11 +1864,7 @@ convert_output <- function( dplyr::count() par_fixes <- par_fixes |> dplyr::left_join( - { - par_fixes |> - dplyr::group_by(label) |> - dplyr::count() - }, + par_fixes_count, by = "label" ) @@ -1887,16 +1878,13 @@ convert_output <- function( df3 <- par_fixes |> dplyr::filter(n == length(file[["data_list"]]$styr:file[["data_list"]]$endyr)) |> - dplyr::mutate(year = year_col_par_fix) |> - rbind( - { - par_fixes |> - dplyr::filter( - n != length(file[["data_list"]]$styr:file[["data_list"]]$endyr) - ) |> - dplyr::mutate(year = NA) - } - ) |> + dplyr::mutate(year = year_col_par_fix) + df3 <- par_fixes |> + dplyr::filter( + n != length(file[["data_list"]]$styr:file[["data_list"]]$endyr) + ) |> + dplyr::mutate(year = NA) |> + rbind(df3) |> dplyr::mutate( uncertainty = NA, uncertainty_label = NA