From f0ea625b1f43afe651f7f4446c0f892695821500 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Tue, 15 Sep 2026 17:07:33 -0400 Subject: [PATCH 01/28] migrate rerender code from create_template into rerender_skeleton --- R/create_template.R | 540 +++++++++++++++++++++--------------------- R/rerender_skeleton.R | 394 ++++++++++++++++++++++++++++++ 2 files changed, 660 insertions(+), 274 deletions(-) create mode 100644 R/rerender_skeleton.R diff --git a/R/create_template.R b/R/create_template.R index 4bae213a..8b0122ff 100644 --- a/R/create_template.R +++ b/R/create_template.R @@ -427,13 +427,6 @@ create_template <- function( } } - # TODO: add switch here instead of if - # if (!is.null(office) & length(office) == 1) { - # office <- match.arg(office, several.ok = FALSE) - # } else if (length(office) > 1) { - # office <- "" - # } - # Create subdirectory for files subdir <- ifelse( grepl("/report", file_dir) || file_dir == "report", @@ -475,14 +468,14 @@ create_template <- function( custom_sections <- c(custom_sections, "references") } } else { - if (rerender_skeleton) { - # id the order of the files in the skeleton and copy over in that order - files_to_copy <- stringr::str_extract(prev_skeleton[grep("knitr::knit_child", prev_skeleton)], "(?<=knit_child\\(').*?(?=\\')") - # copy over template files from past one rather than new blanks - # files_to_copy <- list.files(current_folder)[grepl(".qmd", list.files(current_folder))] - } else { + # if (rerender_skeleton) { + # # id the order of the files in the skeleton and copy over in that order + # files_to_copy <- stringr::str_extract(prev_skeleton[grep("knitr::knit_child", prev_skeleton)], "(?<=knit_child\\(').*?(?=\\')") + # # copy over template files from past one rather than new blanks + # # files_to_copy <- list.files(current_folder)[grepl(".qmd", list.files(current_folder))] + # } else { files_to_copy <- list.files(current_folder) - } + # } } before_body_file <- system.file("resources", "formatting_files", "before-body.tex", package = "asar") @@ -548,63 +541,64 @@ create_template <- function( #### Read in previous skeleton if rerender ---- # Check if this is a rerender of the skeleton file - if (rerender_skeleton) { - # read format in skeleton & check if format is identified in the rerender call - if (!file.exists(file.path(file_dir, list.files(file_dir, pattern = "skeleton.qmd")))) stop("No skeleton quarto file found in the working directory.") - prev_skeleton <- readLines(file.path(file_dir, list.files(file_dir, pattern = "skeleton.qmd"))) - # extract previous format - prev_format <- stringr::str_extract( - prev_skeleton[grep("format:", prev_skeleton) + 1], - "[a-z]+" - ) - - # Update to current year - # prev_year <- as.numeric(stringr::str_extract( + # if (rerender_skeleton) { + # # read format in skeleton & check if format is identified in the rerender call + # if (!file.exists(file.path(file_dir, list.files(file_dir, pattern = "skeleton.qmd")))) stop("No skeleton quarto file found in the working directory.") + # prev_skeleton <- readLines(file.path(file_dir, list.files(file_dir, pattern = "skeleton.qmd"))) + # # extract previous format + # prev_format <- stringr::str_extract( + # prev_skeleton[grep("format:", prev_skeleton) + 1], + # "[a-z]+" + # ) + # year <- ifelse( + # is.na(as.numeric(stringr::str_extract( # prev_skeleton[grep("title:", prev_skeleton)], - # "[0-9]+")) - - # Add in species image if updated in rerender - if (!is.null(spp_image)) { - file.copy(spp_image, supdir, overwrite = FALSE) |> suppressWarnings() - # Change path to spp image since finished copying for yaml - if (file.exists(spp_image)) { - spp_image <- file.path("support_files", stringr::str_extract(spp_image, "(?<=/)[^/]+$")) - } - } - # if it is previously html and the rerender species html then need to copy over html formatting - if (tolower(prev_format) != "html" & tolower(format) == "html") { - if (!file.exists(file.path(file_dir, "support_files", "theme.scss"))) file.copy(system.file("resources", "formatting_files", "theme.scss", package = "asar"), supdir, overwrite = FALSE) |> suppressWarnings() - } - if (tolower(prev_format) != "pdf" & tolower(format) == "pdf") { - if (is.null(species)) { - species <- tolower(stringr::str_extract( - prev_skeleton[grep("species: ", prev_skeleton)], - "(?<=')[^']+(?=')" - )) - } - if (is.null(office)) { - office <- stringr::str_extract( - prev_skeleton[grep("office: ", prev_skeleton)], - "(?<=')[^']+(?=')" - ) - } - # year - default to current year - cli::cli_alert_warning("Undefined year.") - cli::cli_alert_info("Please identify year in your arguments or manually change it in the skeleton if value is incorrect.", - wrap = TRUE - ) - # copy before-body tex - if (!file.exists(file_dir, "support_files", "before-body.tex")) file.copy(before_body_file, supdir, overwrite = FALSE) |> suppressWarnings() - # customize titlepage tex - if (!file.exists(file_dir, "support_files", "_titlepage.tex") | !is.null(species)) create_titlepage_tex(office = office, subdir = supdir, species = species) - # customize in-header tex -- run this even on rerender - create_inheader_tex(species = species, year = year, subdir = supdir) - } - if (tolower(format)=="pdf") { - # customize in-header tex -- run this even on rerender - create_inheader_tex(species = species, year = year, subdir = supdir) - } - } else { + # "[0-9]+" + # ))), + # year, + # as.numeric(stringr::str_extract( + # prev_skeleton[grep("title:", prev_skeleton)], + # "[0-9]+" + # )) + # ) + # # Add in species image if updated in rerender + # if (!is.null(spp_image)) { + # file.copy(spp_image, supdir, overwrite = FALSE) |> suppressWarnings() + # # Change path to spp image since finished copying for yaml + # if (file.exists(spp_image)) { + # spp_image <- file.path("support_files", stringr::str_extract(spp_image, "(?<=/)[^/]+$")) + # } + # } + # # if it is previously html and the rerender species html then need to copy over html formatting + # if (tolower(prev_format) != "html" & tolower(format) == "html") { + # if (!file.exists(file.path(file_dir, "support_files", "theme.scss"))) file.copy(system.file("resources", "formatting_files", "theme.scss", package = "asar"), supdir, overwrite = FALSE) |> suppressWarnings() + # } + # if (tolower(prev_format) != "pdf" & tolower(format) == "pdf") { + # if (is.null(species)) { + # species <- tolower(stringr::str_extract( + # prev_skeleton[grep("species: ", prev_skeleton)], + # "(?<=')[^']+(?=')" + # )) + # } + # if (is.null(office)) { + # office <- stringr::str_extract( + # prev_skeleton[grep("office: ", prev_skeleton)], + # "(?<=')[^']+(?=')" + # ) + # } + # # year - default to current year + # cli::cli_alert_warning("Undefined year.") + # cli::cli_alert_info("Please identify year in your arguments or manually change it in the skeleton if value is incorrect.", + # wrap = TRUE + # ) + # # copy before-body tex + # if (!file.exists(file_dir, "support_files", "before-body.tex")) file.copy(before_body_file, supdir, overwrite = FALSE) |> suppressWarnings() + # # customize titlepage tex + # if (!file.exists(file_dir, "support_files", "_titlepage.tex") | !is.null(species)) create_titlepage_tex(office = office, subdir = supdir, species = species) + # # customize in-header tex + # if (!file.exists(file_dir, "support_files", "in-header.tex") | !is.null(species)) create_inheader_tex(species = species, year = year, subdir = supdir) + # } + # } else { #### Copy template files to report folder ---- # Check if there are already files in the folder # Only files present should be: @@ -693,7 +687,7 @@ create_template <- function( } } # close check for previous files & respective copying # prev_skeleton <- NULL - } # close if rerender + # } # close if rerender # Handle legacy document order and migration fig_info <- migrate_legacy_docs(subdir, doc_type = "figures", rerender_skeleton = rerender_skeleton) @@ -735,7 +729,7 @@ create_template <- function( } # Created tables doc - if (!rerender_skeleton) { + # if (!rerender_skeleton) { tables_doc_name <- switch(type, "nemt" = "06_tables.qmd", "safe" = "12_tables.qmd", @@ -746,17 +740,17 @@ create_template <- function( subdir = subdir, tables_dir = tables_dir ) - } else { - # extract name for tables.qmd from report folder - tables_doc_name <- if (can_rename_legacy_doc(tbl_info)) { - tbl_info$current_name - } else { - list.files(file_dir, pattern = "tables.qmd") - } - } + # } else { + # # extract name for tables.qmd from report folder + # tables_doc_name <- if (can_rename_legacy_doc(tbl_info)) { + # tbl_info$current_name + # } else { + # list.files(file_dir, pattern = "tables.qmd") + # } + # } # Create figures qmd - if (!rerender_skeleton) { + # if (!rerender_skeleton) { figures_doc_name <- switch(type, "nemt" = "05_figures.qmd", "safe" = "11_figures.qmd", @@ -774,14 +768,15 @@ create_template <- function( to = fs::path(subdir, figures_doc_name) ) } - } else { - # extract name for figures.qmd from report folder - figures_doc_name <- if (can_rename_legacy_doc(fig_info)) { - fig_info$current_name - } else { - list.files(file_dir, pattern = "figures.qmd") - } - } + # } else { + # # extract name for figures.qmd from report folder + # figures_doc_name <- if (can_rename_legacy_doc(fig_info)) { + # fig_info$current_name + # } else { + # list.files(file_dir, pattern = "figures.qmd") + # } + # } + # } # Part I # Create a report template file to render for the region and species @@ -790,22 +785,19 @@ create_template <- function( # Extract region based on param if it was previously found if (title == "[TITLE]") { # TODO: update below so title gets updated if new input is added such as region/species/office - if (rerender_skeleton) { - old_title <- sub("title: ", "", prev_skeleton[grep("title:", prev_skeleton)]) - if (old_title == "'Stock Assessment Report Template'" || species != "species" || !is.null(region) || !is.null(spp_latin)) { - title <- create_title( - office = office, - species = species, - spp_latin = spp_latin, - region = region, - type = type, - year = year - ) - } else { - # replace year with current year - title <- stringr::str_replace(old_title, "[0-9]+", as.character(year)) - } - } else { + # if (rerender_skeleton) { + # old_title <- sub("title: ", "", prev_skeleton[grep("title:", prev_skeleton)]) + # if (old_title == "'Stock Assessment Report Template'" || !is.null(office) || species != "species" || !is.null(region) || year != format(as.POSIXct(Sys.Date(), format = "%YYYY-%mm-%dd"), "%Y") || !is.null(spp_latin)) { + # title <- create_title( + # office = office, + # species = species, + # spp_latin = spp_latin, + # region = region, + # type = type, + # year = ifelse(is.na(year), format(as.POSIXct(Sys.Date(), format = "%YYYY-%mm-%dd"), "%Y"), year) + # ) + # } + # } else { title <- create_title( office = office, species = species, @@ -814,15 +806,15 @@ create_template <- function( type = type, year = year ) - } + # } } # Authors and affiliations # Parameters to add authorship to YAML author_list <- add_authors( - prev_skeleton = ifelse(rerender_skeleton, prev_skeleton, NULL), + # prev_skeleton = ifelse(rerender_skeleton, prev_skeleton, NULL), authors = authors, # need to put this in case there is a rerender otherwise it would not use the correct argument - rerender_skeleton = rerender_skeleton + rerender_skeleton = FALSE ) # Create yaml @@ -862,52 +854,52 @@ create_template <- function( if (!rerender_skeleton) cli::cli_alert_success("Built YAML header.") ##### Params chunk ---- - if (rerender_skeleton) { - params_chunk_start <- grep("R_parameters", prev_skeleton) - 1 - if (!any(grepl("R_parameters", prev_skeleton)) & parameters) { - params_chunk <- add_chunk( - paste0( - "# Parameters \n", - "spp <- params$species \n", - "SPP <- params$species \n", - "species <- params$species \n", - "spp_latin <- params$spp_latin \n", - "office <- params$office", - if (!is.null(region)) { - paste0("\n", "region <- params$region") - }, - if (!is.null(param_names)) { - paste0( - "\n", - paste0(param_names, " <- ", "params$", param_names, collapse = " \n") - ) - } - ), - label = "R_parameters" - ) - } else if (parameters) { - params_chunk_end <- grep("```", prev_skeleton)[which(grep("```", prev_skeleton) > params_chunk_start)][1] - params_chunk <- prev_skeleton[params_chunk_start:params_chunk_end] - # Add in region if it's not null - if (!is.null(region) & !any(grepl("region <- params$region", params_chunk))) { - params_chunk <- append( - params_chunk, - "region <- params$region", - after = params_chunk_end - 1 - ) - } - if (!is.null(param_values) & !is.null(param_names)) { - for (i in length(param_values)) { - add_param <- glue::glue("{param_names[i]} <- params${param_names[i]}") - params_chunk <- append( - params_chunk, - add_param, - after = params_chunk_end - 1 - ) - } - } - } - } else { + # if (rerender_skeleton) { + # params_chunk_start <- grep("R_parameters", prev_skeleton) - 1 + # if (!any(grepl("R_parameters", prev_skeleton)) & parameters) { + # params_chunk <- add_chunk( + # paste0( + # "# Parameters \n", + # "spp <- params$species \n", + # "SPP <- params$species \n", + # "species <- params$species \n", + # "spp_latin <- params$spp_latin \n", + # "office <- params$office", + # if (!is.null(region)) { + # paste0("\n", "region <- params$region") + # }, + # if (!is.null(param_names)) { + # paste0( + # "\n", + # paste0(param_names, " <- ", "params$", param_names, collapse = " \n") + # ) + # } + # ), + # label = "R_parameters" + # ) + # } else if (parameters) { + # params_chunk_end <- grep("```", prev_skeleton)[which(grep("```", prev_skeleton) > params_chunk_start)][1] + # params_chunk <- prev_skeleton[params_chunk_start:params_chunk_end] + # # Add in region if it's not null + # if (!is.null(region) & !any(grepl("region <- params$region", params_chunk))) { + # params_chunk <- append( + # params_chunk, + # "region <- params$region", + # after = params_chunk_end - 1 + # ) + # } + # if (!is.null(param_values) & !is.null(param_names)) { + # for (i in length(param_values)) { + # add_param <- glue::glue("{param_names[i]} <- params${param_names[i]}") + # params_chunk <- append( + # params_chunk, + # add_param, + # after = params_chunk_end - 1 + # ) + # } + # } + # } + # } else { params_chunk <- add_chunk( paste0( "# Parameters \n", @@ -928,7 +920,7 @@ create_template <- function( ), label = "R_parameters" ) - } + # } params_chunk <- add_chunk( paste0( @@ -961,7 +953,7 @@ create_template <- function( # identify type of file and adjust load in # df_name <- stringr::str_extract(model_results, "(?<=/)[^/]+(?=\\.[^./]+$)") # extract the name of the data frame from the file name # Assuming user saved converted output - load_method <- glue::glue("load({deparse(substitute(model_results))}) \n") + load_method <- glue::glue("load({model_results}) \n") # output_file_type <- stringr::str_extract(model_results, "(?<=\\.)[a-zA-Z]+$") # load_method <- switch( # output_file_type, @@ -1024,136 +1016,136 @@ create_template <- function( ) # extract old preamble if don't want to change - if (rerender_skeleton) { - question1 <- readline("Update the preamble to match entered arguments? (Y/N)") - - # answer question1 as n if session isn't interactive - if (!interactive()) { - question1 <- "n" - } - if (regexpr(question1, "n", ignore.case = TRUE) == 1) { - start_line <- grep("label: 'preamble'", prev_skeleton) - 1 - # find next trailing "```"` in case it was edited at the end - end_line <- grep("```", prev_skeleton)[grep("```", prev_skeleton) > start_line][1] - # preamble <- paste(prev_skeleton[start_line:end_line], collapse = "\n") - preamble <- prev_skeleton[start_line:end_line] - - if (!is.null(model_results)) { - # show message and make README stating model_results info - mod_time <- as.character(file.info(fs::path(model_results), extra_cols = FALSE)$ctime) - mod_msg <- paste( - "Report is based upon model output from", model_results, - "that was last modified on:", mod_time - ) - cli::cli_alert_info(mod_msg) - writeLines( - mod_msg, - fs::path( - subdir, - paste0( - gsub(".rda", "", basename(model_results)), - "_metadata.md" - ) - ) - ) - prev_results_line <- grep("output <- ", preamble)[1] - prev_results <- stringr::str_replace( - preamble[prev_results_line], - "(?<=output\\s{0,5}<-).*", - deparse(substitute(model_results)) - ) - # add back in pipe - prev_results <- paste0(prev_results, " |>") - preamble <- append(preamble, prev_results, after = prev_results_line)[-prev_results_line] - - # change chunk eval to true - if (any(grepl("eval: false", preamble))) { - chunk_eval_line <- grep("eval: ", preamble) - eval_line_new <- stringr::str_replace( - preamble[chunk_eval_line], - "eval: false", - "eval: true" - ) - preamble <- paste( - append( - preamble, - eval_line_new, - after = chunk_eval_line - )[-chunk_eval_line], - collapse = "\n" - ) - } - preamble <- paste(preamble, collapse = "\n") - - # if (!grepl(".csv", model_results)) warning("Model results are not in csv format - Will not work on render") - } else { - cli::cli_alert_info("Preamble maintained.") - cli::cli_alert_info("Model results not updated.") - preamble <- paste(preamble, collapse = "\n") - } - } else if (regexpr(question1, "y", ignore.case = TRUE) == 1) { - cli::cli_alert_warning("Report template files were not copied into your directory.") - cli::cli_alert_info("If you wish to update the template with new parameters or output files, please edit the {report_name} in your local folder.", - wrap = TRUE - ) - } - } # close if rerender + # if (rerender_skeleton) { + # question1 <- readline("Update the preamble to match entered arguments? (Y/N)") + # + # # answer question1 as n if session isn't interactive + # if (!interactive()) { + # question1 <- "n" + # } + # if (regexpr(question1, "n", ignore.case = TRUE) == 1) { + # start_line <- grep("label: 'preamble'", prev_skeleton) - 1 + # # find next trailing "```"` in case it was edited at the end + # end_line <- grep("```", prev_skeleton)[grep("```", prev_skeleton) > start_line][1] + # # preamble <- paste(prev_skeleton[start_line:end_line], collapse = "\n") + # preamble <- prev_skeleton[start_line:end_line] + # + # if (!is.null(model_results)) { + # # show message and make README stating model_results info + # mod_time <- as.character(file.info(fs::path(model_results), extra_cols = FALSE)$ctime) + # mod_msg <- paste( + # "Report is based upon model output from", model_results, + # "that was last modified on:", mod_time + # ) + # cli::cli_alert_info(mod_msg) + # writeLines( + # mod_msg, + # fs::path( + # subdir, + # paste0( + # gsub(".rda", "", basename(model_results)), + # "_metadata.md" + # ) + # ) + # ) + # prev_results_line <- grep("output <- ", preamble)[1] + # prev_results <- stringr::str_replace( + # preamble[prev_results_line], + # "(?<=output\\s{0,5}<-).*", + # deparse(substitute(model_results)) + # ) + # # add back in pipe + # prev_results <- paste0(prev_results, " |>") + # preamble <- append(preamble, prev_results, after = prev_results_line)[-prev_results_line] + # + # # change chunk eval to true + # if (any(grepl("eval: false", preamble))) { + # chunk_eval_line <- grep("eval: ", preamble) + # eval_line_new <- stringr::str_replace( + # preamble[chunk_eval_line], + # "eval: false", + # "eval: true" + # ) + # preamble <- paste( + # append( + # preamble, + # eval_line_new, + # after = chunk_eval_line + # )[-chunk_eval_line], + # collapse = "\n" + # ) + # } + # preamble <- paste(preamble, collapse = "\n") + # + # # if (!grepl(".csv", model_results)) warning("Model results are not in csv format - Will not work on render") + # } else { + # cli::cli_alert_info("Preamble maintained.") + # cli::cli_alert_info("Model results not updated.") + # preamble <- paste(preamble, collapse = "\n") + # } + # } else if (regexpr(question1, "y", ignore.case = TRUE) == 1) { + # cli::cli_alert_warning("Report template files were not copied into your directory.") + # cli::cli_alert_info("If you wish to update the template with new parameters or output files, please edit the {report_name} in your local folder.", + # wrap = TRUE + # ) + # } + # } # close if rerender ##### Disclaimer ---- disclaimer <- "{{< pagebreak >}}\n\n## Disclaimer {.unnumbered .unlisted}\n\nThese materials do not constitute a formal publication and are for information only. They are in a pre-review, pre-decisional state and should not be formally cited or reproduced. They are to be considered provisional and do not represent any determination or policy of NOAA or the Department of Commerce.\n" ##### Citation ---- # Add page for citation of assessment report - if (rerender_skeleton) { - # Extract citation from previous skeleton - citation <- prev_skeleton[grep("Please cite this publication as:", prev_skeleton) + 2] - if (!is.null(authors)) { - authors_in_skel <- prev_skeleton[grep(" - name: ", prev_skeleton)] - authors_in_skel <- stringr::str_remove_all(authors_in_skel[seq(1, length(authors_in_skel), 2)], "^.*- name: '|'$") - authors <- ifelse( - authors_in_skel == "FIRST LAST", - names(authors), - c(authors_in_skel, names(authors)) - ) - - cit_authors <- format_citation_authors(authors) - - # replace authors in citation - if (authors_in_skel[1] == "FIRST LAST") { - citation <- stringr::str_replace( - citation, - # regex to identify characters in the beginning of the string before the year - "\\[AUTHOR NAME\\].", - cit_authors - ) - } else { - citation <- stringr::str_replace( - citation, - # regex to identify characters in the beginning of the string before the year - "^.*?(?=\\s\\d{4}\\.)", - cit_authors - ) - } - } - - if (!is.null(species) | !is.null(region) | !is.null(spp_latin)) { - # update title in citation - citation <- stringr::str_replace( - citation, - "(?<=\\d{4}\\.\\s).*?(?=\\.\\sNOAA Fisheries)", - # "(?<=\\.\\s)(Stock Assessment Report Template)(?=\\.)", - title - ) - } - cli::cli_alert_success("Added report citation.") - } else { + # if (rerender_skeleton) { + # # Extract citation from previous skeleton + # citation <- prev_skeleton[grep("Please cite this publication as:", prev_skeleton) + 2] + # if (!is.null(authors)) { + # authors_in_skel <- prev_skeleton[grep(" - name: ", prev_skeleton)] + # authors_in_skel <- stringr::str_remove_all(authors_in_skel[seq(1, length(authors_in_skel), 2)], "^.*- name: '|'$") + # authors <- ifelse( + # authors_in_skel == "FIRST LAST", + # names(authors), + # c(authors_in_skel, names(authors)) + # ) + # + # cit_authors <- format_citation_authors(authors) + # + # # replace authors in citation + # if (authors_in_skel[1] == "FIRST LAST") { + # citation <- stringr::str_replace( + # citation, + # # regex to identify characters in the beginning of the string before the year + # "\\[AUTHOR NAME\\].", + # cit_authors + # ) + # } else { + # citation <- stringr::str_replace( + # citation, + # # regex to identify characters in the beginning of the string before the year + # "^.*?(?=\\s\\d{4}\\.)", + # cit_authors + # ) + # } + # } + # + # if (!is.null(species) | !is.null(region) | !is.null(spp_latin)) { + # # update title in citation + # citation <- stringr::str_replace( + # citation, + # "(?<=\\d{4}\\.\\s).*?(?=\\.\\sNOAA Fisheries)", + # # "(?<=\\.\\s)(Stock Assessment Report Template)(?=\\.)", + # title + # ) + # } + # cli::cli_alert_success("Added report citation.") + # } else { citation <- create_citation( authors = authors, title = title, year = year ) cli::cli_alert_success("Added report citation.") - } + # } ##### Create report outline ---- # Include tables and figures in template diff --git a/R/rerender_skeleton.R b/R/rerender_skeleton.R new file mode 100644 index 00000000..a723d588 --- /dev/null +++ b/R/rerender_skeleton.R @@ -0,0 +1,394 @@ +# code that is pulled from create_template(rerender_skeleton) +# was located in another branch 'call-prev-report' + +rerender_skeleton <- function( + file_dir +) { + # Add in report to file_dir + file_dir <- file.path(file_dir, "report") + #### Read in previous skeleton ---- + # TODO: set up situation where species, region can be changed + report_name <- list.files(file_dir, pattern = "skeleton.qmd") # gsub(".qmd", "", list.files(file_dir, pattern = "skeleton.qmd")) + if (length(report_name) == 0) cli::cli_abort("No skeleton quarto file found in the `file_dir` ({file_dir}).") + if (length(report_name) > 1) cli::cli_abort("Multiple skeleton quarto files found in the `file_dir` ({file_dir}).") + + prev_report_name <- gsub("_skeleton.qmd", "", report_name) + # Extract type + type <- stringr::str_extract(prev_report_name, "^[A-Z]+") + # Extract region unless region is changed or updated + # identify region from the skeleton + prev_skeleton <- readLines(file.path(file_dir, list.files(file_dir, pattern = "skeleton.qmd"))) + if (is.null(region)) { + region <- stringr::str_extract( + prev_skeleton[grep("region: ", prev_skeleton)], + "(?<=')[^']+(?=')" + ) + } + region_name <- ifelse( + region != "NA", # !is.null(region) | !is.na(region) + toupper(stringr::str_c(stringr::str_extract_all(region, "\\b[A-Za-z]")[[1]], collapse = "")), + stringr::str_extract(prev_report_name, "(?<=_)[A-Z]+(?=_)") + ) + # report name without type + report_name_1 <- gsub( + glue::glue("{type}_"), + "", + prev_report_name + ) + # Extract species unless species is renamed + species <- ifelse( + species != "species", + species, + gsub( + "_", + " ", + gsub(glue::glue("{region_name}_"), "", report_name_1) + ) + ) + # Set new report name + new_report_name <- paste0( + type, "_", + ifelse( + is.null(region) | is.na(region) | region == "NA", + "", + glue::glue("{region_name}_") + ), + ifelse(is.null(species), "species", stringr::str_replace_all(species, " ", "_")), "_", + "skeleton.qmd" + ) + # make sure type is changed to skeleton + if (type == "sar") type <- "skeleton" + + # extract previous format + prev_format <- stringr::str_extract( + prev_skeleton[grep("format:", prev_skeleton) + 1], + "[a-z]+" + ) + year <- as.numeric(stringr::str_extract( + prev_skeleton[grep("title:", prev_skeleton)], + "[0-9]+" + )) + # Add in species image if updated in rerender + if (species != "species") { + file.copy(spp_image, supdir, overwrite = FALSE) |> suppressWarnings() + } + # Add in species image if updated in rerender + if (!is.null(spp_image)) { + file.copy(spp_image, supdir, overwrite = FALSE) |> suppressWarnings() + # Change path to spp image since finished copying for yaml + if (file.exists(spp_image)) { + spp_image <- file.path("support_files", stringr::str_extract(spp_image, "(?<=/)[^/]+$")) + } + } + # if it is previously html and the rerender species html then need to copy over html formatting + if (tolower(prev_format) != "html" & tolower(format) == "html") { + if (!file.exists(file.path(file_dir, "support_files", "theme.scss"))) file.copy(system.file("resources", "formatting_files", "theme.scss", package = "asar"), supdir, overwrite = FALSE) |> suppressWarnings() + } + if (tolower(prev_format != "pdf" & tolower(format) == "pdf")) { + if (is.null(species)) { + species <- tolower(stringr::str_extract( + prev_skeleton[grep("species: ", prev_skeleton)], + "(?<=')[^']+(?=')" + )) + } + if (is.null(office)) { + office <- stringr::str_extract( + prev_skeleton[grep("office: ", prev_skeleton)], + "(?<=')[^']+(?=')" + ) + } + # year - default to current year + cli::cli_alert_warning("Undefined year.") + cli::cli_alert_info("Please identify year in your arguments or manually change it in the skeleton if value is incorrect.", + wrap = TRUE + ) + + # copy before-body tex + if (!file.exists(file_dir, "support_files", "before-body.tex")) file.copy(before_body_file, supdir, overwrite = FALSE) |> suppressWarnings() + # customize titlepage tex + if (!file.exists(file_dir, "support_files", "_titlepage.tex") | !is.null(species)) create_titlepage_tex(office = office, subdir = supdir, species = species) + # customize in-header tex + if (!file.exists(file_dir, "support_files", "in-header.tex") | !is.null(species)) create_inheader_tex(species = species, year = year, subdir = supdir) + # copy new spp image if updated + if (!is.null(species)) file.copy(spp_image, supdir, overwrite = FALSE) |> suppressWarnings() + } + + #### Figs and tabs docs ---- + # extract name for tables.qmd from report folder + tables_doc_name <- if (can_rename_legacy_doc(tbl_info)) { + tbl_info$current_name + } else { + list.files(file_dir, pattern = "tables.qmd") + } + # extract name for figures.qmd from report folder + figures_doc_name <- if (can_rename_legacy_doc(fig_info)) { + fig_info$current_name + } else { + list.files(file_dir, pattern = "figures.qmd") + } + + #### Adjust the title ---- + if (title == "[TITLE]") { + title <- sub("title: ", "", prev_skeleton[grep("title:", prev_skeleton)]) + if (title == "'Stock Assessment Report Template' " & (!is.null(office) | !is.null(species) | !is.null(region))) { + title <- create_title( + office = office, + species = species, + spp_latin = spp_latin, + region = region, + type = type, + year = year + ) + } + } + + #### authors ---- + # this may not be the case for calling in report + author_list <- add_authors( + prev_skeleton = prev_skeleton, NULL, + author = author, # need to put this in case there is a rerender otherwise it would not use the correct argument + rerender_skeleton = TRUE + ) + + + + #### Initialize bib name ---- + bib_name <- NULL + # Add bib file if bib_file is not NULL + # Note: this is copied from create_template + if (!is.null(bib_file)) { + file.copy(bib_file, bib_dir, overwrite = TRUE) |> suppressWarnings() + bib_name <- c(bib_name, basename(bib_file)) + } + + #### yaml ---- + yaml <- create_yaml( + prev_format = prev_format, + format = format, + prev_skeleton = prev_skeleton, + author_list = author_list, + title = title, + rerender_skeleton = TRUE, + office = office, + spp_image = spp_image, + species = species, + spp_latin = spp_latin, + region = region, + parameters = parameters, + param_names = param_names, + param_values = param_values, + bib_name = bib_name, + bib_file = bib_file, + year = year, + type = type + ) + + #### Params chunk ---- + params_chunk_start <- grep("R_parameters", prev_skeleton) - 1 + if (!any(grepl("R_parameters", prev_skeleton)) & parameters) { + params_chunk <- add_chunk( + paste0( + "# Parameters \n", + "spp <- params$species \n", + "SPP <- params$species \n", + "species <- params$species \n", + "spp_latin <- params$spp_latin \n", + "office <- params$office", + if (!is.null(region)) { + paste0("\n", "region <- params$region") + }, + if (!is.null(param_names)) { + paste0( + "\n", + paste0(param_names, " <- ", "params$", param_names, collapse = " \n") + ) + } + ), + label = "R_parameters" + ) + } else if (parameters) { + params_chunk_end <- grep("```", prev_skeleton)[which(grep("```", prev_skeleton) > params_chunk_start)][1] + params_chunk <- prev_skeleton[params_chunk_start:params_chunk_end] + # Add in region if it's not null + if (!is.null(region) & !any(grepl("region <- params$region", params_chunk))) { + params_chunk <- append( + params_chunk, + "region <- params$region", + after = params_chunk_end - 1 + ) + } + if (!is.null(param_values) & !is.null(param_names)) { + for (i in length(param_values)) { + add_param <- glue::glue("{param_names[i]} <- params${param_names[i]}") + params_chunk <- append( + params_chunk, + add_param, + after = params_chunk_end - 1 + ) + } + } + } + + #### preamble ---- + question1 <- readline("Update the preamble to match entered arguments? (Y/N)") + + # answer question1 as n if session isn't interactive + if (!interactive()) { + question1 <- "n" + } + if (regexpr(question1, "n", ignore.case = TRUE) == 1) { + start_line <- grep("label: 'preamble'", prev_skeleton) - 1 + # find next trailing "```"` in case it was edited at the end + end_line <- grep("```", prev_skeleton)[grep("```", prev_skeleton) > start_line][1] + # preamble <- paste(prev_skeleton[start_line:end_line], collapse = "\n") + preamble <- prev_skeleton[start_line:end_line] + + if (!is.null(model_results)) { + # show message and make README stating model_results info + mod_time <- as.character(file.info(fs::path(model_results), extra_cols = FALSE)$ctime) + mod_msg <- paste( + "Report is based upon model output from", model_results, + "that was last modified on:", mod_time + ) + cli::cli_alert_info(mod_msg) + writeLines( + mod_msg, + fs::path( + subdir, + paste0( + gsub(".rda", "", basename(model_results)), + "_metadata.md" + ) + ) + ) + prev_results_line <- grep("output <- ", preamble)[1] + prev_results <- stringr::str_replace( + preamble[prev_results_line], + "(?<=output\\s{0,5}<-).*", + deparse(substitute(model_results)) + ) + # add back in pipe + prev_results <- paste0(prev_results, " |>") + preamble <- append(preamble, prev_results, after = prev_results_line)[-prev_results_line] + + # change chunk eval to true + if (any(grepl("eval: false", preamble))) { + chunk_eval_line <- grep("eval: ", preamble) + eval_line_new <- stringr::str_replace( + preamble[chunk_eval_line], + "eval: false", + "eval: true" + ) + preamble <- paste( + append( + preamble, + eval_line_new, + after = chunk_eval_line + )[-chunk_eval_line], + collapse = "\n" + ) + } + preamble <- paste(preamble, collapse = "\n") + + # if (!grepl(".csv", model_results)) warning("Model results are not in csv format - Will not work on render") + } else { + cli::cli_alert_info("Preamble maintained.") + cli::cli_alert_info("Model results not updated.") + preamble <- paste(preamble, collapse = "\n") + } + } else if (regexpr(question1, "y", ignore.case = TRUE) == 1) { + if (!is.null(model_results)) {# Assuming user saved converted output + load_method <- glue::glue("load({model_results}) \n") + } else { + load_method <- "" + } + + # standard preamble + # copy preamble code into report folder + file.copy( + system.file("resources", "preamble.R", package = "asar"), + subdir, + overwrite = TRUE + ) |> suppressWarnings() + + preamble <- add_chunk( + paste0( + "# load converted output from stockplotr::convert_output() \n", + load_method, "\n", + "# Call reference points and quantities below \n", + "output <- out_new |> \n", + " ", "dplyr::mutate(estimate = as.numeric(estimate), \n", + " ", " ", "uncertainty = as.numeric(uncertainty)) \n", + "source(\"preamble.R\") \n", + "# Available quantities\n", + "start_year\n", + "end_year\n", + "Fend # terminal fishing mortality\n", + "Ftarg # fishing mortality at msy\n", + "F_Ftarg # Terminal year F respective to F target\n", + "Bend # terminal year biomass\n", + "Btarg # target biomass (msy)\n", + "total_catch # total catch in the last year\n", + "total_landings # total landings in the last year\n", + "SBend # spawning biomass in the last year\n", + "M # overall natural mortality or at age\n", + "Bmsy # target spawning biomass(msy)\n", + "h # steepness\n", + "R0 # recruitment\n" + ), + label = "preamble", + chunk_option = c("warning: false", ifelse(is.null(model_results), "eval: false", "eval: true"), "include: false") + ) + } + + #### disclaimer ---- + disclaimer <- "{{< pagebreak >}}\n\n## Disclaimer {.unnumbered .unlisted}\n\nThese materials do not constitute a formal publication and are for information only. They are in a pre-review, pre-decisional state and should not be formally cited or reproduced. They are to be considered provisional and do not represent any determination or policy of NOAA or the Department of Commerce.\n" + + #### citation ---- + if (!is.null(title) | !is.null(species) | !is.null(year) | !is.null(author)) { + citation_line <- grep("Please cite this publication as:", prev_skeleton) + 2 + citation <- glue::glue("{{< pagebreak >}} \n\n Please cite this publication as: \n\n {prev_skeleton[citation_line]}\n\n") + } else { + author <- grep(" - name: ", prev_skeleton) + citation <- create_citation( + author = author, + ... + ) + cli::cli_alert_success("Added report citation.") + } + if (custom) { + stop("Not currently working") + } else { + # identify all previous sections + files_to_copy <- stringr::str_extract(prev_skeleton[grep("knitr::knit_child", prev_skeleton)], "(?<=knit_child\\(').*?(?=\\')") + sections <- stringr::str_extract_all( + prev_skeleton, + "(?<=['`])[^']+\\.qmd(?=['`])" + ) |> + unlist() |> + purrr::discard(~ .x == "") + # add sections as list + sections <- add_child( + sections, + label = gsub(".qmd", "", unlist(sections)) + ) + } + + #### ID sections to include in skeleton + # id the order of the files in the skeleton and copy over in that order + files_to_copy <- stringr::str_extract(prev_skeleton[grep("knitr::knit_child", prev_skeleton)], "(?<=knit_child\\(').*?(?=\\')") + + #### Pull together template ---- + report_template <- paste( + yaml, + "\\printnoidxglossaries \n", + params_chunk, + preamble, + disclaimer, + citation, + sections, + sep = "\n" + ) + #### save skeleton file ---- + utils::capture.output(cat(report_template), file = file.path(file_dir, new_report_name), append = FALSE) +} \ No newline at end of file From 9310e2f736c13ec5b1160a15051fe75ac6431a1d Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Wed, 16 Sep 2026 16:36:58 -0400 Subject: [PATCH 02/28] remove all rerender_skeleton code from create_template --- R/create_template.R | 847 ++++++++++---------------------------------- 1 file changed, 191 insertions(+), 656 deletions(-) diff --git a/R/create_template.R b/R/create_template.R index 8b0122ff..bccce70b 100644 --- a/R/create_template.R +++ b/R/create_template.R @@ -183,7 +183,6 @@ #' section_location = "before-introduction" #' ) #' -#' #' create_template( #' new_template = TRUE, #' format = "pdf", @@ -294,95 +293,40 @@ create_template <- function( } else if (length(office) > 1 | is.null(office)) { office <- "" } - - #### Rerender skeleton ---- - if (rerender_skeleton) { - # TODO: set up situation where species, region can be changed - report_name <- list.files(file_dir, pattern = "skeleton.qmd") # gsub(".qmd", "", list.files(file_dir, pattern = "skeleton.qmd")) - if (length(report_name) == 0) cli::cli_abort("No skeleton quarto file found in the `file_dir` ({file_dir}).") - if (length(report_name) > 1) cli::cli_abort("Multiple skeleton quarto files found in the `file_dir` ({file_dir}).") - - prev_report_name <- gsub("_skeleton.qmd", "", report_name) - # Extract type - type <- stringr::str_extract(tolower(prev_report_name), "^[a-z]+") - # Extract region unless region is changed or updated - # identify region from the skeleton - prev_skeleton <- readLines(file.path(file_dir, list.files(file_dir, pattern = "skeleton.qmd"))) - if (is.null(region)) { - region <- stringr::str_extract( - prev_skeleton[grep("region: ", prev_skeleton)], - "(?<=')[^']+(?=')" - ) - } - region_name <- ifelse( - region != "NA", # !is.null(region) | !is.na(region) - toupper(stringr::str_c(stringr::str_extract_all(region, "\\b[A-Za-z]")[[1]], collapse = "")), - stringr::str_extract(prev_report_name, "(?<=_)[A-Z]+(?=_)") - ) - # report name without type - report_name_1 <- gsub( - glue::glue("{type}_"), - "", - prev_report_name - ) - # Extract species unless species is renamed - species <- ifelse( - species != "species", - species, - gsub( - "_", - " ", - gsub(glue::glue("{region_name}_"), "", report_name_1) - ) - ) - - new_report_name <- paste0( - type, "_", - ifelse( - is.null(region) | is.na(region) | region == "NA", - "", - glue::glue("{region_name}_") - ), - ifelse(is.null(species), "species", stringr::str_replace_all(species, " ", "_")), "_", - "skeleton.qmd" + + # Name report + if (!is.null(type)) { + report_name <- paste0( + ifelse(type == "skeleton", "sar", type), + "_" ) - # make sure type is changed to skeleton - if (type == "sar") type <- "skeleton" } else { - # Name report - if (!is.null(type)) { - report_name <- paste0( - ifelse(type == "skeleton", "sar", type), - "_" - ) - } else { - report_name <- paste0( - "type_" - ) - } - # Add region to name - report_name <- ifelse( - !is.null(region), - paste0( - report_name, - toupper(stringr::str_c(stringr::str_extract_all(region, "\\b[A-Za-z]")[[1]], collapse = "")), - "_" - ), - report_name - ) - # Add species to name - # TODO: can this be made into a switch? - # report_name <- switch( - # species, - # - # ) - # if (!is.null(species)) { report_name <- paste0( - report_name, - gsub(" ", "_", species), - "_skeleton.qmd" + "type_" ) - } # close if rerender skeleton for naming + } + # Add region to name + report_name <- ifelse( + !is.null(region), + paste0( + report_name, + toupper(stringr::str_c(stringr::str_extract_all(region, "\\b[A-Za-z]")[[1]], collapse = "")), + "_" + ), + report_name + ) + # Add species to name + # TODO: can this be made into a switch? + # report_name <- switch( + # species, + # + # ) + # if (!is.null(species)) { + report_name <- paste0( + report_name, + gsub(" ", "_", species), + "_skeleton.qmd" + ) # Select format if (grepl("^pdf$|^html$", tolower(format))) { @@ -468,14 +412,7 @@ create_template <- function( custom_sections <- c(custom_sections, "references") } } else { - # if (rerender_skeleton) { - # # id the order of the files in the skeleton and copy over in that order - # files_to_copy <- stringr::str_extract(prev_skeleton[grep("knitr::knit_child", prev_skeleton)], "(?<=knit_child\\(').*?(?=\\')") - # # copy over template files from past one rather than new blanks - # # files_to_copy <- list.files(current_folder)[grepl(".qmd", list.files(current_folder))] - # } else { - files_to_copy <- list.files(current_folder) - # } + files_to_copy <- list.files(current_folder) } before_body_file <- system.file("resources", "formatting_files", "before-body.tex", package = "asar") @@ -541,74 +478,72 @@ create_template <- function( #### Read in previous skeleton if rerender ---- # Check if this is a rerender of the skeleton file - # if (rerender_skeleton) { - # # read format in skeleton & check if format is identified in the rerender call - # if (!file.exists(file.path(file_dir, list.files(file_dir, pattern = "skeleton.qmd")))) stop("No skeleton quarto file found in the working directory.") - # prev_skeleton <- readLines(file.path(file_dir, list.files(file_dir, pattern = "skeleton.qmd"))) - # # extract previous format - # prev_format <- stringr::str_extract( - # prev_skeleton[grep("format:", prev_skeleton) + 1], - # "[a-z]+" - # ) - # year <- ifelse( - # is.na(as.numeric(stringr::str_extract( - # prev_skeleton[grep("title:", prev_skeleton)], - # "[0-9]+" - # ))), - # year, - # as.numeric(stringr::str_extract( - # prev_skeleton[grep("title:", prev_skeleton)], - # "[0-9]+" - # )) - # ) - # # Add in species image if updated in rerender - # if (!is.null(spp_image)) { - # file.copy(spp_image, supdir, overwrite = FALSE) |> suppressWarnings() - # # Change path to spp image since finished copying for yaml - # if (file.exists(spp_image)) { - # spp_image <- file.path("support_files", stringr::str_extract(spp_image, "(?<=/)[^/]+$")) - # } - # } - # # if it is previously html and the rerender species html then need to copy over html formatting - # if (tolower(prev_format) != "html" & tolower(format) == "html") { - # if (!file.exists(file.path(file_dir, "support_files", "theme.scss"))) file.copy(system.file("resources", "formatting_files", "theme.scss", package = "asar"), supdir, overwrite = FALSE) |> suppressWarnings() - # } - # if (tolower(prev_format) != "pdf" & tolower(format) == "pdf") { - # if (is.null(species)) { - # species <- tolower(stringr::str_extract( - # prev_skeleton[grep("species: ", prev_skeleton)], - # "(?<=')[^']+(?=')" - # )) - # } - # if (is.null(office)) { - # office <- stringr::str_extract( - # prev_skeleton[grep("office: ", prev_skeleton)], - # "(?<=')[^']+(?=')" - # ) - # } - # # year - default to current year - # cli::cli_alert_warning("Undefined year.") - # cli::cli_alert_info("Please identify year in your arguments or manually change it in the skeleton if value is incorrect.", - # wrap = TRUE - # ) - # # copy before-body tex - # if (!file.exists(file_dir, "support_files", "before-body.tex")) file.copy(before_body_file, supdir, overwrite = FALSE) |> suppressWarnings() - # # customize titlepage tex - # if (!file.exists(file_dir, "support_files", "_titlepage.tex") | !is.null(species)) create_titlepage_tex(office = office, subdir = supdir, species = species) - # # customize in-header tex - # if (!file.exists(file_dir, "support_files", "in-header.tex") | !is.null(species)) create_inheader_tex(species = species, year = year, subdir = supdir) - # } - # } else { - #### Copy template files to report folder ---- - # Check if there are already files in the folder - # Only files present should be: - # 1. bibliography_files folder - # 2. support_files folder - # 3. journals-bibnames.sty - # 4. ? - if (length(list.files(subdir)) < 4) { + #### Copy template files to report folder ---- + # Check if there are already files in the folder + # Only files present should be: + # 1. bibliography_files folder + # 2. support_files folder + # 3. journals-bibnames.sty + # 4. ? + if (length(list.files(subdir)) < 4) { + # copy quarto files + file.copy(file.path(current_folder, files_to_copy), new_folder, overwrite = FALSE) + # copy before-body tex + file.copy(before_body_file, supdir, overwrite = FALSE) |> suppressWarnings() + # customize titlepage tex + create_titlepage_tex(office = office, subdir = supdir, species = species) + # customize in-header tex + create_inheader_tex(species = species, year = year, subdir = supdir) + # Copy species image from package + file.copy(spp_image, supdir, overwrite = FALSE) |> suppressWarnings() + # Copy us doc logo + file.copy(system.file("resources", "us_doc_logo.png", package = "asar"), supdir, overwrite = FALSE) |> suppressWarnings() + # Copy glossary + file.copy(system.file("glossary", "report_glossary.tex", package = "asar"), subdir, overwrite = FALSE) |> suppressWarnings() + # Copy html format file if applicable + if (tolower(format) == "html") file.copy(system.file("resources", "formatting_files", "theme.scss", package = "asar"), supdir, overwrite = FALSE) |> suppressWarnings() + # Copy over glossary and associated tex file + if (tolower(type) == "pfmc") { + # file.copy(system.file("resources", "formatting_files", "sa4ss_glossaries.tex", package = "asar"), supdir, overwrite = FALSE) |> suppressWarnings() + file.copy(system.file("resources", "formatting_files", "pfmc.tex", package = "asar"), supdir, overwrite = FALSE) |> suppressWarnings() + } + # copy csl file + file.copy(system.file("resources", "cjfas.csl", package = "asar"), supdir, overwrite = FALSE) |> suppressWarnings() + # show message and make README stating model_results info + if (!is.null(model_results)) { + mod_time <- as.character(file.info(fs::path(model_results), extra_cols = FALSE)$ctime) + mod_msg <- paste( + "Report is based upon model output from", model_results, + "that was last modified on:", mod_time + ) + cli::cli_alert_info(mod_msg) + writeLines( + mod_msg, + fs::path( + subdir, + paste0( + gsub(".rda", "", basename(model_results)), + "_metadata.md" + ) + ) + ) + } + } else { + cli::cli_alert_warning("There are files in this location.") + question1 <- readline("The function wants to overwrite the files currently in your directory. Would you like to proceed? (Y/N)") + + # answer question1 as y if session isn't interactive + if (!interactive()) { + question1 <- "y" + } + + if (regexpr(question1, "y", ignore.case = TRUE) == 1) { + # remove old skeleton if present + if (any(grepl("_skeleton.qmd", list.files(subdir)))) { + file.remove(file.path(subdir, (list.files(subdir)[grep("_skeleton.qmd", list.files(subdir))]))) + } # copy quarto files - file.copy(file.path(current_folder, files_to_copy), new_folder, overwrite = FALSE) + file.copy(file.path(current_folder, files_to_copy), new_folder, overwrite = TRUE) |> suppressWarnings() # copy before-body tex file.copy(before_body_file, supdir, overwrite = FALSE) |> suppressWarnings() # customize titlepage tex @@ -623,75 +558,19 @@ create_template <- function( file.copy(system.file("glossary", "report_glossary.tex", package = "asar"), subdir, overwrite = FALSE) |> suppressWarnings() # Copy html format file if applicable if (tolower(format) == "html") file.copy(system.file("resources", "formatting_files", "theme.scss", package = "asar"), supdir, overwrite = FALSE) |> suppressWarnings() - # Copy over glossary and associated tex file - if (tolower(type) == "pfmc") { - # file.copy(system.file("resources", "formatting_files", "sa4ss_glossaries.tex", package = "asar"), supdir, overwrite = FALSE) |> suppressWarnings() - file.copy(system.file("resources", "formatting_files", "pfmc.tex", package = "asar"), supdir, overwrite = FALSE) |> suppressWarnings() - } - # copy csl file - file.copy(system.file("resources", "cjfas.csl", package = "asar"), supdir, overwrite = FALSE) |> suppressWarnings() - # show message and make README stating model_results info - if (!is.null(model_results)) { - mod_time <- as.character(file.info(fs::path(model_results), extra_cols = FALSE)$ctime) - mod_msg <- paste( - "Report is based upon model output from", model_results, - "that was last modified on:", mod_time - ) - cli::cli_alert_info(mod_msg) - writeLines( - mod_msg, - fs::path( - subdir, - paste0( - gsub(".rda", "", basename(model_results)), - "_metadata.md" - ) - ) - ) - } - } else { - cli::cli_alert_warning("There are files in this location.") - question1 <- readline("The function wants to overwrite the files currently in your directory. Would you like to proceed? (Y/N)") - - # answer question1 as y if session isn't interactive - if (!interactive()) { - question1 <- "y" - } - - if (regexpr(question1, "y", ignore.case = TRUE) == 1) { - # remove old skeleton if present - if (any(grepl("_skeleton.qmd", list.files(subdir)))) { - file.remove(file.path(subdir, (list.files(subdir)[grep("_skeleton.qmd", list.files(subdir))]))) - } - # copy quarto files - file.copy(file.path(current_folder, files_to_copy), new_folder, overwrite = TRUE) |> suppressWarnings() - # copy before-body tex - file.copy(before_body_file, supdir, overwrite = FALSE) |> suppressWarnings() - # customize titlepage tex - create_titlepage_tex(office = office, subdir = supdir, species = species) - # customize in-header tex - create_inheader_tex(species = species, year = year, subdir = supdir) - # Copy species image from package - file.copy(spp_image, supdir, overwrite = FALSE) |> suppressWarnings() - # Copy us doc logo - file.copy(system.file("resources", "us_doc_logo.png", package = "asar"), supdir, overwrite = FALSE) |> suppressWarnings() - # Copy glossary - file.copy(system.file("glossary", "report_glossary.tex", package = "asar"), subdir, overwrite = FALSE) |> suppressWarnings() - # Copy html format file if applicable - if (tolower(format) == "html") file.copy(system.file("resources", "formatting_files", "theme.scss", package = "asar"), supdir, overwrite = FALSE) |> suppressWarnings() - } else if (regexpr(question1, "n", ignore.case = TRUE) == 1) { - cli::cli_alert_warning("Report template files were not copied into your directory.") - cli::cli_alert_info("If you wish to update the template with new parameters or output files, please edit the {report_name} in your local folder.", - wrap = TRUE - ) - } - } # close check for previous files & respective copying - # prev_skeleton <- NULL - # } # close if rerender + } else if (regexpr(question1, "n", ignore.case = TRUE) == 1) { + cli::cli_alert_warning("Report template files were not copied into your directory.") + cli::cli_alert_info("If you wish to update the template with new parameters or output files, please edit the {report_name} in your local folder.", + wrap = TRUE + ) + } + } # close check for previous files & respective copying # Handle legacy document order and migration - fig_info <- migrate_legacy_docs(subdir, doc_type = "figures", rerender_skeleton = rerender_skeleton) - tbl_info <- migrate_legacy_docs(subdir, doc_type = "tables", rerender_skeleton = rerender_skeleton) + # TODO: Not sure how setting this to rerender = FALSE always impacts this feature + # Maybe this should go through deprecation in x amnt of time? + fig_info <- migrate_legacy_docs(subdir, doc_type = "figures", rerender_skeleton = FALSE) + tbl_info <- migrate_legacy_docs(subdir, doc_type = "tables", rerender_skeleton = FALSE) can_rename_legacy_doc <- function(doc_info) { isTRUE(doc_info$using_legacy) && @@ -729,54 +608,37 @@ create_template <- function( } # Created tables doc - # if (!rerender_skeleton) { - tables_doc_name <- switch(type, - "nemt" = "06_tables.qmd", - "safe" = "12_tables.qmd", - "09_tables.qmd" - ) + tables_doc_name <- switch( + type, + "nemt" = "06_tables.qmd", + "safe" = "12_tables.qmd", + "09_tables.qmd" + ) - create_tables_doc( - subdir = subdir, - tables_dir = tables_dir - ) - # } else { - # # extract name for tables.qmd from report folder - # tables_doc_name <- if (can_rename_legacy_doc(tbl_info)) { - # tbl_info$current_name - # } else { - # list.files(file_dir, pattern = "tables.qmd") - # } - # } + create_tables_doc( + subdir = subdir, + tables_dir = tables_dir + ) # Create figures qmd - # if (!rerender_skeleton) { - figures_doc_name <- switch(type, - "nemt" = "05_figures.qmd", - "safe" = "11_figures.qmd", - "08_figures.qmd" - ) - - create_figures_doc( - subdir = subdir, - figures_dir = figures_dir + figures_doc_name <- switch( + type, + "nemt" = "05_figures.qmd", + "safe" = "11_figures.qmd", + "08_figures.qmd" + ) + + create_figures_doc( + subdir = subdir, + figures_dir = figures_dir + ) + # rename figures doc + if (figures_doc_name != "08_figures.qmd") { + file.rename( + from = fs::path(subdir, "08_figures.qmd"), + to = fs::path(subdir, figures_doc_name) ) - # rename figures doc - if (figures_doc_name != "08_figures.qmd") { - file.rename( - from = fs::path(subdir, "08_figures.qmd"), - to = fs::path(subdir, figures_doc_name) - ) - } - # } else { - # # extract name for figures.qmd from report folder - # figures_doc_name <- if (can_rename_legacy_doc(fig_info)) { - # fig_info$current_name - # } else { - # list.files(file_dir, pattern = "figures.qmd") - # } - # } - # } + } # Part I # Create a report template file to render for the region and species @@ -784,29 +646,14 @@ create_template <- function( # Write title based on report type and region # Extract region based on param if it was previously found if (title == "[TITLE]") { - # TODO: update below so title gets updated if new input is added such as region/species/office - # if (rerender_skeleton) { - # old_title <- sub("title: ", "", prev_skeleton[grep("title:", prev_skeleton)]) - # if (old_title == "'Stock Assessment Report Template'" || !is.null(office) || species != "species" || !is.null(region) || year != format(as.POSIXct(Sys.Date(), format = "%YYYY-%mm-%dd"), "%Y") || !is.null(spp_latin)) { - # title <- create_title( - # office = office, - # species = species, - # spp_latin = spp_latin, - # region = region, - # type = type, - # year = ifelse(is.na(year), format(as.POSIXct(Sys.Date(), format = "%YYYY-%mm-%dd"), "%Y"), year) - # ) - # } - # } else { - title <- create_title( - office = office, - species = species, - spp_latin = spp_latin, - region = region, - type = type, - year = year - ) - # } + title <- create_title( + office = office, + species = species, + spp_latin = spp_latin, + region = region, + type = type, + year = year + ) } # Authors and affiliations @@ -816,29 +663,20 @@ create_template <- function( authors = authors, # need to put this in case there is a rerender otherwise it would not use the correct argument rerender_skeleton = FALSE ) - - # Create yaml - # if (rerender_skeleton) { - # # Verify that the extracted region is correct - # if (!is.null(region)) { - # region <- stringr::str_extract( - # prev_skeleton[grep("region: ", prev_skeleton)], - # "(?<=')[^']+(?=')" - # ) - # } - # } - + + # Parameters parameters <- TRUE param_names <- custom_params |> names() param_values <- custom_params |> unname() + # Create YAML -- put elements together yaml <- create_yaml( prev_format = prev_format, format = format, prev_skeleton = prev_skeleton, author_list = author_list, title = title, - rerender_skeleton = rerender_skeleton, + rerender_skeleton = FALSE, office = office, spp_image = spp_image, species = species, @@ -851,76 +689,29 @@ create_template <- function( type = type ) - if (!rerender_skeleton) cli::cli_alert_success("Built YAML header.") + cli::cli_alert_success("Built YAML header.") ##### Params chunk ---- - # if (rerender_skeleton) { - # params_chunk_start <- grep("R_parameters", prev_skeleton) - 1 - # if (!any(grepl("R_parameters", prev_skeleton)) & parameters) { - # params_chunk <- add_chunk( - # paste0( - # "# Parameters \n", - # "spp <- params$species \n", - # "SPP <- params$species \n", - # "species <- params$species \n", - # "spp_latin <- params$spp_latin \n", - # "office <- params$office", - # if (!is.null(region)) { - # paste0("\n", "region <- params$region") - # }, - # if (!is.null(param_names)) { - # paste0( - # "\n", - # paste0(param_names, " <- ", "params$", param_names, collapse = " \n") - # ) - # } - # ), - # label = "R_parameters" - # ) - # } else if (parameters) { - # params_chunk_end <- grep("```", prev_skeleton)[which(grep("```", prev_skeleton) > params_chunk_start)][1] - # params_chunk <- prev_skeleton[params_chunk_start:params_chunk_end] - # # Add in region if it's not null - # if (!is.null(region) & !any(grepl("region <- params$region", params_chunk))) { - # params_chunk <- append( - # params_chunk, - # "region <- params$region", - # after = params_chunk_end - 1 - # ) - # } - # if (!is.null(param_values) & !is.null(param_names)) { - # for (i in length(param_values)) { - # add_param <- glue::glue("{param_names[i]} <- params${param_names[i]}") - # params_chunk <- append( - # params_chunk, - # add_param, - # after = params_chunk_end - 1 - # ) - # } - # } - # } - # } else { - params_chunk <- add_chunk( - paste0( - "# Parameters \n", - "spp <- params$species \n", - "SPP <- params$species \n", - "species <- params$species \n", - "spp_latin <- params$spp_latin \n", - "office <- params$office", - if (!is.null(region)) { - paste0("\n", "region <- params$region") - }, - if (!is.null(param_names)) { - paste0( - "\n", - paste0(param_names, " <- ", "params$", param_names, collapse = " \n") - ) - } - ), - label = "R_parameters" - ) - # } + params_chunk <- add_chunk( + paste0( + "# Parameters \n", + "spp <- params$species \n", + "SPP <- params$species \n", + "species <- params$species \n", + "spp_latin <- params$spp_latin \n", + "office <- params$office", + if (!is.null(region)) { + paste0("\n", "region <- params$region") + }, + if (!is.null(param_names)) { + paste0( + "\n", + paste0(param_names, " <- ", "params$", param_names, collapse = " \n") + ) + } + ), + label = "R_parameters" + ) params_chunk <- add_chunk( paste0( @@ -950,21 +741,8 @@ create_template <- function( # assign("output", model_results, envir = .GlobalEnv) if (!is.null(model_results)) { - # identify type of file and adjust load in - # df_name <- stringr::str_extract(model_results, "(?<=/)[^/]+(?=\\.[^./]+$)") # extract the name of the data frame from the file name - # Assuming user saved converted output + # add model results according to documentation description load_method <- glue::glue("load({model_results}) \n") - # output_file_type <- stringr::str_extract(model_results, "(?<=\\.)[a-zA-Z]+$") - # load_method <- switch( - # output_file_type, - # "csv" = glue::glue("{df_name} <- utils::read.csv('{model_results}') \n"), - # "rda" = glue::glue("load('{model_results}') \n"), - # "rdata" = glue::glue("load('{model_results}') \n"), - # "rds" = glue::glue("{df_name} <- readRDS('{model_results}') \n"), - # { - # cli::cli_abort("Model results file type {output_file_type} not recognized. Please use csv, rda, rdata, or rds.") - # } - # ) } else { load_method <- "" # df_name <- "NULL" @@ -982,16 +760,10 @@ create_template <- function( paste0( "# load converted output from stockplotr::convert_output() \n", load_method, "\n", - # "output <- utils::read.csv('", - # TODO: replace resdir with substitute object; was removed as arg - # paste0(resdir, "/", model_results), - # "') \n", - # "output <- ", df_name, "\n", "# Call reference points and quantities below \n", "output <- out_new |> \n", # df_name " ", "dplyr::mutate(estimate = as.numeric(estimate), \n", " ", " ", "uncertainty = as.numeric(uncertainty)) \n", - # call in source code "source(\"preamble.R\") \n", "# Available quantities\n", "start_year\n", @@ -1015,255 +787,41 @@ create_template <- function( chunk_option = c("warning: false", ifelse(is.null(model_results), "eval: false", "eval: true"), "include: false") ) - # extract old preamble if don't want to change - # if (rerender_skeleton) { - # question1 <- readline("Update the preamble to match entered arguments? (Y/N)") - # - # # answer question1 as n if session isn't interactive - # if (!interactive()) { - # question1 <- "n" - # } - # if (regexpr(question1, "n", ignore.case = TRUE) == 1) { - # start_line <- grep("label: 'preamble'", prev_skeleton) - 1 - # # find next trailing "```"` in case it was edited at the end - # end_line <- grep("```", prev_skeleton)[grep("```", prev_skeleton) > start_line][1] - # # preamble <- paste(prev_skeleton[start_line:end_line], collapse = "\n") - # preamble <- prev_skeleton[start_line:end_line] - # - # if (!is.null(model_results)) { - # # show message and make README stating model_results info - # mod_time <- as.character(file.info(fs::path(model_results), extra_cols = FALSE)$ctime) - # mod_msg <- paste( - # "Report is based upon model output from", model_results, - # "that was last modified on:", mod_time - # ) - # cli::cli_alert_info(mod_msg) - # writeLines( - # mod_msg, - # fs::path( - # subdir, - # paste0( - # gsub(".rda", "", basename(model_results)), - # "_metadata.md" - # ) - # ) - # ) - # prev_results_line <- grep("output <- ", preamble)[1] - # prev_results <- stringr::str_replace( - # preamble[prev_results_line], - # "(?<=output\\s{0,5}<-).*", - # deparse(substitute(model_results)) - # ) - # # add back in pipe - # prev_results <- paste0(prev_results, " |>") - # preamble <- append(preamble, prev_results, after = prev_results_line)[-prev_results_line] - # - # # change chunk eval to true - # if (any(grepl("eval: false", preamble))) { - # chunk_eval_line <- grep("eval: ", preamble) - # eval_line_new <- stringr::str_replace( - # preamble[chunk_eval_line], - # "eval: false", - # "eval: true" - # ) - # preamble <- paste( - # append( - # preamble, - # eval_line_new, - # after = chunk_eval_line - # )[-chunk_eval_line], - # collapse = "\n" - # ) - # } - # preamble <- paste(preamble, collapse = "\n") - # - # # if (!grepl(".csv", model_results)) warning("Model results are not in csv format - Will not work on render") - # } else { - # cli::cli_alert_info("Preamble maintained.") - # cli::cli_alert_info("Model results not updated.") - # preamble <- paste(preamble, collapse = "\n") - # } - # } else if (regexpr(question1, "y", ignore.case = TRUE) == 1) { - # cli::cli_alert_warning("Report template files were not copied into your directory.") - # cli::cli_alert_info("If you wish to update the template with new parameters or output files, please edit the {report_name} in your local folder.", - # wrap = TRUE - # ) - # } - # } # close if rerender - ##### Disclaimer ---- disclaimer <- "{{< pagebreak >}}\n\n## Disclaimer {.unnumbered .unlisted}\n\nThese materials do not constitute a formal publication and are for information only. They are in a pre-review, pre-decisional state and should not be formally cited or reproduced. They are to be considered provisional and do not represent any determination or policy of NOAA or the Department of Commerce.\n" ##### Citation ---- # Add page for citation of assessment report - # if (rerender_skeleton) { - # # Extract citation from previous skeleton - # citation <- prev_skeleton[grep("Please cite this publication as:", prev_skeleton) + 2] - # if (!is.null(authors)) { - # authors_in_skel <- prev_skeleton[grep(" - name: ", prev_skeleton)] - # authors_in_skel <- stringr::str_remove_all(authors_in_skel[seq(1, length(authors_in_skel), 2)], "^.*- name: '|'$") - # authors <- ifelse( - # authors_in_skel == "FIRST LAST", - # names(authors), - # c(authors_in_skel, names(authors)) - # ) - # - # cit_authors <- format_citation_authors(authors) - # - # # replace authors in citation - # if (authors_in_skel[1] == "FIRST LAST") { - # citation <- stringr::str_replace( - # citation, - # # regex to identify characters in the beginning of the string before the year - # "\\[AUTHOR NAME\\].", - # cit_authors - # ) - # } else { - # citation <- stringr::str_replace( - # citation, - # # regex to identify characters in the beginning of the string before the year - # "^.*?(?=\\s\\d{4}\\.)", - # cit_authors - # ) - # } - # } - # - # if (!is.null(species) | !is.null(region) | !is.null(spp_latin)) { - # # update title in citation - # citation <- stringr::str_replace( - # citation, - # "(?<=\\d{4}\\.\\s).*?(?=\\.\\sNOAA Fisheries)", - # # "(?<=\\.\\s)(Stock Assessment Report Template)(?=\\.)", - # title - # ) - # } - # cli::cli_alert_success("Added report citation.") - # } else { - citation <- create_citation( - authors = authors, - title = title, - year = year - ) - cli::cli_alert_success("Added report citation.") - # } + citation <- create_citation( + authors = authors, + title = title, + year = year + ) + cli::cli_alert_success("Added report citation.") ##### Create report outline ---- # Include tables and figures in template # at this point, files_to_copy is the most updated outline - ###### Rerender & not custom ---- + ###### Not custom ---- # add check if user set custom sections if (!is.null(new_section) || !is.null(custom_sections)) custom <- TRUE - - if (rerender_skeleton & is.null(custom_sections)) { - # identify all previous sections - sections <- stringr::str_extract_all( - prev_skeleton, - "(?<=['`])[^']+\\.qmd(?=['`])" - ) |> - unlist() |> - purrr::discard(~ .x == "") - - has_legacy_tables <- can_rename_legacy_doc(tbl_info) - has_legacy_figures <- can_rename_legacy_doc(fig_info) - - if (has_legacy_tables) { - sections <- stringr::str_replace_all( - sections, - tbl_info$legacy_name, - tbl_info$current_name - ) - } - if (has_legacy_figures) { - sections <- stringr::str_replace_all( - sections, - fig_info$legacy_name, - fig_info$current_name - ) - } - - figure_name <- if (has_legacy_figures) fig_info$current_name else figures_doc_name - table_name <- if (has_legacy_tables) tbl_info$current_name else tables_doc_name - - figure_position <- which(sections == figure_name) - table_position <- which(sections == table_name) - if (length(figure_position) == 1 && length(table_position) == 1 && figure_position > table_position) { - sections <- sections[sections != figure_name] - table_position <- which(sections == table_name) - sections <- append( - sections, - figure_name, - after = table_position - 1 - ) - } - - # add sections as list - sections <- add_child( - sections, - label = gsub(".qmd", "", unlist(sections)) - ) - } else if (is.null(custom_sections)) { + if (is.null(custom_sections)) { sections <- add_child( sort(c(files_to_copy, tables_doc_name, figures_doc_name)), # TODO: need to remove the numbers proceeding the names as well label = stringr::str_extract(sort(c(files_to_copy, tables_doc_name, figures_doc_name)), "(?<=_).+(?=\\.qmd$)") ) } else { - ###### Rerender & custom ---- - # Option for building custom template - # Create custom template from existing skeleton sections - if (is.null(new_section)) { - section_list <- add_base_section(files_to_copy) - # Create sections object to add into template - sections <- add_child(section_list, - label = stringr::str_extract(unlist(section_list), "(?<=_).+(?=\\.qmd$)") - ) - } else { # custom = TRUE - # Create custom template using existing sections and new sections from analyst - # Add sections from package options - - if (is.null(custom_sections)) { - # TODO: type - this needs to just pull all files from folder that - # it was copying from when custom sections is null -- DONE - - sec_list1 <- unique(c(files_to_copy, tables_doc_name, figures_doc_name)) - sec_list2 <- add_section( - new_section = new_section, - section_location = section_location, - custom_sections = sec_list1, - subdir = subdir - ) - - # Create sections object to add into template - sections <- add_child( - sec_list2, - label = stringr::str_remove_all(unlist(sec_list2), "^\\d{2}[a-zA-Z]?_|\\.qmd$") - ) - } else { # custom_sections explicit - - # Add selected sections from base - sec_list1 <- unique(c(unlist(add_base_section(files_to_copy)), tables_doc_name, figures_doc_name)) - # Create new sections as .qmd in folder - # check if sections are in custom_sections list - if (any(stringr::str_replace(section_location, "^[a-z]+-", "") %notin% custom_sections)) { - cli::cli_abort("Defined customizations do not match one or all of the relative placement of a new section. Please review inputs.") - } - # reorder sec_list1 alphabetically so that 11_appendix goes to end of list - sec_list1 <- sec_list1[order(names(stats::setNames(sec_list1, sec_list1)))] - - sec_list2 <- add_section( - new_section = new_section, - section_location = section_location, - custom_sections = sec_list1, - subdir = subdir - ) - # Create sections object to add into template - sections <- add_child( - sec_list2, - label = stringr::str_remove_all(unlist(sec_list2), "^\\d{2}[a-zA-Z]?_|\\.qmd$") - ) - } # close if statement for very specific sectioning - } # close if statement for extra custom + sections <- custom_true( + new_section = new_section, + section_location = section_location, + custom_sections = custom_sections, + files_to_copy = files_to_copy, + tables_doc_name = tables_doc_name, + figures_doc_name = figures_doc_name, + subdir = subdir + ) } # close if statement for custom ###### Pull together skeleton ---- @@ -1282,37 +840,14 @@ create_template <- function( ##### Save skeleton ---- # Save template as .qmd to render - utils::capture.output(cat(report_template), file = file.path(subdir, ifelse(rerender_skeleton, new_report_name, report_name)), append = FALSE) - # Delete old skeleton - if (length(grep("skeleton.qmd", list.files(file_dir, pattern = "skeleton.qmd"))) > 1) { - question1 <- readline("Deleting previous skeleton file... Do you want to proceed? (Y/N)") - - # answer question1 as y if session isn't interactive - if (!interactive()) { - question1 <- "y" - } - - if (regexpr(question1, "y", ignore.case = TRUE) == 1) { - file.remove(file.path(file_dir, report_name)) - } else if (regexpr(question1, "n", ignore.case = TRUE) == 1) { - cli::cli_alert_info("Skeleton file retained.") - } - } + utils::capture.output(cat(report_template), file = file.path(subdir, report_name), append = FALSE) + ##### Final message ---- - # Print message - if (rerender_skeleton) { - cli::cli_alert_success("Updated report skeleton in directory {subdir}.") - } else { - cli::cli_alert_success("Saved report template in directory {subdir}.") - cli::cli_alert_info("To proceed, please edit sections within the report template in order to produce a completed stock assessment report.", - wrap = TRUE - ) - } - # Open file for analyst - # file.show(file.path(subdir, report_name)) # this opens the new file, but also restarts the session - # Open the file so path to other docs is clear - # utils::browseURL(subdir) + cli::cli_alert_success("Saved report template in directory {subdir}.") + cli::cli_alert_info("To proceed, please edit sections within the report template in order to produce a completed stock assessment report.", + wrap = TRUE + ) } else { #### Previous template call ---- # Copy old template and rename for new year From ba3a907346c5c733c2fbd9ef9840b45c2fd16501 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Wed, 16 Sep 2026 16:37:41 -0400 Subject: [PATCH 03/28] organize, format, and add rerender code from create_template to new function --- R/rerender_skeleton.R | 127 +++++++++++++++++++++++++++++++++++------- 1 file changed, 107 insertions(+), 20 deletions(-) diff --git a/R/rerender_skeleton.R b/R/rerender_skeleton.R index a723d588..df533748 100644 --- a/R/rerender_skeleton.R +++ b/R/rerender_skeleton.R @@ -161,26 +161,11 @@ rerender_skeleton <- function( bib_name <- c(bib_name, basename(bib_file)) } - #### yaml ---- - yaml <- create_yaml( - prev_format = prev_format, - format = format, + #### Authors ---- + author_list <- add_authors( prev_skeleton = prev_skeleton, - author_list = author_list, - title = title, - rerender_skeleton = TRUE, - office = office, - spp_image = spp_image, - species = species, - spp_latin = spp_latin, - region = region, - parameters = parameters, - param_names = param_names, - param_values = param_values, - bib_name = bib_name, - bib_file = bib_file, - year = year, - type = type + authors = authors, # need to put this in case there is a rerender otherwise it would not use the correct argument + rerender_skeleton = TRUE ) #### Params chunk ---- @@ -229,6 +214,28 @@ rerender_skeleton <- function( } } + #### yaml ---- + yaml <- create_yaml( + prev_format = prev_format, + format = format, + prev_skeleton = prev_skeleton, + author_list = author_list, + title = title, + rerender_skeleton = TRUE, + office = office, + spp_image = spp_image, + species = species, + spp_latin = spp_latin, + region = region, + parameters = parameters, + param_names = param_names, + param_values = param_values, + bib_name = bib_name, + bib_file = bib_file, + year = year, + type = type + ) + #### preamble ---- question1 <- readline("Update the preamble to match entered arguments? (Y/N)") @@ -374,10 +381,72 @@ rerender_skeleton <- function( ) } - #### ID sections to include in skeleton + #### Create report outline (sections) ---- # id the order of the files in the skeleton and copy over in that order files_to_copy <- stringr::str_extract(prev_skeleton[grep("knitr::knit_child", prev_skeleton)], "(?<=knit_child\\(').*?(?=\\')") + if (!is.null(new_section) || !is.null(custom_sections)) custom <- TRUE + + if (is.null(custom_sections)) { + # identify all previous sections + sections <- stringr::str_extract_all( + prev_skeleton, + "(?<=['`])[^']+\\.qmd(?=['`])" + ) |> + unlist() |> + purrr::discard(~ .x == "") + + has_legacy_tables <- can_rename_legacy_doc(tbl_info) + has_legacy_figures <- can_rename_legacy_doc(fig_info) + + if (has_legacy_tables) { + sections <- stringr::str_replace_all( + sections, + tbl_info$legacy_name, + tbl_info$current_name + ) + } + if (has_legacy_figures) { + sections <- stringr::str_replace_all( + sections, + fig_info$legacy_name, + fig_info$current_name + ) + } + + figure_name <- if (has_legacy_figures) fig_info$current_name else figures_doc_name + table_name <- if (has_legacy_tables) tbl_info$current_name else tables_doc_name + + figure_position <- which(sections == figure_name) + table_position <- which(sections == table_name) + if (length(figure_position) == 1 && length(table_position) == 1 && figure_position > table_position) { + sections <- sections[sections != figure_name] + table_position <- which(sections == table_name) + sections <- append( + sections, + figure_name, + after = table_position - 1 + ) + } + + # add sections as list + sections <- add_child( + sections, + label = gsub(".qmd", "", unlist(sections)) + ) + } else { + sections <- custom_true( + new_section = new_section, + section_location = section_location, + custom_sections = custom_sections, + files_to_copy = files_to_copy, + tables_doc_name = tables_doc_name, + figures_doc_name = figures_doc_name, + subdir = subdir + ) + } + + #### Pull together template ---- report_template <- paste( yaml, @@ -391,4 +460,22 @@ rerender_skeleton <- function( ) #### save skeleton file ---- utils::capture.output(cat(report_template), file = file.path(file_dir, new_report_name), append = FALSE) + + # Delete old skeleton + if (length(grep("skeleton.qmd", list.files(file_dir, pattern = "skeleton.qmd"))) > 1) { + question1 <- readline("Deleting previous skeleton file... Do you want to proceed? (Y/N)") + + # answer question1 as y if session isn't interactive + if (!interactive()) { + question1 <- "y" + } + + if (regexpr(question1, "y", ignore.case = TRUE) == 1) { + file.remove(file.path(file_dir, report_name)) + } else if (regexpr(question1, "n", ignore.case = TRUE) == 1) { + cli::cli_alert_info("Skeleton file retained.") + } + } + # Print message + cli::cli_alert_success("Updated report skeleton in directory {subdir}.") } \ No newline at end of file From 2a08385e6c15ebabb1492dfc416d415ee4be27ff Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Wed, 16 Sep 2026 16:38:17 -0400 Subject: [PATCH 04/28] make new utils for rerender for code shared between create_template and rerender_skeleton fxns --- R/utils_rerender.R | 67 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 67 insertions(+) create mode 100644 R/utils_rerender.R diff --git a/R/utils_rerender.R b/R/utils_rerender.R new file mode 100644 index 00000000..6473f051 --- /dev/null +++ b/R/utils_rerender.R @@ -0,0 +1,67 @@ +# rerender skeleton duplicated utils + +custom_true <- function( + new_section, + section_location, + custom_sections, + files_to_copy, + tables_doc_name, + figures_doc_name, + subdir +){ + ###### Rerender & custom ---- + # Option for building custom template + # Create custom template from existing skeleton sections + if (is.null(new_section)) { + section_list <- add_base_section(files_to_copy) + # Create sections object to add into template + sections <- add_child(section_list, + label = stringr::str_extract(unlist(section_list), "(?<=_).+(?=\\.qmd$)") + ) + } else { # custom = TRUE + # Create custom template using existing sections and new sections from analyst + # Add sections from package options + + if (is.null(custom_sections)) { + # TODO: type - this needs to just pull all files from folder that + # it was copying from when custom sections is null -- DONE + + sec_list1 <- unique(c(files_to_copy, tables_doc_name, figures_doc_name)) + sec_list2 <- add_section( + new_section = new_section, + section_location = section_location, + custom_sections = sec_list1, + subdir = subdir + ) + + # Create sections object to add into template + sections <- add_child( + sec_list2, + label = stringr::str_remove_all(unlist(sec_list2), "^\\d{2}[a-zA-Z]?_|\\.qmd$") + ) + } else { # custom_sections explicit + + # Add selected sections from base + sec_list1 <- unique(c(unlist(add_base_section(files_to_copy)), tables_doc_name, figures_doc_name)) + # Create new sections as .qmd in folder + # check if sections are in custom_sections list + if (any(stringr::str_replace(section_location, "^[a-z]+-", "") %notin% custom_sections)) { + cli::cli_abort("Defined customizations do not match one or all of the relative placement of a new section. Please review inputs.") + } + # reorder sec_list1 alphabetically so that 11_appendix goes to end of list + sec_list1 <- sec_list1[order(names(stats::setNames(sec_list1, sec_list1)))] + + sec_list2 <- add_section( + new_section = new_section, + section_location = section_location, + custom_sections = sec_list1, + subdir = subdir + ) + # Create sections object to add into template + add_child( + sec_list2, + label = stringr::str_remove_all(unlist(sec_list2), "^\\d{2}[a-zA-Z]?_|\\.qmd$") + ) + } # close if statement for very specific sectioning + } # close if statement for extra custom +} \ No newline at end of file From f04d46ffd20cf866880b550aae2afcd2c47f36cc Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Thu, 17 Sep 2026 12:08:35 -0400 Subject: [PATCH 05/28] remove final references to rerender_skeleton in create_template --- R/create_template.R | 75 +++++++++++++-------------------------------- 1 file changed, 22 insertions(+), 53 deletions(-) diff --git a/R/create_template.R b/R/create_template.R index bccce70b..57350330 100644 --- a/R/create_template.R +++ b/R/create_template.R @@ -101,12 +101,6 @@ #' #' Default: FALSE #' -#' @param rerender_skeleton TRUE/FALSE; Update the skeleton YAML and structure -#' (R parameters, preamble, and skeleton sectioning) if relevant or indicated. -#' All files in your folder, such as the `.qmd` child docs, will remain as is. -#' -#' Default: FALSE -#' #' @param custom_sections List of existing sections to include in a custom #' template (rather than the default for stock assessments in your region). #' If adding a new section, also use arguments 'new_section' and 'section_location'. @@ -252,7 +246,6 @@ create_template <- function( spp_image = NULL, bib_file = TRUE, new_template = TRUE, - rerender_skeleton = FALSE, custom_sections = NULL, new_section = NULL, section_location = NULL, @@ -395,7 +388,7 @@ create_template <- function( asar_folder <- system.file("templates", package = "asar") # copy files from specific type folder - current_folder <- ifelse(rerender_skeleton, subdir, file.path(asar_folder, type)) + current_folder <- file.path(asar_folder, type) new_folder <- subdir ##### Identify files to copy ---- @@ -432,10 +425,17 @@ create_template <- function( dir.create(bib_dir, recursive = FALSE) } - bib_name <- NULL - - # asar citation - asar_citation <- "@Manual{asar_2026, + journals::download_bibs(bib_dir) + bib_file_paths <- list.files(bib_dir, pattern = ".bib", full.names = TRUE) + base_bib_file <- bib_file_paths[!grepl(".sty", bib_file_paths)] + # Remove .sty file and copy to main report folder + file.copy(list.files(bib_dir, pattern = ".sty", full.names = TRUE), subdir, overwrite = FALSE) |> suppressWarnings() + file.remove(list.files(bib_dir, pattern = ".sty", full.names = TRUE)) + bib_name <- basename(base_bib_file) + + # append asar citation to first .bib + asar_citation <- " +@Manual{asar_2026, title = {asar: Build NOAA Stock Assessment Report}, author = {Samantha Schiano and Sophie Breitbart and Steve Saul}, year = {2026}, @@ -443,39 +443,16 @@ create_template <- function( url = {https://github.com/nmfs-ost/asar}, }" - if (!rerender_skeleton) { - # make asar bib in all conditions - asar_bib_path <- file.path(bib_dir, "asar_citation.bib") - write(asar_citation, file = asar_bib_path) - bib_name <- c("asar_citation.bib") - if (is.character(bib_file)) { - # File provided: Copy the custom bib and create the asar citation .bib - file.copy(bib_file, bib_dir, overwrite = TRUE) |> suppressWarnings() - bib_name <- c(bib_name, basename(bib_file)) - } else if (isTRUE(bib_file)) { - # TRUE: Download the journal packages bib and create the asar citation .bib - journals::download_bibs(bib_dir) - bib_file_paths <- list.files(bib_dir, pattern = ".bib", full.names = TRUE) - base_bib_file <- bib_file_paths[!grepl(".sty", bib_file_paths)] - - # Move .sty file to main report folder - sty_files <- list.files(bib_dir, pattern = ".sty", full.names = TRUE) - if (length(sty_files) > 0) { - file.copy(sty_files, subdir, overwrite = FALSE) |> suppressWarnings() - file.remove(sty_files) - } - - bib_name <- basename(base_bib_file) - - } # else { # else use default made above - # # FALSE or NULL: Just make the asar citation .bib - # bib_name <- "asar_citation.bib" - # } - } # else { - # # Rerendering the skeleton: Don't touch anything - # bib_name <- NULL - # } - + if (!is.na(base_bib_file[1]) && nzchar(base_bib_file[1])) { + write(asar_citation, file = base_bib_file[1], append = TRUE) + } + + # Add bib file if bib_file is not NULL + if (!is.null(bib_file)) { + file.copy(bib_file, bib_dir, overwrite = TRUE) |> suppressWarnings() + bib_name <- c(bib_name, basename(bib_file)) + } + #### Read in previous skeleton if rerender ---- # Check if this is a rerender of the skeleton file #### Copy template files to report folder ---- @@ -572,14 +549,6 @@ create_template <- function( fig_info <- migrate_legacy_docs(subdir, doc_type = "figures", rerender_skeleton = FALSE) tbl_info <- migrate_legacy_docs(subdir, doc_type = "tables", rerender_skeleton = FALSE) - can_rename_legacy_doc <- function(doc_info) { - isTRUE(doc_info$using_legacy) && - !is.null(doc_info$legacy_name) && - length(doc_info$legacy_name) == 1 && - !is.null(doc_info$current_name) && - length(doc_info$current_name) == 1 - } - renamed_tables_doc <- FALSE if (can_rename_legacy_doc(tbl_info)) { from <- fs::path(subdir, tbl_info$legacy_name) From 202a7bf0ec64a753995a24d5da55901be8e48441 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Thu, 17 Sep 2026 12:09:11 -0400 Subject: [PATCH 06/28] fix remaining bugs or missing pieces in rerender_skeleton fxn --- R/rerender_skeleton.R | 179 ++++++++++++++++++++++++------------------ 1 file changed, 103 insertions(+), 76 deletions(-) diff --git a/R/rerender_skeleton.R b/R/rerender_skeleton.R index df533748..82e6e138 100644 --- a/R/rerender_skeleton.R +++ b/R/rerender_skeleton.R @@ -1,11 +1,49 @@ -# code that is pulled from create_template(rerender_skeleton) -# was located in another branch 'call-prev-report' - +#' Rerender skeleton quarto document +#' +#' @inheritParams create_template +#' @param file_dir Required. Directory where the skeleton file is located. Can include or leave out the report folder in the path. +#' +#' @returns Update the "skeleton" file produce after running `create_template`. +#' Prevents the loss of data in child documents and make easy updates without +#' prior knowledge of quarto. +#' @export +#' +#' @examples +#' \dontrun{ +#' rerender_skeleton( +#' file_dir = getwd(), +#' species = "Red Snapper", +#' office = "SEFSC", +#' region = "Gulf of America", +#' year = 2027, +#' authors = c("Jane Doe" = "SEFSC") +#' ) +#' } rerender_skeleton <- function( - file_dir + file_dir, + species = "species", + spp_latin = NULL, + office = NULL, + region = NULL, + year = format(as.POSIXct(Sys.Date(), format = "%YYYY-%mm-%dd"), "%Y"), + custom_sections = NULL, + new_section = NULL, + section_location = NULL, + custom_params = NULL, + title = "[TITLE]", + model_results = NULL, + bib_file = NULL, + type = "sar", + spp_image = NULL, + format = "pdf", + authors = NULL ) { # Add in report to file_dir - file_dir <- file.path(file_dir, "report") + if (!grepl("report", file_dir)) file_dir <- file.path(file_dir, "report") + # ID other directories + supdir <- file.path(file_dir, "support_files") + bibdir <- file.path(file_dir, "bibliography_files") + #### Read in previous skeleton ---- # TODO: set up situation where species, region can be changed report_name <- list.files(file_dir, pattern = "skeleton.qmd") # gsub(".qmd", "", list.files(file_dir, pattern = "skeleton.qmd")) @@ -14,7 +52,7 @@ rerender_skeleton <- function( prev_report_name <- gsub("_skeleton.qmd", "", report_name) # Extract type - type <- stringr::str_extract(prev_report_name, "^[A-Z]+") + type <- stringr::str_extract(prev_report_name, "^[a-z]+") # Extract region unless region is changed or updated # identify region from the skeleton prev_skeleton <- readLines(file.path(file_dir, list.files(file_dir, pattern = "skeleton.qmd"))) @@ -64,14 +102,11 @@ rerender_skeleton <- function( prev_skeleton[grep("format:", prev_skeleton) + 1], "[a-z]+" ) - year <- as.numeric(stringr::str_extract( + prev_year <- as.numeric(stringr::str_extract( prev_skeleton[grep("title:", prev_skeleton)], "[0-9]+" )) - # Add in species image if updated in rerender - if (species != "species") { - file.copy(spp_image, supdir, overwrite = FALSE) |> suppressWarnings() - } + # Add in species image if updated in rerender if (!is.null(spp_image)) { file.copy(spp_image, supdir, overwrite = FALSE) |> suppressWarnings() @@ -79,12 +114,17 @@ rerender_skeleton <- function( if (file.exists(spp_image)) { spp_image <- file.path("support_files", stringr::str_extract(spp_image, "(?<=/)[^/]+$")) } + } else if (is.null(spp_image) && species != "species") { + spp_image <- system.file("resources", "spp_img", paste(gsub(" ", "_", species), ".png", sep = ""), package = "asar") + # file.copy(spp_image, supdir, overwrite = FALSE) |> suppressWarnings() + # spp image name for yaml + spp_image <- glue::glue("support_files/{basename(spp_image)}") } # if it is previously html and the rerender species html then need to copy over html formatting if (tolower(prev_format) != "html" & tolower(format) == "html") { if (!file.exists(file.path(file_dir, "support_files", "theme.scss"))) file.copy(system.file("resources", "formatting_files", "theme.scss", package = "asar"), supdir, overwrite = FALSE) |> suppressWarnings() } - if (tolower(prev_format != "pdf" & tolower(format) == "pdf")) { + if (tolower(prev_format) != "pdf" & tolower(format) == "pdf") { if (is.null(species)) { species <- tolower(stringr::str_extract( prev_skeleton[grep("species: ", prev_skeleton)], @@ -115,6 +155,9 @@ rerender_skeleton <- function( #### Figs and tabs docs ---- # extract name for tables.qmd from report folder + fig_info <- migrate_legacy_docs(file_dir, doc_type = "figures", rerender_skeleton = FALSE) + tbl_info <- migrate_legacy_docs(file_dir, doc_type = "tables", rerender_skeleton = FALSE) + tables_doc_name <- if (can_rename_legacy_doc(tbl_info)) { tbl_info$current_name } else { @@ -130,7 +173,7 @@ rerender_skeleton <- function( #### Adjust the title ---- if (title == "[TITLE]") { title <- sub("title: ", "", prev_skeleton[grep("title:", prev_skeleton)]) - if (title == "'Stock Assessment Report Template' " & (!is.null(office) | !is.null(species) | !is.null(region))) { + if (title == "'Stock Assessment Report Template'" & (!is.null(office) | !is.null(species) | !is.null(region))) { title <- create_title( office = office, species = species, @@ -141,23 +184,16 @@ rerender_skeleton <- function( ) } } - - #### authors ---- - # this may not be the case for calling in report - author_list <- add_authors( - prev_skeleton = prev_skeleton, NULL, - author = author, # need to put this in case there is a rerender otherwise it would not use the correct argument - rerender_skeleton = TRUE - ) - - - + #### Initialize bib name ---- - bib_name <- NULL + # bib_name <- NULL + # Extract previous bib file names + lines_after_bib <- prev_skeleton[(grep("bibliography:", prev_skeleton)[1] + 1):(grep("csl:", prev_skeleton)[1] - 1)] + bib_name <- basename(stringr::str_replace_all(lines_after_bib, " - ", "")) # Add bib file if bib_file is not NULL # Note: this is copied from create_template if (!is.null(bib_file)) { - file.copy(bib_file, bib_dir, overwrite = TRUE) |> suppressWarnings() + file.copy(bib_file, bibdir, overwrite = TRUE) |> suppressWarnings() bib_name <- c(bib_name, basename(bib_file)) } @@ -168,6 +204,32 @@ rerender_skeleton <- function( rerender_skeleton = TRUE ) + #### Parameters for yaml ---- + # Unpack + parameters <- TRUE + param_names <- custom_params |> names() + param_values <- custom_params |> unname() + + #### yaml ---- + yaml <- create_yaml( + prev_format = prev_format, + format = format, + prev_skeleton = prev_skeleton, + author_list = author_list, + title = title, + rerender_skeleton = TRUE, + office = office, + spp_image = spp_image, + species = species, + spp_latin = spp_latin, + region = region, + parameters = parameters, + custom_params = custom_params, + bib_name = bib_name, + year = year, + type = type + ) + #### Params chunk ---- params_chunk_start <- grep("R_parameters", prev_skeleton) - 1 if (!any(grepl("R_parameters", prev_skeleton)) & parameters) { @@ -214,28 +276,6 @@ rerender_skeleton <- function( } } - #### yaml ---- - yaml <- create_yaml( - prev_format = prev_format, - format = format, - prev_skeleton = prev_skeleton, - author_list = author_list, - title = title, - rerender_skeleton = TRUE, - office = office, - spp_image = spp_image, - species = species, - spp_latin = spp_latin, - region = region, - parameters = parameters, - param_names = param_names, - param_values = param_values, - bib_name = bib_name, - bib_file = bib_file, - year = year, - type = type - ) - #### preamble ---- question1 <- readline("Update the preamble to match entered arguments? (Y/N)") @@ -261,7 +301,7 @@ rerender_skeleton <- function( writeLines( mod_msg, fs::path( - subdir, + file_dir, paste0( gsub(".rda", "", basename(model_results)), "_metadata.md" @@ -272,7 +312,7 @@ rerender_skeleton <- function( prev_results <- stringr::str_replace( preamble[prev_results_line], "(?<=output\\s{0,5}<-).*", - deparse(substitute(model_results)) + model_results # deparse(substitute(model_results)) ) # add back in pipe prev_results <- paste0(prev_results, " |>") @@ -314,7 +354,7 @@ rerender_skeleton <- function( # copy preamble code into report folder file.copy( system.file("resources", "preamble.R", package = "asar"), - subdir, + file_dir, overwrite = TRUE ) |> suppressWarnings() @@ -352,40 +392,28 @@ rerender_skeleton <- function( disclaimer <- "{{< pagebreak >}}\n\n## Disclaimer {.unnumbered .unlisted}\n\nThese materials do not constitute a formal publication and are for information only. They are in a pre-review, pre-decisional state and should not be formally cited or reproduced. They are to be considered provisional and do not represent any determination or policy of NOAA or the Department of Commerce.\n" #### citation ---- - if (!is.null(title) | !is.null(species) | !is.null(year) | !is.null(author)) { + if (title != "[TITLE]" | !is.null(species) | !is.null(year) | !is.null(authors)) { citation_line <- grep("Please cite this publication as:", prev_skeleton) + 2 - citation <- glue::glue("{{< pagebreak >}} \n\n Please cite this publication as: \n\n {prev_skeleton[citation_line]}\n\n") + # citation <- glue::glue("{{< pagebreak >}} \n\n Please cite this publication as: \n\n {prev_skeleton[citation_line]}\n\n") + # create the updated citation + citation <- create_citation( + authors = authors, + title = title, + year = year + ) } else { author <- grep(" - name: ", prev_skeleton) citation <- create_citation( - author = author, - ... + authors = authors ) cli::cli_alert_success("Added report citation.") } - if (custom) { - stop("Not currently working") - } else { - # identify all previous sections - files_to_copy <- stringr::str_extract(prev_skeleton[grep("knitr::knit_child", prev_skeleton)], "(?<=knit_child\\(').*?(?=\\')") - sections <- stringr::str_extract_all( - prev_skeleton, - "(?<=['`])[^']+\\.qmd(?=['`])" - ) |> - unlist() |> - purrr::discard(~ .x == "") - # add sections as list - sections <- add_child( - sections, - label = gsub(".qmd", "", unlist(sections)) - ) - } #### Create report outline (sections) ---- # id the order of the files in the skeleton and copy over in that order files_to_copy <- stringr::str_extract(prev_skeleton[grep("knitr::knit_child", prev_skeleton)], "(?<=knit_child\\(').*?(?=\\')") - if (!is.null(new_section) || !is.null(custom_sections)) custom <- TRUE + if (!is.null(new_section) || !is.null(custom_sections)) custom <- TRUE else custom <- FALSE if (is.null(custom_sections)) { # identify all previous sections @@ -442,11 +470,10 @@ rerender_skeleton <- function( files_to_copy = files_to_copy, tables_doc_name = tables_doc_name, figures_doc_name = figures_doc_name, - subdir = subdir + subdir = file_dir ) } - - + #### Pull together template ---- report_template <- paste( yaml, From 1a9958be421535ed532964682a5d60034f2f0bb6 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Thu, 17 Sep 2026 12:09:35 -0400 Subject: [PATCH 07/28] move shared functions out of create_template into utils --- R/utils.R | 82 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 82 insertions(+) diff --git a/R/utils.R b/R/utils.R index 68a57c71..c0877926 100644 --- a/R/utils.R +++ b/R/utils.R @@ -429,6 +429,8 @@ format_citation_authors <- function(author_names) { as.character() } +#--------------------------------------------------------------- + #' Map legacy document names to current document names #' #' @return A list containing vector mappings for legacy and current @@ -442,6 +444,8 @@ get_doc_order <- function() { ) } +#------------------------------------------------------------------- + #' Detect, rename, and resolve legacy document paths #' #' @param subdir Directory where template files are located. @@ -515,3 +519,81 @@ migrate_legacy_docs <- function(subdir, resolved_name = resolved_name ) } + +#-------------------------------------------------------------- + +can_rename_legacy_doc <- function(doc_info) { + isTRUE(doc_info$using_legacy) && + !is.null(doc_info$legacy_name) && + length(doc_info$legacy_name) == 1 && + !is.null(doc_info$current_name) && + length(doc_info$current_name) == 1 +} + +#-------------------------------------------------------------- + +custom_true <- function( + new_section, + section_location, + custom_sections, + files_to_copy, + tables_doc_name, + figures_doc_name, + subdir +){ + ###### Rerender & custom ---- + # Option for building custom template + # Create custom template from existing skeleton sections + if (is.null(new_section)) { + section_list <- add_base_section(files_to_copy) + # Create sections object to add into template + sections <- add_child(section_list, + label = stringr::str_extract(unlist(section_list), "(?<=_).+(?=\\.qmd$)") + ) + } else { # custom = TRUE + # Create custom template using existing sections and new sections from analyst + # Add sections from package options + + if (is.null(custom_sections)) { + # TODO: type - this needs to just pull all files from folder that + # it was copying from when custom sections is null -- DONE + + sec_list1 <- unique(c(files_to_copy, tables_doc_name, figures_doc_name)) + sec_list2 <- add_section( + new_section = new_section, + section_location = section_location, + custom_sections = sec_list1, + subdir = subdir + ) + + # Create sections object to add into template + sections <- add_child( + sec_list2, + label = stringr::str_remove_all(unlist(sec_list2), "^\\d{2}[a-zA-Z]?_|\\.qmd$") + ) + } else { # custom_sections explicit + + # Add selected sections from base + sec_list1 <- unique(c(unlist(add_base_section(files_to_copy)), tables_doc_name, figures_doc_name)) + # Create new sections as .qmd in folder + # check if sections are in custom_sections list + if (any(stringr::str_replace(section_location, "^[a-z]+-", "") %notin% custom_sections)) { + cli::cli_abort("Defined customizations do not match one or all of the relative placement of a new section. Please review inputs.") + } + # reorder sec_list1 alphabetically so that 11_appendix goes to end of list + sec_list1 <- sec_list1[order(names(stats::setNames(sec_list1, sec_list1)))] + + sec_list2 <- add_section( + new_section = new_section, + section_location = section_location, + custom_sections = sec_list1, + subdir = subdir + ) + # Create sections object to add into template + add_child( + sec_list2, + label = stringr::str_remove_all(unlist(sec_list2), "^\\d{2}[a-zA-Z]?_|\\.qmd$") + ) + } # close if statement for very specific sectioning + } # close if statement for extra custom +} \ No newline at end of file From 212b1fc62ca381ab3a570d0bdd413f528846b628 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Thu, 17 Sep 2026 12:10:31 -0400 Subject: [PATCH 08/28] remove rerender tests from create_template into own file to set up next todo of making more rerender tests --- tests/testthat/test-create_template.R | 132 -------------------------- 1 file changed, 132 deletions(-) diff --git a/tests/testthat/test-create_template.R b/tests/testthat/test-create_template.R index 008ecd11..4b0a8355 100644 --- a/tests/testthat/test-create_template.R +++ b/tests/testthat/test-create_template.R @@ -1,4 +1,3 @@ -# TODO: Add tests if rerender_skeleton = TRUE test_that("Can trace template files from package", { path <- system.file("templates", "skeleton", package = "asar") base_temp_files <- c( @@ -302,137 +301,6 @@ test_that("warning is triggered for existing files", { unlink(fs::path(path, "report"), recursive = T) }) -test_that("rerender updates SAR legacy figures/tables order in skeleton", { - # don't run on GitHub because can't rename files in the GH testing env - skip_on_ci() - # SAR - create_template() |> suppressWarnings() - - report_dir <- fs::path(getwd(), "report") - skeleton_path <- fs::path(report_dir, "sar_species_skeleton.qmd") - skeleton <- readLines(skeleton_path) - figures_idx <- grep("08_figures.qmd", skeleton, fixed = TRUE) - tables_idx <- grep("09_tables.qmd", skeleton, fixed = TRUE) - - skeleton[figures_idx] <- stringr::str_replace(skeleton[figures_idx], "08_figures.qmd", "08_tables.qmd") - skeleton[tables_idx] <- stringr::str_replace(skeleton[tables_idx], "09_tables.qmd", "09_figures.qmd") - writeLines(skeleton, skeleton_path) - - file.rename( - from = fs::path(report_dir, "08_figures.qmd"), - to = fs::path(report_dir, "09_figures.qmd") - ) - file.rename( - from = fs::path(report_dir, "09_tables.qmd"), - to = fs::path(report_dir, "08_tables.qmd") - ) - - create_template( - rerender_skeleton = TRUE, - file_dir = "report" - ) |> suppressWarnings() - - updated_skeleton <- readLines(skeleton_path) - updated_figures_idx <- grep("08_figures.qmd", updated_skeleton, fixed = TRUE) - updated_tables_idx <- grep("09_tables.qmd", updated_skeleton, fixed = TRUE) - - expect_true(file.exists(fs::path(report_dir, "08_figures.qmd"))) - expect_true(file.exists(fs::path(report_dir, "09_tables.qmd"))) - expect_false(file.exists(fs::path(report_dir, "09_figures.qmd"))) - expect_false(file.exists(fs::path(report_dir, "08_tables.qmd"))) - expect_lt(updated_figures_idx, updated_tables_idx) - - unlink(report_dir, recursive = TRUE) -}) - -test_that("rerender updates SAFE legacy figures/tables order in skeleton", { - # don't run on GitHub because can't rename files in the GH testing env - skip_on_ci() - # SAFE - create_template(type = "safe") - - report_dir <- fs::path(getwd(), "report") - skeleton_path <- fs::path(report_dir, "safe_species_skeleton.qmd") - skeleton <- readLines(skeleton_path) - figures_idx <- grep("11_figures.qmd", skeleton, fixed = TRUE) - tables_idx <- grep("12_tables.qmd", skeleton, fixed = TRUE) - - skeleton[figures_idx] <- stringr::str_replace(skeleton[figures_idx], "11_figures.qmd", "11_tables.qmd") - skeleton[tables_idx] <- stringr::str_replace(skeleton[tables_idx], "12_tables.qmd", "12_figures.qmd") - writeLines(skeleton, skeleton_path) - - file.rename( - from = fs::path(report_dir, "11_figures.qmd"), - to = fs::path(report_dir, "12_figures.qmd") - ) - file.rename( - from = fs::path(report_dir, "12_tables.qmd"), - to = fs::path(report_dir, "11_tables.qmd") - ) - - create_template( - rerender_skeleton = TRUE, - type = "safe", - file_dir = "report" - ) |> suppressWarnings() - - updated_skeleton <- readLines(skeleton_path) - updated_figures_idx <- grep("11_figures.qmd", updated_skeleton, fixed = TRUE) - updated_tables_idx <- grep("12_tables.qmd", updated_skeleton, fixed = TRUE) - - expect_true(file.exists(fs::path(report_dir, "11_figures.qmd"))) - expect_true(file.exists(fs::path(report_dir, "12_tables.qmd"))) - expect_false(file.exists(fs::path(report_dir, "12_figures.qmd"))) - expect_false(file.exists(fs::path(report_dir, "11_tables.qmd"))) - expect_lt(updated_figures_idx, updated_tables_idx) - - unlink(report_dir, recursive = TRUE) -}) - -test_that("rerender updates NEMT legacy figures/tables order in skeleton", { - # don't run on GitHub because can't rename files in the GH testing env - skip_on_ci() - # NEMT - create_template(type = "nemt") - - report_dir <- fs::path(getwd(), "report") - skeleton_path <- fs::path(report_dir, "nemt_species_skeleton.qmd") - skeleton <- readLines(skeleton_path) - figures_idx <- grep("05_figures.qmd", skeleton, fixed = TRUE) - tables_idx <- grep("06_tables.qmd", skeleton, fixed = TRUE) - - skeleton[figures_idx] <- stringr::str_replace(skeleton[figures_idx], "05_figures.qmd", "05_tables.qmd") - skeleton[tables_idx] <- stringr::str_replace(skeleton[tables_idx], "06_tables.qmd", "06_figures.qmd") - writeLines(skeleton, skeleton_path) - - file.rename( - from = fs::path(report_dir, "05_figures.qmd"), - to = fs::path(report_dir, "06_figures.qmd") - ) - file.rename( - from = fs::path(report_dir, "06_tables.qmd"), - to = fs::path(report_dir, "05_tables.qmd") - ) - - create_template( - rerender_skeleton = TRUE, - type = "nemt", - file_dir = "report" - ) |> suppressWarnings() - - updated_skeleton <- readLines(skeleton_path) - updated_figures_idx <- grep("05_figures.qmd", updated_skeleton, fixed = TRUE) - updated_tables_idx <- grep("06_tables.qmd", updated_skeleton, fixed = TRUE) - - expect_true(file.exists(fs::path(report_dir, "05_figures.qmd"))) - expect_true(file.exists(fs::path(report_dir, "06_tables.qmd"))) - expect_false(file.exists(fs::path(report_dir, "06_figures.qmd"))) - expect_false(file.exists(fs::path(report_dir, "05_tables.qmd"))) - expect_lt(updated_figures_idx, updated_tables_idx) - - unlink(report_dir, recursive = TRUE) -}) - test_that("file_dir works", { dir <- fs::path(getwd(), "data") on.exit(unlink(dir, recursive = TRUE), add = TRUE) From 28c49d6536979dc09666c39b08019b41ae2cee13 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Thu, 17 Sep 2026 12:11:12 -0400 Subject: [PATCH 09/28] update documentation around this function and specific removals; add initial testing for rerender --- NAMESPACE | 1 + R/utils_rerender.R | 67 ---------- man/add_authors.Rd | 6 - man/create_template.Rd | 8 -- man/create_yaml.Rd | 18 --- man/rerender_skeleton.Rd | 166 ++++++++++++++++++++++++ tests/testthat/test-rerender_skeleton.R | 127 ++++++++++++++++++ 7 files changed, 294 insertions(+), 99 deletions(-) delete mode 100644 R/utils_rerender.R create mode 100644 man/rerender_skeleton.Rd create mode 100644 tests/testthat/test-rerender_skeleton.R diff --git a/NAMESPACE b/NAMESPACE index 8ab30f5a..4551cced 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -22,4 +22,5 @@ export(export_split_tbls) export(format_quarto) export(gt_split) export(render_lg_table) +export(rerender_skeleton) export(update_report) diff --git a/R/utils_rerender.R b/R/utils_rerender.R deleted file mode 100644 index 6473f051..00000000 --- a/R/utils_rerender.R +++ /dev/null @@ -1,67 +0,0 @@ -# rerender skeleton duplicated utils - -custom_true <- function( - new_section, - section_location, - custom_sections, - files_to_copy, - tables_doc_name, - figures_doc_name, - subdir -){ - ###### Rerender & custom ---- - # Option for building custom template - # Create custom template from existing skeleton sections - if (is.null(new_section)) { - section_list <- add_base_section(files_to_copy) - # Create sections object to add into template - sections <- add_child(section_list, - label = stringr::str_extract(unlist(section_list), "(?<=_).+(?=\\.qmd$)") - ) - } else { # custom = TRUE - # Create custom template using existing sections and new sections from analyst - # Add sections from package options - - if (is.null(custom_sections)) { - # TODO: type - this needs to just pull all files from folder that - # it was copying from when custom sections is null -- DONE - - sec_list1 <- unique(c(files_to_copy, tables_doc_name, figures_doc_name)) - sec_list2 <- add_section( - new_section = new_section, - section_location = section_location, - custom_sections = sec_list1, - subdir = subdir - ) - - # Create sections object to add into template - sections <- add_child( - sec_list2, - label = stringr::str_remove_all(unlist(sec_list2), "^\\d{2}[a-zA-Z]?_|\\.qmd$") - ) - } else { # custom_sections explicit - - # Add selected sections from base - sec_list1 <- unique(c(unlist(add_base_section(files_to_copy)), tables_doc_name, figures_doc_name)) - # Create new sections as .qmd in folder - # check if sections are in custom_sections list - if (any(stringr::str_replace(section_location, "^[a-z]+-", "") %notin% custom_sections)) { - cli::cli_abort("Defined customizations do not match one or all of the relative placement of a new section. Please review inputs.") - } - # reorder sec_list1 alphabetically so that 11_appendix goes to end of list - sec_list1 <- sec_list1[order(names(stats::setNames(sec_list1, sec_list1)))] - - sec_list2 <- add_section( - new_section = new_section, - section_location = section_location, - custom_sections = sec_list1, - subdir = subdir - ) - # Create sections object to add into template - add_child( - sec_list2, - label = stringr::str_remove_all(unlist(sec_list2), "^\\d{2}[a-zA-Z]?_|\\.qmd$") - ) - } # close if statement for very specific sectioning - } # close if statement for extra custom -} \ No newline at end of file diff --git a/man/add_authors.Rd b/man/add_authors.Rd index 5f5641ee..eaf8a092 100644 --- a/man/add_authors.Rd +++ b/man/add_authors.Rd @@ -21,12 +21,6 @@ Default: NULL Options: See \code{asar::affiliation_info}.} -\item{rerender_skeleton}{TRUE/FALSE; Update the skeleton YAML and structure -(R parameters, preamble, and skeleton sectioning) if relevant or indicated. -All files in your folder, such as the \code{.qmd} child docs, will remain as is. - -Default: FALSE} - \item{prev_skeleton}{A character vector of the previous skeleton file read in through \code{readLines()}} } \value{ diff --git a/man/create_template.Rd b/man/create_template.Rd index 0af4e79d..70d7f2fa 100644 --- a/man/create_template.Rd +++ b/man/create_template.Rd @@ -21,7 +21,6 @@ create_template( spp_image = NULL, bib_file = NULL, new_template = TRUE, - rerender_skeleton = FALSE, custom_sections = NULL, new_section = NULL, section_location = NULL, @@ -129,12 +128,6 @@ will pull the last saved stock assessment report skeleton. Default: FALSE} -\item{rerender_skeleton}{TRUE/FALSE; Update the skeleton YAML and structure -(R parameters, preamble, and skeleton sectioning) if relevant or indicated. -All files in your folder, such as the \code{.qmd} child docs, will remain as is. - -Default: FALSE} - \item{custom_sections}{List of existing sections to include in a custom template (rather than the default for stock assessments in your region). If adding a new section, also use arguments 'new_section' and 'section_location'. @@ -215,7 +208,6 @@ create_template( section_location = "before-introduction" ) - create_template( new_template = TRUE, format = "pdf", diff --git a/man/create_yaml.Rd b/man/create_yaml.Rd index ec4fce6e..d0da96d9 100644 --- a/man/create_yaml.Rd +++ b/man/create_yaml.Rd @@ -13,7 +13,6 @@ create_yaml( spp_image = NULL, year = NULL, bib_name = NULL, - bib_file = NULL, author_list = NULL, title = "[TITLE]", rerender_skeleton = FALSE, @@ -66,16 +65,6 @@ Default: the year in which the report is rendered.} \item{bib_name}{Name of a bib file being added into the yaml. For example, "asar.bib".} -\item{bib_file}{File path to an existing additional bibliography file (\code{.bib}) used for citing references in -the report. By default, all bibliography files are sourced from the \pkg{journals} package and -references for all NMFS stock assessment reports are provided. To see a full -list of journals included in these files, please visit the -\href{https://github.com/nmfs-ost/journals/blob/main/README.md}{{journals} README} -or see the description at the top of each bib file. It is -recommended to open these files in a text editor rather than R. - -Default: NULL} - \item{author_list}{A list of strings containing pre-formatted author names and affiliations that would be found in the format in a yaml of a quarto file when using base R function \code{cat()}.} @@ -86,12 +75,6 @@ file when using base R function \code{cat()}.} Default: \verb{[TITLE]}. If species and region are provided, a title will be generated based on the report type, species, and region.} -\item{rerender_skeleton}{TRUE/FALSE; Update the skeleton YAML and structure -(R parameters, preamble, and skeleton sectioning) if relevant or indicated. -All files in your folder, such as the \code{.qmd} child docs, will remain as is. - -Default: FALSE} - \item{prev_skeleton}{Vector of strings containing all the lines of the previous skeleton file. File is read in using the function readLines from base R.} @@ -151,7 +134,6 @@ create_yaml( format = "pdf", parameters = TRUE, custom_params = NULL, - bib_file = "path/asar_references.bib", bib_name = "asar_references.bib", year = 2025 ) diff --git a/man/rerender_skeleton.Rd b/man/rerender_skeleton.Rd new file mode 100644 index 00000000..44dd5647 --- /dev/null +++ b/man/rerender_skeleton.Rd @@ -0,0 +1,166 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rerender_skeleton.R +\name{rerender_skeleton} +\alias{rerender_skeleton} +\title{Rerender skeleton quarto document} +\usage{ +rerender_skeleton( + file_dir, + species = "species", + spp_latin = NULL, + office = NULL, + region = NULL, + year = format(as.POSIXct(Sys.Date(), format = "\%YYYY-\%mm-\%dd"), "\%Y"), + custom_sections = NULL, + new_section = NULL, + section_location = NULL, + custom_params = NULL, + title = "[TITLE]", + model_results = NULL, + bib_file = NULL, + type = "sar", + spp_image = NULL, + format = "pdf", + authors = NULL +) +} +\arguments{ +\item{file_dir}{Required. Directory where the skeleton file is located. Can include or leave out the report folder in the path.} + +\item{species}{Common name of target species. Split multi-word names +with space and capitalize first letter(s). Example: "Dover sole". + +Default: "species"} + +\item{spp_latin}{Latin name of target species. Example: "Pomatomus saltatrix". + +Default: NULL} + +\item{office}{Regional Fisheries Science Center producing the report. + +Default: NULL + +Options: "AFSC", "NEFSC", "NWFSC", "PIFSC", "SEFSC", "SWFSC"} + +\item{region}{Full name of the stock's sub-region, if applicable. +If the region is not specified for your center or species, leave default. +Example: "US West Coast". + +Default: NULL} + +\item{year}{Year the assessment is conducted. + +Default: the year in which the report is rendered.} + +\item{custom_sections}{List of existing sections to include in a custom +template (rather than the default for stock assessments in your region). +If adding a new section, also use arguments 'new_section' and 'section_location'. + +Default: NULL + +Options: sections within +\code{list.files(system.file("templates", "skeleton", package = "asar"))}. +The name of the section, rather than the name of the file, can be used +(e.g., 'abstract' rather than '00_abstract.qmd').} + +\item{new_section}{Names of section(s) (e.g., "Special Section") or +subsection(s) (e.g., a section within the introduction) that will be +added to the document. Please make a short list if >1 section/subsection +will be added. The template will be created as a quarto document, added +into the skeleton, and saved for reference. + +Default: NULL} + +\item{section_location}{Where new section(s)/subsection(s) will be added to +the skeleton template. Please use the notation of 'placement-section'. +For example, 'in-introduction' signifies that the new content would +be created as a child document and added into the 02_introduction.qmd. +To add >1 (sub)section, make the location a list corresponding to the +order of (sub)section names listed in the 'new_section' parameter. + +Default: NULL} + +\item{custom_params}{Character vector of additional custom parameter +names and values to include in the skeleton YAML. For example, a +parameter "year2" and its value "2026" would have an entry of +\code{c("year2" = "2026")}. Parameters automatically included: office, region, +species (each of which are listed as individual parameters for this +function, above). + +Default: NULL} + +\item{title}{Custom report title superceding the default composed in +\code{asar::create_title()}. Example: "Management Track Assessments Spring +2024". + +Default: \verb{[TITLE]}. If species and region are provided, a title will be generated based on the report type, species, and region.} + +\item{model_results}{Filepath to the standardized, converted model output +.rda file generated with \code{stockplotr::convert_output()}, relative to the +skeleton .qmd file that will be created within the 'report' folder. + +Default: NULL} + +\item{bib_file}{File path to an existing additional bibliography file (\code{.bib}) used for citing references in +the report. By default, all bibliography files are sourced from the \pkg{journals} package and +references for all NMFS stock assessment reports are provided. To see a full +list of journals included in these files, please visit the +\href{https://github.com/nmfs-ost/journals/blob/main/README.md}{{journals} README} +or see the description at the top of each bib file. It is +recommended to open these files in a text editor rather than R. + +Default: NULL} + +\item{type}{Report template type. + +Default: "sar" (a NOAA standard "Stock Assessment Report") + +Options: "sar" (Stock Assessment Report), "nemt" (Northeast Management Track), "pfmc" (Pacific Fishery Management Council), "safe" (Stock Assessment and Fishery Evaluation)} + +\item{spp_image}{Filepath to a custom species image to be used on the +report cover. Supported file extension is .png. +If empty, searches \code{asar} resources for a matching species name. + +Default: NULL} + +\item{format}{Report rendering format. Note: "docx" is currently unsupported +and will default to "pdf". + +Default: "pdf" + +Options: "pdf", "html"} + +\item{authors}{A character vector of author names and affiliations. +For example, a Jane Doe at the NWFSC Seattle, Washington office +would have an entry of c("Jane Doe"="NWFSC-SWA"). Information on NOAA offices +can be found with: \code{asar::affiliation_info}. Keys to the office addresses +follow the naming convention of: office acronym (ex. NWFSC), a hyphen (-), +the first initial of the city, and then the two-letter abbreviation for +the state the office is located in. If the city has two or more words (e.g., +Panama City), the first initial of each word is used in the key +(ex. Panama City, Florida = PCFL). + +Default: NULL + +Options: See \code{asar::affiliation_info}.} +} +\value{ +Update the "skeleton" file produce after running \code{create_template}. +Prevents the loss of data in child documents and make easy updates without +prior knowledge of quarto. +} +\description{ +Rerender skeleton quarto document +} +\examples{ +\dontrun{ +rerender_skeleton( +file_dir = getwd(), +species = "Red Snapper", +office = "SEFSC", +region = "Gulf of America", +year = 2027, +authors = c("Jane Doe" = "SEFSC") +) +} +} diff --git a/tests/testthat/test-rerender_skeleton.R b/tests/testthat/test-rerender_skeleton.R new file mode 100644 index 00000000..b7d3dc5e --- /dev/null +++ b/tests/testthat/test-rerender_skeleton.R @@ -0,0 +1,127 @@ +test_that("rerender updates SAR legacy figures/tables order in skeleton", { + # don't run on GitHub because can't rename files in the GH testing env + skip_on_ci() + # SAR + create_template() |> suppressWarnings() + + report_dir <- fs::path(getwd(), "report") + skeleton_path <- fs::path(report_dir, "sar_species_skeleton.qmd") + skeleton <- readLines(skeleton_path) + figures_idx <- grep("08_figures.qmd", skeleton, fixed = TRUE) + tables_idx <- grep("09_tables.qmd", skeleton, fixed = TRUE) + + skeleton[figures_idx] <- stringr::str_replace(skeleton[figures_idx], "08_figures.qmd", "08_tables.qmd") + skeleton[tables_idx] <- stringr::str_replace(skeleton[tables_idx], "09_tables.qmd", "09_figures.qmd") + writeLines(skeleton, skeleton_path) + + file.rename( + from = fs::path(report_dir, "08_figures.qmd"), + to = fs::path(report_dir, "09_figures.qmd") + ) + file.rename( + from = fs::path(report_dir, "09_tables.qmd"), + to = fs::path(report_dir, "08_tables.qmd") + ) + + rerender_skeleton( + file_dir = "report" + ) |> suppressWarnings() + + updated_skeleton <- readLines(skeleton_path) + updated_figures_idx <- grep("08_figures.qmd", updated_skeleton, fixed = TRUE) + updated_tables_idx <- grep("09_tables.qmd", updated_skeleton, fixed = TRUE) + + expect_true(file.exists(fs::path(report_dir, "08_figures.qmd"))) + expect_true(file.exists(fs::path(report_dir, "09_tables.qmd"))) + expect_false(file.exists(fs::path(report_dir, "09_figures.qmd"))) + expect_false(file.exists(fs::path(report_dir, "08_tables.qmd"))) + expect_lt(updated_figures_idx, updated_tables_idx) + + unlink(report_dir, recursive = TRUE) +}) + +test_that("rerender updates SAFE legacy figures/tables order in skeleton", { + # don't run on GitHub because can't rename files in the GH testing env + skip_on_ci() + # SAFE + create_template(type = "safe") + + report_dir <- fs::path(getwd(), "report") + skeleton_path <- fs::path(report_dir, "safe_species_skeleton.qmd") + skeleton <- readLines(skeleton_path) + figures_idx <- grep("11_figures.qmd", skeleton, fixed = TRUE) + tables_idx <- grep("12_tables.qmd", skeleton, fixed = TRUE) + + skeleton[figures_idx] <- stringr::str_replace(skeleton[figures_idx], "11_figures.qmd", "11_tables.qmd") + skeleton[tables_idx] <- stringr::str_replace(skeleton[tables_idx], "12_tables.qmd", "12_figures.qmd") + writeLines(skeleton, skeleton_path) + + file.rename( + from = fs::path(report_dir, "11_figures.qmd"), + to = fs::path(report_dir, "12_figures.qmd") + ) + file.rename( + from = fs::path(report_dir, "12_tables.qmd"), + to = fs::path(report_dir, "11_tables.qmd") + ) + + rerender_skeleton( + type = "safe", + file_dir = "report" + ) |> suppressWarnings() + + updated_skeleton <- readLines(skeleton_path) + updated_figures_idx <- grep("11_figures.qmd", updated_skeleton, fixed = TRUE) + updated_tables_idx <- grep("12_tables.qmd", updated_skeleton, fixed = TRUE) + + expect_true(file.exists(fs::path(report_dir, "11_figures.qmd"))) + expect_true(file.exists(fs::path(report_dir, "12_tables.qmd"))) + expect_false(file.exists(fs::path(report_dir, "12_figures.qmd"))) + expect_false(file.exists(fs::path(report_dir, "11_tables.qmd"))) + expect_lt(updated_figures_idx, updated_tables_idx) + + unlink(report_dir, recursive = TRUE) +}) + +test_that("rerender updates NEMT legacy figures/tables order in skeleton", { + # don't run on GitHub because can't rename files in the GH testing env + skip_on_ci() + # NEMT + create_template(type = "nemt") + + report_dir <- fs::path(getwd(), "report") + skeleton_path <- fs::path(report_dir, "nemt_species_skeleton.qmd") + skeleton <- readLines(skeleton_path) + figures_idx <- grep("05_figures.qmd", skeleton, fixed = TRUE) + tables_idx <- grep("06_tables.qmd", skeleton, fixed = TRUE) + + skeleton[figures_idx] <- stringr::str_replace(skeleton[figures_idx], "05_figures.qmd", "05_tables.qmd") + skeleton[tables_idx] <- stringr::str_replace(skeleton[tables_idx], "06_tables.qmd", "06_figures.qmd") + writeLines(skeleton, skeleton_path) + + file.rename( + from = fs::path(report_dir, "05_figures.qmd"), + to = fs::path(report_dir, "06_figures.qmd") + ) + file.rename( + from = fs::path(report_dir, "06_tables.qmd"), + to = fs::path(report_dir, "05_tables.qmd") + ) + + rerender_skeleton( + type = "nemt", + file_dir = "report" + ) |> suppressWarnings() + + updated_skeleton <- readLines(skeleton_path) + updated_figures_idx <- grep("05_figures.qmd", updated_skeleton, fixed = TRUE) + updated_tables_idx <- grep("06_tables.qmd", updated_skeleton, fixed = TRUE) + + expect_true(file.exists(fs::path(report_dir, "05_figures.qmd"))) + expect_true(file.exists(fs::path(report_dir, "06_tables.qmd"))) + expect_false(file.exists(fs::path(report_dir, "06_figures.qmd"))) + expect_false(file.exists(fs::path(report_dir, "05_tables.qmd"))) + expect_lt(updated_figures_idx, updated_tables_idx) + + unlink(report_dir, recursive = TRUE) +}) \ No newline at end of file From bc43db0ee908117afa4173ee6d64b203fb811d3f Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Mon, 14 Sep 2026 16:59:21 -0400 Subject: [PATCH 10/28] fix create template so year updates when calling new report --- R/create_template.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/create_template.R b/R/create_template.R index 57350330..c78d7d73 100644 --- a/R/create_template.R +++ b/R/create_template.R @@ -455,6 +455,7 @@ create_template <- function( #### Read in previous skeleton if rerender ---- # Check if this is a rerender of the skeleton file + #### Copy template files to report folder ---- # Check if there are already files in the folder # Only files present should be: From 2388078e812ce444723bf7905a9012c0faca9e85 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Mon, 21 Sep 2026 11:08:00 -0400 Subject: [PATCH 11/28] fix duplicated bibs and params chunk not getting added to skeleton --- R/rerender_skeleton.R | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/R/rerender_skeleton.R b/R/rerender_skeleton.R index 82e6e138..40c412ef 100644 --- a/R/rerender_skeleton.R +++ b/R/rerender_skeleton.R @@ -186,15 +186,16 @@ rerender_skeleton <- function( } #### Initialize bib name ---- - # bib_name <- NULL - # Extract previous bib file names - lines_after_bib <- prev_skeleton[(grep("bibliography:", prev_skeleton)[1] + 1):(grep("csl:", prev_skeleton)[1] - 1)] - bib_name <- basename(stringr::str_replace_all(lines_after_bib, " - ", "")) + # Don't need to extract previous bib names bc create_yaml with rerender modifies the lines rather than build the whole thing + # lines_after_bib <- prev_skeleton[(grep("bibliography:", prev_skeleton)[1] + 1):(grep("csl:", prev_skeleton)[1] - 1)] + # bib_name <- basename(stringr::str_replace_all(lines_after_bib, " - ", "")) # Add bib file if bib_file is not NULL # Note: this is copied from create_template if (!is.null(bib_file)) { file.copy(bib_file, bibdir, overwrite = TRUE) |> suppressWarnings() bib_name <- c(bib_name, basename(bib_file)) + } else { + bib_name <- NULL } #### Authors ---- @@ -223,7 +224,7 @@ rerender_skeleton <- function( species = species, spp_latin = spp_latin, region = region, - parameters = parameters, + parameters = TRUE, custom_params = custom_params, bib_name = bib_name, year = year, @@ -261,7 +262,7 @@ rerender_skeleton <- function( params_chunk <- append( params_chunk, "region <- params$region", - after = params_chunk_end - 1 + after = length(params_chunk) - 1 ) } if (!is.null(param_values) & !is.null(param_names)) { @@ -270,7 +271,7 @@ rerender_skeleton <- function( params_chunk <- append( params_chunk, add_param, - after = params_chunk_end - 1 + after = length(params_chunk) - 1 ) } } @@ -478,7 +479,7 @@ rerender_skeleton <- function( report_template <- paste( yaml, "\\printnoidxglossaries \n", - params_chunk, + paste(params_chunk, collapse = "\n"), preamble, disclaimer, citation, @@ -504,5 +505,5 @@ rerender_skeleton <- function( } } # Print message - cli::cli_alert_success("Updated report skeleton in directory {subdir}.") + cli::cli_alert_success("Updated report skeleton in directory {file_dir}.") } \ No newline at end of file From 410c8ba58aab86a861cb15f58b3499aabee442aa Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Tue, 22 Sep 2026 09:38:42 -0400 Subject: [PATCH 12/28] add changes from main manually to avoid merge conflicts --- R/create_template.R | 50 +++++++++++++++++++++++++------------------ R/rerender_skeleton.R | 2 +- 2 files changed, 30 insertions(+), 22 deletions(-) diff --git a/R/create_template.R b/R/create_template.R index c78d7d73..a1bf3174 100644 --- a/R/create_template.R +++ b/R/create_template.R @@ -425,32 +425,40 @@ create_template <- function( dir.create(bib_dir, recursive = FALSE) } - journals::download_bibs(bib_dir) - bib_file_paths <- list.files(bib_dir, pattern = ".bib", full.names = TRUE) - base_bib_file <- bib_file_paths[!grepl(".sty", bib_file_paths)] - # Remove .sty file and copy to main report folder - file.copy(list.files(bib_dir, pattern = ".sty", full.names = TRUE), subdir, overwrite = FALSE) |> suppressWarnings() - file.remove(list.files(bib_dir, pattern = ".sty", full.names = TRUE)) - bib_name <- basename(base_bib_file) + bib_name <- NULL - # append asar citation to first .bib - asar_citation <- " -@Manual{asar_2026, - title = {asar: Build NOAA Stock Assessment Report}, - author = {Samantha Schiano and Sophie Breitbart and Steve Saul}, - year = {2026}, - note = {R package version 2.2.0}, - url = {https://github.com/nmfs-ost/asar}, + # asar citation + asar_citation <- "@Manual{asar_2026, +title = {asar: Build NOAA Stock Assessment Report}, +author = {Samantha Schiano and Sophie Breitbart and Steve Saul}, +year = {2026}, +note = {R package version 2.2.0}, +url = {https://github.com/nmfs-ost/asar}, }" - - if (!is.na(base_bib_file[1]) && nzchar(base_bib_file[1])) { - write(asar_citation, file = base_bib_file[1], append = TRUE) - } - # Add bib file if bib_file is not NULL - if (!is.null(bib_file)) { + # make asar bib in all conditions + asar_bib_path <- file.path(bib_dir, "asar_citation.bib") + write(asar_citation, file = asar_bib_path) + bib_name <- c("asar_citation.bib") + if (is.character(bib_file)) { + # File provided: Copy the custom bib and create the asar citation .bib file.copy(bib_file, bib_dir, overwrite = TRUE) |> suppressWarnings() bib_name <- c(bib_name, basename(bib_file)) + } else if (isTRUE(bib_file)) { + # TRUE: Download the journal packages bib and create the asar citation .bib + journals::download_bibs(bib_dir) + bib_file_paths <- list.files(bib_dir, pattern = ".bib", full.names = TRUE) + base_bib_file <- bib_file_paths[!grepl(".sty", bib_file_paths)] + + # Move .sty file to main report folder + sty_files <- list.files(bib_dir, pattern = ".sty", full.names = TRUE) + if (length(sty_files) > 0) { + file.copy(sty_files, subdir, overwrite = FALSE) |> suppressWarnings() + file.remove(sty_files) + } + + bib_name <- basename(base_bib_file) + } #### Read in previous skeleton if rerender ---- diff --git a/R/rerender_skeleton.R b/R/rerender_skeleton.R index 40c412ef..3b14b948 100644 --- a/R/rerender_skeleton.R +++ b/R/rerender_skeleton.R @@ -193,7 +193,7 @@ rerender_skeleton <- function( # Note: this is copied from create_template if (!is.null(bib_file)) { file.copy(bib_file, bibdir, overwrite = TRUE) |> suppressWarnings() - bib_name <- c(bib_name, basename(bib_file)) + bib_name <- basename(bib_file) } else { bib_name <- NULL } From 113a1bde6589d09e83c06228c94e60dbcf39c5d3 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Tue, 22 Sep 2026 14:54:07 -0400 Subject: [PATCH 13/28] add formatting to asar citation --- R/create_template.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/create_template.R b/R/create_template.R index a1bf3174..e54f18fe 100644 --- a/R/create_template.R +++ b/R/create_template.R @@ -429,11 +429,11 @@ create_template <- function( # asar citation asar_citation <- "@Manual{asar_2026, -title = {asar: Build NOAA Stock Assessment Report}, -author = {Samantha Schiano and Sophie Breitbart and Steve Saul}, -year = {2026}, -note = {R package version 2.2.0}, -url = {https://github.com/nmfs-ost/asar}, + title = {asar: Build NOAA Stock Assessment Report}, + author = {Samantha Schiano and Sophie Breitbart and Steve Saul}, + year = {2026}, + note = {R package version 2.2.0}, + url = {https://github.com/nmfs-ost/asar}, }" # make asar bib in all conditions From 94f0666799e84bf1a04c6a7cbfc042af0d8a5436 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Tue, 22 Sep 2026 16:22:39 -0400 Subject: [PATCH 14/28] adjustment to create title to not fail when office == NULL --- R/create_title.R | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/R/create_title.R b/R/create_title.R index 1e140f7d..e9aa37fc 100644 --- a/R/create_title.R +++ b/R/create_title.R @@ -26,7 +26,13 @@ create_title <- function( # if(!is.null(spp_latin)) spp_latin <- paste("\\textit{", spp_latin, "}", sep = "") # Create title dependent on regional language - if (office == "AFSC") { + if (is.null(office) || office == "") { + if (species == "species") { + title <- "Stock Assessment Report Template" + } else { + title <- paste0("Stock Assessment Report for the ", species, " Stock in ", year) + } + } else if (office == "AFSC") { if (is.null(complex)) { title <- paste0("Assessment of the ", species, " Stock in the ", region) } else { @@ -71,13 +77,6 @@ create_title <- function( # region in NW should be specified as a state title <- paste0("Status of the ", species, " stock in U.S. waters off the coast of ", region, " in ", year) } - } else { - if (species == "species" | is.null(region)) { - title <- "Stock Assessment Report Template" - } else { - title <- paste0("Stock Assessment Report for the ", species, " Stock in ", year) - } - # warning("office (FSC) is not defined. Please define which office you are associated with.") } # Cohesive title for any stock assessment From 69a3e4ea21b86ca0fae2a4b713ff5402ddcaaac2 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Tue, 22 Sep 2026 16:23:16 -0400 Subject: [PATCH 15/28] change default title when rerendering in check --- R/rerender_skeleton.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/rerender_skeleton.R b/R/rerender_skeleton.R index 3b14b948..4d9de858 100644 --- a/R/rerender_skeleton.R +++ b/R/rerender_skeleton.R @@ -171,7 +171,7 @@ rerender_skeleton <- function( } #### Adjust the title ---- - if (title == "[TITLE]") { + if (title == "'Stock Assessment Report Template'" || title == "[TITLE]") { title <- sub("title: ", "", prev_skeleton[grep("title:", prev_skeleton)]) if (title == "'Stock Assessment Report Template'" & (!is.null(office) | !is.null(species) | !is.null(region))) { title <- create_title( From d6c03dd75d9486d24d2339bbb92b03ce955d648b Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Tue, 22 Sep 2026 16:23:28 -0400 Subject: [PATCH 16/28] add new tests for rerender --- tests/testthat/test-rerender_skeleton.R | 62 +++++++++++++++++++++++-- 1 file changed, 58 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-rerender_skeleton.R b/tests/testthat/test-rerender_skeleton.R index b7d3dc5e..0d4af56e 100644 --- a/tests/testthat/test-rerender_skeleton.R +++ b/tests/testthat/test-rerender_skeleton.R @@ -2,7 +2,7 @@ test_that("rerender updates SAR legacy figures/tables order in skeleton", { # don't run on GitHub because can't rename files in the GH testing env skip_on_ci() # SAR - create_template() |> suppressWarnings() + create_template(bib_file = FALSE) |> suppressWarnings() report_dir <- fs::path(getwd(), "report") skeleton_path <- fs::path(report_dir, "sar_species_skeleton.qmd") @@ -44,7 +44,7 @@ test_that("rerender updates SAFE legacy figures/tables order in skeleton", { # don't run on GitHub because can't rename files in the GH testing env skip_on_ci() # SAFE - create_template(type = "safe") + create_template(type = "safe", bib_file = FALSE) report_dir <- fs::path(getwd(), "report") skeleton_path <- fs::path(report_dir, "safe_species_skeleton.qmd") @@ -87,7 +87,7 @@ test_that("rerender updates NEMT legacy figures/tables order in skeleton", { # don't run on GitHub because can't rename files in the GH testing env skip_on_ci() # NEMT - create_template(type = "nemt") + create_template(type = "nemt", bib_file = FALSE) report_dir <- fs::path(getwd(), "report") skeleton_path <- fs::path(report_dir, "nemt_species_skeleton.qmd") @@ -124,4 +124,58 @@ test_that("rerender updates NEMT legacy figures/tables order in skeleton", { expect_lt(updated_figures_idx, updated_tables_idx) unlink(report_dir, recursive = TRUE) -}) \ No newline at end of file +}) + +test_that("species is updated in skeleton.",{ + create_template(bib_file = FALSE) + + report_dir <- fs::path(getwd(), "report") + file_names <- list.files(report_dir, full.names = FALSE) + skeleton_name <- file_names[grepl("species_skeleton.qmd", file_names)] + skeleton <- readLines(fs::path(report_dir, skeleton_name)) + init_species_params <- skeleton[grep("species:", skeleton, fixed = TRUE)] + + # rerender for species + rerender_skeleton(file_dir = report_dir, species = "Red snapper") + + re_file_names <- list.files(report_dir, full.names = FALSE) + rerender_skeleton_name <- re_file_names[grepl("_skeleton.qmd", re_file_names)] + rerender_skeleton <- readLines(fs::path(report_dir, rerender_skeleton_name)) + rerender_species_params <- rerender_skeleton[grep("species:", rerender_skeleton, fixed = TRUE)] + + # species is updated in params + expect_equal(" species: 'Red snapper' ", rerender_species_params) + # species is updated in skeleton + expect_no_match(skeleton_name, rerender_skeleton_name) + # species changed in params + expect_no_match(init_species_params, rerender_species_params) + + unlink(report_dir, recursive = TRUE) +}) + +test_that("office is updated in skeleton", { + create_template(bib_file = FALSE) + + report_dir <- fs::path(getwd(), "report") + file_names <- list.files(report_dir, full.names = FALSE) + skeleton_name <- file_names[grepl("_skeleton.qmd", file_names)] + skeleton <- readLines(fs::path(report_dir, skeleton_name)) + init_office_params <- skeleton[grep("office:", skeleton, fixed = TRUE)] + + # rerender for office + rerender_skeleton(file_dir = report_dir, office = "NEFSC") + + re_file_names <- list.files(report_dir, full.names = FALSE) + rerender_skeleton_name <- re_file_names[grepl("_skeleton.qmd", re_file_names)] + rerender_skeleton <- readLines(fs::path(report_dir, rerender_skeleton_name)) + rerender_office_params <- rerender_skeleton[grep("office:", rerender_skeleton, fixed = TRUE)] + + # office is updated in params + expect_equal(" office: 'gls{nefsc}' ", rerender_office_params) + # office changed in params + # cannot test bc negative interaction with {} + # expect_no_match(init_office_params, rerender_office_params) + + unlink(report_dir, recursive = TRUE) +}) + From 07296a1e4b41a44ca62cce0c7440bf4a22b9da6a Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Tue, 22 Sep 2026 16:59:03 -0400 Subject: [PATCH 17/28] adjust when year is rerendered and add test --- R/rerender_skeleton.R | 12 ++++++--- tests/testthat/test-rerender_skeleton.R | 35 +++++++++++++++++++++++++ 2 files changed, 43 insertions(+), 4 deletions(-) diff --git a/R/rerender_skeleton.R b/R/rerender_skeleton.R index 4d9de858..c53e12f1 100644 --- a/R/rerender_skeleton.R +++ b/R/rerender_skeleton.R @@ -147,11 +147,11 @@ rerender_skeleton <- function( if (!file.exists(file_dir, "support_files", "before-body.tex")) file.copy(before_body_file, supdir, overwrite = FALSE) |> suppressWarnings() # customize titlepage tex if (!file.exists(file_dir, "support_files", "_titlepage.tex") | !is.null(species)) create_titlepage_tex(office = office, subdir = supdir, species = species) - # customize in-header tex - if (!file.exists(file_dir, "support_files", "in-header.tex") | !is.null(species)) create_inheader_tex(species = species, year = year, subdir = supdir) # copy new spp image if updated if (!is.null(species)) file.copy(spp_image, supdir, overwrite = FALSE) |> suppressWarnings() } + # customize in-header tex -- always run to update year + if (tolower(format) == "pdf") create_inheader_tex(species = species, year = year, subdir = supdir) #### Figs and tabs docs ---- # extract name for tables.qmd from report folder @@ -171,7 +171,8 @@ rerender_skeleton <- function( } #### Adjust the title ---- - if (title == "'Stock Assessment Report Template'" || title == "[TITLE]") { + old_title <- sub("title: ", "", prev_skeleton[grep("title:", prev_skeleton)]) + if (old_title == "'Stock Assessment Report Template'") { title <- sub("title: ", "", prev_skeleton[grep("title:", prev_skeleton)]) if (title == "'Stock Assessment Report Template'" & (!is.null(office) | !is.null(species) | !is.null(region))) { title <- create_title( @@ -183,8 +184,11 @@ rerender_skeleton <- function( year = year ) } + } else { + # replace year + title <- stringr::str_replace(old_title, "[0-9]+", as.character(year)) } - + #### Initialize bib name ---- # Don't need to extract previous bib names bc create_yaml with rerender modifies the lines rather than build the whole thing # lines_after_bib <- prev_skeleton[(grep("bibliography:", prev_skeleton)[1] + 1):(grep("csl:", prev_skeleton)[1] - 1)] diff --git a/tests/testthat/test-rerender_skeleton.R b/tests/testthat/test-rerender_skeleton.R index 0d4af56e..fb6b99da 100644 --- a/tests/testthat/test-rerender_skeleton.R +++ b/tests/testthat/test-rerender_skeleton.R @@ -179,3 +179,38 @@ test_that("office is updated in skeleton", { unlink(report_dir, recursive = TRUE) }) +test_that("year is changed throughout document", { + create_template( + bib_file = FALSE, + species = "Red snapper", + office = "SEFSC", + region = "South Atlantic", + authors = c("Jane Doe" = "SEFSC"), + year = 2023) + + report_dir <- fs::path(getwd(), "report") + rerender_skeleton(file_dir = report_dir, year = 2027) + + # find year in title, citation, output_file, in-header.tex + skeleton <- readLines(fs::path(report_dir, "sar_SA_Red_snapper_skeleton.qmd")) + title <- stringr::str_replace( + skeleton[grep("title: ", skeleton)], + "title: ", + "" + ) |> stringr::str_extract("\\d{4}") + citation <- stringr::str_extract( + skeleton[grep("Please cite this publication as: ", skeleton) + 2], + "\\d{4}") + output_file <- stringr::str_replace( + skeleton[grep("output-file: ", skeleton)], + "output-file: ", + "" + ) |> stringr::str_extract("\\d{4}") + in_header_lines <- readLines(fs::path(report_dir, "support_files", "in-header.tex")) + in_header <- in_header_lines[grep("\\ohead[]{\\headmark} \\cofoot[\\pagemark]{\\pagemark}", in_header_lines, fixed = TRUE) + 1] |> + stringr::str_extract("\\d{4}") + + # tests + expect_all_equal(c(title, citation, output_file, in_header), "2027") + +}) \ No newline at end of file From 03a12fc02be93431926881f6b7f82594e321a5d8 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Fri, 25 Sep 2026 14:37:25 -0400 Subject: [PATCH 18/28] initialize deprecation lifecycle in package --- DESCRIPTION | 1 + NAMESPACE | 1 + R/asar-package.R | 1 + 3 files changed, 3 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index 55ce6ddc..fa1bc472 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -29,6 +29,7 @@ Imports: glue, gt, journals, + lifecycle, purrr, stats, stringi, diff --git a/NAMESPACE b/NAMESPACE index 4551cced..ff17d4d1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -24,3 +24,4 @@ export(gt_split) export(render_lg_table) export(rerender_skeleton) export(update_report) +importFrom(lifecycle,deprecated) diff --git a/R/asar-package.R b/R/asar-package.R index b7c60170..ef729ba3 100644 --- a/R/asar-package.R +++ b/R/asar-package.R @@ -2,6 +2,7 @@ "_PACKAGE" ## usethis namespace: start +#' @importFrom lifecycle deprecated ## usethis namespace: end NULL From 2b7070dc079083f8fc1d3a97a986108ce5bda6e3 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Fri, 25 Sep 2026 14:38:17 -0400 Subject: [PATCH 19/28] adjust create_template to add deprecated documentation to the rerender_skeleton argument and make a replacement for the function in the beginning of the create_template function --- R/create_template.R | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/R/create_template.R b/R/create_template.R index e54f18fe..9ea7794c 100644 --- a/R/create_template.R +++ b/R/create_template.R @@ -137,6 +137,10 @@ #' function, above). #' #' Default: NULL +#' +#' @param rerender_skeleton `r lifecycle::badge('deprecated')` This argument was +#' deprecated in favor of a separate function `rerender_skeleton()` in order to +#' provide more clarity and separation of functionality. #' #' @param ... Additional arguments passed into functions used in create_template #' such as `create_citation()` or `create_yaml()`. @@ -250,8 +254,39 @@ create_template <- function( new_section = NULL, section_location = NULL, custom_params = NULL, + rerender_skeleton = lifecycle::deprecated(), ... ) { + # check for used deprecated argument + if (lifecycle::is_present(rerender_skeleton)) { + # 1. Trigger the deprecation warning + lifecycle::deprecate_warn( + when = "2.7.0", + what = "create_template(rerender_skeleton)", + details = "Please use `rerender_skeleton()` instead" + ) + + # 2. Maintain backwards compatibility by executing the new logic behind the scenes + return(rerender_skeleton( + file_dir = file_dir, + species = species, + spp_latin = spp_latin, + office = office, + region = region, + year = year, + custom_sections = custom_sections, + new_section = new_section, + section_location = section_location, + custom_params = custom_params, + title = title, + model_results = model_results, + bib_file = bib_file, + type = type, + spp_image = spp_image, + format = format, + authors = authors + )) + } type_map <- c( "Northeast Management Track" = "nemt", "Pacific Fishery Management Council" = "pfmc", From 127274513c1c0d4842f50fadc229dd6149321dd0 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Fri, 25 Sep 2026 14:45:59 -0400 Subject: [PATCH 20/28] update documentation for lifecycle and set new params for rerender_skeleton and bib_file in related functions --- R/add_authors.R | 5 +++++ R/create_yaml.R | 5 +++++ R/rerender_skeleton.R | 8 +++++++- man/add_authors.Rd | 6 ++++++ man/create_template.Rd | 20 +++++++++++--------- man/create_yaml.Rd | 6 ++++++ man/rerender_skeleton.Rd | 13 +++++-------- 7 files changed, 45 insertions(+), 18 deletions(-) diff --git a/R/add_authors.R b/R/add_authors.R index 47efa4f0..13e2c1f1 100644 --- a/R/add_authors.R +++ b/R/add_authors.R @@ -1,6 +1,11 @@ #' Format authors for skeleton #' #' @inheritParams create_template +#' @param rerender_skeleton TRUE/FALSE; Update the skeleton YAML and structure +#' (R parameters, preamble, and skeleton sectioning) if relevant or indicated. +#' All files in your folder, such as the `.qmd` child docs, will remain as is. +#' +#' Default: FALSE #' @param prev_skeleton A character vector of the previous skeleton file read in through \code{readLines()} #' #' @returns A list of authors formatted for a yaml in quarto. Viewable by running the diff --git a/R/create_yaml.R b/R/create_yaml.R index 84ba4e40..86dc4e2c 100644 --- a/R/create_yaml.R +++ b/R/create_yaml.R @@ -1,6 +1,11 @@ #' Create string for yml header in quarto file #' #' @inheritParams create_template +#' @param rerender_skeleton TRUE/FALSE; Update the skeleton YAML and structure +#' (R parameters, preamble, and skeleton sectioning) if relevant or indicated. +#' All files in your folder, such as the `.qmd` child docs, will remain as is. +#' +#' Default: FALSE #' @param parameters Logical indicating whether to include parameters #' in the yaml. Default is TRUE. #' @param author_list A vector of strings containing pre-formatted author names diff --git a/R/rerender_skeleton.R b/R/rerender_skeleton.R index c53e12f1..7d4f2021 100644 --- a/R/rerender_skeleton.R +++ b/R/rerender_skeleton.R @@ -1,7 +1,13 @@ #' Rerender skeleton quarto document #' #' @inheritParams create_template -#' @param file_dir Required. Directory where the skeleton file is located. Can include or leave out the report folder in the path. +#' @param file_dir Required. Directory where the skeleton file is located. Can +#' include or leave out the report folder in the path. +#' @param bib_file A character string of the path to a custom `.bib` file, or a logical. +#' If a path is provided, the custom file is added to the skeleton and copied +#' into the bibliography files folder. +#' +#' Default: NULL #' #' @returns Update the "skeleton" file produce after running `create_template`. #' Prevents the loss of data in child documents and make easy updates without diff --git a/man/add_authors.Rd b/man/add_authors.Rd index eaf8a092..5f5641ee 100644 --- a/man/add_authors.Rd +++ b/man/add_authors.Rd @@ -21,6 +21,12 @@ Default: NULL Options: See \code{asar::affiliation_info}.} +\item{rerender_skeleton}{TRUE/FALSE; Update the skeleton YAML and structure +(R parameters, preamble, and skeleton sectioning) if relevant or indicated. +All files in your folder, such as the \code{.qmd} child docs, will remain as is. + +Default: FALSE} + \item{prev_skeleton}{A character vector of the previous skeleton file read in through \code{readLines()}} } \value{ diff --git a/man/create_template.Rd b/man/create_template.Rd index 70d7f2fa..84dab2cf 100644 --- a/man/create_template.Rd +++ b/man/create_template.Rd @@ -19,12 +19,13 @@ create_template( tables_dir = getwd(), figures_dir = getwd(), spp_image = NULL, - bib_file = NULL, + bib_file = TRUE, new_template = TRUE, custom_sections = NULL, new_section = NULL, section_location = NULL, custom_params = NULL, + rerender_skeleton = lifecycle::deprecated(), ... ) } @@ -113,15 +114,12 @@ If empty, searches \code{asar} resources for a matching species name. Default: NULL} -\item{bib_file}{File path to an existing additional bibliography file (\code{.bib}) used for citing references in -the report. By default, all bibliography files are sourced from the \pkg{journals} package and -references for all NMFS stock assessment reports are provided. To see a full -list of journals included in these files, please visit the -\href{https://github.com/nmfs-ost/journals/blob/main/README.md}{{journals} README} -or see the description at the top of each bib file. It is -recommended to open these files in a text editor rather than R. +\item{bib_file}{A character string of the path to a custom \code{.bib} file, or a logical. +If a path is provided, the custom file is used and journal templates are skipped. +If \code{TRUE}, default journal \code{.bib} templates are downloaded. +If \code{FALSE} or \code{NULL} (default), a minimal \code{.bib} file containing only the \code{asar} package citation is created. -Default: NULL} +Default: TRUE} \item{new_template}{TRUE/FALSE; Create a new template? If true, will pull the last saved stock assessment report skeleton. @@ -165,6 +163,10 @@ function, above). Default: NULL} +\item{rerender_skeleton}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} This argument was +deprecated in favor of a separate function \code{rerender_skeleton()} in order to +provide more clarity and separation of functionality.} + \item{...}{Additional arguments passed into functions used in create_template such as \code{create_citation()} or \code{create_yaml()}.} } diff --git a/man/create_yaml.Rd b/man/create_yaml.Rd index d0da96d9..152462b4 100644 --- a/man/create_yaml.Rd +++ b/man/create_yaml.Rd @@ -75,6 +75,12 @@ file when using base R function \code{cat()}.} Default: \verb{[TITLE]}. If species and region are provided, a title will be generated based on the report type, species, and region.} +\item{rerender_skeleton}{TRUE/FALSE; Update the skeleton YAML and structure +(R parameters, preamble, and skeleton sectioning) if relevant or indicated. +All files in your folder, such as the \code{.qmd} child docs, will remain as is. + +Default: FALSE} + \item{prev_skeleton}{Vector of strings containing all the lines of the previous skeleton file. File is read in using the function readLines from base R.} diff --git a/man/rerender_skeleton.Rd b/man/rerender_skeleton.Rd index 44dd5647..5da8b263 100644 --- a/man/rerender_skeleton.Rd +++ b/man/rerender_skeleton.Rd @@ -25,7 +25,8 @@ rerender_skeleton( ) } \arguments{ -\item{file_dir}{Required. Directory where the skeleton file is located. Can include or leave out the report folder in the path.} +\item{file_dir}{Required. Directory where the skeleton file is located. Can +include or leave out the report folder in the path.} \item{species}{Common name of target species. Split multi-word names with space and capitalize first letter(s). Example: "Dover sole". @@ -101,13 +102,9 @@ skeleton .qmd file that will be created within the 'report' folder. Default: NULL} -\item{bib_file}{File path to an existing additional bibliography file (\code{.bib}) used for citing references in -the report. By default, all bibliography files are sourced from the \pkg{journals} package and -references for all NMFS stock assessment reports are provided. To see a full -list of journals included in these files, please visit the -\href{https://github.com/nmfs-ost/journals/blob/main/README.md}{{journals} README} -or see the description at the top of each bib file. It is -recommended to open these files in a text editor rather than R. +\item{bib_file}{A character string of the path to a custom \code{.bib} file, or a logical. +If a path is provided, the custom file is added to the skeleton and copied +into the bibliography files folder. Default: NULL} From 6a373db77e4e208681498a0f62867c054ece5517 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Fri, 25 Sep 2026 15:01:41 -0400 Subject: [PATCH 21/28] set bib_file to NULL when rerender_skeleton --- R/create_template.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/create_template.R b/R/create_template.R index 9ea7794c..0dfe9238 100644 --- a/R/create_template.R +++ b/R/create_template.R @@ -265,6 +265,8 @@ create_template <- function( what = "create_template(rerender_skeleton)", details = "Please use `rerender_skeleton()` instead" ) + # Set bib_file to be compatible with rerender_skeleton + if (!is.character(bib_file)) bib_file <- NULL # 2. Maintain backwards compatibility by executing the new logic behind the scenes return(rerender_skeleton( From ae398d760f7bba4c2d8f124c97384db5a9d0071b Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Mon, 28 Sep 2026 15:59:40 -0400 Subject: [PATCH 22/28] remove old comments --- R/create_template.R | 3 --- R/rerender_skeleton.R | 1 - 2 files changed, 4 deletions(-) diff --git a/R/create_template.R b/R/create_template.R index 0dfe9238..e08604a7 100644 --- a/R/create_template.R +++ b/R/create_template.R @@ -497,9 +497,6 @@ create_template <- function( bib_name <- basename(base_bib_file) } - - #### Read in previous skeleton if rerender ---- - # Check if this is a rerender of the skeleton file #### Copy template files to report folder ---- # Check if there are already files in the folder diff --git a/R/rerender_skeleton.R b/R/rerender_skeleton.R index 7d4f2021..63704e46 100644 --- a/R/rerender_skeleton.R +++ b/R/rerender_skeleton.R @@ -51,7 +51,6 @@ rerender_skeleton <- function( bibdir <- file.path(file_dir, "bibliography_files") #### Read in previous skeleton ---- - # TODO: set up situation where species, region can be changed report_name <- list.files(file_dir, pattern = "skeleton.qmd") # gsub(".qmd", "", list.files(file_dir, pattern = "skeleton.qmd")) if (length(report_name) == 0) cli::cli_abort("No skeleton quarto file found in the `file_dir` ({file_dir}).") if (length(report_name) > 1) cli::cli_abort("Multiple skeleton quarto files found in the `file_dir` ({file_dir}).") From accc6fe781bbecd22c63ceeb3bed835dadfea305 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Wed, 30 Sep 2026 16:28:49 -0400 Subject: [PATCH 23/28] add prev species and update placement of copying species image when rerender --- R/rerender_skeleton.R | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/R/rerender_skeleton.R b/R/rerender_skeleton.R index 63704e46..b0ee4317 100644 --- a/R/rerender_skeleton.R +++ b/R/rerender_skeleton.R @@ -79,6 +79,11 @@ rerender_skeleton <- function( prev_report_name ) # Extract species unless species is renamed + prev_species <- gsub( + "_", + " ", + gsub(glue::glue("{region_name}_"), "", report_name_1) + ) species <- ifelse( species != "species", species, @@ -114,6 +119,7 @@ rerender_skeleton <- function( # Add in species image if updated in rerender if (!is.null(spp_image)) { + # system_spp_image <- system.file("resources", "spp_img", paste(gsub(" ", "_", species), ".png", sep = ""), package = "asar") file.copy(spp_image, supdir, overwrite = FALSE) |> suppressWarnings() # Change path to spp image since finished copying for yaml if (file.exists(spp_image)) { @@ -121,7 +127,7 @@ rerender_skeleton <- function( } } else if (is.null(spp_image) && species != "species") { spp_image <- system.file("resources", "spp_img", paste(gsub(" ", "_", species), ".png", sep = ""), package = "asar") - # file.copy(spp_image, supdir, overwrite = FALSE) |> suppressWarnings() + file.copy(spp_image, supdir, overwrite = FALSE) |> suppressWarnings() # spp image name for yaml spp_image <- glue::glue("support_files/{basename(spp_image)}") } @@ -193,6 +199,10 @@ rerender_skeleton <- function( # replace year title <- stringr::str_replace(old_title, "[0-9]+", as.character(year)) } + # Replace species name in title if not changed + if (grepl(tolower(prev_species), tolower(title))) { + title <- stringr::str_replace(title, stringr::str_to_title(prev_species), species) + } #### Initialize bib name ---- # Don't need to extract previous bib names bc create_yaml with rerender modifies the lines rather than build the whole thing @@ -515,4 +525,4 @@ rerender_skeleton <- function( } # Print message cli::cli_alert_success("Updated report skeleton in directory {file_dir}.") -} \ No newline at end of file +} From f3ba57f173a444dd35389a0970089ad610f1865d Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Thu, 1 Oct 2026 09:36:13 -0400 Subject: [PATCH 24/28] fix issue with species not changing in title and species image missing --- R/rerender_skeleton.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/rerender_skeleton.R b/R/rerender_skeleton.R index b0ee4317..d7562375 100644 --- a/R/rerender_skeleton.R +++ b/R/rerender_skeleton.R @@ -201,7 +201,7 @@ rerender_skeleton <- function( } # Replace species name in title if not changed if (grepl(tolower(prev_species), tolower(title))) { - title <- stringr::str_replace(title, stringr::str_to_title(prev_species), species) + title <- stringr::str_replace(title, stringr::regex(prev_species, ignore_case = TRUE), species) } #### Initialize bib name ---- From 89de95f863335420c6a9c8298780f0289e6a737d Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Fri, 2 Oct 2026 10:50:22 -0400 Subject: [PATCH 25/28] add quotation around title --- R/rerender_skeleton.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/rerender_skeleton.R b/R/rerender_skeleton.R index d7562375..cfac3f78 100644 --- a/R/rerender_skeleton.R +++ b/R/rerender_skeleton.R @@ -201,7 +201,7 @@ rerender_skeleton <- function( } # Replace species name in title if not changed if (grepl(tolower(prev_species), tolower(title))) { - title <- stringr::str_replace(title, stringr::regex(prev_species, ignore_case = TRUE), species) + title <- glue::glue("'{stringr::str_replace(title, stringr::str_regex(prev_species, ignore_case = TRUE), species)}'") } #### Initialize bib name ---- From 907e2a3c5fb6ca0b1b49c0c986fb78cbeb8bf2a0 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Fri, 2 Oct 2026 10:50:52 -0400 Subject: [PATCH 26/28] remove space after cover in search to prevent error --- R/create_yaml.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/create_yaml.R b/R/create_yaml.R index 86dc4e2c..15cc4954 100644 --- a/R/create_yaml.R +++ b/R/create_yaml.R @@ -128,7 +128,7 @@ create_yaml <- function( # add in spp image/replace if specific if (!is.null(spp_image)) { - yaml <- stringr::str_replace(yaml, yaml[grep("cover: ", yaml)], paste("cover: ", spp_image, sep = "")) + yaml <- stringr::str_replace(yaml, yaml[grep("cover:", yaml)], paste("cover: ", spp_image, sep = "")) } # Replace output-file name From 81bfcc42eff64e2f50328ea7962dd6392e60a74b Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Fri, 2 Oct 2026 11:09:04 -0400 Subject: [PATCH 27/28] adjust how fxns find spp_image from system package --- R/create_template.R | 4 ++-- R/rerender_skeleton.R | 6 +++--- R/utils.R | 7 +++++++ 3 files changed, 12 insertions(+), 5 deletions(-) diff --git a/R/create_template.R b/R/create_template.R index e08604a7..f8c61c37 100644 --- a/R/create_template.R +++ b/R/create_template.R @@ -453,7 +453,7 @@ create_template <- function( if (is.null(spp_image) && species == "species") { spp_image <- "" } else if (is.null(spp_image) && species != "species") { - spp_image <- system.file("resources", "spp_img", paste(gsub(" ", "_", species), ".png", sep = ""), package = "asar") + spp_image <- find_system_spp_image(species) } # Add bib file @@ -690,7 +690,7 @@ create_template <- function( title = title, rerender_skeleton = FALSE, office = office, - spp_image = spp_image, + spp_image = paste0("support_files/", basename(spp_image)), species = species, spp_latin = spp_latin, region = region, diff --git a/R/rerender_skeleton.R b/R/rerender_skeleton.R index cfac3f78..e37d3ac7 100644 --- a/R/rerender_skeleton.R +++ b/R/rerender_skeleton.R @@ -126,10 +126,10 @@ rerender_skeleton <- function( spp_image <- file.path("support_files", stringr::str_extract(spp_image, "(?<=/)[^/]+$")) } } else if (is.null(spp_image) && species != "species") { - spp_image <- system.file("resources", "spp_img", paste(gsub(" ", "_", species), ".png", sep = ""), package = "asar") + spp_image <- find_system_spp_image(species) file.copy(spp_image, supdir, overwrite = FALSE) |> suppressWarnings() # spp image name for yaml - spp_image <- glue::glue("support_files/{basename(spp_image)}") + # spp_image <- glue::glue("support_files/{basename(spp_image)}") } # if it is previously html and the rerender species html then need to copy over html formatting if (tolower(prev_format) != "html" & tolower(format) == "html") { @@ -239,7 +239,7 @@ rerender_skeleton <- function( title = title, rerender_skeleton = TRUE, office = office, - spp_image = spp_image, + spp_image = paste0("support_files/", basename(spp_image)), species = species, spp_latin = spp_latin, region = region, diff --git a/R/utils.R b/R/utils.R index c0877926..7e86cc43 100644 --- a/R/utils.R +++ b/R/utils.R @@ -596,4 +596,11 @@ custom_true <- function( ) } # close if statement for very specific sectioning } # close if statement for extra custom +} + +#-------------------------------------------------------------- + +find_system_spp_image <- function(species) { + all_spp_images <- list.files(system.file("resources", "spp_img", package = "asar"), full.names = TRUE) + grep(species, all_spp_images, value = TRUE, ignore.case = TRUE) } \ No newline at end of file From 37e01b58586a4a0e4fd2b2a73c06b50d27bccaa2 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Fri, 2 Oct 2026 13:36:59 -0400 Subject: [PATCH 28/28] fix issue with multiple spp images being found --- R/rerender_skeleton.R | 12 +++++++++--- R/utils.R | 3 ++- tests/testthat/test-rerender_skeleton.R | 3 ++- 3 files changed, 13 insertions(+), 5 deletions(-) diff --git a/R/rerender_skeleton.R b/R/rerender_skeleton.R index e37d3ac7..371188b4 100644 --- a/R/rerender_skeleton.R +++ b/R/rerender_skeleton.R @@ -123,10 +123,14 @@ rerender_skeleton <- function( file.copy(spp_image, supdir, overwrite = FALSE) |> suppressWarnings() # Change path to spp image since finished copying for yaml if (file.exists(spp_image)) { - spp_image <- file.path("support_files", stringr::str_extract(spp_image, "(?<=/)[^/]+$")) + # spp_image <- file.path("support_files", stringr::str_extract(spp_image, "(?<=/)[^/]+$")) } } else if (is.null(spp_image) && species != "species") { spp_image <- find_system_spp_image(species) + if (length(spp_image) > 1) { + spp_image <- spp_image[1] + cli::cli_alert_warning("> 1 species image found for template") + } file.copy(spp_image, supdir, overwrite = FALSE) |> suppressWarnings() # spp image name for yaml # spp_image <- glue::glue("support_files/{basename(spp_image)}") @@ -201,7 +205,7 @@ rerender_skeleton <- function( } # Replace species name in title if not changed if (grepl(tolower(prev_species), tolower(title))) { - title <- glue::glue("'{stringr::str_replace(title, stringr::str_regex(prev_species, ignore_case = TRUE), species)}'") + title <- glue::glue("'{stringr::str_replace(title, stringr::regex(prev_species, ignore_case = TRUE), species)}'") } #### Initialize bib name ---- @@ -231,6 +235,8 @@ rerender_skeleton <- function( param_values <- custom_params |> unname() #### yaml ---- + # set spp_image to relative path atp + if (!is.null(spp_image)) spp_image <- glue::glue("support_files/{basename(spp_image)}") yaml <- create_yaml( prev_format = prev_format, format = format, @@ -239,7 +245,7 @@ rerender_skeleton <- function( title = title, rerender_skeleton = TRUE, office = office, - spp_image = paste0("support_files/", basename(spp_image)), + spp_image = spp_image, species = species, spp_latin = spp_latin, region = region, diff --git a/R/utils.R b/R/utils.R index 7e86cc43..a222ab71 100644 --- a/R/utils.R +++ b/R/utils.R @@ -602,5 +602,6 @@ custom_true <- function( find_system_spp_image <- function(species) { all_spp_images <- list.files(system.file("resources", "spp_img", package = "asar"), full.names = TRUE) - grep(species, all_spp_images, value = TRUE, ignore.case = TRUE) + spp_pattern <- glue::glue("\\b{stringr::str_replace_all(species, ' ', '_')}") + grep(spp_pattern, all_spp_images, value = TRUE, ignore.case = TRUE) } \ No newline at end of file diff --git a/tests/testthat/test-rerender_skeleton.R b/tests/testthat/test-rerender_skeleton.R index fb6b99da..98cc7cf7 100644 --- a/tests/testthat/test-rerender_skeleton.R +++ b/tests/testthat/test-rerender_skeleton.R @@ -213,4 +213,5 @@ test_that("year is changed throughout document", { # tests expect_all_equal(c(title, citation, output_file, in_header), "2027") -}) \ No newline at end of file + unlink(report_dir, recursive = TRUE) +})