diff --git a/DESCRIPTION b/DESCRIPTION index 54bb8e5..9dad86c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -52,14 +52,14 @@ Suggests: VignetteBuilder: knitr Remotes: + nmfs-fish-tools/nmfspalette, nmfs-fish-tools/nmfspalette, nmfs-ost/satf, - r4ss/r4ss, - nmfs-fish-tools/nmfspalette + r4ss/r4ss Config/testthat/edition: 3 Config/testthat/parallel: true Encoding: UTF-8 Language: en-US +LazyData: true Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2 -LazyData: true diff --git a/R/add_chunk.R b/R/add_chunk.R index 1dd42fa..0c81e6a 100644 --- a/R/add_chunk.R +++ b/R/add_chunk.R @@ -28,7 +28,7 @@ add_chunk <- function( chunk_op = NULL, rmark_op = NULL) { chunk <- paste0( - "```{r", ifelse(add_option, paste0(c("",rmark_op), collapse = ", "), ""), "} \n" + "```{r", ifelse(add_option, paste0(c("", rmark_op), collapse = ", "), ""), "} \n" ) if (!is.null(label)) { chunk <- paste0( diff --git a/R/asar-package.R b/R/asar-package.R index 7b5007d..610a68d 100644 --- a/R/asar-package.R +++ b/R/asar-package.R @@ -6,8 +6,10 @@ NULL ## quiets concerns of R CMD check re: the .'s that appear in pipelines -globvar <- c("yr","value","estimate","seas","subseas","age_bins","morph", - "age","year","nsim","fleet","uncertainty","initial","alt_label", - "last","affiliation","label","type","caption","alt_text","caption", - "name",".") -if(getRversion() >= "2.15.1") utils::globalVariables(globvar) +globvar <- c( + "yr", "value", "estimate", "seas", "subseas", "age_bins", "morph", + "age", "year", "nsim", "fleet", "uncertainty", "initial", "alt_label", + "last", "affiliation", "label", "type", "caption", "alt_text", "caption", + "name", "." +) +if (getRversion() >= "2.15.1") utils::globalVariables(globvar) diff --git a/R/convert_output.R b/R/convert_output.R index e6aee9e..ee20d4e 100644 --- a/R/convert_output.R +++ b/R/convert_output.R @@ -720,13 +720,13 @@ convert_output <- function( # Extract names from landings landings <- dat$t.series |> dplyr::select(dplyr::contains("L.") & dplyr::contains(".ob") | - dplyr::contains("D.") & dplyr::contains(".ob")) + dplyr::contains("D.") & dplyr::contains(".ob")) fleets_land <- stringr::str_extract(as.vector(colnames(landings)), "(?<=L\\.)\\w+(?=\\.ob)") fleets_disc <- stringr::str_extract(as.vector(colnames(landings)), "(?<=D\\.)\\w+(?=\\.ob)") # Extract names from lof F dev parm <- dat$parm.tvec |> - dplyr::select(dplyr::contains("log.F.dev.")| - dplyr::contains("log.F.dev.") & dplyr::contains(".D")) + dplyr::select(dplyr::contains("log.F.dev.") | + dplyr::contains("log.F.dev.") & dplyr::contains(".D")) # fleets_parm_D <- stringr::str_extract(as.vector(colnames(parm)), "(?<=log\\.F\\.dev\\.)\\w+(?=\\.D)") fleets_parm <- stringr::str_extract(as.vector(colnames(parm)), "(?<=log\\.F\\.dev\\.)\\w+") fleets <- unique(c(fleets_ind, fleets_land, fleets_disc, fleets_parm)) @@ -1183,7 +1183,7 @@ convert_output <- function( var_names_sheet <- openxlsx::read.xlsx(con_file) } if (file.exists(con_file)) { - out_new <- dplyr::inner_join(out_new, var_names_sheet, by = c("module_name","label")) |> + out_new <- dplyr::inner_join(out_new, var_names_sheet, by = c("module_name", "label")) |> dplyr::mutate(label = dplyr::case_when( !is.na(alt_label) ~ alt_label, TRUE ~ label diff --git a/R/create_figures_doc.R b/R/create_figures_doc.R index 4f733d6..88bf217 100644 --- a/R/create_figures_doc.R +++ b/R/create_figures_doc.R @@ -18,22 +18,20 @@ create_figures_doc <- function(resdir = NULL, subdir = NULL, include_all = TRUE, rda_dir = NULL) { - model <- match.arg(model, several.ok = FALSE) if (include_all) { - # add header figures_doc <- paste0("## Figures \n \n") # add chunk that creates object as the directory of all rdas -figures_doc <- paste0( + figures_doc <- paste0( figures_doc, add_chunk( paste0("rda_dir <- '", rda_dir, "/rda_files'"), label = "set-rda-dir-figs", eval = "true" - ), + ), "\n" ) @@ -283,7 +281,6 @@ spawning_recruitment_alt_text <- spawning_recruitment_plot_rda$alt_text"), ), "\n" ) - } else { # add option for only adding specified figures } diff --git a/R/create_tables_doc.R b/R/create_tables_doc.R index d76cf84..1d1004a 100644 --- a/R/create_tables_doc.R +++ b/R/create_tables_doc.R @@ -17,11 +17,9 @@ create_tables_doc <- function(resdir = NULL, subdir = NULL, include_all = TRUE, rda_dir = NULL) { - model <- match.arg(model, several.ok = FALSE) if (include_all) { - # add header tables_doc <- paste0("## Tables \n \n") @@ -32,7 +30,7 @@ create_tables_doc <- function(resdir = NULL, paste0("rda_dir <- '", rda_dir, "/rda_files'"), label = "set-rda-dir-tbls", eval = "false" - ), + ), "\n" ) @@ -74,7 +72,6 @@ indices_cap <- indices_table_rda$cap"), ) # Add other tables follow the same above format - } else { # add option for only adding specified tables } diff --git a/R/create_template.R b/R/create_template.R index 57d9d46..0664b7e 100644 --- a/R/create_template.R +++ b/R/create_template.R @@ -272,8 +272,7 @@ create_template <- function( ref_line = c("target", "MSY", "msy", "unfished"), spawning_biomass_label = "metric tons", recruitment_label = "metric tons", - ref_line_sb = c("target", "MSY", "msy", "unfished") - ) { + ref_line_sb = c("target", "MSY", "msy", "unfished")) { # If analyst forgets to add year, default will be the current year report is being produced if (is.null(year)) { year <- format(as.POSIXct(Sys.Date(), format = "%YYYY-%mm-%dd"), "%Y") @@ -370,7 +369,7 @@ create_template <- function( # check if enter file exists if (!file.exists(bib_file)) stop(".bib file not found.") bib_loc <- bib_file # dirname(bib_file) - bib_name <- utils::tail(stringr::str_split(bib_file, "/")[[1]], n=1) + bib_name <- utils::tail(stringr::str_split(bib_file, "/")[[1]], n = 1) } # Check if there are already files in the folder @@ -420,23 +419,22 @@ create_template <- function( # Create tables qmd if (include_tables) { if (!is.null(resdir) | !is.null(model_results) | !is.null(model)) { - if (!is.null(rda_dir) & !is.null(end_year)){ - create_tables_doc( - resdir = resdir, - model_results = model_results, - model = model, - subdir = subdir, - rda_dir = rda_dir - ) - - } else { - tables_doc <- paste0( - "### Tables \n \n", - "Please refer to the `satf` package downloaded from remotes::install_github('nmfs-ost/satf') to add premade tables." - ) - utils::capture.output(cat(tables_doc), file = fs::path(subdir, "08_tables.qmd"), append = FALSE) - warning("Rda directory and/or arguments needed to create .rda files not defined.") - } + if (!is.null(rda_dir) & !is.null(end_year)) { + create_tables_doc( + resdir = resdir, + model_results = model_results, + model = model, + subdir = subdir, + rda_dir = rda_dir + ) + } else { + tables_doc <- paste0( + "### Tables \n \n", + "Please refer to the `satf` package downloaded from remotes::install_github('nmfs-ost/satf') to add premade tables." + ) + utils::capture.output(cat(tables_doc), file = fs::path(subdir, "08_tables.qmd"), append = FALSE) + warning("Rda directory and/or arguments needed to create .rda files not defined.") + } } else { tables_doc <- paste0( "### Tables \n \n", @@ -444,7 +442,7 @@ create_template <- function( ) utils::capture.output(cat(tables_doc), file = fs::path(subdir, "08_tables.qmd"), append = FALSE) warning("Results file or model name not defined.") - } + } } @@ -457,23 +455,23 @@ create_template <- function( # Create figures qmd if (include_figures) { if (!is.null(resdir) | !is.null(model_results) | !is.null(model)) { - if (!is.null(rda_dir) & !is.null(end_year)){ - create_figures_doc( - resdir = resdir, - model_results = model_results, - model = model, - subdir = subdir, - year = year, - rda_dir = rda_dir - ) - } else { - figures_doc <- paste0( - "### Figures \n \n", - "Please refer to the `satf` package downloaded from remotes::install_github('nmfs-ost/satf') to add premade figures." - ) - utils::capture.output(cat(figures_doc), file = fs::path(subdir, "09_figures.qmd"), append = FALSE) - warning("Rda directory and/or arguments needed to create .rda files not defined.") - } + if (!is.null(rda_dir) & !is.null(end_year)) { + create_figures_doc( + resdir = resdir, + model_results = model_results, + model = model, + subdir = subdir, + year = year, + rda_dir = rda_dir + ) + } else { + figures_doc <- paste0( + "### Figures \n \n", + "Please refer to the `satf` package downloaded from remotes::install_github('nmfs-ost/satf') to add premade figures." + ) + utils::capture.output(cat(figures_doc), file = fs::path(subdir, "09_figures.qmd"), append = FALSE) + warning("Rda directory and/or arguments needed to create .rda files not defined.") + } } else { figures_doc <- paste0( "### Figures \n \n", @@ -481,8 +479,7 @@ create_template <- function( ) utils::capture.output(cat(figures_doc), file = fs::path(subdir, "09_figures.qmd"), append = FALSE) warning("Results file or model name not defined.") - - } + } } # Part I @@ -711,15 +708,15 @@ create_template <- function( # Add option for bib file # if (!is.null(bib_file)) { - bib <- glue::glue( - "bibliography: ", "\n" - ) - bib_all <- paste(" ", "- ", bib_name, "\n", collapse = "") - bib <- glue::glue( - bib, "\n", - bib_all, "\n" - ) - yaml <- paste0(yaml, bib) + bib <- glue::glue( + "bibliography: ", "\n" + ) + bib_all <- paste(" ", "- ", bib_name, "\n", collapse = "") + bib <- glue::glue( + bib, "\n", + bib_all, "\n" + ) + yaml <- paste0(yaml, bib) # } # add in else statement once a national .bib file is made @@ -743,16 +740,16 @@ create_template <- function( savedir = subdir, save_name = paste(stringr::str_replace_all(species, " ", "_"), "_std_res_", year, sep = "") ) - # } else if (tolower(model) == "bam") { - # convert_output( - # output_file = model_results, - # outdir = resdir, - # file_save = TRUE, - # model = model, - # fleet_names = fleet_names, - # savedir = subdir, - # save_name = paste(sub(" ", "_", species), "_std_res_", year, sep = "") - # ) + # } else if (tolower(model) == "bam") { + # convert_output( + # output_file = model_results, + # outdir = resdir, + # file_save = TRUE, + # model = model, + # fleet_names = fleet_names, + # savedir = subdir, + # save_name = paste(sub(" ", "_", species), "_std_res_", year, sep = "") + # ) } else { convert_output( output_file = model_results, @@ -769,28 +766,26 @@ create_template <- function( } # run satf::exp_all_figs_tables() if rda files not premade - if (!is.null(rda_dir) & !is.null(end_year)){ - - if(!dir.exists(file.path(rda_dir, "rda_files"))){ - - # load converted output - output <- utils::read.csv(paste0(resdir, "/", model_results)) - - # run satf::exp_all_figs_tables() to make rda files - satf::exp_all_figs_tables( - dat = output, - unit_label = unit_label, - scale_amount = scale_amount, - end_year = end_year, - n_projected_years = n_projected_years, - relative = relative, - make_rda = TRUE, - rda_dir = rda_dir, - ref_line = ref_line, - spawning_biomass_label = spawning_biomass_label, - recruitment_label = recruitment_label, - ref_line_sb = ref_line_sb - ) + if (!is.null(rda_dir) & !is.null(end_year)) { + if (!dir.exists(file.path(rda_dir, "rda_files"))) { + # load converted output + output <- utils::read.csv(paste0(resdir, "/", model_results)) + + # run satf::exp_all_figs_tables() to make rda files + satf::exp_all_figs_tables( + dat = output, + unit_label = unit_label, + scale_amount = scale_amount, + end_year = end_year, + n_projected_years = n_projected_years, + relative = relative, + make_rda = TRUE, + rda_dir = rda_dir, + ref_line = ref_line, + spawning_biomass_label = spawning_biomass_label, + recruitment_label = recruitment_label, + ref_line_sb = ref_line_sb + ) } } @@ -804,14 +799,13 @@ create_template <- function( "# load converted output from asar::convert_output() \n", "output <- utils::read.csv('", ifelse(convert_output, - paste0(subdir, "/", stringr::str_replace_all(species, " ", "_"), "_std_res_", year, ".csv"), - paste0(resdir, "/", model_results) - ), "') \n", + paste0(subdir, "/", stringr::str_replace_all(species, " ", "_"), "_std_res_", year, ".csv"), + paste0(resdir, "/", model_results) + ), "') \n", "# Call reference points and quantities below \n", "output <- output |> \n", " ", "dplyr::mutate(estimate = as.numeric(estimate), \n", " ", " ", "uncertainty = as.numeric(uncertainty)) \n", - "start_year <- as.numeric(min(output$year, na.rm = TRUE)) \n", # change end year in the fxn to ifelse where is.null(year) "end_year <- (output |> \n", @@ -829,34 +823,28 @@ create_template <- function( " ", " ", "is.na(area), \n", " ", " ", "is.na(growth_pattern), \n", " ", " ", "is.na(subseason), \n", - " ", " ", "is.na(age))", "\n", - + " ", " ", "is.na(age))", "\n", "# terminal fishing mortality \n", "Fend <- output2 |> ", "\n", " ", "dplyr::filter(c(label == 'fishing_mortality' & year == end_year) | c(label == 'terminal_fishing_mortality' & is.na(year))) |>", "\n", " ", "dplyr::pull(estimate)", "\n", - "# fishing mortality at msy \n", "# please change target if desired \n", "Ftarg <- output2 |>", "\n", " ", "dplyr::filter(grepl('f_target', label) | grepl('f_msy', label) | c(grepl('fishing_mortality_msy', label) & is.na(year))) |>", "\n", " ", "dplyr::pull(estimate)", "\n", - "# Terminal year F respective to F target \n", "F_Ftarg <- Fend / Ftarg", "\n", - "# terminal year biomass \n", "Bend <- output2 |>", "\n", " ", "dplyr::filter(grepl('mature_biomass', label) | grepl('^biomass$', label),", "\n", " ", " ", "year == end_year) |>", "\n", " ", "dplyr::pull(estimate)", "\n", - "# target biomass (msy) \n", "# please change target if desired \n", "Btarg <- output2 |>", "\n", " ", "dplyr::filter(c(grepl('biomass', label) & grepl('target', label) & estimate >1) | label == 'biomass_msy') |>", "\n", " ", "dplyr::pull(estimate)", "\n", - "# total catch in the last year \n", "total_catch <- output |>", "\n", " ", "dplyr::filter(grepl('^catch$', label), \n", @@ -875,40 +863,33 @@ create_template <- function( " ", " ", "is.na(fleet),", "\n", " ", " ", "is.na(age)) |>", "\n", " ", "dplyr::pull(estimate)", "\n", - "# spawning biomass in the last year\n", "sbend <- output2 |>", "\n", " ", "dplyr::filter(grepl('spawning_biomass', label), year == end_year) |>", "\n", " ", "dplyr::pull(estimate) |>", "\n", " ", " ", "unique()", "\n", - "# overall natural mortality or at age \n", "M <- output |>", "\n", " ", "dplyr::filter(grepl('natural_mortality', label)) |>", "\n", " ", "dplyr::pull(estimate)", "\n", - "# Biomass at msy \n", "# to change to another reference point, replace msy in the following lines with other label \n", "Bmsy <- output2 |>", "\n", " ", "dplyr::filter(c(grepl('biomass', label) & grepl('msy', label) & estimate >1) | label == 'biomass_msy') |>", "\n", " ", "dplyr::pull(estimate)", "\n", - "# target spawning biomass(msy) \n", "# please change target if desired \n", "SBtarg <- output2 |>", "\n", " ", "dplyr::filter(c(grepl('spawning_biomass', label) & grepl('msy$', label) & estimate >1) | label == 'spawning_biomass_msy$') |>", "\n", " ", "dplyr::pull(estimate)", "\n", - "# steepness \n", "h <- output |> ", "\n", " ", "dplyr::filter(grepl('steep', label)) |> ", "\n", " ", "dplyr::pull(estimate)", "\n", - "# recruitment \n", "R0 <- output |> ", "\n", " ", "dplyr::filter(grepl('R0', label) | grepl('recruitment_virgin', label)) |> ", "\n", " ", "dplyr::pull(estimate)", "\n", - "# female SB (placeholder)", "\n" ), label = "output_and_quantities", diff --git a/tests/testthat/test-create_template.R b/tests/testthat/test-create_template.R index 7f41a68..c594c3c 100644 --- a/tests/testthat/test-create_template.R +++ b/tests/testthat/test-create_template.R @@ -43,7 +43,7 @@ test_that("create_template() creates correct files", { "SAR_species_skeleton.qmd", "asar_references.bib", "support_files" - ) + ) # Define expected support files expect_support_files <- c( @@ -63,7 +63,8 @@ test_that("create_template() creates correct files", { object_support_files <- list.files(file.path(no_inputs_output_path, "support_files")) on.exit(unlink(file.path(path, "report"), - recursive = TRUE), add = TRUE) + recursive = TRUE + ), add = TRUE) # Check if all expected report files are created expect_true(all(sort(expect_report_files) == sort(object_report_files))) @@ -152,7 +153,8 @@ test_that("warning is triggered for missing models", { regexp = "Results file or model name not defined." ) on.exit(unlink(file.path(getwd(), "report"), - recursive = TRUE), add = TRUE) + recursive = TRUE + ), add = TRUE) }) test_that("warning is triggered for existing files", { diff --git a/vignettes/accessibility_guide.Rmd b/vignettes/accessibility_guide.Rmd index 018bbaa..48c9259 100644 --- a/vignettes/accessibility_guide.Rmd +++ b/vignettes/accessibility_guide.Rmd @@ -75,28 +75,36 @@ Both presentations are great resources for learning about alt text and will help Here is an example of a figure with a caption and alt text. The caption is shown directly below the figure and is written in the chunk's options (`fig.cap=""`). The alt text is also included in the chunk's options (`fig.alt=""`) but is not shown unless the webpage is inspected with Developer Tools or it's extracted with a screen reader. ```{r, warning=FALSE, eval = TRUE, fig.align='center', fig.cap= "Tree circumference and age for 5 orange trees.", fig.alt="A line graph showing how tree circumference increases with age for a set of 5 orange trees. Age, shown on the x axis, is measured in days since 1968/12/31 and spans from 118-1582 days. Circumference, shown on the y axis, spans from 30-214 mm. All trees showed an increasing trend of trunk circumference with age, with each tree starting with a circumference of 30-33 mm at age 0 and ending with a circumference of 140-216 mm at age 1582. At age 1582, the tree with the largest circumference was tree 4, followed by trees 2, 5, 1, and 3."} - library(ggplot2) orange <- as.data.frame(Orange) orange <- orange |> dplyr::mutate(Tree = base::factor(Tree, - levels = c(1,2,3,4,5))) |> - dplyr::rename(Age = age, - Circumference = circumference) - -ggplot2::ggplot(data = orange, - aes(x = Age, - y = Circumference, - color = Tree)) + -ggplot2::geom_line(size = 1) + -ggplot2::geom_point(size = 2) + -ggplot2::scale_color_viridis_d() + -ggplot2::xlim(0, NA) + -ggplot2::ylim(0, NA) + -ggplot2::theme_bw() + - labs(x = "Age (days since 1968/12/31)", - y = "Orange Tree Circumference (mm)") + levels = c(1, 2, 3, 4, 5) + )) |> + dplyr::rename( + Age = age, + Circumference = circumference + ) + +ggplot2::ggplot( + data = orange, + aes( + x = Age, + y = Circumference, + color = Tree + ) +) + + ggplot2::geom_line(size = 1) + + ggplot2::geom_point(size = 2) + + ggplot2::scale_color_viridis_d() + + ggplot2::xlim(0, NA) + + ggplot2::ylim(0, NA) + + ggplot2::theme_bw() + + labs( + x = "Age (days since 1968/12/31)", + y = "Orange Tree Circumference (mm)" + ) ``` The figure's alt text is written as such: @@ -133,7 +141,6 @@ To edit your rda’s alt text, follow these steps: 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: ```{r, eval = FALSE} - # the original alt text for the recruitment figure recruitment_alt_text @@ -147,7 +154,6 @@ recruitment_alt_text <- paste0(recruitment_alt_text, new_alt_text) 5. **Replace the alt text by** updating the original alt text object *within the chunk*. To do this, reassign the original alt text object as your new text object. For example: ```{r, eval = FALSE} - # the original alt text for the recruitment figure recruitment_alt_text