diff --git a/DESCRIPTION b/DESCRIPTION index 55ce6ddc..fa1bc472 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -29,6 +29,7 @@ Imports: glue, gt, journals, + lifecycle, purrr, stats, stringi, diff --git a/NAMESPACE b/NAMESPACE index 983ccd34..ff17d4d1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -22,3 +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 47efa4f0..13e2c1f1 100644 --- a/R/add_authors.R +++ b/R/add_authors.R @@ -1,6 +1,11 @@ #' Format authors for skeleton #' #' @inheritParams create_template +#' @param rerender_skeleton TRUE/FALSE; Update the skeleton YAML and structure +#' (R parameters, preamble, and skeleton sectioning) if relevant or indicated. +#' All files in your folder, such as the `.qmd` child docs, will remain as is. +#' +#' Default: FALSE #' @param prev_skeleton A character vector of the previous skeleton file read in through \code{readLines()} #' #' @returns A list of authors formatted for a yaml in quarto. Viewable by running the diff --git a/R/asar-package.R b/R/asar-package.R index b7c60170..ef729ba3 100644 --- a/R/asar-package.R +++ b/R/asar-package.R @@ -2,6 +2,7 @@ "_PACKAGE" ## usethis namespace: start +#' @importFrom lifecycle deprecated ## usethis namespace: end NULL diff --git a/R/create_template.R b/R/create_template.R index d940172a..bbd896c6 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,119 +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]+" - ) - year <- ifelse( - is.na(as.numeric(stringr::str_extract( - prev_skeleton[grep("title:", prev_skeleton)], - "[0-9]+" - ))), - year, - as.numeric(stringr::str_extract( - prev_skeleton[grep("title:", prev_skeleton)], - "[0-9]+" - )) - ) - # Add in species image if updated in rerender - if (!is.null(spp_image)) { - file.copy(spp_image, supdir, overwrite = FALSE) |> suppressWarnings() - # Change path to spp image since finished copying for yaml - if (file.exists(spp_image)) { - spp_image <- file.path("support_files", stringr::str_extract(spp_image, "(?<=/)[^/]+$")) - } + # 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) } - # 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 - if (!file.exists(file_dir, "support_files", "in-header.tex") | !is.null(species)) create_inheader_tex(species = species, year = year, subdir = supdir) } } else { - #### Copy template files to report folder ---- - # Check if there are already files in the folder - # Only files present should be: - # 1. bibliography_files folder - # 2. support_files folder - # 3. journals-bibnames.sty - # 4. ? - if (length(list.files(subdir)) < 4) { + 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 @@ -630,158 +578,53 @@ 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 - - # 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 - } - - 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) + } 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 + ) } - } - - 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 - if (!rerender_skeleton) { - tables_doc_name <- switch(type, - "nemt" = "06_tables.qmd", - "safe" = "12_tables.qmd", - "09_tables.qmd" - ) + } # close check for previous files & respective copying + + # Create tables doc + 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" + 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) ) - - create_figures_doc( - subdir = subdir, - figures_dir = figures_dir + } + + # 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) ) - # 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 @@ -790,63 +633,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'" || !is.null(office) || species != "species" || !is.null(region) || year != format(as.POSIXct(Sys.Date(), format = "%YYYY-%mm-%dd"), "%Y") || !is.null(spp_latin)) { - title <- create_title( - office = office, - species = species, - spp_latin = spp_latin, - region = region, - type = type, - year = ifelse(is.na(year), format(as.POSIXct(Sys.Date(), format = "%YYYY-%mm-%dd"), "%Y"), year) - ) - } - } else { - title <- create_title( - office = office, - species = species, - spp_latin = spp_latin, - region = region, - type = type, - year = year - ) - } + title <- create_title( + office = office, + species = species, + spp_latin = spp_latin, + region = region, + type = type, + year = year + ) } # Authors and affiliations # 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, @@ -857,76 +676,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( @@ -956,21 +728,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" @@ -988,16 +747,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", @@ -1021,255 +774,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 ---- @@ -1288,37 +827,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 1e140f7d..e9aa37fc 100644 --- a/R/create_title.R +++ b/R/create_title.R @@ -26,7 +26,13 @@ create_title <- function( # if(!is.null(spp_latin)) spp_latin <- paste("\\textit{", spp_latin, "}", sep = "") # Create title dependent on regional language - if (office == "AFSC") { + if (is.null(office) || office == "") { + if (species == "species") { + title <- "Stock Assessment Report Template" + } else { + title <- paste0("Stock Assessment Report for the ", species, " Stock in ", year) + } + } else if (office == "AFSC") { if (is.null(complex)) { title <- paste0("Assessment of the ", species, " Stock in the ", region) } else { @@ -71,13 +77,6 @@ create_title <- function( # region in NW should be specified as a state title <- paste0("Status of the ", species, " stock in U.S. waters off the coast of ", region, " in ", year) } - } else { - if (species == "species" | is.null(region)) { - title <- "Stock Assessment Report Template" - } else { - title <- paste0("Stock Assessment Report for the ", species, " Stock in ", year) - } - # warning("office (FSC) is not defined. Please define which office you are associated with.") } # Cohesive title for any stock assessment diff --git a/R/create_yaml.R b/R/create_yaml.R index 84ba4e40..15cc4954 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 00000000..99f278db --- /dev/null +++ b/R/rerender_skeleton.R @@ -0,0 +1,565 @@ +#' 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}.") + + + # 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.") + + } +} diff --git a/R/update_report.R b/R/update_report.R new file mode 100644 index 00000000..f102436a --- /dev/null +++ b/R/update_report.R @@ -0,0 +1,160 @@ +#' 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. Required. +#' @param previous_file_dir String of the path where the previous report files +#' 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 +#' +#' @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 + authors = 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, + figures_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 + 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( + list.files(previous_file_dir, pattern = "skeleton\\.qmd"), + # find characters before the first _ + "(?<=^)[^_]+" + ) + if (tolower(type) == "sar") type <- "skeleton" + + # 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$|.sty$" + ) + 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 + ) + # 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 + 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 + # TODO: reset author section in skeleton -- remove all previous authorship (does this work?) + # Update skeleton with new year, authors, model results, region, if added + rerender_skeleton( + file_dir = report_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 ---- + 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.") + } + + if (reset_tables_and_figures) { + # 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 + ) + cli::cli_alert_info("Tables document reset to default.") + } +} diff --git a/R/utils.R b/R/utils.R index 68a57c71..a222ab71 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 0af4e79d..84dab2cf 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 ec4fce6e..152462b4 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 00000000..5da8b263 --- /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/man/update_report.Rd b/man/update_report.Rd new file mode 100644 index 00000000..0693007a --- /dev/null +++ b/man/update_report.Rd @@ -0,0 +1,106 @@ +% 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, + figures_dir = getwd(), + tables_dir = getwd() +) +} +\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} + +\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 +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" +} +} diff --git a/tests/testthat/test-create_template.R b/tests/testthat/test-create_template.R index 008ecd11..4b0a8355 100644 --- a/tests/testthat/test-create_template.R +++ b/tests/testthat/test-create_template.R @@ -1,4 +1,3 @@ -# TODO: Add tests if rerender_skeleton = TRUE test_that("Can trace template files from package", { path <- system.file("templates", "skeleton", package = "asar") base_temp_files <- c( @@ -302,137 +301,6 @@ test_that("warning is triggered for existing files", { unlink(fs::path(path, "report"), recursive = T) }) -test_that("rerender updates SAR legacy figures/tables order in skeleton", { - # don't run on GitHub because can't rename files in the GH testing env - skip_on_ci() - # SAR - create_template() |> suppressWarnings() - - report_dir <- fs::path(getwd(), "report") - skeleton_path <- fs::path(report_dir, "sar_species_skeleton.qmd") - skeleton <- readLines(skeleton_path) - figures_idx <- grep("08_figures.qmd", skeleton, fixed = TRUE) - tables_idx <- grep("09_tables.qmd", skeleton, fixed = TRUE) - - skeleton[figures_idx] <- stringr::str_replace(skeleton[figures_idx], "08_figures.qmd", "08_tables.qmd") - skeleton[tables_idx] <- stringr::str_replace(skeleton[tables_idx], "09_tables.qmd", "09_figures.qmd") - writeLines(skeleton, skeleton_path) - - file.rename( - from = fs::path(report_dir, "08_figures.qmd"), - to = fs::path(report_dir, "09_figures.qmd") - ) - file.rename( - from = fs::path(report_dir, "09_tables.qmd"), - to = fs::path(report_dir, "08_tables.qmd") - ) - - create_template( - rerender_skeleton = TRUE, - file_dir = "report" - ) |> suppressWarnings() - - updated_skeleton <- readLines(skeleton_path) - updated_figures_idx <- grep("08_figures.qmd", updated_skeleton, fixed = TRUE) - updated_tables_idx <- grep("09_tables.qmd", updated_skeleton, fixed = TRUE) - - expect_true(file.exists(fs::path(report_dir, "08_figures.qmd"))) - expect_true(file.exists(fs::path(report_dir, "09_tables.qmd"))) - expect_false(file.exists(fs::path(report_dir, "09_figures.qmd"))) - expect_false(file.exists(fs::path(report_dir, "08_tables.qmd"))) - expect_lt(updated_figures_idx, updated_tables_idx) - - unlink(report_dir, recursive = TRUE) -}) - -test_that("rerender updates SAFE legacy figures/tables order in skeleton", { - # don't run on GitHub because can't rename files in the GH testing env - skip_on_ci() - # SAFE - create_template(type = "safe") - - report_dir <- fs::path(getwd(), "report") - skeleton_path <- fs::path(report_dir, "safe_species_skeleton.qmd") - skeleton <- readLines(skeleton_path) - figures_idx <- grep("11_figures.qmd", skeleton, fixed = TRUE) - tables_idx <- grep("12_tables.qmd", skeleton, fixed = TRUE) - - skeleton[figures_idx] <- stringr::str_replace(skeleton[figures_idx], "11_figures.qmd", "11_tables.qmd") - skeleton[tables_idx] <- stringr::str_replace(skeleton[tables_idx], "12_tables.qmd", "12_figures.qmd") - writeLines(skeleton, skeleton_path) - - file.rename( - from = fs::path(report_dir, "11_figures.qmd"), - to = fs::path(report_dir, "12_figures.qmd") - ) - file.rename( - from = fs::path(report_dir, "12_tables.qmd"), - to = fs::path(report_dir, "11_tables.qmd") - ) - - create_template( - rerender_skeleton = TRUE, - type = "safe", - file_dir = "report" - ) |> suppressWarnings() - - updated_skeleton <- readLines(skeleton_path) - updated_figures_idx <- grep("11_figures.qmd", updated_skeleton, fixed = TRUE) - updated_tables_idx <- grep("12_tables.qmd", updated_skeleton, fixed = TRUE) - - expect_true(file.exists(fs::path(report_dir, "11_figures.qmd"))) - expect_true(file.exists(fs::path(report_dir, "12_tables.qmd"))) - expect_false(file.exists(fs::path(report_dir, "12_figures.qmd"))) - expect_false(file.exists(fs::path(report_dir, "11_tables.qmd"))) - expect_lt(updated_figures_idx, updated_tables_idx) - - unlink(report_dir, recursive = TRUE) -}) - -test_that("rerender updates NEMT legacy figures/tables order in skeleton", { - # don't run on GitHub because can't rename files in the GH testing env - skip_on_ci() - # NEMT - create_template(type = "nemt") - - report_dir <- fs::path(getwd(), "report") - skeleton_path <- fs::path(report_dir, "nemt_species_skeleton.qmd") - skeleton <- readLines(skeleton_path) - figures_idx <- grep("05_figures.qmd", skeleton, fixed = TRUE) - tables_idx <- grep("06_tables.qmd", skeleton, fixed = TRUE) - - skeleton[figures_idx] <- stringr::str_replace(skeleton[figures_idx], "05_figures.qmd", "05_tables.qmd") - skeleton[tables_idx] <- stringr::str_replace(skeleton[tables_idx], "06_tables.qmd", "06_figures.qmd") - writeLines(skeleton, skeleton_path) - - file.rename( - from = fs::path(report_dir, "05_figures.qmd"), - to = fs::path(report_dir, "06_figures.qmd") - ) - file.rename( - from = fs::path(report_dir, "06_tables.qmd"), - to = fs::path(report_dir, "05_tables.qmd") - ) - - create_template( - rerender_skeleton = TRUE, - type = "nemt", - file_dir = "report" - ) |> suppressWarnings() - - updated_skeleton <- readLines(skeleton_path) - updated_figures_idx <- grep("05_figures.qmd", updated_skeleton, fixed = TRUE) - updated_tables_idx <- grep("06_tables.qmd", updated_skeleton, fixed = TRUE) - - expect_true(file.exists(fs::path(report_dir, "05_figures.qmd"))) - expect_true(file.exists(fs::path(report_dir, "06_tables.qmd"))) - expect_false(file.exists(fs::path(report_dir, "06_figures.qmd"))) - expect_false(file.exists(fs::path(report_dir, "05_tables.qmd"))) - expect_lt(updated_figures_idx, updated_tables_idx) - - unlink(report_dir, recursive = TRUE) -}) - test_that("file_dir works", { dir <- fs::path(getwd(), "data") on.exit(unlink(dir, recursive = TRUE), add = TRUE) diff --git a/tests/testthat/test-rerender_skeleton.R b/tests/testthat/test-rerender_skeleton.R new file mode 100644 index 00000000..98cc7cf7 --- /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) +}) diff --git a/tests/testthat/test-update_report.R b/tests/testthat/test-update_report.R new file mode 100644 index 00000000..663b10e4 --- /dev/null +++ b/tests/testthat/test-update_report.R @@ -0,0 +1,96 @@ +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") + year2_dir <- fs::path(getwd(), "species_year2") + + # 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 + ) + + # commenting out table until withdir issue fixed + # stockplotr::table_index( + # stockplotr::example_data, + # make_rda = TRUE, + # # tables_dir = x, + # interactive = FALSE + # ) + } + ) + + # make initial report + withr::with_dir( + year1_dir, + 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 + ) + + 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_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) +}) \ No newline at end of file