From eb554d8a956ebc248d025b2d4ea9b4b29a95d5cf Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Tue, 18 Aug 2026 15:42:02 -0400 Subject: [PATCH 01/19] initial commit of new function --- R/update_report.R | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) create mode 100644 R/update_report.R diff --git a/R/update_report.R b/R/update_report.R new file mode 100644 index 000000000..a5c816504 --- /dev/null +++ b/R/update_report.R @@ -0,0 +1,30 @@ +update_report <- function( + dir = "report", + new_dir = getwd() +) { + # Identify location of previous folder and copy over to new directory + # Don't copy old figures and tables + # Run create_template(rerender_skeleton = TRUE) with new arguments + # Take out rerender from own function? + + # Create "report" folder in new dir + dir.create(file.path(new_dir, "report")) + + previous_report_files <- list.files(dir, recursive = TRUE) + from_path <- file.path(dir, previous_report_files) + to_path <- file.path(new_dir, previous_report_files) + # copy files to new folder + # currently not working - showing warning: + # Warning message: + # In FUN(X[[i]], ...) : + # 'C:\Users\samantha.schiano.NMFS\Documents\test_folder' already exists + vapply( + unique(dirname(to_path)), + dir.create, + logical(1), + recursive = TRUE, + showWarnings = TRUE + ) + + file.copy(from_path,to_path, overwrite = FALSE) +} From a23e2e70e22fc950d45966baec3a62fe7de3437a Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Tue, 18 Aug 2026 15:54:15 -0400 Subject: [PATCH 02/19] add other code from call-prev-report branch -- need to consolidate and merge --- R/update_report.R | 124 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 124 insertions(+) diff --git a/R/update_report.R b/R/update_report.R index a5c816504..e9a96f5ba 100644 --- a/R/update_report.R +++ b/R/update_report.R @@ -28,3 +28,127 @@ update_report <- function( file.copy(from_path,to_path, overwrite = FALSE) } + +call_report <- function( + file_dir = getwd(), + previous_file_dir, + author = NULL, + model_results = NULL, + year = format(as.POSIXct(Sys.Date(), format = "%YYYY-%mm-%dd"), "%Y"), + format = "pdf", + region = NULL, # just in case this changes + new_section = NULL, + section_location = NULL +) { + #### set up ---- + # Add "report" to previous report file path - user does not have to include this + previous_file_dir <- glue::glue("{previous_file_dir}/report") + + # Identify report type + type <- stringr::str_extract( + list.files(previous_file_dir, pattern = "skeleton\\.qmd"), + # find characters before the first _ + "(?<=^)[^_]+" + ) + if (type == "SAR") type <- "skeleton" + + # Check if the previous report directory exists + if (!dir.exists(previous_file_dir)) { + stop("The previous report directory does not exist.") + } + + # Create the report directory if it doesn't exist + report_dir <- file.path(file_dir, "report") + if (!dir.exists(report_dir)) { + dir.create(report_dir) + } + + #### copy files ---- + # Copy previous assessment files over + prev_files <-list.files( + previous_file_dir, + # qmd, bib files, glossary, and preamble + pattern = "\\.qmd$|\\.bib$|report_glossary\\.tex$|preamble\\.R$" + ) + file.copy(glue::glue("{previous_file_dir}/{prev_files}"), report_dir) + # Copy support files + prev_support_files <- list.files(file.path(previous_file_dir, 'support_files'), full.names = TRUE) + # create supporting files folder + supdir <- file.path(report_dir, 'support_files') + if (!dir.exists(supdir)) { + dir.create(supdir) + } + file.copy( + prev_support_files, + supdir, + recursive = TRUE + ) + # warning which files are not in the standard framework + std_files <- list.files(file.path(system.file("templates", package = "asar"), type)) + # select "section" qmd from prev_files and remove skeleton, figures, and tables docs + prev_file_outline <- prev_files[grepl("\\.qmd$", prev_files)] + prev_file_outline <- prev_file_outline[!grepl("skeleton|figures|tables", prev_file_outline)] + non_std_files <- setdiff(prev_file_outline, std_files) + if (length(non_std_files) > 0) cli::cli_alert_info("Non-standard section files exist.") + + #### reset tables and figures docs ---- + + if (any(grepl("figures\\.qmd$", prev_files))) { + reset_figures <- readline("Figures document already exists. Do you want to reset it? [y/n]") + if (!interactive()) { + reset_figures <- "y" + } + if (regexpr(reset_figures, "y", ignore.case = TRUE) == 1) { + figures_doc_name <- prev_files[grepl("figures\\.qmd$", prev_files)] + figures_doc <- paste0( + "# Figures \n \n", + "Please refer to the `stockplotr` package downloaded from remotes::install_github('nmfs-ost/stockplotr') to add premade figures." + ) + utils::capture.output(cat(figures_doc), file = fs::path(file_dir, figures_doc_name), append = FALSE) + # TODO: Uncomment below and replace with above code once function is adjusted for defaults + # create_figures_doc( + # subdir = report_dir + # ) + cli::cli_alert_info("Figures document reset to default.") + } else if (regexpr(reset_figures, "n", ignore.case = TRUE) == 1) { + cli::cli_alert_info("Previous assessment figures qmd retained.") + } + } + + if (any(grepl("tables\\.qmd$", prev_files))) { + reset_tables <- readline("Tables document already exists. Do you want to reset it? [y/n]") + if (!interactive()) { + reset_tables <- "y" + } + if (regexpr(reset_figures, "y", ignore.case = TRUE) == 1) { + tables_doc_name <- prev_files[grepl("tables\\.qmd$", prev_files)] + tables_doc <- paste0( + "# Figures \n \n", + "Please refer to the `stockplotr` package downloaded from remotes::install_github('nmfs-ost/stockplotr') to add premade figures." + ) + utils::capture.output(cat(tables_doc), file = fs::path(file_dir, tables_doc_name), append = FALSE) + # TODO: Uncomment below and replace with above code once function is adjusted for defaults + # create_tables_doc( + # subdir = report_dir + # ) + cli::cli_alert_info("Tables document reset to default.") + } else if (regexpr(reset_figures, "n", ignore.case = TRUE) == 1) { + cli::cli_alert_info("Previous assessment tables qmd retained.") + } + } + + #### update skeleton ---- + # part of skeleton: + # yaml + # disclaimer + # citation + # preamble + # section chunks + skeleton_file <- list.files(report_dir, pattern = "skeleton\\.qmd", full.names = TRUE) + + if (length(skeleton_file) == 0) { + cli::cli_abort("No skeleton.qmd file found in the previous report directory.") + } + skeleton <- readLines(skeleton_file) + +} From de6f74760cca158df07c28b3cb4eb1e7b75bd85e Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Tue, 18 Aug 2026 15:55:22 -0400 Subject: [PATCH 03/19] initial commit of update_skeleton --- R/update_skeleton.R | 227 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 227 insertions(+) create mode 100644 R/update_skeleton.R diff --git a/R/update_skeleton.R b/R/update_skeleton.R new file mode 100644 index 000000000..58cda9ca9 --- /dev/null +++ b/R/update_skeleton.R @@ -0,0 +1,227 @@ +# code that is pulled from create_template(rerender_skeleton) +# was located in another branch 'call-prev-report' + +update_skeleton <- function( + file_dir +) { + # Add in report to file_dir + file_dir <- file.path(file_dir, "report") + #### Call in old 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 + region <- stringr::str_extract(prev_report_name, "(?<=_)[A-Z]+(?=_)") + # report name without type and region + report_name_1 <- gsub(glue::glue("{type}_"), "", prev_report_name) + # Extract species + species <- gsub( + "_", + " ", + gsub(glue::glue("{region}_"), "", report_name_1) + ) + new_report_name <- paste0( + type, "_", + ifelse(is.null(region), "", paste(gsub("(\\b[A-Z])[^A-Z]+", "\\1", region), "_", sep = "")), + ifelse(is.null(species), "species", stringr::str_replace_all(species, " ", "_")), "_", + "skeleton.qmd" + ) + + #### Read in previous 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 <- 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() + } + # 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() + } + + #### Adjust the 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 + ) + + #### 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 ---- + start_line <- grep("output_and_quantities", 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 = F)$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") + } + + #### 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 + 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)) + ) + } + + #### 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 2a02e3bc7e8df9ef37a0afe505f3c87b020ba643 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Fri, 21 Aug 2026 11:45:28 -0400 Subject: [PATCH 04/19] make changes to call prev report function and add documentation --- NAMESPACE | 1 + R/update_report.R | 86 +++++++++++++++++--------------------------- man/update_report.Rd | 86 ++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 119 insertions(+), 54 deletions(-) create mode 100644 man/update_report.Rd diff --git a/NAMESPACE b/NAMESPACE index 983ccd34a..8ab30f5a0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -22,3 +22,4 @@ export(export_split_tbls) export(format_quarto) export(gt_split) export(render_lg_table) +export(update_report) diff --git a/R/update_report.R b/R/update_report.R index e9a96f5ba..a3a6cd35e 100644 --- a/R/update_report.R +++ b/R/update_report.R @@ -1,38 +1,20 @@ +#' Call previous assessment report and update +#' +#' @inheritParams create_template +#' @param file_dir String of the path where the new report folder and files +#' should be located. +#' @param previous_file_dir String of the path where the previous report files +#' are located. +#' +#' @returns Creates a new folder of pre-filled assessment report files for the +#' next assessment cycle. +#' @export +#' +#' @examples update_report <- function( - dir = "report", - new_dir = getwd() -) { - # Identify location of previous folder and copy over to new directory - # Don't copy old figures and tables - # Run create_template(rerender_skeleton = TRUE) with new arguments - # Take out rerender from own function? - - # Create "report" folder in new dir - dir.create(file.path(new_dir, "report")) - - previous_report_files <- list.files(dir, recursive = TRUE) - from_path <- file.path(dir, previous_report_files) - to_path <- file.path(new_dir, previous_report_files) - # copy files to new folder - # currently not working - showing warning: - # Warning message: - # In FUN(X[[i]], ...) : - # 'C:\Users\samantha.schiano.NMFS\Documents\test_folder' already exists - vapply( - unique(dirname(to_path)), - dir.create, - logical(1), - recursive = TRUE, - showWarnings = TRUE - ) - - file.copy(from_path,to_path, overwrite = FALSE) -} - -call_report <- function( file_dir = getwd(), - previous_file_dir, - author = NULL, + previous_file_dir, # required + authors = NULL, model_results = NULL, year = format(as.POSIXct(Sys.Date(), format = "%YYYY-%mm-%dd"), "%Y"), format = "pdf", @@ -53,7 +35,7 @@ call_report <- function( if (type == "SAR") type <- "skeleton" # Check if the previous report directory exists - if (!dir.exists(previous_file_dir)) { + if (!dir.exists(file.path(previous_file_dir, "report"))) { stop("The previous report directory does not exist.") } @@ -99,16 +81,14 @@ call_report <- function( reset_figures <- "y" } if (regexpr(reset_figures, "y", ignore.case = TRUE) == 1) { - figures_doc_name <- prev_files[grepl("figures\\.qmd$", prev_files)] - figures_doc <- paste0( - "# Figures \n \n", - "Please refer to the `stockplotr` package downloaded from remotes::install_github('nmfs-ost/stockplotr') to add premade figures." + # Remove previous file + file.remove( + stringr::str_match(prev_files, "figures") + ) + # Create figures doc + create_figures_doc( + subdir = report_dir ) - utils::capture.output(cat(figures_doc), file = fs::path(file_dir, figures_doc_name), append = FALSE) - # TODO: Uncomment below and replace with above code once function is adjusted for defaults - # create_figures_doc( - # subdir = report_dir - # ) cli::cli_alert_info("Figures document reset to default.") } else if (regexpr(reset_figures, "n", ignore.case = TRUE) == 1) { cli::cli_alert_info("Previous assessment figures qmd retained.") @@ -120,19 +100,17 @@ call_report <- function( if (!interactive()) { reset_tables <- "y" } - if (regexpr(reset_figures, "y", ignore.case = TRUE) == 1) { - tables_doc_name <- prev_files[grepl("tables\\.qmd$", prev_files)] - tables_doc <- paste0( - "# Figures \n \n", - "Please refer to the `stockplotr` package downloaded from remotes::install_github('nmfs-ost/stockplotr') to add premade figures." + if (regexpr(reset_tables, "y", ignore.case = TRUE) == 1) { + # Remove previous file + file.remove( + stringr::str_match(prev_files, "tables") + ) + # Create tables doc + create_tables_doc( + subdir = report_dir ) - utils::capture.output(cat(tables_doc), file = fs::path(file_dir, tables_doc_name), append = FALSE) - # TODO: Uncomment below and replace with above code once function is adjusted for defaults - # create_tables_doc( - # subdir = report_dir - # ) cli::cli_alert_info("Tables document reset to default.") - } else if (regexpr(reset_figures, "n", ignore.case = TRUE) == 1) { + } else if (regexpr(reset_tables, "n", ignore.case = TRUE) == 1) { cli::cli_alert_info("Previous assessment tables qmd retained.") } } diff --git a/man/update_report.Rd b/man/update_report.Rd new file mode 100644 index 000000000..fe98606dd --- /dev/null +++ b/man/update_report.Rd @@ -0,0 +1,86 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/update_report.R +\name{update_report} +\alias{update_report} +\title{Call previous assessment report and update} +\usage{ +update_report( + file_dir = getwd(), + previous_file_dir, + authors = NULL, + model_results = NULL, + year = format(as.POSIXct(Sys.Date(), format = "\%YYYY-\%mm-\%dd"), "\%Y"), + format = "pdf", + region = NULL, + new_section = NULL, + section_location = NULL +) +} +\arguments{ +\item{file_dir}{String of the path where the new report folder and files +should be located.} + +\item{previous_file_dir}{String of the path where the previous report files +are located.} + +\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}.} + +\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{year}{Year the assessment is conducted. + +Default: the year in which the report is rendered.} + +\item{format}{Report rendering format. Note: "docx" is currently unsupported +and will default to "pdf". + +Default: "pdf" + +Options: "pdf", "html"} + +\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{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} +} +\value{ +Creates a new folder of pre-filled assessment report files for the +next assessment cycle. +} +\description{ +Call previous assessment report and update +} From e53ac259dd1456eb7956b330e8253ad9d96d4270 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Fri, 21 Aug 2026 12:04:38 -0400 Subject: [PATCH 05/19] add component to update_report that actually updates based on new args --- R/update_report.R | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/R/update_report.R b/R/update_report.R index a3a6cd35e..284510268 100644 --- a/R/update_report.R +++ b/R/update_report.R @@ -122,11 +122,20 @@ update_report <- function( # citation # preamble # section chunks - skeleton_file <- list.files(report_dir, pattern = "skeleton\\.qmd", full.names = TRUE) + # Run create_template but with rerender_skeleton = TRUE + # TODO: change once rerender is outside of create_template + # TODO: reset author section in skeleton -- remove all previous authorship (does this work?) - if (length(skeleton_file) == 0) { - cli::cli_abort("No skeleton.qmd file found in the previous report directory.") - } - skeleton <- readLines(skeleton_file) + create_template( + rerender_skeleton = TRUE, + dir = file_dir, + authors = authors, + model_results = model_results, + year = year, + format = format, + region = region, + new_section = new_section, + section_location = section_location + ) } From 8b3f0f8f26f18a39ca9b979e973b9af947fb5877 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Fri, 11 Sep 2026 15:07:02 -0400 Subject: [PATCH 06/19] add checks and move location where skeleton gets updated --- R/update_report.R | 96 ++++++++++++++++++++++++++++------------------- 1 file changed, 57 insertions(+), 39 deletions(-) diff --git a/R/update_report.R b/R/update_report.R index 284510268..bc4389018 100644 --- a/R/update_report.R +++ b/R/update_report.R @@ -24,7 +24,16 @@ update_report <- function( ) { #### set up ---- # Add "report" to previous report file path - user does not have to include this - previous_file_dir <- glue::glue("{previous_file_dir}/report") + if (!grepl("report",previous_file_dir)) { + previous_file_dir <- glue::glue("{previous_file_dir}/report") + if (!dir.exists(previous_file_dir)) { + stop("The previous report directory does not exist.") + } + } + # check for skeleton file in previous folder + if (!any(grepl("skeleton.qmd", list.files(previous_file_dir, full.names = FALSE)))) { + cli::cli_abort("No skeleton file found. Please use `create_template` to generate a new template") + } # Identify report type type <- stringr::str_extract( @@ -32,12 +41,7 @@ update_report <- function( # find characters before the first _ "(?<=^)[^_]+" ) - if (type == "SAR") type <- "skeleton" - - # Check if the previous report directory exists - if (!dir.exists(file.path(previous_file_dir, "report"))) { - stop("The previous report directory does not exist.") - } + if (tolower(type) == "sar") type <- "skeleton" # Create the report directory if it doesn't exist report_dir <- file.path(file_dir, "report") @@ -47,10 +51,10 @@ update_report <- function( #### copy files ---- # Copy previous assessment files over - prev_files <-list.files( + prev_files <- list.files( previous_file_dir, # qmd, bib files, glossary, and preamble - pattern = "\\.qmd$|\\.bib$|report_glossary\\.tex$|preamble\\.R$" + pattern = "\\.qmd$|report_glossary\\.tex$|preamble\\.R$|.sty$" ) file.copy(glue::glue("{previous_file_dir}/{prev_files}"), report_dir) # Copy support files @@ -65,13 +69,51 @@ update_report <- function( supdir, recursive = TRUE ) + # Copy bib folder + prev_bib_files <- list.files(file.path(previous_file_dir, 'bibliography_files'), full.names = TRUE) + # create new folder and copy into + bibdir <- file.path(report_dir, "bibliography_files") + if (!dir.exists(bibdir)) { + dir.create(bibdir) + } + file.copy( + prev_bib_files, + bibdir, + recursive = TRUE + ) + # warning which files are not in the standard framework - std_files <- list.files(file.path(system.file("templates", package = "asar"), type)) - # select "section" qmd from prev_files and remove skeleton, figures, and tables docs - prev_file_outline <- prev_files[grepl("\\.qmd$", prev_files)] - prev_file_outline <- prev_file_outline[!grepl("skeleton|figures|tables", prev_file_outline)] - non_std_files <- setdiff(prev_file_outline, std_files) - if (length(non_std_files) > 0) cli::cli_alert_info("Non-standard section files exist.") + if (type == "skeleton") { + std_files <- list.files(file.path(system.file("templates", package = "asar"), type)) + # select "section" qmd from prev_files and remove skeleton, figures, and tables docs + prev_file_outline <- prev_files[grepl("\\.qmd$", prev_files)] + prev_file_outline <- prev_file_outline[!grepl("skeleton|figures|tables", prev_file_outline)] + non_std_files <- setdiff(prev_file_outline, std_files) + if (length(non_std_files) > 0) cli::cli_alert_info("Non-standard section files exist.") + } + + #### Update skeleton ---- + # part of skeleton: + # yaml + # disclaimer + # citation + # preamble + # section chunks + # Run create_template but with rerender_skeleton = TRUE + # TODO: change once rerender is outside of create_template + # TODO: reset author section in skeleton -- remove all previous authorship (does this work?) + # Update skeleton with new year, authors, model results, region, if added + create_template( + rerender_skeleton = TRUE, + dir = file_dir, + authors = authors, + model_results = model_results, + year = year, + format = format, + region = region, + new_section = new_section, + section_location = section_location + ) #### reset tables and figures docs ---- @@ -114,28 +156,4 @@ update_report <- function( cli::cli_alert_info("Previous assessment tables qmd retained.") } } - - #### update skeleton ---- - # part of skeleton: - # yaml - # disclaimer - # citation - # preamble - # section chunks - # Run create_template but with rerender_skeleton = TRUE - # TODO: change once rerender is outside of create_template - # TODO: reset author section in skeleton -- remove all previous authorship (does this work?) - - create_template( - rerender_skeleton = TRUE, - dir = file_dir, - authors = authors, - model_results = model_results, - year = year, - format = format, - region = region, - new_section = new_section, - section_location = section_location - ) - } From e4aac22956ce72ad13d20f0c1b82ed49695bcc0e Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Fri, 11 Sep 2026 15:48:21 -0400 Subject: [PATCH 07/19] add figures and tables dir args, update removal of figs and tabs doc if desired --- R/update_report.R | 24 ++++++++++++++++++------ 1 file changed, 18 insertions(+), 6 deletions(-) diff --git a/R/update_report.R b/R/update_report.R index bc4389018..94479106f 100644 --- a/R/update_report.R +++ b/R/update_report.R @@ -1,6 +1,8 @@ #' Call previous assessment report and update #' #' @inheritParams create_template +#' @inheritParams create_figures_dir +#' @inheritParams create_tables_dir #' @param file_dir String of the path where the new report folder and files #' should be located. #' @param previous_file_dir String of the path where the previous report files @@ -20,7 +22,9 @@ update_report <- function( format = "pdf", region = NULL, # just in case this changes new_section = NULL, - section_location = NULL + section_location = NULL, + figures_dir = getwd(), + tables_dir = getwd() ) { #### set up ---- # Add "report" to previous report file path - user does not have to include this @@ -54,7 +58,7 @@ update_report <- function( prev_files <- list.files( previous_file_dir, # qmd, bib files, glossary, and preamble - pattern = "\\.qmd$|report_glossary\\.tex$|preamble\\.R$|.sty$" + pattern = "\\.qmd$|.bib$|report_glossary\\.tex$|preamble\\.R$|.sty$" ) file.copy(glue::glue("{previous_file_dir}/{prev_files}"), report_dir) # Copy support files @@ -105,7 +109,7 @@ update_report <- function( # Update skeleton with new year, authors, model results, region, if added create_template( rerender_skeleton = TRUE, - dir = file_dir, + file_dir = report_dir, authors = authors, model_results = model_results, year = year, @@ -114,6 +118,7 @@ update_report <- function( new_section = new_section, section_location = section_location ) + # TODO: update year in title #### reset tables and figures docs ---- @@ -125,11 +130,15 @@ update_report <- function( if (regexpr(reset_figures, "y", ignore.case = TRUE) == 1) { # Remove previous file file.remove( - stringr::str_match(prev_files, "figures") + file.path( + report_dir, + prev_files[grep("figures.qmd", prev_files)] + ) ) # Create figures doc create_figures_doc( - subdir = report_dir + subdir = report_dir, + figures_dir = figures_dir ) cli::cli_alert_info("Figures document reset to default.") } else if (regexpr(reset_figures, "n", ignore.case = TRUE) == 1) { @@ -145,7 +154,10 @@ update_report <- function( if (regexpr(reset_tables, "y", ignore.case = TRUE) == 1) { # Remove previous file file.remove( - stringr::str_match(prev_files, "tables") + file.path( + report_dir, + prev_files[grep("tables.qmd", prev_files)] + ) ) # Create tables doc create_tables_doc( From efe31354e4b7dffb9bb783c93a350226a82cfb38 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Fri, 11 Sep 2026 16:11:45 -0400 Subject: [PATCH 08/19] add documentation for update_report --- R/update_report.R | 8 ++++++++ man/update_report.Rd | 22 +++++++++++++++++++++- 2 files changed, 29 insertions(+), 1 deletion(-) diff --git a/R/update_report.R b/R/update_report.R index 94479106f..df8fb5ed7 100644 --- a/R/update_report.R +++ b/R/update_report.R @@ -13,6 +13,12 @@ #' @export #' #' @examples +#' \dontrun{ +#' update_report( +#' previous_file_dir = "~/testing/goa_2023/report", +#' file_dir = "~/testing/goa_2025", +#' model_results = "../new_std_res.rda" +#' } update_report <- function( file_dir = getwd(), previous_file_dir, # required @@ -112,6 +118,8 @@ update_report <- function( file_dir = report_dir, authors = authors, model_results = model_results, + species = species, + spp_latin = spp_latin, year = year, format = format, region = region, diff --git a/man/update_report.Rd b/man/update_report.Rd index fe98606dd..0693007ad 100644 --- a/man/update_report.Rd +++ b/man/update_report.Rd @@ -13,7 +13,9 @@ update_report( format = "pdf", region = NULL, new_section = NULL, - section_location = NULL + section_location = NULL, + figures_dir = getwd(), + tables_dir = getwd() ) } \arguments{ @@ -76,6 +78,16 @@ 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{figures_dir}{The location of the "figures" folder, which contains +figures files + +Default: the working directory} + +\item{tables_dir}{The location of the "tables" folder, which contains tables +files + +Default: the working directory} } \value{ Creates a new folder of pre-filled assessment report files for the @@ -84,3 +96,11 @@ next assessment cycle. \description{ Call previous assessment report and update } +\examples{ +\dontrun{ +update_report( + previous_file_dir = "~/testing/goa_2023/report", + file_dir = "~/testing/goa_2025", + model_results = "../new_std_res.rda" +} +} From 258dc77648f318bd410ae42a5b068110a5ebb32c Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Fri, 11 Sep 2026 16:29:13 -0400 Subject: [PATCH 09/19] remove update_skeleton from this branch -- moved to feat-rerender-fxn --- R/update_skeleton.R | 227 -------------------------------------------- 1 file changed, 227 deletions(-) delete mode 100644 R/update_skeleton.R diff --git a/R/update_skeleton.R b/R/update_skeleton.R deleted file mode 100644 index 58cda9ca9..000000000 --- a/R/update_skeleton.R +++ /dev/null @@ -1,227 +0,0 @@ -# code that is pulled from create_template(rerender_skeleton) -# was located in another branch 'call-prev-report' - -update_skeleton <- function( - file_dir -) { - # Add in report to file_dir - file_dir <- file.path(file_dir, "report") - #### Call in old 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 - region <- stringr::str_extract(prev_report_name, "(?<=_)[A-Z]+(?=_)") - # report name without type and region - report_name_1 <- gsub(glue::glue("{type}_"), "", prev_report_name) - # Extract species - species <- gsub( - "_", - " ", - gsub(glue::glue("{region}_"), "", report_name_1) - ) - new_report_name <- paste0( - type, "_", - ifelse(is.null(region), "", paste(gsub("(\\b[A-Z])[^A-Z]+", "\\1", region), "_", sep = "")), - ifelse(is.null(species), "species", stringr::str_replace_all(species, " ", "_")), "_", - "skeleton.qmd" - ) - - #### Read in previous 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 <- 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() - } - # 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() - } - - #### Adjust the 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 - ) - - #### 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 ---- - start_line <- grep("output_and_quantities", 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 = F)$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") - } - - #### 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 - 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)) - ) - } - - #### 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 1ece7c8c788f833087147c75b9118065fd207f83 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Mon, 14 Sep 2026 11:47:24 -0400 Subject: [PATCH 10/19] remove year extraction when rerender is TRUE so year will change in update --- R/create_template.R | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/R/create_template.R b/R/create_template.R index d940172ae..ad64435ea 100644 --- a/R/create_template.R +++ b/R/create_template.R @@ -557,17 +557,17 @@ create_template <- function( 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]+" - )) - ) + # 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() From 8adde8e75103635837c91f7c4784bb9fb64a4be8 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 11/19] fix create template so year updates when calling new report --- R/create_template.R | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/R/create_template.R b/R/create_template.R index ad64435ea..4bae213a9 100644 --- a/R/create_template.R +++ b/R/create_template.R @@ -557,17 +557,12 @@ create_template <- function( prev_skeleton[grep("format:", prev_skeleton) + 1], "[a-z]+" ) - # year <- ifelse( - # is.na(as.numeric(stringr::str_extract( + + # Update to current year + # prev_year <- 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]+" - # )) - # ) + # "[0-9]+")) + # Add in species image if updated in rerender if (!is.null(spp_image)) { file.copy(spp_image, supdir, overwrite = FALSE) |> suppressWarnings() @@ -602,8 +597,12 @@ create_template <- 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) + # 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 { #### Copy template files to report folder ---- @@ -793,15 +792,18 @@ create_template <- function( # 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)) { + 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 = ifelse(is.na(year), format(as.POSIXct(Sys.Date(), format = "%YYYY-%mm-%dd"), "%Y"), year) + year = year ) + } else { + # replace year with current year + title <- stringr::str_replace(old_title, "[0-9]+", as.character(year)) } } else { title <- create_title( From 9542924cf5af6f462ac43b92d9c496bd5a6a28ca Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Tue, 15 Sep 2026 13:37:54 -0400 Subject: [PATCH 12/19] remove notes for TODO --- R/update_report.R | 3 --- 1 file changed, 3 deletions(-) diff --git a/R/update_report.R b/R/update_report.R index df8fb5ed7..776255061 100644 --- a/R/update_report.R +++ b/R/update_report.R @@ -118,15 +118,12 @@ update_report <- function( file_dir = report_dir, authors = authors, model_results = model_results, - species = species, - spp_latin = spp_latin, year = year, format = format, region = region, new_section = new_section, section_location = section_location ) - # TODO: update year in title #### reset tables and figures docs ---- From c9f79b0ae281ba1e125c8f0d1f1e417fc2cf4e29 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Wed, 23 Sep 2026 09:14:46 -0400 Subject: [PATCH 13/19] change to rerender_skeleton fxn rather than argument --- R/update_report.R | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/R/update_report.R b/R/update_report.R index 776255061..4a8799b8d 100644 --- a/R/update_report.R +++ b/R/update_report.R @@ -109,12 +109,9 @@ update_report <- function( # citation # preamble # section chunks - # Run create_template but with rerender_skeleton = TRUE - # TODO: change once rerender is outside of create_template # TODO: reset author section in skeleton -- remove all previous authorship (does this work?) # Update skeleton with new year, authors, model results, region, if added - create_template( - rerender_skeleton = TRUE, + rerender_skeleton( file_dir = report_dir, authors = authors, model_results = model_results, From 0bd6ecbd27678f9b2c2897af00ec57e11885f85a Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Wed, 23 Sep 2026 09:51:20 -0400 Subject: [PATCH 14/19] change update_report so resetting tables and figures is an argument rather than interactive question --- R/update_report.R | 77 ++++++++++++++++++++--------------------------- 1 file changed, 32 insertions(+), 45 deletions(-) diff --git a/R/update_report.R b/R/update_report.R index 4a8799b8d..f102436ac 100644 --- a/R/update_report.R +++ b/R/update_report.R @@ -4,10 +4,13 @@ #' @inheritParams create_figures_dir #' @inheritParams create_tables_dir #' @param file_dir String of the path where the new report folder and files -#' should be located. +#' should be located. Required. #' @param previous_file_dir String of the path where the previous report files -#' are located. +#' are located. Required. +#' @param reset_tables_and_figures Logical indicating whether to reset tables +#' and figures Quarto documents. #' +#' Default: FALSE #' @returns Creates a new folder of pre-filled assessment report files for the #' next assessment cycle. #' @export @@ -30,7 +33,8 @@ update_report <- function( new_section = NULL, section_location = NULL, figures_dir = getwd(), - tables_dir = getwd() + tables_dir = getwd(), + reset_tables_and_figures = FALSE ) { #### set up ---- # Add "report" to previous report file path - user does not have to include this @@ -123,51 +127,34 @@ update_report <- function( ) #### reset tables and figures docs ---- - - if (any(grepl("figures\\.qmd$", prev_files))) { - reset_figures <- readline("Figures document already exists. Do you want to reset it? [y/n]") - if (!interactive()) { - reset_figures <- "y" - } - if (regexpr(reset_figures, "y", ignore.case = TRUE) == 1) { - # Remove previous file - file.remove( - file.path( - report_dir, - prev_files[grep("figures.qmd", prev_files)] - ) + if (reset_tables_and_figures) { + # Remove previous file + file.remove( + file.path( + report_dir, + prev_files[grep("figures.qmd", prev_files)] ) - # Create figures doc - create_figures_doc( - subdir = report_dir, - figures_dir = figures_dir - ) - cli::cli_alert_info("Figures document reset to default.") - } else if (regexpr(reset_figures, "n", ignore.case = TRUE) == 1) { - cli::cli_alert_info("Previous assessment figures qmd retained.") - } + ) + # Create figures doc + create_figures_doc( + subdir = report_dir, + figures_dir = figures_dir + ) + cli::cli_alert_info("Figures document reset to default.") } - if (any(grepl("tables\\.qmd$", prev_files))) { - reset_tables <- readline("Tables document already exists. Do you want to reset it? [y/n]") - if (!interactive()) { - reset_tables <- "y" - } - if (regexpr(reset_tables, "y", ignore.case = TRUE) == 1) { - # Remove previous file - file.remove( - file.path( - report_dir, - prev_files[grep("tables.qmd", prev_files)] - ) - ) - # Create tables doc - create_tables_doc( - subdir = report_dir + if (reset_tables_and_figures) { + # Remove previous file + file.remove( + file.path( + report_dir, + prev_files[grep("tables.qmd", prev_files)] ) - cli::cli_alert_info("Tables document reset to default.") - } else if (regexpr(reset_tables, "n", ignore.case = TRUE) == 1) { - cli::cli_alert_info("Previous assessment tables qmd retained.") - } + ) + # Create tables doc + create_tables_doc( + subdir = report_dir + ) + cli::cli_alert_info("Tables document reset to default.") } } From e27f21a8e4015490a24256f8c6e87401377418f4 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Mon, 28 Sep 2026 10:16:24 -0400 Subject: [PATCH 15/19] update update_report test --- tests/testthat/test-update_report.R | 79 +++++++++++++++++++++++++++++ 1 file changed, 79 insertions(+) create mode 100644 tests/testthat/test-update_report.R diff --git a/tests/testthat/test-update_report.R b/tests/testthat/test-update_report.R new file mode 100644 index 000000000..376df1daa --- /dev/null +++ b/tests/testthat/test-update_report.R @@ -0,0 +1,79 @@ +test_that("multiplication works", { + # create folder for initial report + dir.create("species_year1") + # create folder for "next" report + dir.create("species_year2") + + # make initial report + create_template( + file_dir = "species_year1", + year = 2023, + bib_file = FALSE + ) + + # add writing to intro doc + line <- "this is some additional text to add into the intro file." + write(line, file = "species_year1/report/02_introduction.qmd", append = TRUE) + + # update the report to the other folder + update_report( + file_dir = "species_year2", + previous_file_dir = "species_year1", + year = 2027 + ) + + # test number of files is the same + num_files_init <- length(list.files("species_year1/report")) + num_files_next <- length(list.files("species_year2/report")) + expect_all_equal(num_files_init, num_files_next) + # test one of the child docs is the same -- intro + yr1_intro <- readLines("species_year1/report/02_introduction.qmd") + yr2_intro <- readLines("species_year2/report/02_introduction.qmd") + expect_equal(yr1_intro, yr2_intro) + + unlink("species_year1", recursive = TRUE) + unlink("species_year2", recursive = TRUE) +}) + +test_that("tables and figures are reset when prompted.", { + # create folder for initial report + dir.create("species_year1") + # create folder for "next" report + dir.create("species_year2") + + year1_dir <- fs::path(getwd(), "species_year1") + + # make example table and figure + withr::with_dir( + year1_dir, { + stockplotr::plot_spawning_biomass( + stockplotr::example_data, + make_rda = TRUE, + # figures_dir = x, + interactive = FALSE + ) + + stockplotr::table_index( + stockplotr::example_data, + make_rda = TRUE, + # tables_dir = x, + interactive = FALSE + ) + } + ) + + # make initial report + create_template( + file_dir = "species_year1", + year = 2023, + bib_file = FALSE + ) + + # update the report to the other folder + update_report( + file_dir = "species_year2", + previous_file_dir = "species_year1", + year = 2027, + reset_tables_and_figures = TRUE + ) +}) \ No newline at end of file From 9848fc5d0f528ed88a72ea9d784b3e6d54abd01f Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Thu, 1 Oct 2026 09:58:32 -0400 Subject: [PATCH 16/19] finish update report check --- tests/testthat/test-update_report.R | 37 +++++++++++++++++++++-------- 1 file changed, 27 insertions(+), 10 deletions(-) diff --git a/tests/testthat/test-update_report.R b/tests/testthat/test-update_report.R index 376df1daa..748ab7958 100644 --- a/tests/testthat/test-update_report.R +++ b/tests/testthat/test-update_report.R @@ -42,6 +42,7 @@ test_that("tables and figures are reset when prompted.", { dir.create("species_year2") year1_dir <- fs::path(getwd(), "species_year1") + year2_dir <- fs::path(getwd(), "species_year2") # make example table and figure withr::with_dir( @@ -53,20 +54,24 @@ test_that("tables and figures are reset when prompted.", { interactive = FALSE ) - stockplotr::table_index( - stockplotr::example_data, - make_rda = TRUE, - # tables_dir = x, - interactive = FALSE - ) + # commenting out table until withdir issue fixed + # stockplotr::table_index( + # stockplotr::example_data, + # make_rda = TRUE, + # # tables_dir = x, + # interactive = FALSE + # ) } ) # make initial report - create_template( - file_dir = "species_year1", - year = 2023, - bib_file = FALSE + withr::with_dir( + year1_dir, + create_template( + # file_dir = "species_year1", + year = 2023, + bib_file = FALSE + ) ) # update the report to the other folder @@ -76,4 +81,16 @@ test_that("tables and figures are reset when prompted.", { year = 2027, reset_tables_and_figures = TRUE ) + + init_figs_doc <- readLines(file.path(year1_dir, "report", "08_figures.qmd")) + update_figs_doc <- readLines(file.path(year2_dir, "report", "08_figures.qmd")) + + # init_tabs_doc <- readLines(file.path(year1_dir, "report", "09_tables.qmd")) + # update_tabs_doc <- readLines(file.path(year2_dir, "report", "09_tables.qmd")) + + expect_false(init_figs_doc == update_figs_doc) + # expect_false(init_tabs_doc == update_tabs_doc) + + unlink("species_year1", recursive = TRUE) + unlink("species_year2", recursive = TRUE) }) \ No newline at end of file From be5bd2a4d445dc70fba7c1c36419fe9d54b3ab19 Mon Sep 17 00:00:00 2001 From: Sam Schiano <125507018+Schiano-NOAA@users.noreply.github.com> Date: Thu, 1 Oct 2026 10:12:32 -0400 Subject: [PATCH 17/19] update tests to work with lines --- tests/testthat/test-update_report.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-update_report.R b/tests/testthat/test-update_report.R index 748ab7958..663b10e4a 100644 --- a/tests/testthat/test-update_report.R +++ b/tests/testthat/test-update_report.R @@ -88,8 +88,8 @@ test_that("tables and figures are reset when prompted.", { # init_tabs_doc <- readLines(file.path(year1_dir, "report", "09_tables.qmd")) # update_tabs_doc <- readLines(file.path(year2_dir, "report", "09_tables.qmd")) - expect_false(init_figs_doc == update_figs_doc) - # expect_false(init_tabs_doc == update_tabs_doc) + expect_true(length(init_figs_doc) != length(update_figs_doc)) + # expect_true(length(init_tabs_doc) != length(update_tabs_doc)) unlink("species_year1", recursive = TRUE) unlink("species_year2", recursive = TRUE) From 9fdfe748bd10ca0a6510c7c27d14c9f5165105a9 Mon Sep 17 00:00:00 2001 From: "Sam (Schiano) Bredeck" <125507018+Schiano-NOAA@users.noreply.github.com> Date: Fri, 2 Oct 2026 14:48:40 -0400 Subject: [PATCH 18/19] [feat]: `rerender_skeleton()` (#569) --- DESCRIPTION | 1 + NAMESPACE | 2 + R/add_authors.R | 5 + R/asar-package.R | 1 + R/create_template.R | 961 ++++++------------------ R/create_title.R | 15 +- R/create_yaml.R | 7 +- R/rerender_skeleton.R | 534 +++++++++++++ R/utils.R | 90 +++ man/create_template.Rd | 28 +- man/create_yaml.Rd | 12 - man/rerender_skeleton.Rd | 163 ++++ tests/testthat/test-create_template.R | 132 ---- tests/testthat/test-rerender_skeleton.R | 217 ++++++ 14 files changed, 1287 insertions(+), 881 deletions(-) create mode 100644 R/rerender_skeleton.R create mode 100644 man/rerender_skeleton.Rd create mode 100644 tests/testthat/test-rerender_skeleton.R diff --git a/DESCRIPTION b/DESCRIPTION index 55ce6ddcd..fa1bc4724 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -29,6 +29,7 @@ Imports: glue, gt, journals, + lifecycle, purrr, stats, stringi, diff --git a/NAMESPACE b/NAMESPACE index 8ab30f5a0..ff17d4d18 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -22,4 +22,6 @@ export(export_split_tbls) export(format_quarto) export(gt_split) export(render_lg_table) +export(rerender_skeleton) export(update_report) +importFrom(lifecycle,deprecated) diff --git a/R/add_authors.R b/R/add_authors.R index 47efa4f06..13e2c1f1d 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/asar-package.R b/R/asar-package.R index b7c601704..ef729ba38 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 diff --git a/R/create_template.R b/R/create_template.R index 4bae213a9..f8c61c373 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'. @@ -143,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()`. @@ -183,7 +181,6 @@ #' section_location = "before-introduction" #' ) #' -#' #' create_template( #' new_template = TRUE, #' format = "pdf", @@ -253,13 +250,45 @@ create_template <- function( spp_image = NULL, bib_file = TRUE, new_template = TRUE, - rerender_skeleton = FALSE, custom_sections = NULL, 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" + ) + # 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( + 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", @@ -294,95 +323,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))) { @@ -427,13 +401,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", @@ -458,7 +425,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 ---- @@ -475,14 +442,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") @@ -493,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 @@ -503,118 +463,107 @@ create_template <- function( } bib_name <- NULL - + # asar citation - asar_citation <- "@Manual{asar_2026, + 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 (!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)) + + # 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 - # } - - #### 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( - # prev_skeleton[grep("title:", prev_skeleton)], - # "[0-9]+")) + # 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)] - # 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, "(?<=/)[^/]+$")) - } + # 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) } - # 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() + + bib_name <- basename(base_bib_file) + + } + + #### 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() } - 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)], - "(?<=')[^']+(?=')" + # 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" + ) ) - } - # 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 { - #### 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) { + 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 @@ -629,83 +578,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) - - 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 - } + # 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) renamed_tables_doc <- FALSE if (can_rename_legacy_doc(tbl_info)) { @@ -735,52 +620,36 @@ 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 @@ -789,66 +658,39 @@ 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'" || 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 { - 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 # 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 - # 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, + spp_image = paste0("support_files/", basename(spp_image)), species = species, spp_latin = spp_latin, region = region, @@ -859,76 +701,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( + 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( - "# 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 + "\n", + paste0(param_names, " <- ", "params$", param_names, collapse = " \n") ) } - 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" - ) - } + ), + label = "R_parameters" + ) params_chunk <- add_chunk( paste0( @@ -958,21 +753,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 - load_method <- glue::glue("load({deparse(substitute(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.") - # } - # ) + # add model results according to documentation description + load_method <- glue::glue("load({model_results}) \n") } else { load_method <- "" # df_name <- "NULL" @@ -990,16 +772,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", @@ -1023,255 +799,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 ---- @@ -1290,37 +852,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 diff --git a/R/create_title.R b/R/create_title.R index 1e140f7d8..e9aa37fc0 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 diff --git a/R/create_yaml.R b/R/create_yaml.R index 84ba4e40e..15cc49545 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 @@ -123,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 diff --git a/R/rerender_skeleton.R b/R/rerender_skeleton.R new file mode 100644 index 000000000..371188b4b --- /dev/null +++ b/R/rerender_skeleton.R @@ -0,0 +1,534 @@ +#' 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 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 +#' 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, + 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 + 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 ---- + 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 + prev_species <- gsub( + "_", + " ", + gsub(glue::glue("{region_name}_"), "", report_name_1) + ) + 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]+" + ) + prev_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)) { + # 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)) { + # 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)}") + } + # 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) + # 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 + 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 { + 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 ---- + 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( + office = office, + species = species, + spp_latin = spp_latin, + region = region, + type = type, + year = year + ) + } + } else { + # 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 <- glue::glue("'{stringr::str_replace(title, stringr::regex(prev_species, ignore_case = TRUE), 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 + # 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 <- basename(bib_file) + } else { + bib_name <- NULL + } + + #### Authors ---- + author_list <- add_authors( + prev_skeleton = prev_skeleton, + authors = authors, # need to put this in case there is a rerender otherwise it would not use the correct argument + rerender_skeleton = TRUE + ) + + #### Parameters for yaml ---- + # Unpack + parameters <- TRUE + param_names <- custom_params |> names() + 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, + 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 = TRUE, + 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) { + 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 = length(params_chunk) - 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 = length(params_chunk) - 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( + file_dir, + 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}<-).*", + model_results # 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"), + file_dir, + 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 (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") + # create the updated citation + citation <- create_citation( + authors = authors, + title = title, + year = year + ) + } else { + author <- grep(" - name: ", prev_skeleton) + citation <- create_citation( + authors = authors + ) + cli::cli_alert_success("Added report citation.") + } + + #### 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 else custom <- FALSE + + 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 = file_dir + ) + } + + #### Pull together template ---- + report_template <- paste( + yaml, + "\\printnoidxglossaries \n", + paste(params_chunk, collapse = "\n"), + 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) + + # 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 {file_dir}.") +} diff --git a/R/utils.R b/R/utils.R index 68a57c716..a222ab71c 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,89 @@ 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 +} + +#-------------------------------------------------------------- + +find_system_spp_image <- function(species) { + all_spp_images <- list.files(system.file("resources", "spp_img", package = "asar"), full.names = 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/man/create_template.Rd b/man/create_template.Rd index 0af4e79d7..84dab2cf1 100644 --- a/man/create_template.Rd +++ b/man/create_template.Rd @@ -19,13 +19,13 @@ create_template( tables_dir = getwd(), figures_dir = getwd(), spp_image = NULL, - bib_file = NULL, + bib_file = TRUE, new_template = TRUE, - rerender_skeleton = FALSE, custom_sections = NULL, new_section = NULL, section_location = NULL, custom_params = NULL, + rerender_skeleton = lifecycle::deprecated(), ... ) } @@ -114,27 +114,18 @@ 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. 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'. @@ -172,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()}.} } @@ -215,7 +210,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 ec4fce6ee..152462b4c 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()}.} @@ -151,7 +140,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 000000000..5da8b2634 --- /dev/null +++ b/man/rerender_skeleton.Rd @@ -0,0 +1,163 @@ +% 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}{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} + +\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-create_template.R b/tests/testthat/test-create_template.R index 008ecd116..4b0a8355e 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) diff --git a/tests/testthat/test-rerender_skeleton.R b/tests/testthat/test-rerender_skeleton.R new file mode 100644 index 000000000..98cc7cf7e --- /dev/null +++ b/tests/testthat/test-rerender_skeleton.R @@ -0,0 +1,217 @@ +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(bib_file = FALSE) |> 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", bib_file = FALSE) + + 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", bib_file = FALSE) + + 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) +}) + +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) +}) + +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") + + unlink(report_dir, recursive = TRUE) +}) From 5a78e18120fadcb50211fa052632f7120fa8c302 Mon Sep 17 00:00:00 2001 From: Sophie Breitbart Date: Fri, 2 Oct 2026 16:27:54 -0400 Subject: [PATCH 19/19] [feat] Add functionality to rename legacy figure/table docs (#585) * Add functionality to rename legacy figure/table docs with rerender_skeleton(); fix bug where tables docs weren't renamed in create_template() * Remove code from create_template() associated with legacy fig/table names --- R/create_template.R | 43 +++++++++---------------------------------- R/rerender_skeleton.R | 31 +++++++++++++++++++++++++++++++ 2 files changed, 40 insertions(+), 34 deletions(-) diff --git a/R/create_template.R b/R/create_template.R index f8c61c373..bbd896c63 100644 --- a/R/create_template.R +++ b/R/create_template.R @@ -586,40 +586,7 @@ create_template <- function( } } # close check for previous files & respective copying - # Handle legacy document order and migration - # 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) - - renamed_tables_doc <- FALSE - if (can_rename_legacy_doc(tbl_info)) { - from <- fs::path(subdir, tbl_info$legacy_name) - to <- fs::path(subdir, tbl_info$current_name) - if (!identical(from, to) && file.exists(from)) { - renamed_tables_doc <- file.rename(from = from, to = to) - } - } - - renamed_figures_doc <- FALSE - if (can_rename_legacy_doc(fig_info)) { - from <- fs::path(subdir, fig_info$legacy_name) - to <- fs::path(subdir, fig_info$current_name) - if (!identical(from, to) && file.exists(from)) { - renamed_figures_doc <- file.rename(from = from, to = to) - } - } - - if (renamed_figures_doc || renamed_tables_doc) { - renamed_docs <- c( - if (renamed_figures_doc) paste0("{.file ", fig_info$current_name, "}"), - if (renamed_tables_doc) paste0("{.file ", tbl_info$current_name, "}") - ) - cli::cli_alert_info("Detected legacy figure/table document order in the skeleton.") - cli::cli_alert_info("asar switched to {toString(renamed_docs)}.") - } - - # Created tables doc + # Create tables doc tables_doc_name <- switch( type, "nemt" = "06_tables.qmd", @@ -651,6 +618,14 @@ create_template <- function( to = fs::path(subdir, figures_doc_name) ) } + + # rename tables doc + if (tables_doc_name != "09_tables.qmd") { + file.rename( + from = fs::path(subdir, "09_tables.qmd"), + to = fs::path(subdir, tables_doc_name) + ) + } # Part I # Create a report template file to render for the region and species diff --git a/R/rerender_skeleton.R b/R/rerender_skeleton.R index 371188b4b..99f278db2 100644 --- a/R/rerender_skeleton.R +++ b/R/rerender_skeleton.R @@ -531,4 +531,35 @@ rerender_skeleton <- function( } # Print message cli::cli_alert_success("Updated report skeleton in directory {file_dir}.") + + + # Handle legacy document order and migration + fig_doc <- list.files(file_dir, pattern = "figures.qmd") + tbl_doc <- list.files(file_dir, pattern = "tables.qmd") + + # if the number preceding the figures.qmd is higher than the number preceding the tables.qmd, then rename the files to match the new order + fig_num <- as.numeric(stringr::str_extract(fig_doc, "(?<=^)[0-9]+")) + tbl_num <- as.numeric(stringr::str_extract(tbl_doc, "(?<=^)[0-9]+")) + + if (!is.na(fig_num) && !is.na(tbl_num) && fig_num > tbl_num) { + cli::cli_alert_info("Detected legacy figure/table document order in the skeleton.") + + # Rename the files to match the new order + file.rename( + from = fs::path(file_dir, fig_doc), + to = fs::path(file_dir, + paste0(stringi::stri_pad_left(tbl_num, 2, "0"), + "_figures.qmd") + ) + ) + file.rename( + from = fs::path(file_dir, tbl_doc), + to = fs::path(file_dir, + paste0(stringi::stri_pad_left(fig_num, 2, "0"), + "_tables.qmd") + ) + ) + cli::cli_alert_success("Changed order to match the new skeleton.") + + } }