diff --git a/R/create_figures_doc.R b/R/create_figures_doc.R index d655c8f8..f0928c64 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,37 +22,33 @@ #' ) #' } 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" - - # 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) { 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, @@ -63,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 (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 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 @@ -130,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", @@ -151,20 +138,20 @@ rm(rda)\n ), "\n" ) - + paste0( figures_doc_plot_setup1, figures_doc_plot_setup2 ) } - + 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 + 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)}", @@ -178,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)) { @@ -189,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" @@ -197,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( @@ -223,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"), @@ -249,28 +231,37 @@ rm(rda)\n ) ) } - # Save figures doc to template folder + + 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 + } + 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))], - "09_figures.qmd" - ) - ), - append = append - ) - - # 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, "09_figures.qmd") + file = fs::path(subdir, figures_doc_name), + append = append ) - + + if (doc_info$using_legacy) { + file.rename( + 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) + } + + current_figures_doc <- fs::path(subdir, doc_info$resolved_name) + fix_duplicate_chunks( - doc_path = doc_path, + 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 4b51ee3d..e8f317ae 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. @@ -32,51 +38,35 @@ #' } create_tables_doc <- function(subdir = getwd(), tables_dir = getwd()) { - # 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) 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" - - # 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() - + 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, @@ -89,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", @@ -101,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 (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 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( @@ -208,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( @@ -220,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", @@ -233,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( @@ -251,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", @@ -262,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( @@ -313,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( @@ -354,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", @@ -363,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( @@ -394,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( @@ -442,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", @@ -451,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( @@ -485,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 (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 + 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)}", @@ -525,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)) { @@ -535,68 +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, + "" + ) ) } - - # Save tables doc to template folder + + 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 + } + 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))], - "08_tables.qmd" - ) - ), - append = append - ) - - # 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, "08_tables.qmd") + file = fs::path(subdir, tables_doc_name), + append = append ) - + + if (doc_info$using_legacy) { + file.rename( + 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) + } + + current_tables_doc <- fs::path(subdir, doc_info$resolved_name) + fix_duplicate_chunks( - doc_path = doc_path, + 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 ab842072..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,82 +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 - 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() - } + 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" + ) + + # 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) { + + 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( @@ -319,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}_"), "", @@ -339,7 +335,7 @@ create_template <- function( gsub(glue::glue("{region_name}_"), "", report_name_1) ) ) - + new_report_name <- paste0( type, "_", ifelse( @@ -350,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 @@ -360,9 +355,7 @@ create_template <- function( "_" ) } else { - report_name <- paste0( - "type_" - ) + report_name <- paste0("type_") } # Add region to name report_name <- ifelse( @@ -375,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 { @@ -420,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) { @@ -430,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]+" @@ -536,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() } @@ -561,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( @@ -624,104 +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 - - # created tables doc + } + } + + # 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 + + if (using_legacy_doc_order) { + 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 will switch to {.file {fig_info$current_name}} before {.file {tbl_info$current_name}}.") + } + + # Created tables doc if (!rerender_skeleton) { - { - tables_doc_name <- switch(type, - "nemt" = "05_tables.qmd", - "safe" = "11_tables.qmd", - "08_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 - ) - } # |> - # 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 <- list.files(file_dir, pattern = "tables.qmd") + tables_doc_name <- if (using_legacy_doc_order) { + tbl_info$current_name + } else { + list.files(file_dir, pattern = "tables.qmd") + } } - + # 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( subdir = subdir, - figures_dir = figures_dir + figures_dir = figures_dir, + figures_doc_name = figures_doc_name ) - # 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) ) } } 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) { + 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)) { @@ -745,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, @@ -788,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 @@ -804,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( @@ -821,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, @@ -850,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( @@ -865,6 +786,7 @@ create_template <- function( label = "R_parameters" ) } + params_chunk <- add_chunk( paste0( "# Parameters \n", @@ -874,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( @@ -888,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", @@ -959,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, @@ -999,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( @@ -1021,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.") @@ -1031,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)] @@ -1052,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, @@ -1092,25 +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 == "") - # add sections as list + + if (using_legacy_doc_order) { + sections <- sections |> + 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 == 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, + fig_info$current_name, + after = table_position - 1 + ) + } + } + sections <- add_child( sections, label = gsub(".qmd", "", unlist(sections)) @@ -1118,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, @@ -1146,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, @@ -1190,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)) @@ -1237,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 0bce2c78..5816a656 100644 --- a/R/utils.R +++ b/R/utils.R @@ -413,3 +413,93 @@ format_citation_authors <- function(author_names) { glue::glue_collapse(sep = ", ", last = ", and ") |> as.character() } + +# ---------------------------- + +#' 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") + ) +} + +#' 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 <- mapping$legacy_tables + current_docs <- mapping$current_tables + } + + # 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 <- (rerender_skeleton || doc_type != "skeleton") && length(legacy_match) > 0 + + 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 + )) + } + + # 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 = 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 1921b117..51095e95 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,9 +80,9 @@ 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) + head_figure_content <- head(figure_content, 6) # remove line numbers and collapse fc_pasted <- paste(head_figure_content, 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)] @@ -173,3 +173,66 @@ 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", { + # 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( + 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("nemt figures doc name is named correctly", { + create_template(type = "nemt") + + expect_true(file.exists(file.path("report", "05_figures.qmd"))) + expect_false(file.exists(file.path("report", "06_figures.qmd"))) + + unlink(fs::path("report"), recursive = T) +}) + +test_that("safe figures doc name is named correctly", { + create_template(type = "safe") + + expect_true(file.exists(file.path("report", "11_figures.qmd"))) + expect_false(file.exists(file.path("report", "12_figures.qmd"))) + + 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 d3935f90..24fd3c78 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)] @@ -182,3 +182,51 @@ 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", { + # standalone doc + 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")) + + # 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"))) + + 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"))) + + unlink(fs::path("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) +}) diff --git a/tests/testthat/test-create_template.R b/tests/testthat/test-create_template.R index 639a4b6d..42302319 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", @@ -238,6 +238,45 @@ 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, + file_dir = "report") |> suppressWarnings() + + updated_skeleton <- readLines(skeleton_path) + updated_figures_idx <- grep("08_figures.qmd", updated_skeleton, fixed = TRUE) + updated_tables_idx <- grep("09_tables.qmd", updated_skeleton, fixed = TRUE) + + expect_true(file.exists(fs::path(report_dir, "08_figures.qmd"))) + expect_true(file.exists(fs::path(report_dir, "09_tables.qmd"))) + expect_false(file.exists(fs::path(report_dir, "09_figures.qmd"))) + expect_false(file.exists(fs::path(report_dir, "08_tables.qmd"))) + expect_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) @@ -314,8 +353,8 @@ test_that("model_results metadata file created", { "05_discussion.qmd", "06_acknowledgments.qmd", "07_references.qmd", - "08_tables.qmd", - "09_figures.qmd", + "08_figures.qmd", + "09_tables.qmd", # "10_notes.qmd", "11_appendix.qmd", "sar_species_skeleton.qmd", @@ -335,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", { 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..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 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 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 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 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 261fc180..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 '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 '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 a09a917e..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 '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 '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 7f49d326..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 '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 '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.