From c77d0bff9bb7441ac212f1fba924eb39c45246c6 Mon Sep 17 00:00:00 2001 From: sbreitbart-NOAA Date: Mon, 17 Aug 2026 11:36:57 -0400 Subject: [PATCH 01/11] Change order of figures and tables qmds (08 <--> 09) --- R/create_figures_doc.R | 4 ++-- R/create_tables_doc.R | 4 ++-- R/create_template.R | 16 +++++++-------- tests/testthat/test-create_figures_doc.R | 14 ++++++------- tests/testthat/test-create_tables_doc.R | 16 +++++++-------- tests/testthat/test-create_template.R | 20 +++++++++---------- vignettes/articles/accessibility_guide.qmd | 4 ++-- vignettes/articles/faqs.qmd | 4 ++-- .../articles/snippets/add-plots_coding.Rmd | 2 +- vignettes/articles/snippets/add-plots_img.Rmd | 2 +- vignettes/articles/snippets/add-plots_rda.Rmd | 2 +- 11 files changed, 44 insertions(+), 44 deletions(-) diff --git a/R/create_figures_doc.R b/R/create_figures_doc.R index d655c8f8..a718d39a 100644 --- a/R/create_figures_doc.R +++ b/R/create_figures_doc.R @@ -256,7 +256,7 @@ rm(rda)\n ifelse( any(grepl("_figures.qmd$", list.files(subdir))), list.files(subdir)[grep("_figures.qmd", list.files(subdir))], - "09_figures.qmd" + "08_figures.qmd" ) ), append = append @@ -266,7 +266,7 @@ rm(rda)\n doc_path <- ifelse( any(grepl("_figures.qmd$", list.files(subdir))), fs::path(subdir, list.files(subdir)[grep("_figures.qmd", list.files(subdir))]), - fs::path(subdir, "09_figures.qmd") + fs::path(subdir, "08_figures.qmd") ) fix_duplicate_chunks( diff --git a/R/create_tables_doc.R b/R/create_tables_doc.R index 4b51ee3d..b4ec9898 100644 --- a/R/create_tables_doc.R +++ b/R/create_tables_doc.R @@ -582,7 +582,7 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n ifelse( any(grepl("_tables.qmd$", list.files(subdir))), list.files(subdir)[grep("_tables.qmd", list.files(subdir))], - "08_tables.qmd" + "09_tables.qmd" ) ), append = append @@ -592,7 +592,7 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n doc_path <- ifelse( any(grepl("_tables.qmd$", list.files(subdir))), fs::path(subdir, list.files(subdir)[grep("_tables.qmd", list.files(subdir))]), - fs::path(subdir, "08_tables.qmd") + fs::path(subdir, "09_tables.qmd") ) fix_duplicate_chunks( diff --git a/R/create_template.R b/R/create_template.R index ab842072..ce132828 100644 --- a/R/create_template.R +++ b/R/create_template.R @@ -667,9 +667,9 @@ create_template <- function( if (!rerender_skeleton) { { tables_doc_name <- switch(type, - "nemt" = "05_tables.qmd", - "safe" = "11_tables.qmd", - "08_tables.qmd" + "nemt" = "06_tables.qmd", + "safe" = "12_tables.qmd", + "09_tables.qmd" ) tables_doc <- "" utils::capture.output(cat(tables_doc), @@ -694,9 +694,9 @@ create_template <- function( # Create figures qmd if (!rerender_skeleton) { figures_doc_name <- switch(type, - "nemt" = "06_figures.qmd", - "safe" = "12_figures.qmd", - "09_figures.qmd" + "nemt" = "05_figures.qmd", + "safe" = "11_figures.qmd", + "08_figures.qmd" ) create_figures_doc( @@ -704,9 +704,9 @@ create_template <- function( figures_dir = figures_dir ) # rename figures doc - if (figures_doc_name != "09_figures.qmd") { + if (figures_doc_name != "08_figures.qmd") { file.rename( - from = fs::path(subdir, "09_figures.qmd"), + from = fs::path(subdir, "08_figures.qmd"), to = fs::path(subdir, figures_doc_name) ) } diff --git a/tests/testthat/test-create_figures_doc.R b/tests/testthat/test-create_figures_doc.R index 1921b117..7ada1c3e 100644 --- a/tests/testthat/test-create_figures_doc.R +++ b/tests/testthat/test-create_figures_doc.R @@ -6,7 +6,7 @@ test_that("Creates expected start of nearly empty figures doc", { ) # read in figures doc - figure_content <- readLines("09_figures.qmd") + figure_content <- readLines("08_figures.qmd") # extract first line head_figure_content <- figure_content[1] # remove line numbers and collapse @@ -24,7 +24,7 @@ test_that("Creates expected start of nearly empty figures doc", { ) # erase temporary testing files - file.remove(fs::path(getwd(), "09_figures.qmd")) + file.remove(fs::path(getwd(), "08_figures.qmd")) }) test_that("Creates expected start of figures doc with figure", { @@ -41,7 +41,7 @@ test_that("Creates expected start of figures doc with figure", { ) # read in figures doc - figure_content <- readLines("09_figures.qmd") + figure_content <- readLines("08_figures.qmd") # extract first 6 lines head_figure_content <- head(figure_content, 6) # remove line numbers and collapse @@ -57,7 +57,7 @@ test_that("Creates expected start of figures doc with figure", { ) # erase temporary testing files - file.remove(fs::path(getwd(), "09_figures.qmd")) + file.remove(fs::path(getwd(), "08_figures.qmd")) file.remove(fs::path(getwd(), "captions_alt_text.csv")) file.remove(fs::path(getwd(), "key_quantities.csv")) unlink(fs::path(getwd(), "figures"), recursive = T) @@ -80,7 +80,7 @@ test_that("Formerly empty figures doc renders correctly", { ) # read in figures doc - figure_content <- readLines(file.path(getwd(), "report", "09_figures.qmd")) + figure_content <- readLines(file.path(getwd(), "report", "08_figures.qmd")) # extract first 7 lines head_figure_content <- head(figure_content, 7) # remove line numbers and collapse @@ -125,7 +125,7 @@ test_that("Formerly empty figures doc renders correctly", { # ) # # # erase temporary testing files -# file.remove(fs::path(getwd(), "09_figures.qmd")) +# file.remove(fs::path(getwd(), "08_figures.qmd")) # file.remove(fs::path(getwd(), "captions_alt_text.csv")) # file.remove(fs::path(getwd(), "key_quantities.csv")) # unlink(fs::path(getwd(), "figures"), recursive = T) @@ -155,7 +155,7 @@ test_that("Adds new figure from figures folder.", { ) # read in figures doc - figure_content <- readLines(file.path(getwd(), "report", "09_figures.qmd")) + figure_content <- readLines(file.path(getwd(), "report", "08_figures.qmd")) # Remove the first lines so test doesn't test path differences # Note: you CAN NOT test rendering with this approach figure_content <- figure_content[-c(3:11)] diff --git a/tests/testthat/test-create_tables_doc.R b/tests/testthat/test-create_tables_doc.R index d3935f90..771c25c0 100644 --- a/tests/testthat/test-create_tables_doc.R +++ b/tests/testthat/test-create_tables_doc.R @@ -6,7 +6,7 @@ test_that("Creates expected start of nearly empty tables doc", { ) # read in tables doc - table_content <- readLines("08_tables.qmd") + table_content <- readLines("09_tables.qmd") # extract first line head_table_content <- table_content[1] # remove line numbers and collapse @@ -24,7 +24,7 @@ test_that("Creates expected start of nearly empty tables doc", { ) # erase temporary testing files - file.remove(fs::path(getwd(), "08_tables.qmd")) + file.remove(fs::path(getwd(), "09_tables.qmd")) }) test_that("Creates expected start of tables doc with table", { @@ -41,7 +41,7 @@ test_that("Creates expected start of tables doc with table", { ) # read in tables doc - table_content <- readLines("08_tables.qmd") + table_content <- readLines("09_tables.qmd") # extract first 7 lines head_table_content <- head(table_content, 7) # remove line numbers and collapse @@ -57,7 +57,7 @@ test_that("Creates expected start of tables doc with table", { ) # erase temporary testing files - file.remove(fs::path(getwd(), "08_tables.qmd")) + file.remove(fs::path(getwd(), "09_tables.qmd")) file.remove(fs::path(getwd(), "captions_alt_text.csv")) file.remove(fs::path(getwd(), "key_quantities.csv")) unlink(fs::path(getwd(), "tables"), recursive = T) @@ -87,7 +87,7 @@ test_that("Creates expected start of tables doc with table", { # ) # # # erase temporary testing files -# file.remove(fs::path(getwd(), "08_tables.qmd")) +# file.remove(fs::path(getwd(), "09_tables.qmd")) # file.remove(fs::path(getwd(), "captions_alt_text.csv")) # file.remove(fs::path(getwd(), "key_quantities.csv")) # unlink(fs::path(getwd(), "tables"), recursive = T) @@ -112,7 +112,7 @@ test_that("Formerly empty tables doc renders correctly", { ) # read in tables doc - table_content <- readLines(file.path(getwd(), "report", "08_tables.qmd")) + table_content <- readLines(file.path(getwd(), "report", "09_tables.qmd")) # extract first 8 lines head_table_content <- head(table_content, 8) # remove line numbers and collapse @@ -128,7 +128,7 @@ test_that("Formerly empty tables doc renders correctly", { ) # erase temporary testing files - # file.remove(fs::path(getwd(), "08_tables.qmd")) + # file.remove(fs::path(getwd(), "09_tables.qmd")) file.remove(fs::path(getwd(), "captions_alt_text.csv")) file.remove(fs::path(getwd(), "key_quantities.csv")) unlink(fs::path(getwd(), "tables"), recursive = T) @@ -164,7 +164,7 @@ test_that("Adds new table from tables folder.", { ) # read in figures doc - table_content <- readLines(file.path(getwd(), "report", "08_tables.qmd")) + table_content <- readLines(file.path(getwd(), "report", "09_tables.qmd")) # Remove the first lines so test doesn't test path differences # Note: you CAN NOT test rendering with this approach table_content <- table_content[-c(3:11)] diff --git a/tests/testthat/test-create_template.R b/tests/testthat/test-create_template.R index 639a4b6d..95095f2a 100644 --- a/tests/testthat/test-create_template.R +++ b/tests/testthat/test-create_template.R @@ -15,9 +15,9 @@ test_that("Can trace template files from package", { "07_references.qmd", # "10_notes.qmd", "11_appendix.qmd" - # "09_figures.qmd", + # "08_figures.qmd", # "in-header.tex", - # "08_tables.qmd", + # "09_tables.qmd", # "title.tex" ) expect_equal(list.files(path), base_temp_files) @@ -37,8 +37,8 @@ test_that("create_template() creates correct files", { "05_discussion.qmd", "06_acknowledgments.qmd", "07_references.qmd", - "08_tables.qmd", - "09_figures.qmd", + "09_tables.qmd", + "08_figures.qmd", # "10_notes.qmd", "11_appendix.qmd", "preamble.R", @@ -112,8 +112,8 @@ test_that("create_template() creates correct files", { "05_discussion.qmd", "06_acknowledgments.qmd", "07_references.qmd", - "08_tables.qmd", - "09_figures.qmd", + "09_tables.qmd", + "08_figures.qmd", # "10_notes.qmd", "11_appendix.qmd", "sar_Dover_sole_skeleton.qmd", @@ -168,8 +168,8 @@ test_that("create_template() creates correct files", { "03_data.qmd", "06_acknowledgments.qmd", "07_references.qmd", - "08_tables.qmd", - "09_figures.qmd", + "09_tables.qmd", + "08_figures.qmd", "11_appendix.qmd", "sar_Rex_sole_skeleton.qmd", "asar_references.bib", @@ -314,8 +314,8 @@ test_that("model_results metadata file created", { "05_discussion.qmd", "06_acknowledgments.qmd", "07_references.qmd", - "08_tables.qmd", - "09_figures.qmd", + "09_tables.qmd", + "08_figures.qmd", # "10_notes.qmd", "11_appendix.qmd", "sar_species_skeleton.qmd", diff --git a/vignettes/articles/accessibility_guide.qmd b/vignettes/articles/accessibility_guide.qmd index 950b5346..5f3c39e2 100644 --- a/vignettes/articles/accessibility_guide.qmd +++ b/vignettes/articles/accessibility_guide.qmd @@ -147,7 +147,7 @@ There is no one-size-fits-all approach for explaining what a figure is conveying To edit your rda’s alt text, follow these steps: -1. Open your report's 09_figures.qmd file. +1. Open your report's 08_figures.qmd file. 2. Run the first code chunk, which saves the filepath of your rda directory as an object (it has the label `"set-rda-dir-figs"`). 3. Find the two code chunks associated with the figure you're interested (e.g., recruitment). Run the first chunk, which will have "setup" in the label (e.g., `"fig-recruitment-setup"`,`"fig-spawning_biomass-setup"`, etc.). 4. **Add to the alt text by** pasting the existing alt text with a new string *within the chunk*. To do this, find your existing alt text object, which is an object named with the figure's topic and "alt_text" (e.g., `recruitment_alt_text`). Then, make an object (a string) containing your additional text (e.g., `new_alt_text`). Then, paste together the existing alt text object and your new text object. For example: @@ -178,7 +178,7 @@ recruitment_alt_text <- new_alt_text **NOTES**: -1. Changes to your alt text will be saved within your 09_figures.qmd file, but not within the rda file itself. To directly edit the rda file's alt text or caption, assign a new value to the text you wish to change. For example, if your rda is called `rda` and you want to change the caption to "my new caption", you'd enter the following command: `rda[["caption"]] <- "my new caption"`. To change the alt text, you'd change "caption" to "alt_text" (e.g., `rda[["alt_text"]] <- "my new alt text"`.). Save the changes to the rda's file by entering the following command (in this example, our rda is called "biomass_figure.rda"): `save(rda, file = 'biomass_figure.rda')`. +1. Changes to your alt text will be saved within your 08_figures.qmd file, but not within the rda file itself. To directly edit the rda file's alt text or caption, assign a new value to the text you wish to change. For example, if your rda is called `rda` and you want to change the caption to "my new caption", you'd enter the following command: `rda[["caption"]] <- "my new caption"`. To change the alt text, you'd change "caption" to "alt_text" (e.g., `rda[["alt_text"]] <- "my new alt text"`.). Save the changes to the rda's file by entering the following command (in this example, our rda is called "biomass_figure.rda"): `save(rda, file = 'biomass_figure.rda')`. 2. Edit figure and table captions with the same process. Just substitute mentions of alt text with caption. diff --git a/vignettes/articles/faqs.qmd b/vignettes/articles/faqs.qmd index 67e7897a..7709a44f 100644 --- a/vignettes/articles/faqs.qmd +++ b/vignettes/articles/faqs.qmd @@ -122,11 +122,11 @@ You may be using a version of Quarto [older than v1.6](https://quarto.org/docs/b ## My figure and table references aren't in chronological order in the report. How do I fix this? -You will notice that the order of your figures and tables in their respective 08_tables.qmd and 09_figures.qmd docs will determine their numbers in the report. This might result in Table 2 being referenced before Table 1, for instance, in your report. +You will notice that the order of your figures and tables in their respective 09_tables.qmd and 08_figures.qmd docs will determine their numbers in the report. This might result in Table 2 being referenced before Table 1, for instance, in your report. We are encouraging users to keep the order as-is for a few reasons. First, the predictability of standardized figure and table order could prove useful when comparing reports. Second, the choice of where to prioritize the figure/table order- in the Figures and Tables sections, or in the main text- is somewhat of a personal preference, rather than a hard rule. Third, as far as we know, a fix isn't yet possible with Quarto. We are choosing to focus on building other features for `asar`. -However, we understand that some will strongly prefer to set the order of their tables and figures. You *can* try manually changing the order of the figure and table chunks in the 08_tables.qmd and 09_figures.qmd docs, but this isn't a reproducible or permanent solution. +However, we understand that some will strongly prefer to set the order of their tables and figures. You *can* try manually changing the order of the figure and table chunks in the 09_tables.qmd and 08_figures.qmd docs, but this isn't a reproducible or permanent solution. ## Why are there absolute, rather than relative, filepaths for `tables_dir` and `figures_dir` at the tops of my figures and tables docs? diff --git a/vignettes/articles/snippets/add-plots_coding.Rmd b/vignettes/articles/snippets/add-plots_coding.Rmd index 261fc180..59ed133d 100644 --- a/vignettes/articles/snippets/add-plots_coding.Rmd +++ b/vignettes/articles/snippets/add-plots_coding.Rmd @@ -1,6 +1,6 @@ ### Add custom tables and figures {#sec-add-plots_coding} -In your 'report' folder, open your figures and tables docs (probably named something like '08_tables.qmd' and '09_figures.qmd'). Add the following code there. +In your 'report' folder, open your figures and tables docs (probably named something like '09_tables.qmd' and '08_figures.qmd'). Add the following code there. **IMPORTANT**: The label in your captions/alt text csv must match the label in your plot's chunk options, **MINUS the "fig-" or "tab-"**. For example, the label "custom_table1" in the csv would match up properly with the "tbl-custom_table1" label in a code chunk. The same rule applies for figures: "custom_figure1" in the csv would match up with "fig-custom_figure1" in the chunk options' label. diff --git a/vignettes/articles/snippets/add-plots_img.Rmd b/vignettes/articles/snippets/add-plots_img.Rmd index a09a917e..e4da71cb 100644 --- a/vignettes/articles/snippets/add-plots_img.Rmd +++ b/vignettes/articles/snippets/add-plots_img.Rmd @@ -1,6 +1,6 @@ ### Add custom tables and figures {#sec-add-plots_img} -In your 'report' folder, open your figures and tables docs (probably named something like '08_tables.qmd' and '09_figures.qmd'). Add the following code there. +In your 'report' folder, open your figures and tables docs (probably named something like '09_tables.qmd' and '08_figures.qmd'). Add the following code there. **IMPORTANT**: The label in your captions/alt text csv must match the label in your plot's chunk options, **MINUS the "fig-" or "tab-"**. For example, the label "your_image_label_name" in the csv would match up properly with the "tbl-your_image_label_name" label in this code: diff --git a/vignettes/articles/snippets/add-plots_rda.Rmd b/vignettes/articles/snippets/add-plots_rda.Rmd index 7f49d326..07ca097f 100644 --- a/vignettes/articles/snippets/add-plots_rda.Rmd +++ b/vignettes/articles/snippets/add-plots_rda.Rmd @@ -1,6 +1,6 @@ ### Add custom tables and figures {#sec-add-plots_rda} -This step will alter your figures and tables docs (probably named something like '08_tables.qmd' and '09_figures.qmd'), located in your 'report' folder. +This step will alter your figures and tables docs (probably named something like '09_tables.qmd' and '08_figures.qmd'), located in your 'report' folder. As a reminder, this workflow assumes that you have tables and/or figures stored in rda files. If you don't have those rda files, please see the [Export your custom tables and figures](#sec-export-custom-figs-tables) section to create them. From 49fd3c3506c85bfd73b89bf47902e71de7c915ee Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Mon, 17 Aug 2026 16:11:36 +0000 Subject: [PATCH 02/11] Handle legacy figures/tables order and update docs text Co-authored-by: sbreitbart-NOAA <181890943+sbreitbart-NOAA@users.noreply.github.com> --- R/create_figures_doc.R | 46 +++++++++++++------ R/create_tables_doc.R | 46 +++++++++++++------ tests/testthat/test-create_figures_doc.R | 14 ++++++ tests/testthat/test-create_tables_doc.R | 14 ++++++ vignettes/articles/faqs.qmd | 4 +- .../articles/snippets/add-plots_coding.Rmd | 2 +- vignettes/articles/snippets/add-plots_img.Rmd | 2 +- vignettes/articles/snippets/add-plots_rda.Rmd | 2 +- 8 files changed, 99 insertions(+), 31 deletions(-) diff --git a/R/create_figures_doc.R b/R/create_figures_doc.R index a718d39a..6669aa67 100644 --- a/R/create_figures_doc.R +++ b/R/create_figures_doc.R @@ -249,25 +249,45 @@ rm(rda)\n ) ) } + legacy_figures_doc <- fs::path(subdir, "09_figures.qmd") + current_figures_doc <- fs::path(subdir, "08_figures.qmd") + using_legacy_figures_doc <- file.exists(legacy_figures_doc) && !file.exists(current_figures_doc) + + if (using_legacy_figures_doc) { + cli::cli_alert_info("Detected legacy figure/table document order ({.file 08_tables.qmd} then {.file 09_figures.qmd}). {asar} now uses {.file 08_figures.qmd} then {.file 09_tables.qmd} to keep table-of-contents entries in logical order.") + } + + figures_doc_name <- if (using_legacy_figures_doc) { + "09_figures.qmd" + } else if (file.exists(current_figures_doc)) { + "08_figures.qmd" + } else if (any(grepl("_figures.qmd$", list.files(subdir)))) { + list.files(subdir)[grep("_figures.qmd$", list.files(subdir))][1] + } else { + "08_figures.qmd" + } + # Save figures doc to template folder utils::capture.output(cat(figures_doc), - file = paste0( - subdir, "/", - ifelse( - any(grepl("_figures.qmd$", list.files(subdir))), - list.files(subdir)[grep("_figures.qmd", list.files(subdir))], - "08_figures.qmd" - ) - ), + file = fs::path(subdir, figures_doc_name), append = append ) + if (using_legacy_figures_doc && file.exists(legacy_figures_doc)) { + file.rename( + from = legacy_figures_doc, + to = current_figures_doc + ) + } + # Read through figures doc and warn about identical labels - doc_path <- ifelse( - any(grepl("_figures.qmd$", list.files(subdir))), - fs::path(subdir, list.files(subdir)[grep("_figures.qmd", list.files(subdir))]), - fs::path(subdir, "08_figures.qmd") - ) + doc_path <- if (file.exists(current_figures_doc)) { + current_figures_doc + } else if (any(grepl("_figures.qmd$", list.files(subdir)))) { + fs::path(subdir, list.files(subdir)[grep("_figures.qmd$", list.files(subdir))][1]) + } else { + current_figures_doc + } fix_duplicate_chunks( doc_path = doc_path, diff --git a/R/create_tables_doc.R b/R/create_tables_doc.R index b4ec9898..dd35e7d9 100644 --- a/R/create_tables_doc.R +++ b/R/create_tables_doc.R @@ -575,25 +575,45 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n ) } + legacy_tables_doc <- fs::path(subdir, "08_tables.qmd") + current_tables_doc <- fs::path(subdir, "09_tables.qmd") + using_legacy_tables_doc <- file.exists(legacy_tables_doc) && !file.exists(current_tables_doc) + + if (using_legacy_tables_doc) { + cli::cli_alert_info("Detected legacy figure/table document order ({.file 08_tables.qmd} then {.file 09_figures.qmd}). {asar} now uses {.file 08_figures.qmd} then {.file 09_tables.qmd} to keep table-of-contents entries in logical order.") + } + + tables_doc_name <- if (using_legacy_tables_doc) { + "08_tables.qmd" + } else if (file.exists(current_tables_doc)) { + "09_tables.qmd" + } else if (any(grepl("_tables.qmd$", list.files(subdir)))) { + list.files(subdir)[grep("_tables.qmd$", list.files(subdir))][1] + } else { + "09_tables.qmd" + } + # Save tables doc to template folder utils::capture.output(cat(tables_doc), - file = paste0( - subdir, "/", - ifelse( - any(grepl("_tables.qmd$", list.files(subdir))), - list.files(subdir)[grep("_tables.qmd", list.files(subdir))], - "09_tables.qmd" - ) - ), + file = fs::path(subdir, tables_doc_name), append = append ) + if (using_legacy_tables_doc && file.exists(legacy_tables_doc)) { + file.rename( + from = legacy_tables_doc, + to = current_tables_doc + ) + } + # Read through tables doc and warn about identical labels - doc_path <- ifelse( - any(grepl("_tables.qmd$", list.files(subdir))), - fs::path(subdir, list.files(subdir)[grep("_tables.qmd", list.files(subdir))]), - fs::path(subdir, "09_tables.qmd") - ) + doc_path <- if (file.exists(current_tables_doc)) { + current_tables_doc + } else if (any(grepl("_tables.qmd$", list.files(subdir)))) { + fs::path(subdir, list.files(subdir)[grep("_tables.qmd$", list.files(subdir))][1]) + } else { + current_tables_doc + } fix_duplicate_chunks( doc_path = doc_path, diff --git a/tests/testthat/test-create_figures_doc.R b/tests/testthat/test-create_figures_doc.R index 7ada1c3e..d9c3a0a3 100644 --- a/tests/testthat/test-create_figures_doc.R +++ b/tests/testthat/test-create_figures_doc.R @@ -173,3 +173,17 @@ test_that("Adds new figure from figures folder.", { unlink(fs::path(getwd(), "figures"), recursive = T) unlink(fs::path(getwd(), "report"), recursive = T) }) + +test_that("Legacy figures doc name is renamed to new order", { + writeLines("# Figures {#sec-figures}", "09_figures.qmd") + + create_figures_doc( + subdir = getwd(), + figures_dir = getwd() + ) + + expect_true(file.exists("08_figures.qmd")) + expect_false(file.exists("09_figures.qmd")) + + file.remove(fs::path(getwd(), "08_figures.qmd")) +}) diff --git a/tests/testthat/test-create_tables_doc.R b/tests/testthat/test-create_tables_doc.R index 771c25c0..af611d56 100644 --- a/tests/testthat/test-create_tables_doc.R +++ b/tests/testthat/test-create_tables_doc.R @@ -182,3 +182,17 @@ test_that("Adds new table from tables folder.", { unlink(fs::path("tables"), recursive = T) unlink(fs::path("report"), recursive = T) }) + +test_that("Legacy tables doc name is renamed to new order", { + writeLines("# Tables {#sec-tables}", "08_tables.qmd") + + create_tables_doc( + subdir = getwd(), + tables_dir = getwd() + ) + + expect_true(file.exists("09_tables.qmd")) + expect_false(file.exists("08_tables.qmd")) + + file.remove(fs::path(getwd(), "09_tables.qmd")) +}) diff --git a/vignettes/articles/faqs.qmd b/vignettes/articles/faqs.qmd index 7709a44f..420c1911 100644 --- a/vignettes/articles/faqs.qmd +++ b/vignettes/articles/faqs.qmd @@ -122,11 +122,11 @@ You may be using a version of Quarto [older than v1.6](https://quarto.org/docs/b ## My figure and table references aren't in chronological order in the report. How do I fix this? -You will notice that the order of your figures and tables in their respective 09_tables.qmd and 08_figures.qmd docs will determine their numbers in the report. This might result in Table 2 being referenced before Table 1, for instance, in your report. +You will notice that the order of your figures and tables in their respective 08_figures.qmd and 09_tables.qmd docs will determine their numbers in the report. This might result in Table 2 being referenced before Table 1, for instance, in your report. We are encouraging users to keep the order as-is for a few reasons. First, the predictability of standardized figure and table order could prove useful when comparing reports. Second, the choice of where to prioritize the figure/table order- in the Figures and Tables sections, or in the main text- is somewhat of a personal preference, rather than a hard rule. Third, as far as we know, a fix isn't yet possible with Quarto. We are choosing to focus on building other features for `asar`. -However, we understand that some will strongly prefer to set the order of their tables and figures. You *can* try manually changing the order of the figure and table chunks in the 09_tables.qmd and 08_figures.qmd docs, but this isn't a reproducible or permanent solution. +However, we understand that some will strongly prefer to set the order of their tables and figures. You *can* try manually changing the order of the figure and table chunks in the 08_figures.qmd and 09_tables.qmd docs, but this isn't a reproducible or permanent solution. ## Why are there absolute, rather than relative, filepaths for `tables_dir` and `figures_dir` at the tops of my figures and tables docs? diff --git a/vignettes/articles/snippets/add-plots_coding.Rmd b/vignettes/articles/snippets/add-plots_coding.Rmd index 59ed133d..34c8175e 100644 --- a/vignettes/articles/snippets/add-plots_coding.Rmd +++ b/vignettes/articles/snippets/add-plots_coding.Rmd @@ -1,6 +1,6 @@ ### Add custom tables and figures {#sec-add-plots_coding} -In your 'report' folder, open your figures and tables docs (probably named something like '09_tables.qmd' and '08_figures.qmd'). Add the following code there. +In your 'report' folder, open your figures and tables docs (probably named something like '08_figures.qmd' and '09_tables.qmd'). Add the following code there. **IMPORTANT**: The label in your captions/alt text csv must match the label in your plot's chunk options, **MINUS the "fig-" or "tab-"**. For example, the label "custom_table1" in the csv would match up properly with the "tbl-custom_table1" label in a code chunk. The same rule applies for figures: "custom_figure1" in the csv would match up with "fig-custom_figure1" in the chunk options' label. diff --git a/vignettes/articles/snippets/add-plots_img.Rmd b/vignettes/articles/snippets/add-plots_img.Rmd index e4da71cb..53b0e754 100644 --- a/vignettes/articles/snippets/add-plots_img.Rmd +++ b/vignettes/articles/snippets/add-plots_img.Rmd @@ -1,6 +1,6 @@ ### Add custom tables and figures {#sec-add-plots_img} -In your 'report' folder, open your figures and tables docs (probably named something like '09_tables.qmd' and '08_figures.qmd'). Add the following code there. +In your 'report' folder, open your figures and tables docs (probably named something like '08_figures.qmd' and '09_tables.qmd'). Add the following code there. **IMPORTANT**: The label in your captions/alt text csv must match the label in your plot's chunk options, **MINUS the "fig-" or "tab-"**. For example, the label "your_image_label_name" in the csv would match up properly with the "tbl-your_image_label_name" label in this code: diff --git a/vignettes/articles/snippets/add-plots_rda.Rmd b/vignettes/articles/snippets/add-plots_rda.Rmd index 07ca097f..6eaddc13 100644 --- a/vignettes/articles/snippets/add-plots_rda.Rmd +++ b/vignettes/articles/snippets/add-plots_rda.Rmd @@ -1,6 +1,6 @@ ### Add custom tables and figures {#sec-add-plots_rda} -This step will alter your figures and tables docs (probably named something like '09_tables.qmd' and '08_figures.qmd'), located in your 'report' folder. +This step will alter your figures and tables docs (probably named something like '08_figures.qmd' and '09_tables.qmd'), located in your 'report' folder. As a reminder, this workflow assumes that you have tables and/or figures stored in rda files. If you don't have those rda files, please see the [Export your custom tables and figures](#sec-export-custom-figs-tables) section to create them. From 0b5ec5fc235c0a9f622b30e2d696d748bc3fa08d Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Mon, 17 Aug 2026 16:58:26 +0000 Subject: [PATCH 03/11] Extend legacy figures/tables renaming for NEMT and SAFE Co-authored-by: sbreitbart-NOAA <181890943+sbreitbart-NOAA@users.noreply.github.com> --- R/create_figures_doc.R | 37 +++++++++++++++++++----- R/create_tables_doc.R | 37 +++++++++++++++++++----- tests/testthat/test-create_figures_doc.R | 28 ++++++++++++++++++ tests/testthat/test-create_tables_doc.R | 28 ++++++++++++++++++ 4 files changed, 116 insertions(+), 14 deletions(-) diff --git a/R/create_figures_doc.R b/R/create_figures_doc.R index 6669aa67..501faffa 100644 --- a/R/create_figures_doc.R +++ b/R/create_figures_doc.R @@ -249,18 +249,40 @@ rm(rda)\n ) ) } - legacy_figures_doc <- fs::path(subdir, "09_figures.qmd") - current_figures_doc <- fs::path(subdir, "08_figures.qmd") - using_legacy_figures_doc <- file.exists(legacy_figures_doc) && !file.exists(current_figures_doc) + legacy_figures_docs <- c("09_figures.qmd", "06_figures.qmd", "12_figures.qmd") + current_figures_docs <- c("08_figures.qmd", "05_figures.qmd", "11_figures.qmd") + legacy_tables_docs <- c("08_tables.qmd", "05_tables.qmd", "11_tables.qmd") + current_tables_docs <- c("09_tables.qmd", "06_tables.qmd", "12_tables.qmd") + legacy_match <- which( + file.exists(fs::path(subdir, legacy_figures_docs)) & + !file.exists(fs::path(subdir, current_figures_docs)) + ) + using_legacy_figures_doc <- length(legacy_match) > 0 if (using_legacy_figures_doc) { - cli::cli_alert_info("Detected legacy figure/table document order ({.file 08_tables.qmd} then {.file 09_figures.qmd}). {asar} now uses {.file 08_figures.qmd} then {.file 09_tables.qmd} to keep table-of-contents entries in logical order.") + legacy_match <- legacy_match[1] + legacy_figures_doc_name <- legacy_figures_docs[legacy_match] + legacy_tables_doc_name <- legacy_tables_docs[legacy_match] + current_figures_doc_name <- current_figures_docs[legacy_match] + current_tables_doc_name <- current_tables_docs[legacy_match] + } + + if (using_legacy_figures_doc) { + cli::cli_alert_info("Detected legacy figure/table document order ({.file {legacy_tables_doc_name}} then {.file {legacy_figures_doc_name}}). {asar} now uses {.file {current_figures_doc_name}} then {.file {current_tables_doc_name}} to keep table-of-contents entries in logical order.") + } + + current_figures_doc <- if (using_legacy_figures_doc) { + fs::path(subdir, current_figures_doc_name) + } else if (any(file.exists(fs::path(subdir, current_figures_docs)))) { + fs::path(subdir, current_figures_docs[which(file.exists(fs::path(subdir, current_figures_docs)))[1]]) + } else { + fs::path(subdir, "08_figures.qmd") } figures_doc_name <- if (using_legacy_figures_doc) { - "09_figures.qmd" + legacy_figures_doc_name } else if (file.exists(current_figures_doc)) { - "08_figures.qmd" + basename(current_figures_doc) } else if (any(grepl("_figures.qmd$", list.files(subdir)))) { list.files(subdir)[grep("_figures.qmd$", list.files(subdir))][1] } else { @@ -273,7 +295,8 @@ rm(rda)\n append = append ) - if (using_legacy_figures_doc && file.exists(legacy_figures_doc)) { + if (using_legacy_figures_doc) { + legacy_figures_doc <- fs::path(subdir, legacy_figures_doc_name) file.rename( from = legacy_figures_doc, to = current_figures_doc diff --git a/R/create_tables_doc.R b/R/create_tables_doc.R index dd35e7d9..108e3828 100644 --- a/R/create_tables_doc.R +++ b/R/create_tables_doc.R @@ -575,18 +575,40 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n ) } - legacy_tables_doc <- fs::path(subdir, "08_tables.qmd") - current_tables_doc <- fs::path(subdir, "09_tables.qmd") - using_legacy_tables_doc <- file.exists(legacy_tables_doc) && !file.exists(current_tables_doc) + legacy_tables_docs <- c("08_tables.qmd", "05_tables.qmd", "11_tables.qmd") + current_tables_docs <- c("09_tables.qmd", "06_tables.qmd", "12_tables.qmd") + legacy_figures_docs <- c("09_figures.qmd", "06_figures.qmd", "12_figures.qmd") + current_figures_docs <- c("08_figures.qmd", "05_figures.qmd", "11_figures.qmd") + + legacy_match <- which( + file.exists(fs::path(subdir, legacy_tables_docs)) & + !file.exists(fs::path(subdir, current_tables_docs)) + ) + using_legacy_tables_doc <- length(legacy_match) > 0 + if (using_legacy_tables_doc) { + legacy_match <- legacy_match[1] + legacy_tables_doc_name <- legacy_tables_docs[legacy_match] + legacy_figures_doc_name <- legacy_figures_docs[legacy_match] + current_tables_doc_name <- current_tables_docs[legacy_match] + current_figures_doc_name <- current_figures_docs[legacy_match] + } if (using_legacy_tables_doc) { - cli::cli_alert_info("Detected legacy figure/table document order ({.file 08_tables.qmd} then {.file 09_figures.qmd}). {asar} now uses {.file 08_figures.qmd} then {.file 09_tables.qmd} to keep table-of-contents entries in logical order.") + cli::cli_alert_info("Detected legacy figure/table document order ({.file {legacy_tables_doc_name}} then {.file {legacy_figures_doc_name}}). {asar} now uses {.file {current_figures_doc_name}} then {.file {current_tables_doc_name}} to keep table-of-contents entries in logical order.") + } + + current_tables_doc <- if (using_legacy_tables_doc) { + fs::path(subdir, current_tables_doc_name) + } else if (any(file.exists(fs::path(subdir, current_tables_docs)))) { + fs::path(subdir, current_tables_docs[which(file.exists(fs::path(subdir, current_tables_docs)))[1]]) + } else { + fs::path(subdir, "09_tables.qmd") } tables_doc_name <- if (using_legacy_tables_doc) { - "08_tables.qmd" + legacy_tables_doc_name } else if (file.exists(current_tables_doc)) { - "09_tables.qmd" + basename(current_tables_doc) } else if (any(grepl("_tables.qmd$", list.files(subdir)))) { list.files(subdir)[grep("_tables.qmd$", list.files(subdir))][1] } else { @@ -599,7 +621,8 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n append = append ) - if (using_legacy_tables_doc && file.exists(legacy_tables_doc)) { + if (using_legacy_tables_doc) { + legacy_tables_doc <- fs::path(subdir, legacy_tables_doc_name) file.rename( from = legacy_tables_doc, to = current_tables_doc diff --git a/tests/testthat/test-create_figures_doc.R b/tests/testthat/test-create_figures_doc.R index d9c3a0a3..2f6b8f93 100644 --- a/tests/testthat/test-create_figures_doc.R +++ b/tests/testthat/test-create_figures_doc.R @@ -187,3 +187,31 @@ test_that("Legacy figures doc name is renamed to new order", { file.remove(fs::path(getwd(), "08_figures.qmd")) }) + +test_that("Legacy NEMT figures doc name is renamed to new order", { + writeLines("# Figures {#sec-figures}", "06_figures.qmd") + + create_figures_doc( + subdir = getwd(), + figures_dir = getwd() + ) + + expect_true(file.exists("05_figures.qmd")) + expect_false(file.exists("06_figures.qmd")) + + file.remove(fs::path(getwd(), "05_figures.qmd")) +}) + +test_that("Legacy SAFE figures doc name is renamed to new order", { + writeLines("# Figures {#sec-figures}", "12_figures.qmd") + + create_figures_doc( + subdir = getwd(), + figures_dir = getwd() + ) + + expect_true(file.exists("11_figures.qmd")) + expect_false(file.exists("12_figures.qmd")) + + file.remove(fs::path(getwd(), "11_figures.qmd")) +}) diff --git a/tests/testthat/test-create_tables_doc.R b/tests/testthat/test-create_tables_doc.R index af611d56..117d87c6 100644 --- a/tests/testthat/test-create_tables_doc.R +++ b/tests/testthat/test-create_tables_doc.R @@ -196,3 +196,31 @@ test_that("Legacy tables doc name is renamed to new order", { file.remove(fs::path(getwd(), "09_tables.qmd")) }) + +test_that("Legacy NEMT tables doc name is renamed to new order", { + writeLines("# Tables {#sec-tables}", "05_tables.qmd") + + create_tables_doc( + subdir = getwd(), + tables_dir = getwd() + ) + + expect_true(file.exists("06_tables.qmd")) + expect_false(file.exists("05_tables.qmd")) + + file.remove(fs::path(getwd(), "06_tables.qmd")) +}) + +test_that("Legacy SAFE tables doc name is renamed to new order", { + writeLines("# Tables {#sec-tables}", "11_tables.qmd") + + create_tables_doc( + subdir = getwd(), + tables_dir = getwd() + ) + + expect_true(file.exists("12_tables.qmd")) + expect_false(file.exists("11_tables.qmd")) + + file.remove(fs::path(getwd(), "12_tables.qmd")) +}) From 44205c2ca1e854144b10b8e5364345a22a80d033 Mon Sep 17 00:00:00 2001 From: sbreitbart-NOAA Date: Mon, 17 Aug 2026 13:43:26 -0400 Subject: [PATCH 04/11] Update messages about figures/tables doc orders --- R/create_figures_doc.R | 3 ++- R/create_tables_doc.R | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/R/create_figures_doc.R b/R/create_figures_doc.R index 501faffa..06dcd2ac 100644 --- a/R/create_figures_doc.R +++ b/R/create_figures_doc.R @@ -268,7 +268,8 @@ rm(rda)\n } if (using_legacy_figures_doc) { - cli::cli_alert_info("Detected legacy figure/table document order ({.file {legacy_tables_doc_name}} then {.file {legacy_figures_doc_name}}). {asar} now uses {.file {current_figures_doc_name}} then {.file {current_tables_doc_name}} to keep table-of-contents entries in logical order.") + cli::cli_alert_info("Detected legacy figure/table document order ({.file {legacy_tables_doc_name}} & {.file {legacy_figures_doc_name}}). asar now uses {.file {current_figures_doc_name}} & {.file {current_tables_doc_name}} to maintain an accurate Table of Contents.") + cli::cli_alert_info("{.file {legacy_figures_doc_name}} will be renamed to {.file {current_figures_doc_name}}.") } current_figures_doc <- if (using_legacy_figures_doc) { diff --git a/R/create_tables_doc.R b/R/create_tables_doc.R index 108e3828..cd7f4869 100644 --- a/R/create_tables_doc.R +++ b/R/create_tables_doc.R @@ -594,7 +594,8 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n } if (using_legacy_tables_doc) { - cli::cli_alert_info("Detected legacy figure/table document order ({.file {legacy_tables_doc_name}} then {.file {legacy_figures_doc_name}}). {asar} now uses {.file {current_figures_doc_name}} then {.file {current_tables_doc_name}} to keep table-of-contents entries in logical order.") + cli::cli_alert_info("Detected legacy figure/table document order ({.file {legacy_tables_doc_name}} & {.file {legacy_figures_doc_name}}). asar now uses {.file {current_figures_doc_name}} & {.file {current_tables_doc_name}} to maintain an accurate Table of Contents.") + cli::cli_alert_info("{.file {legacy_tables_doc_name}} will be renamed to {.file {current_tables_doc_name}}.") } current_tables_doc <- if (using_legacy_tables_doc) { From c733d546f90a159dab2782d5cc0551ce6dfa846e Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Mon, 17 Aug 2026 17:47:37 +0000 Subject: [PATCH 05/11] Update rerender workflow for legacy figure/table order Co-authored-by: sbreitbart-NOAA <181890943+sbreitbart-NOAA@users.noreply.github.com> --- R/create_template.R | 62 ++++++++++++++++++++++++++- tests/testthat/test-create_template.R | 38 ++++++++++++++++ 2 files changed, 98 insertions(+), 2 deletions(-) diff --git a/R/create_template.R b/R/create_template.R index ce132828..a852c079 100644 --- a/R/create_template.R +++ b/R/create_template.R @@ -663,6 +663,37 @@ create_template <- function( # prev_skeleton <- NULL } # close if rerender + legacy_tables_docs <- c("08_tables.qmd", "05_tables.qmd", "11_tables.qmd") + current_tables_docs <- c("09_tables.qmd", "06_tables.qmd", "12_tables.qmd") + legacy_figures_docs <- c("09_figures.qmd", "06_figures.qmd", "12_figures.qmd") + current_figures_docs <- c("08_figures.qmd", "05_figures.qmd", "11_figures.qmd") + + legacy_match <- which( + file.exists(fs::path(subdir, legacy_tables_docs)) & + file.exists(fs::path(subdir, legacy_figures_docs)) & + !file.exists(fs::path(subdir, current_tables_docs)) & + !file.exists(fs::path(subdir, current_figures_docs)) + ) + using_legacy_doc_order <- rerender_skeleton && length(legacy_match) > 0 + if (using_legacy_doc_order) { + legacy_match <- legacy_match[1] + legacy_tables_doc_name <- legacy_tables_docs[legacy_match] + current_tables_doc_name <- current_tables_docs[legacy_match] + legacy_figures_doc_name <- legacy_figures_docs[legacy_match] + current_figures_doc_name <- current_figures_docs[legacy_match] + + file.rename( + from = fs::path(subdir, legacy_tables_doc_name), + to = fs::path(subdir, current_tables_doc_name) + ) + file.rename( + from = fs::path(subdir, legacy_figures_doc_name), + to = fs::path(subdir, current_figures_doc_name) + ) + + cli::cli_alert_info("Detected legacy figure/table document order in the skeleton. asar will switch to {.file {current_figures_doc_name}} before {.file {current_tables_doc_name}}.") + } + # created tables doc if (!rerender_skeleton) { { @@ -688,7 +719,11 @@ create_template <- function( # suppressWarnings() } else { # extract name for tables.qmd from report folder - tables_doc_name <- list.files(file_dir, pattern = "tables.qmd") + tables_doc_name <- if (using_legacy_doc_order) { + current_tables_doc_name + } else { + list.files(file_dir, pattern = "tables.qmd") + } } # Create figures qmd @@ -712,7 +747,11 @@ create_template <- function( } } else { # extract name for figures.qmd from report folder - figures_doc_name <- list.files(file_dir, pattern = "figures.qmd") + figures_doc_name <- if (using_legacy_doc_order) { + current_figures_doc_name + } else { + list.files(file_dir, pattern = "figures.qmd") + } } # Part I @@ -1110,6 +1149,25 @@ create_template <- function( ) |> unlist() |> purrr::discard(~ .x == "") + + if (using_legacy_doc_order) { + sections <- sections |> + stringr::str_replace_all(legacy_tables_doc_name, current_tables_doc_name) |> + stringr::str_replace_all(legacy_figures_doc_name, current_figures_doc_name) + + figure_position <- which(sections == current_figures_doc_name) + table_position <- which(sections == current_tables_doc_name) + if (length(figure_position) == 1 && length(table_position) == 1 && figure_position > table_position) { + sections <- sections[sections != current_figures_doc_name] + table_position <- which(sections == current_tables_doc_name) + sections <- append( + sections, + current_figures_doc_name, + after = table_position - 1 + ) + } + } + # add sections as list sections <- add_child( sections, diff --git a/tests/testthat/test-create_template.R b/tests/testthat/test-create_template.R index 95095f2a..14c02e96 100644 --- a/tests/testthat/test-create_template.R +++ b/tests/testthat/test-create_template.R @@ -238,6 +238,44 @@ test_that("warning is triggered for existing files", { unlink(fs::path(path, "report"), recursive = T) }) +test_that("rerender updates legacy figures/tables order in skeleton", { + 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) |> 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_length(grep("09_figures.qmd|08_tables.qmd", updated_skeleton), 0) + expect_lt(updated_figures_idx, updated_tables_idx) + + unlink(report_dir, recursive = TRUE) +}) + test_that("file_dir works", { dir <- fs::path(getwd(), "data") on.exit(unlink(dir, recursive = TRUE), add = TRUE) From e84b002bb8f13f1c42d7de2989f76eec76c2a912 Mon Sep 17 00:00:00 2001 From: sbreitbart-NOAA Date: Mon, 17 Aug 2026 15:19:50 -0400 Subject: [PATCH 06/11] Update messages --- R/create_tables_doc.R | 4 ++-- R/create_template.R | 3 ++- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/R/create_tables_doc.R b/R/create_tables_doc.R index cd7f4869..fd92ef60 100644 --- a/R/create_tables_doc.R +++ b/R/create_tables_doc.R @@ -594,8 +594,8 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n } if (using_legacy_tables_doc) { - cli::cli_alert_info("Detected legacy figure/table document order ({.file {legacy_tables_doc_name}} & {.file {legacy_figures_doc_name}}). asar now uses {.file {current_figures_doc_name}} & {.file {current_tables_doc_name}} to maintain an accurate Table of Contents.") - cli::cli_alert_info("{.file {legacy_tables_doc_name}} will be renamed to {.file {current_tables_doc_name}}.") + cli::cli_alert_info("Detected legacy figure/table document order ({.file {legacy_tables_doc_name}} & {.file {legacy_figures_doc_name}}). asar now uses {.file {current_figures_doc_name}} & {.file {current_tables_doc_name}} to maintain an accurate Table of Contents.") + cli::cli_alert_info("{.file {legacy_tables_doc_name}} will be renamed to {.file {current_tables_doc_name}}.") } current_tables_doc <- if (using_legacy_tables_doc) { diff --git a/R/create_template.R b/R/create_template.R index a852c079..1a90bf03 100644 --- a/R/create_template.R +++ b/R/create_template.R @@ -691,7 +691,8 @@ create_template <- function( to = fs::path(subdir, current_figures_doc_name) ) - cli::cli_alert_info("Detected legacy figure/table document order in the skeleton. asar will switch to {.file {current_figures_doc_name}} before {.file {current_tables_doc_name}}.") + cli::cli_alert_info("Detected legacy figure/table document order in the skeleton. asar now uses {.file {current_figures_doc_name}} & {.file {current_tables_doc_name}} to maintain an accurate Table of Contents.") + cli::cli_alert_info("Skeleton will be updated to show figures before tables.") } # created tables doc From 3f65c68fce62dad6e5baa01bb7e13dcdd519d6ac Mon Sep 17 00:00:00 2001 From: sbreitbart-NOAA Date: Mon, 17 Aug 2026 16:05:45 -0400 Subject: [PATCH 07/11] Fix tests --- tests/testthat/test-create_template.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-create_template.R b/tests/testthat/test-create_template.R index 14c02e96..42302319 100644 --- a/tests/testthat/test-create_template.R +++ b/tests/testthat/test-create_template.R @@ -260,7 +260,8 @@ test_that("rerender updates legacy figures/tables order in skeleton", { to = fs::path(report_dir, "08_tables.qmd") ) - create_template(rerender_skeleton = TRUE) |> suppressWarnings() + 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) @@ -352,8 +353,8 @@ test_that("model_results metadata file created", { "05_discussion.qmd", "06_acknowledgments.qmd", "07_references.qmd", - "09_tables.qmd", "08_figures.qmd", + "09_tables.qmd", # "10_notes.qmd", "11_appendix.qmd", "sar_species_skeleton.qmd", @@ -373,7 +374,6 @@ test_that("model_results metadata file created", { # erase temporary testing files unlink(file_path, recursive = T) - file.remove(fs::path(getwd(), "std_output.rda")) }) test_that("function aborts if `authors` improperly formatted", { From fdec66a5131beb6a5fb80d40e3b9e0a5d035648f Mon Sep 17 00:00:00 2001 From: sbreitbart-NOAA Date: Thu, 20 Aug 2026 16:40:42 -0400 Subject: [PATCH 08/11] Move duplicated code from create_tables/figures_doc() into utils --- R/create_figures_doc.R | 67 +++++++++++++-------------------------- R/create_tables_doc.R | 71 +++++++++++++----------------------------- R/utils.R | 58 ++++++++++++++++++++++++++++++++++ 3 files changed, 101 insertions(+), 95 deletions(-) diff --git a/R/create_figures_doc.R b/R/create_figures_doc.R index 06dcd2ac..88f887c8 100644 --- a/R/create_figures_doc.R +++ b/R/create_figures_doc.R @@ -249,68 +249,43 @@ rm(rda)\n ) ) } - legacy_figures_docs <- c("09_figures.qmd", "06_figures.qmd", "12_figures.qmd") - current_figures_docs <- c("08_figures.qmd", "05_figures.qmd", "11_figures.qmd") - legacy_tables_docs <- c("08_tables.qmd", "05_tables.qmd", "11_tables.qmd") - current_tables_docs <- c("09_tables.qmd", "06_tables.qmd", "12_tables.qmd") - legacy_match <- which( - file.exists(fs::path(subdir, legacy_figures_docs)) & - !file.exists(fs::path(subdir, current_figures_docs)) - ) - using_legacy_figures_doc <- length(legacy_match) > 0 - if (using_legacy_figures_doc) { - legacy_match <- legacy_match[1] - legacy_figures_doc_name <- legacy_figures_docs[legacy_match] - legacy_tables_doc_name <- legacy_tables_docs[legacy_match] - current_figures_doc_name <- current_figures_docs[legacy_match] - current_tables_doc_name <- current_tables_docs[legacy_match] - } - - if (using_legacy_figures_doc) { - cli::cli_alert_info("Detected legacy figure/table document order ({.file {legacy_tables_doc_name}} & {.file {legacy_figures_doc_name}}). asar now uses {.file {current_figures_doc_name}} & {.file {current_tables_doc_name}} to maintain an accurate Table of Contents.") - cli::cli_alert_info("{.file {legacy_figures_doc_name}} will be renamed to {.file {current_figures_doc_name}}.") - } - - current_figures_doc <- if (using_legacy_figures_doc) { - fs::path(subdir, current_figures_doc_name) - } else if (any(file.exists(fs::path(subdir, current_figures_docs)))) { - fs::path(subdir, current_figures_docs[which(file.exists(fs::path(subdir, current_figures_docs)))[1]]) + fig_doc_data <- id_fig_tab_num( + subdir = subdir, + fig_or_tab = "figure" + ) + legacy_fig_status <- ifelse(!is.null(fig_doc_data), + fig_doc_data[[1]], + FALSE) + legacy_doc_name <- fig_doc_data[[2]] + if (!is.null(fig_doc_data)){ + current_doc_name <- fig_doc_data[[3]] + } else if (exists("existing_figs_doc")) { + current_doc_name <- basename(existing_figs_doc) } else { - fs::path(subdir, "08_figures.qmd") + current_doc_name <- "08_figures.qmd" } - - figures_doc_name <- if (using_legacy_figures_doc) { - legacy_figures_doc_name - } else if (file.exists(current_figures_doc)) { - basename(current_figures_doc) - } else if (any(grepl("_figures.qmd$", list.files(subdir)))) { - list.files(subdir)[grep("_figures.qmd$", list.files(subdir))][1] - } else { - "08_figures.qmd" - } - # Save figures doc to template folder utils::capture.output(cat(figures_doc), - file = fs::path(subdir, figures_doc_name), + file = fs::path(subdir, current_doc_name), append = append ) - if (using_legacy_figures_doc) { - legacy_figures_doc <- fs::path(subdir, legacy_figures_doc_name) + if (legacy_fig_status) { + legacy_figures_doc <- fs::path(subdir, legacy_doc_name) file.rename( - from = legacy_figures_doc, - to = current_figures_doc + from = legacy_doc_name, + to = current_doc_name ) } # Read through figures doc and warn about identical labels - doc_path <- if (file.exists(current_figures_doc)) { - current_figures_doc + doc_path <- if (file.exists(current_doc_name)) { + current_doc_name } else if (any(grepl("_figures.qmd$", list.files(subdir)))) { fs::path(subdir, list.files(subdir)[grep("_figures.qmd$", list.files(subdir))][1]) } else { - current_figures_doc + current_doc_name } fix_duplicate_chunks( diff --git a/R/create_tables_doc.R b/R/create_tables_doc.R index fd92ef60..f265098f 100644 --- a/R/create_tables_doc.R +++ b/R/create_tables_doc.R @@ -575,68 +575,41 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n ) } - legacy_tables_docs <- c("08_tables.qmd", "05_tables.qmd", "11_tables.qmd") - current_tables_docs <- c("09_tables.qmd", "06_tables.qmd", "12_tables.qmd") - legacy_figures_docs <- c("09_figures.qmd", "06_figures.qmd", "12_figures.qmd") - current_figures_docs <- c("08_figures.qmd", "05_figures.qmd", "11_figures.qmd") - - legacy_match <- which( - file.exists(fs::path(subdir, legacy_tables_docs)) & - !file.exists(fs::path(subdir, current_tables_docs)) + tab_doc_data <- id_fig_tab_num( + subdir = subdir, + fig_or_tab = "table" ) - using_legacy_tables_doc <- length(legacy_match) > 0 - if (using_legacy_tables_doc) { - legacy_match <- legacy_match[1] - legacy_tables_doc_name <- legacy_tables_docs[legacy_match] - legacy_figures_doc_name <- legacy_figures_docs[legacy_match] - current_tables_doc_name <- current_tables_docs[legacy_match] - current_figures_doc_name <- current_figures_docs[legacy_match] - } - - if (using_legacy_tables_doc) { - cli::cli_alert_info("Detected legacy figure/table document order ({.file {legacy_tables_doc_name}} & {.file {legacy_figures_doc_name}}). asar now uses {.file {current_figures_doc_name}} & {.file {current_tables_doc_name}} to maintain an accurate Table of Contents.") - cli::cli_alert_info("{.file {legacy_tables_doc_name}} will be renamed to {.file {current_tables_doc_name}}.") - } - - current_tables_doc <- if (using_legacy_tables_doc) { - fs::path(subdir, current_tables_doc_name) - } else if (any(file.exists(fs::path(subdir, current_tables_docs)))) { - fs::path(subdir, current_tables_docs[which(file.exists(fs::path(subdir, current_tables_docs)))[1]]) + legacy_tab_status <- ifelse(!is.null(tab_doc_data), + tab_doc_data[[1]], + FALSE) + legacy_doc_name <- tab_doc_data[[2]] + if (!is.null(tab_doc_data)){ + current_doc_name <- tab_doc_data[[3]] + } else if (exists("existing_tables_doc")) { + current_doc_name <- basename(existing_tables_doc) } else { - fs::path(subdir, "09_tables.qmd") + current_doc_name <- "09_tables.qmd" } - - tables_doc_name <- if (using_legacy_tables_doc) { - legacy_tables_doc_name - } else if (file.exists(current_tables_doc)) { - basename(current_tables_doc) - } else if (any(grepl("_tables.qmd$", list.files(subdir)))) { - list.files(subdir)[grep("_tables.qmd$", list.files(subdir))][1] - } else { - "09_tables.qmd" - } - # Save tables doc to template folder utils::capture.output(cat(tables_doc), - file = fs::path(subdir, tables_doc_name), - append = append + file = fs::path(subdir, current_doc_name), + append = append ) - - if (using_legacy_tables_doc) { - legacy_tables_doc <- fs::path(subdir, legacy_tables_doc_name) + + if (legacy_tab_status) { + legacy_tables_doc <- fs::path(subdir, legacy_doc_name) file.rename( - from = legacy_tables_doc, - to = current_tables_doc + from = legacy_doc_name, + to = current_doc_name ) } - # Read through tables doc and warn about identical labels - doc_path <- if (file.exists(current_tables_doc)) { - current_tables_doc + doc_path <- if (file.exists(current_doc_name)) { + current_doc_name } else if (any(grepl("_tables.qmd$", list.files(subdir)))) { fs::path(subdir, list.files(subdir)[grep("_tables.qmd$", list.files(subdir))][1]) } else { - current_tables_doc + current_doc_name } fix_duplicate_chunks( diff --git a/R/utils.R b/R/utils.R index 0bce2c78..445ab6a8 100644 --- a/R/utils.R +++ b/R/utils.R @@ -413,3 +413,61 @@ format_citation_authors <- function(author_names) { glue::glue_collapse(sep = ", ", last = ", and ") |> as.character() } + +#-------- update figures/tables doc numbers + +id_fig_tab_num <- function(subdir, + fig_or_tab) { + + if (fig_or_tab == "figure"){ + legacy_docs <- c("09_figures.qmd", "06_figures.qmd", "12_figures.qmd") + current_docs <- c("08_figures.qmd", "05_figures.qmd", "11_figures.qmd") + } else { + legacy_docs <- c("08_tables.qmd", "05_tables.qmd", "11_tables.qmd") + current_docs <- c("09_tables.qmd", "06_tables.qmd", "12_tables.qmd") + } + + legacy_match <- which( + file.exists(fs::path(subdir, legacy_docs)) & + !file.exists(fs::path(subdir, current_docs)) + ) + using_legacy_doc <- length(legacy_match) > 0 + if (using_legacy_doc) { + legacy_match <- legacy_match[1] + legacy_doc_name <- legacy_docs[legacy_match] + current_doc_name <- current_docs[legacy_match] + + cli::cli_alert_info("Detected legacy figure/table document order ({.file {legacy_doc_name}} & {.file {legacy_doc_name}}). asar now uses {.file {current_doc_name}} & {.file {current_doc_name}} to maintain an accurate Table of Contents.") + cli::cli_alert_info("{.file {legacy_doc_name}} will be renamed to {.file {current_doc_name}}.") + } + + current_doc_path <- if (using_legacy_doc) { + fs::path(subdir, current_doc_name) + } else if (any(file.exists(fs::path(subdir, current_docs)))) { + fs::path(subdir, current_docs[which(file.exists(fs::path(subdir, current_docs)))[1]]) + } else { + fs::path(subdir, current_docs[1]) + } + + qmd_suffix <- ifelse(fig_or_tab == "figure", + "_figures.qmd$", + "_tables.qmd$") + + qmd_name <- if (using_legacy_doc) { + legacy_doc_name + } else if (file.exists(current_doc_path)) { + basename(current_doc_path) + } else if (any(grepl(qmd_suffix, list.files(subdir)))) { + list.files(subdir)[grep(qmd_suffix, list.files(subdir))][1] + } else { + fs::path(subdir, "08_figures.qmd") + } + + if (using_legacy_doc) { + return( + list(using_legacy_doc = using_legacy_doc, + legacy_doc_name = legacy_doc_name, + current_doc_name = current_doc_name) + ) + } +} From 5267704cb49d277aa6e7fd2092c9203a31d2caed Mon Sep 17 00:00:00 2001 From: sbreitbart-NOAA Date: Fri, 21 Aug 2026 14:09:58 -0400 Subject: [PATCH 09/11] Enable entire pipeline to work --- R/create_figures_doc.R | 77 ++++++++++---------- R/create_tables_doc.R | 68 +++++++++--------- R/create_template.R | 74 +++++++++---------- R/utils.R | 94 ++++++++++++++----------- tests/testthat/08_tables.qmd | 1 + tests/testthat/test-create_tables_doc.R | 26 +++---- 6 files changed, 171 insertions(+), 169 deletions(-) create mode 100644 tests/testthat/08_tables.qmd diff --git a/R/create_figures_doc.R b/R/create_figures_doc.R index 88f887c8..242c9a46 100644 --- a/R/create_figures_doc.R +++ b/R/create_figures_doc.R @@ -3,7 +3,12 @@ #' @param subdir Location of subdirectory storing the assessment report template #' @param figures_dir The location of the "figures" folder, which contains #' figures files. -#' +#' @param figures_doc_name (Optional) Filename for the figures doc written in +#' `subdir` (e.g., `"05_figures.qmd"`). If NULL, the function auto-detects an +#' existing `*_figures.qmd` file, or defaults to `"08_figures.qmd"`. +#' +#' Default: NULL +#' #' @return A quarto document with pre-loaded R chunk that adds the #' stock assessment tables from the nmfs-ost/stockplotr R package. The #' quarto document will become part of the stock assessment outline. @@ -17,15 +22,26 @@ #' ) #' } create_figures_doc <- function(subdir = getwd(), - figures_dir = getwd()) { + figures_dir = getwd(), + figures_doc_name = NULL) { empty_doc_text <- "Please refer to the `stockplotr` package downloaded from remotes::install_github('nmfs-ost/stockplotr') to add premade figures." fig_header <- "# Figures {#sec-figures}\n \n" + + existing_fig_docs <- list.files(subdir)[grepl("_figures.qmd$", list.files(subdir))] + target_fig_doc_name <- if (!is.null(figures_doc_name)) { + figures_doc_name + } else if (length(existing_fig_docs) > 0) { + existing_fig_docs[1] + } else { + "08_figures.qmd" + } + target_fig_doc <- fs::path(subdir, target_fig_doc_name) # append figure-producing code to non-empty figures doc, if it exists, vs. overwriting it append <- FALSE - if (length(file.path(subdir, list.files(subdir, pattern = "figures.qmd"))) == 1) { - existing_figs_doc <- file.path(subdir, list.files(subdir, pattern = "figures.qmd")) + if (file.exists(target_fig_doc)) { + existing_figs_doc <- target_fig_doc figure_content <- readLines(existing_figs_doc) |> suppressWarnings() if ("# Figures {#sec-figures}" %in% figure_content) { @@ -77,8 +93,8 @@ create_figures_doc <- function(subdir = getwd(), # Check if rda or non-rda already exists and remove from list new_rda <- FALSE new_non.rda <- FALSE - if (length(file.path(subdir, list.files(subdir, pattern = "figures.qmd"))) == 1) { - existing_figs_doc <- file.path(subdir, list.files(subdir, pattern = "figures.qmd")) + if (file.exists(target_fig_doc)) { + existing_figs_doc <- target_fig_doc figure_content <- readLines(existing_figs_doc) |> suppressWarnings() # find all instances of figures @@ -159,7 +175,7 @@ rm(rda)\n } if (length(file_list) == 0) { - if (length(file.path(subdir, list.files(subdir, pattern = "figures.qmd"))) != 1) { + if (!file.exists(target_fig_doc)) { cli::cli_alert_warning("Found zero figure files in {fs::path(figures_dir, 'figures')}.", wrap = TRUE ) @@ -251,45 +267,30 @@ rm(rda)\n } fig_doc_data <- id_fig_tab_num( - subdir = subdir, - fig_or_tab = "figure" - ) - legacy_fig_status <- ifelse(!is.null(fig_doc_data), - fig_doc_data[[1]], - FALSE) - legacy_doc_name <- fig_doc_data[[2]] - if (!is.null(fig_doc_data)){ - current_doc_name <- fig_doc_data[[3]] - } else if (exists("existing_figs_doc")) { - current_doc_name <- basename(existing_figs_doc) - } else { - current_doc_name <- "08_figures.qmd" - } + subdir = subdir, + fig_or_tab = "figure", + type = "default" + ) + + legacy_fig_status <- isTRUE(fig_doc_data$using_legacy_doc) + # detected_doc_name <- fig_doc_data$detected_doc_name + # Save figures doc to template folder utils::capture.output(cat(figures_doc), - file = fs::path(subdir, current_doc_name), - append = append + file = target_fig_doc, + append = append ) - - if (legacy_fig_status) { - legacy_figures_doc <- fs::path(subdir, legacy_doc_name) + + if (legacy_fig_status && !is.null(fig_doc_data$detected_doc_name)) { file.rename( - from = legacy_doc_name, - to = current_doc_name + from = fig_doc_data$detected_doc_name, + to = target_fig_doc_name ) } - + # Read through figures doc and warn about identical labels - doc_path <- if (file.exists(current_doc_name)) { - current_doc_name - } else if (any(grepl("_figures.qmd$", list.files(subdir)))) { - fs::path(subdir, list.files(subdir)[grep("_figures.qmd$", list.files(subdir))][1]) - } else { - current_doc_name - } - fix_duplicate_chunks( - doc_path = doc_path, + doc_path = target_fig_doc, doc_type = "Figures" ) } diff --git a/R/create_tables_doc.R b/R/create_tables_doc.R index f265098f..a570ae47 100644 --- a/R/create_tables_doc.R +++ b/R/create_tables_doc.R @@ -18,6 +18,12 @@ #' @param tables_dir The location of the "tables" folder, which contains tables #' files. #' +#' @param tables_doc_name (Optional) Filename for the figures doc written in +#' `subdir` (e.g., `"06_tables.qmd"`). If NULL, the function auto-detects an +#' existing `*_tables.qmd` file, or defaults to `"09_tables.qmd"`. +#' +#' Default: NULL +#' #' @return Create a quarto document as part of a stock assessment outline with #' pre-loaded R chunks that add stock assessment tables from the nmfs-ost/stockplotr #' R package, or other tables in the same rda format. @@ -31,7 +37,8 @@ #' ) #' } create_tables_doc <- function(subdir = getwd(), - tables_dir = getwd()) { + tables_dir = getwd(), + tables_doc_name = NULL) { # NOTE: essential_columns = 1 for all tables split using export_split_tbls() in # the code below. # To customize essential_columns, the user must run export_split_tbls() manually @@ -50,10 +57,20 @@ create_tables_doc <- function(subdir = getwd(), tab_header <- "# Tables {#sec-tables}\n \n" + existing_table_docs <- list.files(subdir)[grepl("_tables.qmd$", list.files(subdir))] + target_table_doc_name <- if (!is.null(tables_doc_name)) { + tables_doc_name + } else if (length(existing_table_docs) > 0) { + existing_table_docs[1] + } else { + "09_tables.qmd" + } + target_table_doc <- fs::path(subdir, target_table_doc_name) + # append table-producing code to non-empty tables doc, if it exists, vs. overwriting it append <- FALSE - if (length(file.path(subdir, list.files(subdir, pattern = "tables.qmd"))) == 1) { - existing_tables_doc <- file.path(subdir, list.files(subdir, pattern = "tables.qmd")) + if (file.exists(target_table_doc)) { + existing_tables_doc <- target_table_doc table_content <- readLines(existing_tables_doc) |> suppressWarnings() @@ -113,8 +130,8 @@ create_tables_doc <- function(subdir = getwd(), # Check if rda already exists and remove from list # Check if rda or non-rda already exists and remove from list new_rda <- FALSE - if (length(file.path(subdir, list.files(subdir, pattern = "tables.qmd"))) == 1) { - existing_tbls_doc <- file.path(subdir, list.files(subdir, pattern = "tables.qmd")) + if (file.exists(target_table_doc)) { + existing_tbls_doc <- target_table_doc table_content <- readLines(existing_tbls_doc) |> suppressWarnings() # find all instances of figures @@ -505,7 +522,7 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n } if (length(rda_tab_list) == 0) { - if (length(file.path(subdir, list.files(subdir, pattern = "tables.qmd"))) != 1) { + if (!file.exists(target_table_doc)) { cli::cli_alert_warning("Found zero tables in an rda format (i.e., .rda) in {fs::path(tables_dir, 'tables')}.", wrap = TRUE ) @@ -577,43 +594,28 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n tab_doc_data <- id_fig_tab_num( subdir = subdir, - fig_or_tab = "table" + fig_or_tab = "table", + type = "default" ) - legacy_tab_status <- ifelse(!is.null(tab_doc_data), - tab_doc_data[[1]], - FALSE) - legacy_doc_name <- tab_doc_data[[2]] - if (!is.null(tab_doc_data)){ - current_doc_name <- tab_doc_data[[3]] - } else if (exists("existing_tables_doc")) { - current_doc_name <- basename(existing_tables_doc) - } else { - current_doc_name <- "09_tables.qmd" - } + + legacy_tab_status <- isTRUE(tab_doc_data$using_legacy_doc) + # Save tables doc to template folder utils::capture.output(cat(tables_doc), - file = fs::path(subdir, current_doc_name), + file = target_table_doc, append = append ) - if (legacy_tab_status) { - legacy_tables_doc <- fs::path(subdir, legacy_doc_name) + if (legacy_tab_status && !is.null(tab_doc_data$detected_doc_name)) { file.rename( - from = legacy_doc_name, - to = current_doc_name + from = tab_doc_data$detected_doc_name, + to = target_table_doc_name ) } + # Read through tables doc and warn about identical labels - doc_path <- if (file.exists(current_doc_name)) { - current_doc_name - } else if (any(grepl("_tables.qmd$", list.files(subdir)))) { - fs::path(subdir, list.files(subdir)[grep("_tables.qmd$", list.files(subdir))][1]) - } else { - current_doc_name - } - fix_duplicate_chunks( - doc_path = doc_path, + doc_path = target_table_doc, doc_type = "Tables" ) -} +} \ No newline at end of file diff --git a/R/create_template.R b/R/create_template.R index 1a90bf03..206bdcce 100644 --- a/R/create_template.R +++ b/R/create_template.R @@ -663,25 +663,26 @@ create_template <- function( # prev_skeleton <- NULL } # close if rerender - legacy_tables_docs <- c("08_tables.qmd", "05_tables.qmd", "11_tables.qmd") - current_tables_docs <- c("09_tables.qmd", "06_tables.qmd", "12_tables.qmd") - legacy_figures_docs <- c("09_figures.qmd", "06_figures.qmd", "12_figures.qmd") - current_figures_docs <- c("08_figures.qmd", "05_figures.qmd", "11_figures.qmd") - - legacy_match <- which( - file.exists(fs::path(subdir, legacy_tables_docs)) & - file.exists(fs::path(subdir, legacy_figures_docs)) & - !file.exists(fs::path(subdir, current_tables_docs)) & - !file.exists(fs::path(subdir, current_figures_docs)) + doc_type <- ifelse(type %in% c("nemt", "safe"), type, "default") + tab_doc_data <- id_fig_tab_num( + subdir = subdir, + fig_or_tab = "table", + type = doc_type ) - using_legacy_doc_order <- rerender_skeleton && length(legacy_match) > 0 + fig_doc_data <- id_fig_tab_num( + subdir = subdir, + fig_or_tab = "figure", + type = doc_type + ) + legacy_tables_doc_name <- tab_doc_data$legacy_doc_name + current_tables_doc_name <- tab_doc_data$current_doc_name + legacy_figures_doc_name <- fig_doc_data$legacy_doc_name + current_figures_doc_name <- fig_doc_data$current_doc_name + + using_legacy_doc_order <- rerender_skeleton && + tab_doc_data$using_legacy_doc && + fig_doc_data$using_legacy_doc if (using_legacy_doc_order) { - legacy_match <- legacy_match[1] - legacy_tables_doc_name <- legacy_tables_docs[legacy_match] - current_tables_doc_name <- current_tables_docs[legacy_match] - legacy_figures_doc_name <- legacy_figures_docs[legacy_match] - current_figures_doc_name <- current_figures_docs[legacy_match] - file.rename( from = fs::path(subdir, legacy_tables_doc_name), to = fs::path(subdir, current_tables_doc_name) @@ -690,7 +691,7 @@ create_template <- function( from = fs::path(subdir, legacy_figures_doc_name), to = fs::path(subdir, current_figures_doc_name) ) - + cli::cli_alert_info("Detected legacy figure/table document order in the skeleton. asar now uses {.file {current_figures_doc_name}} & {.file {current_tables_doc_name}} to maintain an accurate Table of Contents.") cli::cli_alert_info("Skeleton will be updated to show figures before tables.") } @@ -698,11 +699,7 @@ create_template <- function( # created tables doc if (!rerender_skeleton) { { - tables_doc_name <- switch(type, - "nemt" = "06_tables.qmd", - "safe" = "12_tables.qmd", - "09_tables.qmd" - ) + tables_doc_name <- current_tables_doc_name tables_doc <- "" utils::capture.output(cat(tables_doc), file = fs::path(subdir, tables_doc_name), @@ -713,7 +710,8 @@ create_template <- function( create_tables_doc( subdir = subdir, - tables_dir = tables_dir + tables_dir = tables_dir, + tables_doc_name = tables_doc_name ) } # |> # suppressMessages() |> @@ -729,23 +727,20 @@ create_template <- function( # 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 <- current_figures_doc_name + figures_doc <- "" + utils::capture.output(cat(figures_doc), + file = fs::path(subdir, figures_doc_name), + append = FALSE + ) |> + suppressMessages() |> + suppressWarnings() create_figures_doc( subdir = subdir, - figures_dir = figures_dir + figures_dir = figures_dir, + figures_doc_name = figures_doc_name ) - # rename figures doc - if (figures_doc_name != "08_figures.qmd") { - file.rename( - from = fs::path(subdir, "08_figures.qmd"), - to = fs::path(subdir, figures_doc_name) - ) - } } else { # extract name for figures.qmd from report folder figures_doc_name <- if (using_legacy_doc_order) { @@ -1155,10 +1150,11 @@ create_template <- function( sections <- sections |> stringr::str_replace_all(legacy_tables_doc_name, current_tables_doc_name) |> stringr::str_replace_all(legacy_figures_doc_name, current_figures_doc_name) - + figure_position <- which(sections == current_figures_doc_name) table_position <- which(sections == current_tables_doc_name) - if (length(figure_position) == 1 && length(table_position) == 1 && figure_position > table_position) { + if (length(figure_position) == 1 && length(table_position) == 1 && + figure_position > table_position) { sections <- sections[sections != current_figures_doc_name] table_position <- which(sections == current_tables_doc_name) sections <- append( diff --git a/R/utils.R b/R/utils.R index 445ab6a8..23ab192a 100644 --- a/R/utils.R +++ b/R/utils.R @@ -415,59 +415,67 @@ format_citation_authors <- function(author_names) { } #-------- update figures/tables doc numbers +# +#' Identify correct figure/table qmd name +#' +#' @param subdir The subdirectory containing the figures or tables document. +#' +#' Default: working directory (getwd()) +#' +#' @param fig_or_tab Character string. Specifies application to a figure or table doc. +#' Options: "figure", "table" +#' +#' Default: "figure" +#' +#' @param type Character string. Specifies the type of document. +#' +#' Options: "default" (SAR), "nemt", "safe" +#' +#' Default: "default" +#' +#' @return A list containing information about the identified figure or table doc, +#' including whether a legacy document is being used, the names of the legacy +#' and current documents, and the detected document name. +#' @noRd -id_fig_tab_num <- function(subdir, - fig_or_tab) { - - if (fig_or_tab == "figure"){ - legacy_docs <- c("09_figures.qmd", "06_figures.qmd", "12_figures.qmd") - current_docs <- c("08_figures.qmd", "05_figures.qmd", "11_figures.qmd") +id_fig_tab_num <- function(subdir = getwd(), + fig_or_tab = "figure", + type = "default") { + if (fig_or_tab == "figure") { + legacy_docs <- c(default = "09_figures.qmd", nemt = "06_figures.qmd", safe = "12_figures.qmd") + current_docs <- c(default = "08_figures.qmd", nemt = "05_figures.qmd", safe = "11_figures.qmd") + qmd_suffix <- "_figures.qmd$" } else { - legacy_docs <- c("08_tables.qmd", "05_tables.qmd", "11_tables.qmd") - current_docs <- c("09_tables.qmd", "06_tables.qmd", "12_tables.qmd") - } - - legacy_match <- which( - file.exists(fs::path(subdir, legacy_docs)) & - !file.exists(fs::path(subdir, current_docs)) - ) - using_legacy_doc <- length(legacy_match) > 0 - if (using_legacy_doc) { - legacy_match <- legacy_match[1] - legacy_doc_name <- legacy_docs[legacy_match] - current_doc_name <- current_docs[legacy_match] - - cli::cli_alert_info("Detected legacy figure/table document order ({.file {legacy_doc_name}} & {.file {legacy_doc_name}}). asar now uses {.file {current_doc_name}} & {.file {current_doc_name}} to maintain an accurate Table of Contents.") - cli::cli_alert_info("{.file {legacy_doc_name}} will be renamed to {.file {current_doc_name}}.") + legacy_docs <- c(default = "08_tables.qmd", nemt = "05_tables.qmd", safe = "11_tables.qmd") + current_docs <- c(default = "09_tables.qmd", nemt = "06_tables.qmd", safe = "12_tables.qmd") + qmd_suffix <- "_tables.qmd$" } - current_doc_path <- if (using_legacy_doc) { - fs::path(subdir, current_doc_name) - } else if (any(file.exists(fs::path(subdir, current_docs)))) { - fs::path(subdir, current_docs[which(file.exists(fs::path(subdir, current_docs)))[1]]) - } else { - fs::path(subdir, current_docs[1]) - } + legacy_doc_name <- legacy_docs[[type]] + current_doc_name <- current_docs[[type]] - qmd_suffix <- ifelse(fig_or_tab == "figure", - "_figures.qmd$", - "_tables.qmd$") + using_legacy_doc <- file.exists(fs::path(subdir, legacy_doc_name)) && + !file.exists(fs::path(subdir, current_doc_name)) - qmd_name <- if (using_legacy_doc) { + detected_doc_name <- if (using_legacy_doc) { legacy_doc_name - } else if (file.exists(current_doc_path)) { - basename(current_doc_path) + } else if (file.exists(fs::path(subdir, current_doc_name))) { + current_doc_name } else if (any(grepl(qmd_suffix, list.files(subdir)))) { list.files(subdir)[grep(qmd_suffix, list.files(subdir))][1] } else { - fs::path(subdir, "08_figures.qmd") + current_doc_name } - + if (using_legacy_doc) { - return( - list(using_legacy_doc = using_legacy_doc, - legacy_doc_name = legacy_doc_name, - current_doc_name = current_doc_name) - ) + cli::cli_alert_info("Detected legacy figure/table document order ({.file {legacy_doc_name}} & {.file {legacy_doc_name}}). asar now uses {.file {current_doc_name}} & {.file {current_doc_name}} to maintain an accurate Table of Contents.") + cli::cli_alert_info("{.file {legacy_doc_name}} will be renamed to {.file {current_doc_name}}.") } -} + + list( + using_legacy_doc = using_legacy_doc, + legacy_doc_name = legacy_doc_name, + current_doc_name = current_doc_name, + detected_doc_name = detected_doc_name + ) +} \ No newline at end of file diff --git a/tests/testthat/08_tables.qmd b/tests/testthat/08_tables.qmd new file mode 100644 index 00000000..2b250fe4 --- /dev/null +++ b/tests/testthat/08_tables.qmd @@ -0,0 +1 @@ +# Tables {#sec-tables} diff --git a/tests/testthat/test-create_tables_doc.R b/tests/testthat/test-create_tables_doc.R index 117d87c6..d3ee443e 100644 --- a/tests/testthat/test-create_tables_doc.R +++ b/tests/testthat/test-create_tables_doc.R @@ -198,29 +198,23 @@ test_that("Legacy tables doc name is renamed to new order", { }) test_that("Legacy NEMT tables doc name is renamed to new order", { - writeLines("# Tables {#sec-tables}", "05_tables.qmd") - - create_tables_doc( - subdir = getwd(), - tables_dir = getwd() + create_template( + type = "nemt" ) - expect_true(file.exists("06_tables.qmd")) - expect_false(file.exists("05_tables.qmd")) + expect_true(file.exists(fs::path("report", "06_tables.qmd"))) + expect_false(file.exists(fs::path("report", "05_tables.qmd"))) - file.remove(fs::path(getwd(), "06_tables.qmd")) + unlink(fs::path(getwd(), "report"), recursive = T) }) test_that("Legacy SAFE tables doc name is renamed to new order", { - writeLines("# Tables {#sec-tables}", "11_tables.qmd") - - create_tables_doc( - subdir = getwd(), - tables_dir = getwd() + create_template( + type = "safe" ) - expect_true(file.exists("12_tables.qmd")) - expect_false(file.exists("11_tables.qmd")) + expect_true(file.exists(fs::path("report", "12_tables.qmd"))) + expect_false(file.exists(fs::path("report", "11_tables.qmd"))) - file.remove(fs::path(getwd(), "12_tables.qmd")) + unlink(fs::path(getwd(), "report"), recursive = T) }) From f47ada3b87ba2b554287c2129ddb6e42dd3e9568 Mon Sep 17 00:00:00 2001 From: sbreitbart-NOAA Date: Fri, 21 Aug 2026 14:58:33 -0400 Subject: [PATCH 10/11] Keep debugging pipeline; update tests --- R/create_figures_doc.R | 5 +- R/create_tables_doc.R | 5 +- R/create_template.R | 90 +++++++++++++----------- tests/testthat/08_tables.qmd | 1 - tests/testthat/test-create_figures_doc.R | 81 ++++++++++++++------- tests/testthat/test-create_tables_doc.R | 10 +-- 6 files changed, 116 insertions(+), 76 deletions(-) delete mode 100644 tests/testthat/08_tables.qmd diff --git a/R/create_figures_doc.R b/R/create_figures_doc.R index 242c9a46..20f34f80 100644 --- a/R/create_figures_doc.R +++ b/R/create_figures_doc.R @@ -283,9 +283,10 @@ rm(rda)\n if (legacy_fig_status && !is.null(fig_doc_data$detected_doc_name)) { file.rename( - from = fig_doc_data$detected_doc_name, - to = target_fig_doc_name + from = fs::path(subdir, fig_doc_data$detected_doc_name), + to = fs::path(subdir, fig_doc_data$current_doc_name) ) + target_fig_doc <- fs::path(subdir, fig_doc_data$current_doc_name) } # Read through figures doc and warn about identical labels diff --git a/R/create_tables_doc.R b/R/create_tables_doc.R index a570ae47..46a0d61e 100644 --- a/R/create_tables_doc.R +++ b/R/create_tables_doc.R @@ -608,9 +608,10 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n if (legacy_tab_status && !is.null(tab_doc_data$detected_doc_name)) { file.rename( - from = tab_doc_data$detected_doc_name, - to = target_table_doc_name + from = fs::path(subdir, tab_doc_data$detected_doc_name), + to = fs::path(subdir, tab_doc_data$current_doc_name) ) + target_table_doc <- fs::path(subdir, tab_doc_data$current_doc_name) } # Read through tables doc and warn about identical labels diff --git a/R/create_template.R b/R/create_template.R index 206bdcce..50cd9cc3 100644 --- a/R/create_template.R +++ b/R/create_template.R @@ -259,39 +259,35 @@ create_template <- function( ... ) { # Check input type - if (interactive()) { - type <- switch(type, - "Northeast Management Track" = "nemt", - "Pacific Fishery Management Council" = "pfmc", - "Stock Assessment and Fishery Evaluation" = "safe", - "Stock Assessment Report" = "skeleton", - "sar" = "skeleton", - "pfmc" = "pfmc", - "nemt" = "nemt", - "safe" = "safe", - { - type_fxn <- function() { - selection <- utils::menu( - title = "Unrecognized template type. Please select an option below: ", - choices = c("Default", "Pacific Fisheries Management Council", "Northeast Management Track", "SAFE") - ) - type <- switch(as.character(selection), - "1" = "skeleton", - "2" = "pfmc", - "3" = "nemt", - "4" = "safe", - { - "skeleton" - } - ) - return(type) - } - type_fxn() - } - ) - } else { - type <- "skeleton" - } + type <- switch(type, + "Northeast Management Track" = "nemt", + "Pacific Fishery Management Council" = "pfmc", + "Stock Assessment and Fishery Evaluation" = "safe", + "Stock Assessment Report" = "skeleton", + "sar" = "skeleton", + "pfmc" = "pfmc", + "nemt" = "nemt", + "safe" = "safe", + "skeleton" = "skeleton", + { + # If unrecognized AND interactive, show prompt + if (interactive()) { + selection <- utils::menu( + title = "Unrecognized template type. Please select an option below: ", + choices = c("Default", "Pacific Fisheries Management Council", "Northeast Management Track", "SAFE") + ) + switch(as.character(selection), + "1" = "skeleton", + "2" = "pfmc", + "3" = "nemt", + "4" = "safe", + "skeleton" + ) + } else { + "skeleton" + } + } + ) if (!is.null(office) & length(office) == 1) { office <- match.arg(office, choices = c("AFSC", "PIFSC", "NEFSC", "NWFSC", "SEFSC", "SWFSC"), several.ok = FALSE) @@ -683,14 +679,26 @@ create_template <- function( tab_doc_data$using_legacy_doc && fig_doc_data$using_legacy_doc if (using_legacy_doc_order) { - file.rename( - from = fs::path(subdir, legacy_tables_doc_name), - to = fs::path(subdir, current_tables_doc_name) - ) - file.rename( - from = fs::path(subdir, legacy_figures_doc_name), - to = fs::path(subdir, current_figures_doc_name) - ) + # 1. Safely copy & remove old table file + old_tbl_path <- fs::path(subdir, legacy_tables_doc_name) + new_tbl_path <- fs::path(subdir, current_tables_doc_name) + if (file.exists(old_tbl_path) && legacy_tables_doc_name != current_tables_doc_name) { + file.copy(from = old_tbl_path, to = new_tbl_path, overwrite = TRUE) + file.remove(old_tbl_path) + } + + # 2. Safely copy & remove old figure file (prevents 09_figures.qmd from persisting) + old_fig_path <- fs::path(subdir, legacy_figures_doc_name) + new_fig_path <- fs::path(subdir, current_figures_doc_name) + if (file.exists(old_fig_path) && legacy_figures_doc_name != current_figures_doc_name) { + file.copy(from = old_fig_path, to = new_fig_path, overwrite = TRUE) + file.remove(old_fig_path) + } + + # 3. Clean up prev_skeleton so knit_child references don't recreate the old filenames + prev_skeleton <- prev_skeleton |> + stringr::str_replace_all(legacy_tables_doc_name, current_tables_doc_name) |> + stringr::str_replace_all(legacy_figures_doc_name, current_figures_doc_name) cli::cli_alert_info("Detected legacy figure/table document order in the skeleton. asar now uses {.file {current_figures_doc_name}} & {.file {current_tables_doc_name}} to maintain an accurate Table of Contents.") cli::cli_alert_info("Skeleton will be updated to show figures before tables.") diff --git a/tests/testthat/08_tables.qmd b/tests/testthat/08_tables.qmd deleted file mode 100644 index 2b250fe4..00000000 --- a/tests/testthat/08_tables.qmd +++ /dev/null @@ -1 +0,0 @@ -# Tables {#sec-tables} diff --git a/tests/testthat/test-create_figures_doc.R b/tests/testthat/test-create_figures_doc.R index 2f6b8f93..b6715f3f 100644 --- a/tests/testthat/test-create_figures_doc.R +++ b/tests/testthat/test-create_figures_doc.R @@ -82,7 +82,7 @@ test_that("Formerly empty figures doc renders correctly", { # read in figures doc figure_content <- readLines(file.path(getwd(), "report", "08_figures.qmd")) # extract first 7 lines - head_figure_content <- head(figure_content, 7) + head_figure_content <- head(figure_content, 6) # remove line numbers and collapse fc_pasted <- paste(head_figure_content, collapse = "") @@ -175,43 +175,72 @@ test_that("Adds new figure from figures folder.", { }) test_that("Legacy figures doc name is renamed to new order", { - writeLines("# Figures {#sec-figures}", "09_figures.qmd") - - create_figures_doc( - subdir = getwd(), - figures_dir = getwd() + # standalone figures doc + create_figures_doc() + + file.rename( + from = file.path(getwd(),"08_figures.qmd"), + to = file.path(getwd(), "09_figures.qmd") ) + + create_figures_doc() expect_true(file.exists("08_figures.qmd")) expect_false(file.exists("09_figures.qmd")) file.remove(fs::path(getwd(), "08_figures.qmd")) + + # figures doc within report directory + create_template() + + file.rename( + from = file.path(getwd(), "report", "08_figures.qmd"), + to = file.path(getwd(), "report", "09_figures.qmd") + ) + + create_template(rerender_skeleton = TRUE, + species = "my species", + file_dir = file.path(getwd(), "report")) + + expect_true(file.exists(file.path(getwd(), "report", "08_figures.qmd"))) + expect_false(file.exists(file.path(getwd(), "report", "09_figures.qmd"))) + + unlink(fs::path(getwd(), "report"), recursive = T) + }) test_that("Legacy NEMT figures doc name is renamed to new order", { - writeLines("# Figures {#sec-figures}", "06_figures.qmd") - - create_figures_doc( - subdir = getwd(), - figures_dir = getwd() + create_template(type = "nemt") + + file.rename( + from = file.path(getwd(), "report", "05_figures.qmd"), + to = file.path(getwd(), "report", "06_figures.qmd") ) - - expect_true(file.exists("05_figures.qmd")) - expect_false(file.exists("06_figures.qmd")) - - file.remove(fs::path(getwd(), "05_figures.qmd")) + + create_template(rerender_skeleton = TRUE, + species = "my species", + file_dir = file.path(getwd(), "report")) + + expect_true(file.exists(file.path(getwd(), "report", "05_figures.qmd"))) + expect_false(file.exists(file.path(getwd(), "report", "06_figures.qmd"))) + + unlink(fs::path(getwd(), "report"), recursive = T) }) test_that("Legacy SAFE figures doc name is renamed to new order", { - writeLines("# Figures {#sec-figures}", "12_figures.qmd") - - create_figures_doc( - subdir = getwd(), - figures_dir = getwd() + create_template(type = "nemt") + + file.rename( + from = file.path(getwd(), "report", "11_figures.qmd"), + to = file.path(getwd(), "report", "12_figures.qmd") ) - - expect_true(file.exists("11_figures.qmd")) - expect_false(file.exists("12_figures.qmd")) - - file.remove(fs::path(getwd(), "11_figures.qmd")) + + create_template(rerender_skeleton = TRUE, + species = "my species", + file_dir = file.path(getwd(), "report")) + + expect_true(file.exists(file.path(getwd(), "report", "11_figures.qmd"))) + expect_false(file.exists(file.path(getwd(), "report", "12_figures.qmd"))) + + unlink(fs::path(getwd(), "report"), recursive = T) }) diff --git a/tests/testthat/test-create_tables_doc.R b/tests/testthat/test-create_tables_doc.R index d3ee443e..18723313 100644 --- a/tests/testthat/test-create_tables_doc.R +++ b/tests/testthat/test-create_tables_doc.R @@ -201,13 +201,15 @@ test_that("Legacy NEMT tables doc name is renamed to new order", { create_template( type = "nemt" ) + + expect_true(file.exists(file.path(getwd(), "report", "06_tables.qmd"))) + expect_false(file.exists(file.path(getwd(), "report", "05_tables.qmd"))) - expect_true(file.exists(fs::path("report", "06_tables.qmd"))) - expect_false(file.exists(fs::path("report", "05_tables.qmd"))) - - unlink(fs::path(getwd(), "report"), recursive = T) + unlink(file.path(getwd(), "report"), recursive = T) }) + + test_that("Legacy SAFE tables doc name is renamed to new order", { create_template( type = "safe" From 8721e03712c9c27782c98fcefff0c884cca9486a Mon Sep 17 00:00:00 2001 From: Sophie Breitbart Date: Fri, 21 Aug 2026 16:48:16 -0400 Subject: [PATCH 11/11] convert repeated code into reusable functions; update tests; update create_template() to allow various types when interactive is F (#541) --- R/create_figures_doc.R | 118 ++--- R/create_tables_doc.R | 281 ++++------- R/create_template.R | 579 +++++++---------------- R/utils.R | 126 +++-- tests/testthat/test-create_figures_doc.R | 52 +- tests/testthat/test-create_tables_doc.R | 40 +- 6 files changed, 435 insertions(+), 761 deletions(-) diff --git a/R/create_figures_doc.R b/R/create_figures_doc.R index 20f34f80..f0928c64 100644 --- a/R/create_figures_doc.R +++ b/R/create_figures_doc.R @@ -25,20 +25,9 @@ create_figures_doc <- function(subdir = getwd(), figures_dir = getwd(), figures_doc_name = NULL) { empty_doc_text <- "Please refer to the `stockplotr` package downloaded from remotes::install_github('nmfs-ost/stockplotr') to add premade figures." - + fig_header <- "# Figures {#sec-figures}\n \n" - existing_fig_docs <- list.files(subdir)[grepl("_figures.qmd$", list.files(subdir))] - target_fig_doc_name <- if (!is.null(figures_doc_name)) { - figures_doc_name - } else if (length(existing_fig_docs) > 0) { - existing_fig_docs[1] - } else { - "08_figures.qmd" - } - target_fig_doc <- fs::path(subdir, target_fig_doc_name) - - # append figure-producing code to non-empty figures doc, if it exists, vs. overwriting it append <- FALSE if (file.exists(target_fig_doc)) { existing_figs_doc <- target_fig_doc @@ -47,23 +36,19 @@ create_figures_doc <- function(subdir = getwd(), if ("# Figures {#sec-figures}" %in% figure_content) { append <- TRUE cli::cli_alert_info("Figures doc will be appended to include figures in `figures_dir`.") - - # remove empty_doc_text + updated_content <- gsub(empty_doc_text, "", figure_content, fixed = TRUE) writeLines(updated_content, existing_figs_doc) } } else { - # existing_figs_doc <- NULL figure_content <- "" } - + figures_doc_header <- ifelse(append, - "", - fig_header + "", + fig_header ) - - # add chunk that creates object as the directory of all rdas - # check if the current setup already has the setup chunk + if (!(any(grepl( "#| label: 'set-rda-dir-figs'", figure_content, @@ -79,56 +64,45 @@ create_figures_doc <- function(subdir = getwd(), } else { figures_doc_setup <- "" } - + figures_doc <- "" - - # list all files in figures + file_list <- list.files(file.path(figures_dir, "figures")) - - # create sublist of only rda figure files + rda_fig_list <- file_list[grepl("_figure.rda", file_list)] - # create sublist of only non-rda figure files non.rda_fig_list <- file_list[!grepl(".rda", file_list)] - - # Check if rda or non-rda already exists and remove from list + new_rda <- FALSE new_non.rda <- FALSE if (file.exists(target_fig_doc)) { existing_figs_doc <- target_fig_doc figure_content <- readLines(existing_figs_doc) |> suppressWarnings() - # find all instances of figures existing_rda_figs <- vapply(rda_fig_list, function(x) { any(grepl(x, figure_content, fixed = TRUE)) }, FUN.VALUE = logical(1)) rda_fig_list <- rda_fig_list[!existing_rda_figs] - # add condition for message to add "new" into message new_rda <- ifelse( length(existing_rda_figs) > 0, TRUE, FALSE ) - # find instances of non-rda and remove existing_non.rda_figs <- vapply(non.rda_fig_list, function(x) { any(grepl(x, figure_content, fixed = TRUE)) }, FUN.VALUE = logical(1)) non.rda_fig_list <- non.rda_fig_list[!existing_non.rda_figs] - # add condition for message to add "new" into message new_non.rda <- ifelse( length(existing_non.rda_figs) > 0, TRUE, FALSE ) } - - # create two-chunk system to plot each rda figure + create_fig_chunks <- function(fig = NA, figures_dir = getwd()) { fig_shortname <- stringr::str_remove(fig, "_figure.rda") - - ## import plot, caption, alt text + figures_doc_plot_setup1 <- paste0( - # figures_doc, add_chunk( paste0( "# load rda @@ -146,14 +120,11 @@ rm(rda)\n ), "\n" ) - - ## make figure chunk + figures_doc_plot_setup2 <- paste0( - # figures_doc_plot_setup1, add_chunk( paste0(fig_shortname, "_plot"), label = glue::glue("fig-{fig_shortname}"), - # add_option = TRUE, chunk_option = c( "echo: false", "warning: false", @@ -167,20 +138,20 @@ rm(rda)\n ), "\n" ) - + paste0( figures_doc_plot_setup1, figures_doc_plot_setup2 ) } - + if (length(file_list) == 0) { if (!file.exists(target_fig_doc)) { cli::cli_alert_warning("Found zero figure files in {fs::path(figures_dir, 'figures')}.", - wrap = TRUE + wrap = TRUE ) cli::cli_alert_info("For `create_figures_doc` to incorporate figures, there must be:", - wrap = TRUE + wrap = TRUE ) cli::cli_ol(c( "a 'figures' folder in {fs::path(figures_dir)}", @@ -194,10 +165,9 @@ rm(rda)\n cli::cli_alert("No new figures detected.") } } else { - # paste rda figure code chunks into one object if (length(rda_fig_list) > 0) { cli::cli_alert_success("Found {length(rda_fig_list)}{ifelse(new_rda, ' new ', ' ')}figure{?s} in an rda format (i.e., .rda) in {fs::path(figures_dir, 'figures')}.", - wrap = TRUE + wrap = TRUE ) rda_figures_doc <- "" for (i in seq_along(rda_fig_list)) { @@ -205,7 +175,7 @@ rm(rda)\n fig = rda_fig_list[i], figures_dir = figures_dir ) - + rda_figures_doc <- paste0( rda_figures_doc, fig_chunk, "{{< pagebreak >}} \n\n" @@ -213,21 +183,19 @@ rm(rda)\n } } else { cli::cli_alert_warning("Found zero figures in an rda format (i.e., .rda) in {fs::path(figures_dir, 'figures')}.", - wrap = TRUE + wrap = TRUE ) } if (length(non.rda_fig_list) > 0) { cli::cli_alert_success("Found {length(non.rda_fig_list)}{ifelse(new_non.rda, ' new ', ' ')}figure{?s} in a non-rda format (e.g., .jpg, .png) in {fs::path(figures_dir, 'figures')}.", - wrap = TRUE + wrap = TRUE ) non.rda_figures_doc <- "" for (i in seq_along(non.rda_fig_list)) { - # remove file extension fig_name <- stringr::str_extract( non.rda_fig_list[i], "^[^.]+" ) - # remove "_figure", if present fig_name <- sub("_figure", "", fig_name) fig_chunk <- paste0( "![Your caption here](", fs::path( @@ -239,19 +207,17 @@ rm(rda)\n "}\n\n", "{{< pagebreak >}} \n\n" ) - + non.rda_figures_doc <- paste0(non.rda_figures_doc, fig_chunk) } } else { cli::cli_alert_warning("Found zero figure files in a non-rda format (e.g., .jpg, .png) in {fs::path(figures_dir, 'figures')}.", - wrap = TRUE + wrap = TRUE ) } - - # combine figures_doc setup with figure chunks + figures_doc <- paste0( figures_doc_header, - # ifelse(!append, figures_doc_setup, ""), figures_doc_setup, ifelse( exists("rda_figures_doc"), @@ -265,33 +231,37 @@ rm(rda)\n ) ) } - - fig_doc_data <- id_fig_tab_num( - subdir = subdir, - fig_or_tab = "figure", - type = "default" - ) - legacy_fig_status <- isTRUE(fig_doc_data$using_legacy_doc) - # detected_doc_name <- fig_doc_data$detected_doc_name + doc_info <- migrate_legacy_docs(subdir, doc_type = "figures") + + if (doc_info$using_legacy) { + cli::cli_alert_info("Detected legacy figure/table document order ({.file {doc_info$legacy_name}}). asar now uses {.file {doc_info$current_name}} to maintain an accurate Table of Contents.") + cli::cli_alert_info("{.file {doc_info$legacy_name}} will be renamed to {.file {doc_info$current_name}}.") + } + + figures_doc_name <- if (doc_info$using_legacy) { + doc_info$legacy_name + } else { + doc_info$resolved_name + } - # Save figures doc to template folder utils::capture.output(cat(figures_doc), - file = target_fig_doc, + file = fs::path(subdir, figures_doc_name), append = append ) - if (legacy_fig_status && !is.null(fig_doc_data$detected_doc_name)) { + if (doc_info$using_legacy) { file.rename( - from = fs::path(subdir, fig_doc_data$detected_doc_name), - to = fs::path(subdir, fig_doc_data$current_doc_name) + from = fs::path(subdir, doc_info$legacy_name), + to = fs::path(subdir, doc_info$current_name) ) target_fig_doc <- fs::path(subdir, fig_doc_data$current_doc_name) } - # Read through figures doc and warn about identical labels + current_figures_doc <- fs::path(subdir, doc_info$resolved_name) + fix_duplicate_chunks( - doc_path = target_fig_doc, + doc_path = current_figures_doc, doc_type = "Figures" ) -} +} \ No newline at end of file diff --git a/R/create_tables_doc.R b/R/create_tables_doc.R index 46a0d61e..e8f317ae 100644 --- a/R/create_tables_doc.R +++ b/R/create_tables_doc.R @@ -37,63 +37,36 @@ #' ) #' } create_tables_doc <- function(subdir = getwd(), - tables_dir = getwd(), - tables_doc_name = NULL) { - # NOTE: essential_columns = 1 for all tables split using export_split_tbls() in - # the code below. - # To customize essential_columns, the user must run export_split_tbls() manually - # and specify essential_columns. Then, the split table will be imported into - # the tables doc as is. - # Upon adding more tables to stockplotr, the code may need to be altered to - # specify essential_columns for stockplotr-created tables. - - # set portrait page width (in) + tables_dir = getwd()) { portrait_pg_width <- 5 - - # set landscape page width (in) landscape_pg_width <- 8 - + empty_doc_text <- "Please refer to the `stockplotr` package downloaded from remotes::install_github('nmfs-ost/stockplotr') to add premade tables." - + tab_header <- "# Tables {#sec-tables}\n \n" - - existing_table_docs <- list.files(subdir)[grepl("_tables.qmd$", list.files(subdir))] - target_table_doc_name <- if (!is.null(tables_doc_name)) { - tables_doc_name - } else if (length(existing_table_docs) > 0) { - existing_table_docs[1] - } else { - "09_tables.qmd" - } - target_table_doc <- fs::path(subdir, target_table_doc_name) - # append table-producing code to non-empty tables doc, if it exists, vs. overwriting it append <- FALSE if (file.exists(target_table_doc)) { existing_tables_doc <- target_table_doc table_content <- readLines(existing_tables_doc) |> suppressWarnings() - + if ("# Tables {#sec-tables}" %in% table_content) { append <- TRUE cli::cli_alert_info("Tables doc will be appended to include tables in `tables_dir`.") - - # remove empty_doc_text + updated_content <- gsub(empty_doc_text, "", table_content, fixed = TRUE) writeLines(updated_content, existing_tables_doc) } } else { - # existing_figs_doc <- NULL table_content <- "" } - - # add header + tables_doc_header <- ifelse(append, - "", - tab_header + "", + tab_header ) - - # add chunk that creates object as the directory of all rdas + if (!(any(grepl( "#| label: 'set-rda-dir-tbls'", table_content, @@ -106,7 +79,6 @@ create_tables_doc <- function(subdir = getwd(), tables_dir <- fs::path('{tables_dir}', 'tables')" ), label = "set-rda-dir-tbls", - # add_option = TRUE, chunk_option = c( "echo: false", "warning: false", @@ -118,98 +90,74 @@ create_tables_doc <- function(subdir = getwd(), } else { tables_doc_setup <- "" } - + tables_doc <- "" - - # list all files in tables + file_list <- list.files(file.path(tables_dir, "tables")) - - # create sublist of only rda table files + rda_tab_list <- file_list[grepl(".rda", file_list)] - - # Check if rda already exists and remove from list - # Check if rda or non-rda already exists and remove from list + new_rda <- FALSE if (file.exists(target_table_doc)) { existing_tbls_doc <- target_table_doc table_content <- readLines(existing_tbls_doc) |> suppressWarnings() - # find all instances of figures existing_rda_tabs <- vapply(rda_tab_list, function(x) { any(grepl(x, table_content, fixed = TRUE)) }, FUN.VALUE = logical(1)) rda_tab_list <- rda_tab_list[!existing_rda_tabs] - # add condition for message to add "new" into message new_rda <- ifelse( length(existing_rda_tabs) > 0, TRUE, FALSE ) } - - # remove rda table files that have an associated "split" version - # remove "_split" from filenames + remove_split_names <- gsub("_split", "", rda_tab_list) - # identify duplicates in remove_split_names dup_tab <- remove_split_names[duplicated(remove_split_names) | duplicated(remove_split_names, fromLast = TRUE)] - # remove duplicates in remove_split_names to create final list final_rda_tab_list <- rda_tab_list[!(remove_split_names %in% dup_tab & !grepl("_split", rda_tab_list))] - - # create sublist of only non-rda table files - # non.rda_tab_list <- file_list[!grepl(".rda", file_list)] - - # create two-chunk system to plot each rda table + create_tab_chunks <- function(tab = NA, tables_dir = getwd()) { - # test whether table has been split split <- grepl("split", tab) - + tab_shortname <- ifelse(split, - stringr::str_remove(tab, "_table_split.rda"), - stringr::str_remove(tab, "_table.rda") + stringr::str_remove(tab, "_table_split.rda"), + stringr::str_remove(tab, "_table.rda") ) - - # identify table orientation - # split tables will always be extra-wide + tbl_orient <- ifelse(split, - "extra-wide", - ID_tbl_width_class( - plot_name = tab_shortname, - tables_dir = tables_dir, - portrait_pg_width = portrait_pg_width - ) + "extra-wide", + ID_tbl_width_class( + plot_name = tab_shortname, + tables_dir = tables_dir, + portrait_pg_width = portrait_pg_width + ) ) - - # identify table length: regular (1 landscape page) or long (>1 landscape page) + tbl_length <- ID_tbl_length_class( plot_name = tab_shortname, tables_dir = tables_dir ) - + table_specs <- list(tbl_orient, tbl_length) - + tbl_class <- dplyr::case_when( - table_specs[[1]] == "regular" & table_specs[[2]] == "regular" ~ "reg_reg", # 38 rows / portrait - table_specs[[1]] == "regular" & table_specs[[2]] == "long" ~ "reg_long", # 38 rows, split / portrait - table_specs[[1]] == "wide" & table_specs[[2]] == "regular" ~ "wide_reg", # 28 rows / landscape - table_specs[[1]] == "wide" & table_specs[[2]] == "long" ~ "wide_long", # 28 rows, split / landscape - table_specs[[1]] == "extra-wide" & table_specs[[2]] == "regular" ~ "ewide_reg", # 28 rows, split / landscape - table_specs[[1]] == "extra-wide" & table_specs[[2]] == "long" ~ "ewide_long", # 28 rows, split / landscape + table_specs[[1]] == "regular" & table_specs[[2]] == "regular" ~ "reg_reg", + table_specs[[1]] == "regular" & table_specs[[2]] == "long" ~ "reg_long", + table_specs[[1]] == "wide" & table_specs[[2]] == "regular" ~ "wide_reg", + table_specs[[1]] == "wide" & table_specs[[2]] == "long" ~ "wide_long", + table_specs[[1]] == "extra-wide" & table_specs[[2]] == "regular" ~ "ewide_reg", + table_specs[[1]] == "extra-wide" & table_specs[[2]] == "long" ~ "ewide_long", TRUE ~ "unknown" ) - + if (tbl_class == "unknown") { cli::cli_abort("Unknown table class. Check table is an acceptable `gt` table.") } - - # set max number of rows per table based on orientation - max_rows <- ifelse(tbl_orient == "regular", - 38, # max rows for portrait - 28 - ) # max rows for landscape - - ## import table, caption - ## do this for all tables + + max_rows <- ifelse(tbl_orient == "regular", 38, 28) + tables_doc_plot_setup1 <- paste0( add_chunk( paste0( @@ -225,8 +173,7 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n ), "\n" ) - - ## add table if it is intact on a portrait page + if (tbl_class == "reg_reg") { tables_doc_plot_setup2 <- paste0( add_chunk( @@ -237,7 +184,6 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n " ) \n" ), label = glue::glue("tbl-{tab_shortname}"), - # add_option = TRUE, chunk_option = c( "echo: false", "warnings: false", @@ -250,11 +196,9 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n "\n" ) } - - ## add table if it is intact, rotated on a landscape page + if (tbl_class == "wide_reg") { tables_doc_plot_setup2 <- paste0( - # add landscape braces before R chunk "::: {.landscape}\n\n", add_chunk( glue::glue( @@ -268,7 +212,6 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n " ) \n" ), label = glue::glue("tbl-{tab_shortname}"), - # add_option = TRUE, chunk_option = c( "echo: false", "warnings: false", @@ -279,32 +222,22 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n ) ), "\n", - # add landscape braces after R chunk ":::\n" ) } - - ## add table if it is long enough to be shown on >1 portrait ("reg_long") OR landscape ("wide_long") page - ### only differences: latter has landscape braces and narrower cols + if (tbl_class == "reg_long" | tbl_class == "wide_long") { - # identify number of tables in rda load(fs::path(tables_dir, "tables", tab)) - # split_tables <- length(table_list) - # identify number of tables that each split table must be further split - # into, with different rows per table split_table_rows <- length(rda[[1]]$`_data`[[1]]) split_tables_rowwise <- ceiling(split_table_rows / max_rows) - - # prepare text for chunk that will display split tables + tables_doc_plot_setup2 <- "" for (i in 1:as.numeric(split_tables_rowwise)) { - # add a chunk for each table tables_doc_plot_setup2 <- paste0( tables_doc_plot_setup2, - # add landscape braces before R chunk if tbl_class == "wide_long" ifelse(tbl_class == "wide_long", - "::: {.landscape}\n\n", - "" + "::: {.landscape}\n\n", + "" ), add_chunk( paste0( @@ -330,37 +263,30 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n "tbl-pos: 't'" ) ), - # add landscape braces after R chunk if tbl_class == "wide_long" ifelse(tbl_class == "wide_long", - ":::\n", - "\n" + ":::\n", + "\n" ) ) } } - - ## add table if it is wide enough to be rotated and shown on >1 landscape + if (tbl_class == "ewide_reg") { if (split) { - # identify number of split tables load(fs::path(tables_dir, "tables", tab)) split_tables <- length(table_list) } else { - # split extra-wide tables into smaller tables and export AND - # identify number of split tables IF not already split split_tables <- export_split_tbls( tables_dir = tables_dir, plot_name = tab, essential_columns = 1 ) - - # identify number of split tables + tab <- gsub("table", "table_split", tab) load(fs::path(tables_dir, "tables", tab)) split_tables <- length(table_list) } - - # add a chunk to import split tables + tables_doc_plot_setup2_import <- paste0( add_chunk( paste0( @@ -371,7 +297,6 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n tab_shortname, "_cap_split <- names(", tab_shortname, "_table_split_rda)" ), label = glue::glue("tbl-{tab_shortname}-labels"), - # add_option = TRUE, chunk_option = c( "echo: false", "warnings: false", @@ -380,13 +305,11 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n ), "\n" ) - # prepare text for chunk that will display split tables + tables_doc_plot_setup2_display <- "" for (i in 1:as.numeric(split_tables)) { - # add a chunk for each table tables_doc_plot_setup2_display <- paste0( tables_doc_plot_setup2_display, - # add landscape braces before R chunk "::: {.landscape}\n\n", add_chunk( paste0( @@ -411,44 +334,35 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n ) ), "\n", - # add landscape braces after R chunk ":::\n" ) } - + tables_doc_plot_setup2 <- paste0( tables_doc_plot_setup2_import, tables_doc_plot_setup2_display, "{{< pagebreak >}} \n\n" ) } - - ## add table if it is wide and long enough to be rotated and split across >1 landscape pages + if (tbl_class == "ewide_long") { if (split) { - # identify number of split tables load(fs::path(tables_dir, "tables", tab)) split_tables <- length(table_list) } else { - # split extra-wide tables into smaller tables and export AND - # identify number of split tables IF not already split split_tables <- export_split_tbls( tables_dir = tables_dir, plot_name = tab, essential_columns = 1 ) - - # identify number of split tables + tab <- gsub("table", "table_split", tab) load(fs::path(tables_dir, "tables", tab)) split_tables <- length(table_list) } - # identify number of tables that each split table must be further split - # into, with different rows per table split_table_rows <- length(table_list[[1]]$`_data`[[1]]) split_tables_rowwise <- ceiling(split_table_rows / max_rows) - - # add a chunk to import split tables + tables_doc_plot_setup2_import <- paste0( add_chunk( paste0( @@ -459,7 +373,6 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n tab_shortname, "_cap_split <- names(", tab_shortname, "_table_split_rda)" ), label = glue::glue("tbl-{tab_shortname}-labels"), - # add_option = TRUE, chunk_option = c( "echo: false", "warnings: false", @@ -468,14 +381,12 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n ), "\n" ) - # prepare text for chunk that will display split tables + tables_doc_plot_setup2_display <- "" for (i in 1:as.numeric(split_tables)) { for (j in 1:as.numeric(split_tables_rowwise)) { - # add a chunk for each table tables_doc_plot_setup2_display <- paste0( tables_doc_plot_setup2_display, - # add landscape braces before R chunk "::: {.landscape}\n\n", add_chunk( paste0( @@ -502,32 +413,31 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n ) ), "\n", - # add landscape braces after R chunk ":::\n" ) } } - + tables_doc_plot_setup2 <- paste0( tables_doc_plot_setup2_import, tables_doc_plot_setup2_display ) } - + paste0( tables_doc_plot_setup1, tables_doc_plot_setup2, "{{< pagebreak >}} \n\n" ) } - + if (length(rda_tab_list) == 0) { if (!file.exists(target_table_doc)) { cli::cli_alert_warning("Found zero tables in an rda format (i.e., .rda) in {fs::path(tables_dir, 'tables')}.", - wrap = TRUE + wrap = TRUE ) cli::cli_alert_info("For `create_tables_doc` to incorporate tables, there must be:", - wrap = TRUE + wrap = TRUE ) cli::cli_ol(c( "a 'tables' folder in {fs::path(tables_dir)}", @@ -542,9 +452,8 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n } } else { cli::cli_alert_success("Found {length(final_rda_tab_list)}{ifelse(new_rda, ' new ', ' ')}table{?s} in an rda format (i.e., .rda) in {fs::path(tables_dir, 'tables')}.", - wrap = TRUE + wrap = TRUE ) - # paste rda table code chunks into one object if (length(final_rda_tab_list) > 0) { rda_tables_doc <- "" for (i in seq_along(final_rda_tab_list)) { @@ -552,71 +461,51 @@ load(file.path(tables_dir, '", stringr::str_remove(tab, "_split"), "'))\n tab = final_rda_tab_list[i], tables_dir = tables_dir ) - + rda_tables_doc <- paste0(rda_tables_doc, tab_chunk) } } - # if (length(non.rda_tab_list) > 0){ - # non.rda_tables_doc <- "" - # for (i in seq_along(non.rda_tab_list)){ - # # remove file extension - # tab_name <- stringr::str_extract(non.rda_tab_list[i], - # "^[^.]+") - # # remove "_table", if present - # tab_name <- sub("_table", "", tab_name) - # tab_chunk <- paste0( - # "![Your caption here](", fs::path("tables", - # non.rda_tab_list[i]), - # "){#tab-", - # tab_name, - # "}\n\n" - # ) - # - # non.rda_tables_doc <- paste0(non.rda_tables_doc, tab_chunk) - # } - # } else { - # message(paste0("Note: No table files in a non-rda format (e.g., .jpg, .png) were found in '", fs::path(tables_dir, "tables") , "'.")) - # } - - # combine tables_doc setup with table chunks + tables_doc <- paste0( tables_doc_header, tables_doc_setup, ifelse(exists("rda_tables_doc"), - rda_tables_doc, - "" - ) # , - # ifelse(exists("non.rda_tables_doc"), - # non.rda_tables_doc, - # "") + rda_tables_doc, + "" + ) ) } - - tab_doc_data <- id_fig_tab_num( - subdir = subdir, - fig_or_tab = "table", - type = "default" - ) - legacy_tab_status <- isTRUE(tab_doc_data$using_legacy_doc) + doc_info <- migrate_legacy_docs(subdir, doc_type = "tables") + + if (doc_info$using_legacy) { + cli::cli_alert_info("Detected legacy figure/table document order ({.file {doc_info$legacy_name}}). asar now uses {.file {doc_info$current_name}} to maintain an accurate Table of Contents.") + cli::cli_alert_info("{.file {doc_info$legacy_name}} will be renamed to {.file {doc_info$current_name}}.") + } + + tables_doc_name <- if (doc_info$using_legacy) { + doc_info$legacy_name + } else { + doc_info$resolved_name + } - # Save tables doc to template folder utils::capture.output(cat(tables_doc), - file = target_table_doc, + file = fs::path(subdir, tables_doc_name), append = append ) - if (legacy_tab_status && !is.null(tab_doc_data$detected_doc_name)) { + if (doc_info$using_legacy) { file.rename( - from = fs::path(subdir, tab_doc_data$detected_doc_name), - to = fs::path(subdir, tab_doc_data$current_doc_name) + from = fs::path(subdir, doc_info$legacy_name), + to = fs::path(subdir, doc_info$current_name) ) target_table_doc <- fs::path(subdir, tab_doc_data$current_doc_name) } - # Read through tables doc and warn about identical labels + current_tables_doc <- fs::path(subdir, doc_info$resolved_name) + fix_duplicate_chunks( - doc_path = target_table_doc, + doc_path = current_tables_doc, doc_type = "Tables" ) } \ No newline at end of file diff --git a/R/create_template.R b/R/create_template.R index 50cd9cc3..c69a0639 100644 --- a/R/create_template.R +++ b/R/create_template.R @@ -181,7 +181,6 @@ #' section_location = "before-introduction" #' ) #' -#' #' create_template( #' new_template = TRUE, #' format = "pdf", @@ -235,78 +234,80 @@ #' } #' create_template <- function( - format = "pdf", - type = "sar", - office = NULL, - region = NULL, - species = "species", - spp_latin = NULL, - year = format(as.POSIXct(Sys.Date(), format = "%YYYY-%mm-%dd"), "%Y"), - authors = NULL, - file_dir = getwd(), - title = "[TITLE]", - model_results = NULL, - tables_dir = getwd(), - figures_dir = getwd(), - spp_image = NULL, - bib_file = "asar_references.bib", - new_template = TRUE, - rerender_skeleton = FALSE, - custom_sections = NULL, - new_section = NULL, - section_location = NULL, - custom_params = NULL, - ... + format = "pdf", + type = "sar", + office = NULL, + region = NULL, + species = "species", + spp_latin = NULL, + year = format(as.POSIXct(Sys.Date(), format = "%YYYY-%mm-%dd"), "%Y"), + authors = NULL, + file_dir = getwd(), + title = "[TITLE]", + model_results = NULL, + tables_dir = getwd(), + figures_dir = getwd(), + spp_image = NULL, + bib_file = "asar_references.bib", + new_template = TRUE, + rerender_skeleton = FALSE, + custom_sections = NULL, + new_section = NULL, + section_location = NULL, + custom_params = NULL, + ... ) { # Check input type - type <- switch(type, - "Northeast Management Track" = "nemt", - "Pacific Fishery Management Council" = "pfmc", - "Stock Assessment and Fishery Evaluation" = "safe", - "Stock Assessment Report" = "skeleton", - "sar" = "skeleton", - "pfmc" = "pfmc", - "nemt" = "nemt", - "safe" = "safe", - "skeleton" = "skeleton", - { - # If unrecognized AND interactive, show prompt - if (interactive()) { - selection <- utils::menu( - title = "Unrecognized template type. Please select an option below: ", - choices = c("Default", "Pacific Fisheries Management Council", "Northeast Management Track", "SAFE") - ) - switch(as.character(selection), - "1" = "skeleton", - "2" = "pfmc", - "3" = "nemt", - "4" = "safe", - "skeleton" - ) - } else { - "skeleton" - } - } + type_map <- c( + "Northeast Management Track" = "nemt", + "Pacific Fishery Management Council" = "pfmc", + "Stock Assessment and Fishery Evaluation" = "safe", + "Stock Assessment Report" = "skeleton", + "sar" = "skeleton", + "pfmc" = "pfmc", + "nemt" = "nemt", + "safe" = "safe", + "skeleton" = "skeleton" ) - - if (!is.null(office) & length(office) == 1) { + + # 1. Match if it exists in the mapping + if (type %in% names(type_map)) { + type <- unname(type_map[type]) + + # 2. If unmatched and interactive, prompt the user + } else if (isTRUE(interactive) || (is.function(interactive) && interactive())) { + selection <- utils::menu( + title = "Unrecognized template type. Please select an option below: ", + choices = c("Default", "Pacific Fisheries Management Council", "Northeast Management Track", "SAFE") + ) + type <- switch(as.character(selection), + "2" = "pfmc", + "3" = "nemt", + "4" = "safe", + "skeleton" + ) + + # 3. If unmatched and non-interactive, revert to skeleton + } else { + type <- "skeleton" + } + + if (!is.null(office) & length(office) == 1) { office <- match.arg(office, choices = c("AFSC", "PIFSC", "NEFSC", "NWFSC", "SEFSC", "SWFSC"), several.ok = FALSE) } 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")) + report_name <- 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( @@ -315,11 +316,10 @@ create_template <- function( ) } region_name <- ifelse( - region != "NA", # !is.null(region) | !is.na(region) + region != "NA", 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}_"), "", @@ -335,7 +335,7 @@ create_template <- function( gsub(glue::glue("{region_name}_"), "", report_name_1) ) ) - + new_report_name <- paste0( type, "_", ifelse( @@ -346,7 +346,6 @@ create_template <- function( ifelse(is.null(species), "species", stringr::str_replace_all(species, " ", "_")), "_", "skeleton.qmd" ) - # make sure type is changed to skeleton if (type == "sar") type <- "skeleton" } else { # Name report @@ -356,9 +355,7 @@ create_template <- function( "_" ) } else { - report_name <- paste0( - "type_" - ) + report_name <- paste0("type_") } # Add region to name report_name <- ifelse( @@ -371,25 +368,19 @@ create_template <- function( 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" ) - } # close if rerender skeleton for naming - + } + # Select format if (grepl("^pdf$|^html$", tolower(format))) { format <- tolower(format) } else if (grepl("docx", tolower(format))) { cli::cli_alert_warning("The docx format is not currently supported by asar. Defaulting to pdf.", - wrap = TRUE + wrap = TRUE ) format <- "pdf" } else { @@ -416,7 +407,7 @@ create_template <- function( if (!interactive()) question1 <- "y" if (regexpr(question1, "y", ignore.case = TRUE) == 1) { cli::cli_alert_warning("The docx format is not currently supported by asar. Defaulting to pdf.", - wrap = TRUE + wrap = TRUE ) format <- "pdf" } else if (regexpr(question1, "n", ignore.case = TRUE) == 1) { @@ -426,97 +417,74 @@ create_template <- function( cli::cli_abort("Format not recognized. Please use pdf, html, or docx.") } } - - # 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", fs::path(file_dir), fs::path(file_dir, "report") ) - + # Supporting files folder supdir <- file.path(subdir, "support_files") - + if (dir.exists(subdir) == FALSE) { dir.create(subdir, recursive = TRUE) } if (dir.exists(supdir) == FALSE) { dir.create(supdir, recursive = FALSE) } - + #### New template ---- if (new_template) { - ##### Pull sections based on type ---- - # Pull skeleton for sections - asar_folder <- system.file("templates", package = "asar") - # copy files from specific type folder current_folder <- ifelse(rerender_skeleton, subdir, file.path(asar_folder, type)) new_folder <- subdir - + ##### Identify files to copy ---- if (!is.null(custom_sections)) { files_to_copy <- unlist(list.files(current_folder))[c(unlist(sapply(custom_sections, function(x) grep(x, list.files(current_folder)))))] - # add acknowledgments sections if not selected manually if (!any(grepl("acknowledgments", files_to_copy))) { files_to_copy <- c(files_to_copy, unlist(list.files(current_folder))[10]) custom_sections <- c(custom_sections, "acknowledgments") } - # add references sections if not selected manually if (!any(grepl("references", files_to_copy))) { files_to_copy <- c(files_to_copy, unlist(list.files(current_folder))[11]) 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) } } - + before_body_file <- system.file("resources", "formatting_files", "before-body.tex", package = "asar") - # header_file <- system.file("resources", "formatting_files", "in-header.tex", package = "asar") - # format_files <- list(before_body_file, header_file) - + #### Links to files for yaml ---- 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") } - + # Add bib file if (bib_file == "asar_references.bib") { bib_loc <- system.file("resources", "asar_references.bib", package = "asar") bib_name <- bib_file } else { - # check if enter file exists - # if (!file.exists(bib_file)) stop(".bib file not found.") cli::cli_alert_warning("Bibliography file {bib_file} not in the report directory.") cli::cli_alert_info("The file will not be read in on render if not in the same path as the skeleton file.") - - bib_loc <- bib_file # dirname(bib_file) - bib_name <- stringr::str_extract(bib_file, "[^/]+$") # utils::tail(stringr::str_split(bib_file, "/")[[1]], n = 1) + + bib_loc <- bib_file + bib_name <- stringr::str_extract(bib_file, "[^/]+$") } - + #### 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]+" @@ -532,15 +500,12 @@ create_template <- function( "[0-9]+" )) ) - # Add in species image if updated in rerender if (!is.null(spp_image)) { file.copy(spp_image, supdir, overwrite = FALSE) |> suppressWarnings() - # Change path to spp image since finished copying for yaml if (file.exists(spp_image)) { spp_image <- file.path("support_files", stringr::str_extract(spp_image, "(?<=/)[^/]+$")) } } - # if it is previously html and the rerender species html then need to copy over html formatting if (tolower(prev_format) != "html" & tolower(format) == "html") { if (!file.exists(file.path(file_dir, "support_files", "theme.scss"))) file.copy(system.file("resources", "formatting_files", "theme.scss", package = "asar"), supdir, overwrite = FALSE) |> suppressWarnings() } @@ -557,48 +522,30 @@ create_template <- function( "(?<=')[^']+(?=')" ) } - # 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 + 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 if (length(list.files(subdir)) < 2) { - # 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 bib file file.copy(bib_loc, subdir, overwrite = TRUE) |> suppressWarnings() - # Copy us doc logo file.copy(system.file("resources", "us_doc_logo.png", package = "asar"), supdir, overwrite = FALSE) |> suppressWarnings() - # Copy glossary file.copy(system.file("glossary", "report_glossary.tex", package = "asar"), subdir, overwrite = FALSE) |> suppressWarnings() - # Copy html format file if applicable if (tolower(format) == "html") file.copy(system.file("resources", "formatting_files", "theme.scss", package = "asar"), supdir, overwrite = FALSE) |> suppressWarnings() - # Copy over glossary and associated tex file if (tolower(type) == "pfmc") { - # file.copy(system.file("resources", "formatting_files", "sa4ss_glossaries.tex", package = "asar"), supdir, overwrite = FALSE) |> suppressWarnings() file.copy(system.file("resources", "formatting_files", "pfmc.tex", package = "asar"), supdir, overwrite = FALSE) |> suppressWarnings() } - # copy csl file file.copy(system.file("resources", "cjfas.csl", package = "asar"), supdir, overwrite = FALSE) |> suppressWarnings() - # show message and make README stating model_results info if (!is.null(model_results)) { mod_time <- as.character(file.info(fs::path(model_results), extra_cols = FALSE)$ctime) mod_msg <- paste( @@ -620,151 +567,102 @@ create_template <- function( } 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 bib file file.copy(bib_loc, subdir, overwrite = TRUE) |> 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 + wrap = TRUE ) } - } # close check for previous files & respective copying - # prev_skeleton <- NULL - } # close if rerender - - doc_type <- ifelse(type %in% c("nemt", "safe"), type, "default") - tab_doc_data <- id_fig_tab_num( - subdir = subdir, - fig_or_tab = "table", - type = doc_type - ) - fig_doc_data <- id_fig_tab_num( - subdir = subdir, - fig_or_tab = "figure", - type = doc_type - ) - legacy_tables_doc_name <- tab_doc_data$legacy_doc_name - current_tables_doc_name <- tab_doc_data$current_doc_name - legacy_figures_doc_name <- fig_doc_data$legacy_doc_name - current_figures_doc_name <- fig_doc_data$current_doc_name + } + } + + # 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) + + using_legacy_doc_order <- fig_info$using_legacy || tbl_info$using_legacy - using_legacy_doc_order <- rerender_skeleton && - tab_doc_data$using_legacy_doc && - fig_doc_data$using_legacy_doc if (using_legacy_doc_order) { - # 1. Safely copy & remove old table file - old_tbl_path <- fs::path(subdir, legacy_tables_doc_name) - new_tbl_path <- fs::path(subdir, current_tables_doc_name) - if (file.exists(old_tbl_path) && legacy_tables_doc_name != current_tables_doc_name) { - file.copy(from = old_tbl_path, to = new_tbl_path, overwrite = TRUE) - file.remove(old_tbl_path) - } - - # 2. Safely copy & remove old figure file (prevents 09_figures.qmd from persisting) - old_fig_path <- fs::path(subdir, legacy_figures_doc_name) - new_fig_path <- fs::path(subdir, current_figures_doc_name) - if (file.exists(old_fig_path) && legacy_figures_doc_name != current_figures_doc_name) { - file.copy(from = old_fig_path, to = new_fig_path, overwrite = TRUE) - file.remove(old_fig_path) - } - - # 3. Clean up prev_skeleton so knit_child references don't recreate the old filenames - prev_skeleton <- prev_skeleton |> - stringr::str_replace_all(legacy_tables_doc_name, current_tables_doc_name) |> - stringr::str_replace_all(legacy_figures_doc_name, current_figures_doc_name) + file.rename(from = fs::path(subdir, tbl_info$legacy_name), to = fs::path(subdir, tbl_info$current_name)) + file.rename(from = fs::path(subdir, fig_info$legacy_name), to = fs::path(subdir, fig_info$current_name)) - cli::cli_alert_info("Detected legacy figure/table document order in the skeleton. asar now uses {.file {current_figures_doc_name}} & {.file {current_tables_doc_name}} to maintain an accurate Table of Contents.") - cli::cli_alert_info("Skeleton will be updated to show figures before tables.") + cli::cli_alert_info("Detected legacy figure/table document order in the skeleton. asar will switch to {.file {fig_info$current_name}} before {.file {tbl_info$current_name}}.") } - - # created tables doc + + # Created tables doc if (!rerender_skeleton) { - { - tables_doc_name <- current_tables_doc_name - tables_doc <- "" - utils::capture.output(cat(tables_doc), - file = fs::path(subdir, tables_doc_name), - append = FALSE - ) |> - suppressMessages() |> - suppressWarnings() - - create_tables_doc( - subdir = subdir, - tables_dir = tables_dir, - tables_doc_name = tables_doc_name - ) - } # |> - # suppressMessages() |> - # suppressWarnings() + tables_doc_name <- switch(type, + "nemt" = "06_tables.qmd", + "safe" = "12_tables.qmd", + "09_tables.qmd" + ) + tables_doc <- "" + utils::capture.output(cat(tables_doc), + file = fs::path(subdir, tables_doc_name), + append = FALSE + ) |> + suppressMessages() |> + suppressWarnings() + + create_tables_doc( + subdir = subdir, + tables_dir = tables_dir + ) } else { - # extract name for tables.qmd from report folder tables_doc_name <- if (using_legacy_doc_order) { - current_tables_doc_name + tbl_info$current_name } else { list.files(file_dir, pattern = "tables.qmd") } } - + # Create figures qmd if (!rerender_skeleton) { - figures_doc_name <- current_figures_doc_name - figures_doc <- "" - utils::capture.output(cat(figures_doc), - file = fs::path(subdir, figures_doc_name), - append = FALSE - ) |> - suppressMessages() |> - suppressWarnings() - + figures_doc_name <- switch(type, + "nemt" = "05_figures.qmd", + "safe" = "11_figures.qmd", + "08_figures.qmd" + ) + create_figures_doc( subdir = subdir, figures_dir = figures_dir, figures_doc_name = figures_doc_name ) + 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 (using_legacy_doc_order) { - current_figures_doc_name + fig_info$current_name } else { list.files(file_dir, pattern = "figures.qmd") } } - - # Part I - # Create a report template file to render for the region and species - # Create YAML header for document - # Write title based on report type and region - # Extract region based on param if it was previously found + + # Part I: YAML & Preamble 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)) { @@ -788,30 +686,17 @@ create_template <- function( ) } } - - # Authors and affiliations - # Parameters to add authorship to YAML + author_list <- add_authors( 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 + authors = authors, rerender_skeleton = rerender_skeleton ) - - # 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 <- TRUE param_names <- custom_params |> names() param_values <- custom_params |> unname() - + yaml <- create_yaml( prev_format = prev_format, format = format, @@ -831,9 +716,9 @@ create_template <- function( year = year, type = type ) - + if (!rerender_skeleton) cli::cli_alert_success("Built YAML header.") - + ##### Params chunk ---- if (rerender_skeleton) { params_chunk_start <- grep("R_parameters", prev_skeleton) - 1 @@ -847,10 +732,7 @@ create_template <- function( "spp_latin <- params$spp_latin \n", "office <- params$office", if (!is.null(region)) { - paste0( - "\n", - "region <- params$region" - ) + paste0("\n", "region <- params$region") }, if (!is.null(param_names)) { paste0( @@ -864,7 +746,6 @@ create_template <- function( } 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, @@ -893,10 +774,7 @@ create_template <- function( "spp_latin <- params$spp_latin \n", "office <- params$office", if (!is.null(region)) { - paste0( - "\n", - "region <- params$region" - ) + paste0("\n", "region <- params$region") }, if (!is.null(param_names)) { paste0( @@ -908,6 +786,7 @@ create_template <- function( label = "R_parameters" ) } + params_chunk <- add_chunk( paste0( "# Parameters \n", @@ -917,10 +796,7 @@ create_template <- function( "spp_latin <- params$spp_latin \n", "office <- params$office", if (!is.null(region)) { - paste0( - "\n", - "region <- params$region" - ) + paste0("\n", "region <- params$region") }, if (!is.null(param_names)) { paste0( @@ -931,62 +807,33 @@ create_template <- function( ), label = "R_parameters" ) - + ##### Preamble ---- - # Add preamble - # add in quantities and output data R chunk - # Reassign model_results as output and save into environment for user - # 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.") - # } - # ) } else { load_method <- "" - # df_name <- "NULL" } - - # standard preamble - # copy preamble code into report folder + file.copy( system.file("resources", "preamble.R", package = "asar"), subdir, overwrite = TRUE ) |> suppressWarnings() + preamble <- add_chunk( paste0( "# load converted output from stockplotr::convert_output() \n", load_method, "\n", - # "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 + "output <- out_new |> \n", " ", "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", "end_year\n", "Fend # terminal fishing mortality\n", - - # "# modify in source code if alternative target desired", "\n", "Ftarg # fishing mortality at msy\n", "F_Ftarg # Terminal year F respective to F target\n", "Bend # terminal year biomass\n", @@ -1002,24 +849,18 @@ create_template <- function( label = "preamble", 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, @@ -1042,11 +883,9 @@ create_template <- function( "(?<=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( @@ -1064,8 +903,6 @@ create_template <- function( ) } 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.") @@ -1074,18 +911,16 @@ create_template <- function( } 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 + 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)] @@ -1095,38 +930,32 @@ create_template <- function( 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, @@ -1135,45 +964,36 @@ create_template <- function( ) 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 ---- - # 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 == "") - + if (using_legacy_doc_order) { sections <- sections |> - stringr::str_replace_all(legacy_tables_doc_name, current_tables_doc_name) |> - stringr::str_replace_all(legacy_figures_doc_name, current_figures_doc_name) + stringr::str_replace_all(tbl_info$legacy_name, tbl_info$current_name) |> + stringr::str_replace_all(fig_info$legacy_name, fig_info$current_name) - figure_position <- which(sections == current_figures_doc_name) - table_position <- which(sections == current_tables_doc_name) - if (length(figure_position) == 1 && length(table_position) == 1 && - figure_position > table_position) { - sections <- sections[sections != current_figures_doc_name] - table_position <- which(sections == current_tables_doc_name) + figure_position <- which(sections == fig_info$current_name) + table_position <- which(sections == tbl_info$current_name) + if (length(figure_position) == 1 && length(table_position) == 1 && figure_position > table_position) { + sections <- sections[sections != fig_info$current_name] + table_position <- which(sections == tbl_info$current_name) sections <- append( sections, - current_figures_doc_name, + fig_info$current_name, after = table_position - 1 ) } } - - # add sections as list + sections <- add_child( sections, label = gsub(".qmd", "", unlist(sections)) @@ -1181,27 +1001,16 @@ create_template <- function( } else 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$)") + 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 - + } else { 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, @@ -1209,39 +1018,32 @@ create_template <- function( 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 + } else { 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 - } # close if statement for custom - + } + } + } + ###### Pull together skeleton ---- report_template <- paste( yaml, @@ -1253,46 +1055,36 @@ create_template <- function( sections, sep = "\n" ) - + cli::cli_alert_success("Created report template.") - + ##### 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.") } } - + ##### 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 + 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) } else { #### Previous template call ---- - # Copy old template and rename for new year - # Create copy of previous assessment if (!is.null(region)) { olddir <- fs::path(file_dir, "report") invisible(file.copy(file.path(olddir, list.files(olddir)), subdir, recursive = FALSE)) @@ -1300,14 +1092,11 @@ create_template <- function( olddir <- fs::path(file_dir, "report") invisible(file.copy(file.path(olddir, list.files(olddir)), subdir, recursive = FALSE)) } - - # Edit skeleton to update year and results file + skeleton <- list.files(subdir, pattern = "skeleton.qmd") - # Open previous skeleton - # file.show(file.path(subdir, report_name)) - + svDialogs::dlg_message("Reminder: Changes should be made when calling an old report. Please change 1) the year in the citation and 2) the location and name of the results file in the first chunk of the report.", - type = "ok" + type = "ok" ) } -} +} \ No newline at end of file diff --git a/R/utils.R b/R/utils.R index 23ab192a..5816a656 100644 --- a/R/utils.R +++ b/R/utils.R @@ -414,68 +414,92 @@ format_citation_authors <- function(author_names) { as.character() } -#-------- update figures/tables doc numbers -# -#' Identify correct figure/table qmd name -#' -#' @param subdir The subdirectory containing the figures or tables document. -#' -#' Default: working directory (getwd()) -#' -#' @param fig_or_tab Character string. Specifies application to a figure or table doc. -#' Options: "figure", "table" -#' -#' Default: "figure" -#' -#' @param type Character string. Specifies the type of document. -#' -#' Options: "default" (SAR), "nemt", "safe" -#' -#' Default: "default" -#' -#' @return A list containing information about the identified figure or table doc, -#' including whether a legacy document is being used, the names of the legacy -#' and current documents, and the detected document name. +# ---------------------------- + +#' Map legacy document names to current document names +#' +#' @return A list containing vector mappings for legacy and current +#' tables and figures files. +#' @keywords internal #' @noRd +get_doc_order <- function() { + list( + legacy_tables = c("08_tables.qmd", "05_tables.qmd", "11_tables.qmd"), + current_tables = c("09_tables.qmd", "06_tables.qmd", "12_tables.qmd"), + legacy_figs = c("09_figures.qmd", "06_figures.qmd", "12_figures.qmd"), + current_figs = c("08_figures.qmd", "05_figures.qmd", "11_figures.qmd") + ) +} -id_fig_tab_num <- function(subdir = getwd(), - fig_or_tab = "figure", - type = "default") { - if (fig_or_tab == "figure") { - legacy_docs <- c(default = "09_figures.qmd", nemt = "06_figures.qmd", safe = "12_figures.qmd") - current_docs <- c(default = "08_figures.qmd", nemt = "05_figures.qmd", safe = "11_figures.qmd") - qmd_suffix <- "_figures.qmd$" +#' Detect, rename, and resolve legacy document paths +#' +#' @param subdir Directory where template files are located. +#' @param doc_type Type of document. +#' +#' Options: "figures" or "tables" +#' @param rerender_skeleton Logical indicating if rerendering active. +#' +#' @return A list containing `using_legacy` (logical), `legacy_name`, `current_name`, +#' and `resolved_name`. +#' @keywords internal +#' @noRd +migrate_legacy_docs <- function(subdir, + doc_type, + rerender_skeleton = FALSE) { + mapping <- get_doc_order() + + # Determine target vectors based on type requested + if (doc_type == "figures") { + legacy_docs <- mapping$legacy_figs + current_docs <- mapping$current_figs } else { - legacy_docs <- c(default = "08_tables.qmd", nemt = "05_tables.qmd", safe = "11_tables.qmd") - current_docs <- c(default = "09_tables.qmd", nemt = "06_tables.qmd", safe = "12_tables.qmd") - qmd_suffix <- "_tables.qmd$" + legacy_docs <- mapping$legacy_tables + current_docs <- mapping$current_tables } - legacy_doc_name <- legacy_docs[[type]] - current_doc_name <- current_docs[[type]] + # Check for existing legacy files in subdir (both figs and tables exist in legacy format) + legacy_match <- which( + file.exists(fs::path(subdir, mapping$legacy_figs)) & + file.exists(fs::path(subdir, mapping$legacy_tables)) & + !file.exists(fs::path(subdir, mapping$current_figs)) & + !file.exists(fs::path(subdir, mapping$current_tables)) + ) + + # Fallback check when called independently per file type + if (length(legacy_match) == 0) { + legacy_match <- which( + file.exists(fs::path(subdir, legacy_docs)) & + !file.exists(fs::path(subdir, current_docs)) + ) + } - using_legacy_doc <- file.exists(fs::path(subdir, legacy_doc_name)) && - !file.exists(fs::path(subdir, current_doc_name)) + using_legacy <- (rerender_skeleton || doc_type != "skeleton") && length(legacy_match) > 0 - detected_doc_name <- if (using_legacy_doc) { - legacy_doc_name - } else if (file.exists(fs::path(subdir, current_doc_name))) { - current_doc_name - } else if (any(grepl(qmd_suffix, list.files(subdir)))) { - list.files(subdir)[grep(qmd_suffix, list.files(subdir))][1] - } else { - current_doc_name + if (using_legacy) { + idx <- legacy_match[1] + legacy_name <- legacy_docs[idx] + current_name <- current_docs[idx] + + return(list( + using_legacy = TRUE, + legacy_name = legacy_name, + current_name = current_name, + resolved_name = current_name + )) } - if (using_legacy_doc) { - cli::cli_alert_info("Detected legacy figure/table document order ({.file {legacy_doc_name}} & {.file {legacy_doc_name}}). asar now uses {.file {current_doc_name}} & {.file {current_doc_name}} to maintain an accurate Table of Contents.") - cli::cli_alert_info("{.file {legacy_doc_name}} will be renamed to {.file {current_doc_name}}.") + # Fallback for standard non-legacy paths + existing_current <- current_docs[file.exists(fs::path(subdir, current_docs))] + resolved_name <- if (length(existing_current) > 0) { + existing_current[1] + } else { + current_docs[1] } list( - using_legacy_doc = using_legacy_doc, - legacy_doc_name = legacy_doc_name, - current_doc_name = current_doc_name, - detected_doc_name = detected_doc_name + using_legacy = FALSE, + legacy_name = NULL, + current_name = current_docs[1], + resolved_name = resolved_name ) } \ No newline at end of file diff --git a/tests/testthat/test-create_figures_doc.R b/tests/testthat/test-create_figures_doc.R index b6715f3f..51095e95 100644 --- a/tests/testthat/test-create_figures_doc.R +++ b/tests/testthat/test-create_figures_doc.R @@ -175,7 +175,18 @@ test_that("Adds new figure from figures folder.", { }) test_that("Legacy figures doc name is renamed to new order", { - # standalone figures doc + # standalone doc + create_figures_doc( + subdir = getwd(), + figures_dir = getwd() + ) + + expect_true(file.exists("08_figures.qmd")) + expect_false(file.exists("09_figures.qmd")) + + file.remove(fs::path(getwd(), "08_figures.qmd")) + + # legacy-named doc create_figures_doc() file.rename( @@ -184,10 +195,9 @@ test_that("Legacy figures doc name is renamed to new order", { ) create_figures_doc() - expect_true(file.exists("08_figures.qmd")) expect_false(file.exists("09_figures.qmd")) - + file.remove(fs::path(getwd(), "08_figures.qmd")) # figures doc within report directory @@ -209,38 +219,20 @@ test_that("Legacy figures doc name is renamed to new order", { }) -test_that("Legacy NEMT figures doc name is renamed to new order", { +test_that("nemt figures doc name is named correctly", { create_template(type = "nemt") - file.rename( - from = file.path(getwd(), "report", "05_figures.qmd"), - to = file.path(getwd(), "report", "06_figures.qmd") - ) - - create_template(rerender_skeleton = TRUE, - species = "my species", - file_dir = file.path(getwd(), "report")) - - expect_true(file.exists(file.path(getwd(), "report", "05_figures.qmd"))) - expect_false(file.exists(file.path(getwd(), "report", "06_figures.qmd"))) + expect_true(file.exists(file.path("report", "05_figures.qmd"))) + expect_false(file.exists(file.path("report", "06_figures.qmd"))) - unlink(fs::path(getwd(), "report"), recursive = T) + unlink(fs::path("report"), recursive = T) }) -test_that("Legacy SAFE figures doc name is renamed to new order", { - create_template(type = "nemt") +test_that("safe figures doc name is named correctly", { + create_template(type = "safe") - file.rename( - from = file.path(getwd(), "report", "11_figures.qmd"), - to = file.path(getwd(), "report", "12_figures.qmd") - ) + expect_true(file.exists(file.path("report", "11_figures.qmd"))) + expect_false(file.exists(file.path("report", "12_figures.qmd"))) - create_template(rerender_skeleton = TRUE, - species = "my species", - file_dir = file.path(getwd(), "report")) - - expect_true(file.exists(file.path(getwd(), "report", "11_figures.qmd"))) - expect_false(file.exists(file.path(getwd(), "report", "12_figures.qmd"))) - - unlink(fs::path(getwd(), "report"), recursive = T) + unlink(fs::path("report"), recursive = T) }) diff --git a/tests/testthat/test-create_tables_doc.R b/tests/testthat/test-create_tables_doc.R index 18723313..24fd3c78 100644 --- a/tests/testthat/test-create_tables_doc.R +++ b/tests/testthat/test-create_tables_doc.R @@ -184,8 +184,7 @@ test_that("Adds new table from tables folder.", { }) test_that("Legacy tables doc name is renamed to new order", { - writeLines("# Tables {#sec-tables}", "08_tables.qmd") - + # standalone doc create_tables_doc( subdir = getwd(), tables_dir = getwd() @@ -195,28 +194,39 @@ test_that("Legacy tables doc name is renamed to new order", { expect_false(file.exists("08_tables.qmd")) file.remove(fs::path(getwd(), "09_tables.qmd")) -}) -test_that("Legacy NEMT tables doc name is renamed to new order", { - create_template( - type = "nemt" + # legacy-named doc + create_tables_doc() + + file.rename( + from = file.path(getwd(),"09_tables.qmd"), + to = file.path(getwd(), "08_tables.qmd") ) expect_true(file.exists(file.path(getwd(), "report", "06_tables.qmd"))) expect_false(file.exists(file.path(getwd(), "report", "05_tables.qmd"))) - unlink(file.path(getwd(), "report"), recursive = T) + create_tables_doc() + expect_true(file.exists("09_tables.qmd")) + expect_false(file.exists("08_tables.qmd")) + + file.remove(fs::path(getwd(), "09_tables.qmd")) }) +test_that("nemt tables doc name is named correctly", { + create_template(type = "nemt") + expect_true(file.exists(file.path("report", "06_tables.qmd"))) + expect_false(file.exists(file.path("report", "05_tables.qmd"))) -test_that("Legacy SAFE tables doc name is renamed to new order", { - create_template( - type = "safe" - ) - - expect_true(file.exists(fs::path("report", "12_tables.qmd"))) - expect_false(file.exists(fs::path("report", "11_tables.qmd"))) + unlink(fs::path("report"), recursive = T) +}) - unlink(fs::path(getwd(), "report"), recursive = T) +test_that("safe tables doc name is named correctly", { + create_template(type = "safe") + + expect_true(file.exists(file.path("report", "12_tables.qmd"))) + expect_false(file.exists(file.path("report", "11_tables.qmd"))) + + unlink(fs::path("report"), recursive = T) })