diff --git a/.Rbuildignore b/.Rbuildignore index fd4e1bcc..5a38238f 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -11,3 +11,4 @@ CONTRIBUTING.md ^validation\.yml$ vignettes/validation/validation.yml +^man/figures/cheatsheets/* diff --git a/.gitignore b/.gitignore index 48553b66..f0a9bbde 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ valtools.Rproj .Rproj.user .Rhistory +inst/doc diff --git a/DESCRIPTION b/DESCRIPTION index d9984ad3..c8d534b9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,12 +1,12 @@ Package: valtools Title: Automate Validated Package Creation -Version: 0.3.0 +Version: 0.4.0 Authors@R: c( person(given = "Ellis", family = "Hughes", role = c("aut","cre"), - email = "ehhughes@scharp.org", + email = "ellishughes@live.com", comment = c(ORCID = "0000-0003-0637-4436")), person(given = "Eli", family = "Miller", @@ -23,6 +23,11 @@ Authors@R: role = "aut", email = "peymaan.es@gmail.com", comment = c(ORCID = "0000-0003-1613-2705")), + person(given = "Maya", + family = "Gans", + role = "ctb", + email = "maya.gans@atorusresearch.com", + comment = c(ORCID = "0000-0002-5452-6089")), person(given = "PHUSE", role = "cph") ) @@ -35,7 +40,7 @@ License: MIT + file LICENSE Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.1.1 +RoxygenNote: 7.1.2 Suggests: covr, XML, diff --git a/NAMESPACE b/NAMESPACE index d213717a..ec5f8e09 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,6 +18,7 @@ S3method(roxy_tag_rd,roxy_tag_riskAssessment) export(vt_add_file_to_config) export(vt_add_user_to_config) export(vt_create_package) +export(vt_create_packet) export(vt_drop_file_from_config) export(vt_drop_user_from_config) export(vt_dynamic_referencer) @@ -87,6 +88,7 @@ importFrom(kableExtra,kable_styling) importFrom(knitr,asis_output) importFrom(knitr,current_input) importFrom(knitr,kable) +importFrom(knitr,knit) importFrom(knitr,knit_child) importFrom(knitr,opts_knit) importFrom(lubridate,parse_date_time) @@ -128,9 +130,12 @@ importFrom(tools,file_ext) importFrom(tools,file_path_sans_ext) importFrom(usethis,create_package) importFrom(usethis,edit_file) +importFrom(usethis,local_project) +importFrom(usethis,proj_activate) importFrom(usethis,ui_stop) importFrom(usethis,ui_value) importFrom(usethis,use_git_ignore) +importFrom(usethis,use_rstudio) importFrom(usethis,write_union) importFrom(utils,capture.output) importFrom(utils,getFromNamespace) diff --git a/R/case.R b/R/case.R index c8f13a5e..6b9f435b 100644 --- a/R/case.R +++ b/R/case.R @@ -40,7 +40,7 @@ vt_use_test_case <- function(name, username = vt_username(), title = NULL, open = interactive(), add_before = NULL, add_after = NULL) { - name <- vt_set_ext(name, ext = "md") + name <- vt_set_ext(name, ext = c("md","rmd")) is_valid_name(name) @@ -60,14 +60,17 @@ vt_use_test_case <- function(name, username = vt_username(), title = NULL, open username = username, editDate = as.character(Sys.Date()) )) - + + # Add file to validation configuration + vt_add_file_to_config( + filename = name, + after = {{add_after}}, + before = {{add_before}} + ) } - # Add file to validation configuration - vt_add_file_to_config(filename = name, after = {{add_after}}, before = {{add_before}}) - if(open){ - edit_file(case_name) + edit_file(case_name) # nocov } invisible(case_name) diff --git a/R/code.R b/R/code.R index dd30bb50..a758c266 100644 --- a/R/code.R +++ b/R/code.R @@ -20,14 +20,19 @@ vt_use_test_code <- function(name, username = vt_username(), open = interactive( username = username, editDate = as.character(Sys.Date()) )) + + # Add file to validation configuration + vt_add_file_to_config( + filename = name, + after = {{add_after}}, + before = {{add_before}} + ) } - # Add file to validation configuration - vt_add_file_to_config(filename = name, after = {{add_after}}, - before = {{add_before}}) + if(open){ - edit_file(code_name) + edit_file(code_name) # nocov } invisible(code_name) diff --git a/R/coverage-matrix.R b/R/coverage-matrix.R index 26d4bcf1..80af6eaf 100644 --- a/R/coverage-matrix.R +++ b/R/coverage-matrix.R @@ -13,12 +13,10 @@ vt_scrape_coverage_matrix <- function(type = c("long", "wide"), do.call("rbind", apply(vals, 1, FUN = function(x){ this_row <- strsplit(x[["coverage"]], split = ":")[[1]] - if(length(this_row) == 1){ - this_row <- rep(this_row, 2) - } else if(length(this_row) != 2){ - rlang::abort(paste("Coverage details must follow format Test_Case:Requirement.", - "See", x[["tc_title"]]), + if(length(this_row) != 2){ + rlang::abort(paste0("Coverage details must follow format Test_Case:Requirement.", + " See ", x[["tc_title"]], ", Coverage Entry: ",trimws(x[["coverage"]])), class = "vt.coverage_format") } names(this_row) <- c("tc_id", "req_id") @@ -31,19 +29,31 @@ vt_scrape_coverage_matrix <- function(type = c("long", "wide"), } split_req <- function(vals){ - do.call("rbind", apply(vals, 1, FUN = function(x){ + out <- do.call("rbind", apply(vals, 1, FUN = function(x){ req_one_row <- data.frame(tc_title = x[["tc_title"]], tc_id = x[["tc_id"]], - req_id = strsplit(trimws(x[["req_id"]]), split = ", ")[[1]], + req_id = trimws(strsplit(trimws(x[["req_id"]]), split = ", ")[[1]]), deprecate = x[["deprecate"]], stringsAsFactors = FALSE) + + + req_one_row$req_title <- paste0("Requirement ", gsub(req_one_row$req_id, pattern = "^(\\d+)\\.*.*", replacement = "\\1")) + req_one_row })) + + # req_title uses only first numeric position + out$req_title <- factor(out$req_title, + levels = paste0("Requirement ", + sort(as.numeric(unique(unlist(lapply(strsplit(out$req_title, split = " "), + function(x){x[2]}))))))) + out[order(out$req_title),] + } # avoids dependency on tidyr::pivot_wider @@ -64,6 +74,7 @@ vt_scrape_coverage_matrix <- function(type = c("long", "wide"), x }) out <- do.call("rbind", list_all_x) + row.names(out) <- 1:nrow(out) out[, c("req_title", "req_id", sort(names(out)[-1:-2]))] } @@ -91,7 +102,7 @@ vt_scrape_coverage_matrix <- function(type = c("long", "wide"), vals_all <- split_req(numbered_cov_vals) if(type[1] == "long"){ - out_data <- vals_all[order(vals_all$req_id),] + out_data <- vals_all[order(vals_all$req_title),] row.names(out_data) <- 1:nrow(out_data) out_data <- out_data[, c("req_title", "req_id", "tc_title", "tc_id", "deprecate")] attr(out_data, "table_type") <- "long" diff --git a/R/dynamic_referencing.R b/R/dynamic_referencing.R index 324ae8de..1cfb5638 100644 --- a/R/dynamic_referencing.R +++ b/R/dynamic_referencing.R @@ -50,9 +50,12 @@ vt_dynamic_referencer <- R6::R6Class("vt_dynamic_referencer", #' ref$list_references() scrape_references = function(text){ - + ## Drop roxygen comment headers from text for scraping references. text <- unname(unlist(text[!grepl("^#'", text)])) + + ## drop NA text from scraping + text <- text[!is.na(text)] reference_locations <- gregexpr( diff --git a/R/file_and_path_utils.R b/R/file_and_path_utils.R index 0b86af62..ccbb221b 100644 --- a/R/file_and_path_utils.R +++ b/R/file_and_path_utils.R @@ -58,8 +58,18 @@ vt_path <- function(...){ #' #' @export vt_find_config <- function(){ - - root <- find_root(has_file(".here") | is_rstudio_project | is_r_package | is_vcs_root) + + tryCatch({ + root <- find_root(has_file(".here") | is_rstudio_project | is_r_package | is_vcs_root) + }, error = function(e){ + abort( + paste0( + "Could not find root directory. ", + "Is your working directory inside a package, validation packet, or project?\n" + ), + class = "vt.validation_root_missing" + ) + }) tryCatch({ diff --git a/R/init.R b/R/init.R index 85a003b9..132336bf 100644 --- a/R/init.R +++ b/R/init.R @@ -54,7 +54,7 @@ vt_use_validation <- function( pkg = ".", working_dir, ...) { #' @inheritParams usethis::create_package #' #' @importFrom usethis create_package -#' @importFrom rlang inform abort +#' @importFrom rlang inform abort is_interactive #' #' @rdname val_init #' @@ -89,6 +89,62 @@ vt_create_package <- function(pkg = ".", ..., fields = list(), rstudio = rstudio } +#' @description Create the validation packet infrastructure. Intended to create +#' validation infrastructure external to an R package. +#' +#' @param target target of validation. Character name of package or scope validation packet is being performed for. +#' @param ... Additional argument passed to `vt_use_config()` +#' @inheritParams usethis::create_project +#' +#' @importFrom usethis use_rstudio local_project proj_activate +#' @importFrom rlang inform abort is_interactive +#' +#' @rdname val_init +#' +#' @export +vt_create_packet <- function(path = ".", target, ..., rstudio = rstudioapi::isAvailable(), open = rlang::is_interactive()) { + + if(is_package(path)){ + abort(paste0( + "`vt_create_packet()` is not intended to add validation infrastructure", + " to an existing package. Use `vt_use_validation()` instead." + )) + } + + tryCatch({ + + if(!dir.exists(path)){ + dir.create(path = path, recursive = TRUE, showWarnings = FALSE) + usethis::with_project(path = path,force = TRUE,{ + if(rstudio){ + usethis::use_rstudio() + }else{ + file.create(".here") + } + }) + } + + ## set up validation structure in package & create basic config for validation + vt_use_validation(pkg = path, working_dir = ".", package = target, ...) + + inform("Created validation packet", + class = "vt.initPacket") + + }, error = function(e) { + abort(paste0("Failed to create validation packet.\n", #nocov + e, sep = "\n"), #nocov + class = "vt.initPacketFail") #nocov + + }) + + if(open){ + usethis::proj_activate(path = path) + } + + invisible() + +} + #' Internal wrapper function to call vt_create_package(). #' To be used by RStudio project wizard, preventing opening the project twice. #' @@ -99,5 +155,14 @@ vt_create_package_wizard <- function(path, ...){ vt_create_package(pkg= path, open= FALSE, ...) # nocov } +#' Internal wrapper function to call vt_create_packet(). +#' To be used by RStudio project wizard, preventing opening the project twice. +#' +#' @param path Project directory, collected through project wizard +#' +#' @noRd +vt_create_packet_wizard <- function(path, ...){ + vt_create_packet(path = path, open= FALSE, ...) # nocov +} diff --git a/R/req.R b/R/req.R index ee04595d..78f8865f 100644 --- a/R/req.R +++ b/R/req.R @@ -8,7 +8,7 @@ vt_use_req <- function(name, username = vt_username(), title = NULL, open = inte add_before = NULL, add_after = NULL){ # ensure file extensions are of the acceptable type - name <- vt_set_ext(name, ext = "md") + name <- vt_set_ext(name, ext = c("md", "rmd")) is_valid_name(name) @@ -29,12 +29,17 @@ vt_use_req <- function(name, username = vt_username(), title = NULL, open = inte title = title, editDate = as.character(Sys.Date()) )) + + vt_add_file_to_config( + filename = name, + after = {{add_after}}, + before = {{add_before}} + ) } - vt_add_file_to_config(filename = name, after = {{add_after}}, before = {{add_before}}) if(open){ - edit_file(req_name) + edit_file(req_name) # nocov } invisible(req_name) diff --git a/R/roxygen_extension.R b/R/roxygen_extension.R index e80ea928..f499a623 100644 --- a/R/roxygen_extension.R +++ b/R/roxygen_extension.R @@ -30,6 +30,8 @@ roxy_tag_parse.roxy_tag_deprecate <- function(x) { tag_markdown(x) } +# nocov start + #' @export #' @importFrom roxygen2 rd_section roxy_tag_rd roxy_tag_rd.roxy_tag_editor <- function(x, base_path, env) { @@ -97,6 +99,7 @@ format.rd_section_deprecate <- function(x, ...) { ) } +# nocov end format_coverage_text <- function(x){ diff --git a/R/utils.R b/R/utils.R index 45ddf3f0..14312d12 100644 --- a/R/utils.R +++ b/R/utils.R @@ -13,6 +13,13 @@ create_item <- function(type = c("requirements","test_cases","test_code"), item_ type <- match.arg(type) validation_directory <- vt_path() + + item_file_path <- file.path(validation_directory, type, item_name) + + ## if file exists, just return path + if(file.exists(item_file_path)){ + return(item_file_path) + } # Create item folder if this is the first item if(!dir.exists(file.path(validation_directory, type))) { @@ -35,19 +42,29 @@ create_item <- function(type = c("requirements","test_cases","test_code"), item_ }) } - item_file_path <- file.path(validation_directory, type, item_name) - tryCatch({ + tryCatch({ file.create(item_file_path) - inform(paste0("Item created:", file.path(type, item_name), sep = " ", collapse = "")) + inform(paste0( + "Item created:", + file.path(type, item_name), + sep = " ", + collapse = "" + )) return(item_file_path) - + }, error = function(e) { - abort(paste0("Failed to create validation", type, item_name, - sep = " ", collapse = ""), - class = "vt.itemCreateFail") + abort(paste0( + "Failed to create validation", + type, + item_name, + sep = " ", + collapse = "" + ), + class = "vt.itemCreateFail") }) + } @@ -87,7 +104,7 @@ vt_username <- function(){ #' #' @noRd #' @param filename the filname to add/replace extention -#' @param ext intended extention +#' @param ext intended extention(s) #' #' @returns filename with correct extention #' @@ -98,9 +115,9 @@ vt_set_ext <- function(filename, ext){ filename <- file_path_sans_ext(filename) filename_ext <- ifelse( - identical(tolower(filename_ext), tolower(ext)), + tolower(filename_ext) %in% tolower(ext), filename_ext, - ext + ext[1] ) paste0(filename, ".", filename_ext) diff --git a/R/vt_file.R b/R/vt_file.R index eb7bf038..1c339486 100644 --- a/R/vt_file.R +++ b/R/vt_file.R @@ -80,7 +80,7 @@ file_parse.default <- function(file, ..., dynamic_referencing = FALSE){ #' @importFrom knitr knit_child #' @importFrom withr with_options -file_parse.md <- function(file, ..., reference = NULL, envir = parent.frame(), dynamic_referencing = FALSE){ +file_parse.md <- function(file, ..., reference = NULL, envir = parent.frame(), interactive_output = interactive(), dynamic_referencing = FALSE){ if(dynamic_referencing){ text <- dynamic_reference_rendering(file, reference = reference) @@ -91,6 +91,29 @@ file_parse.md <- function(file, ..., reference = NULL, envir = parent.frame(), d ## remove roxygen comments text <- text[!grepl("^#'", text)] + if(interactive_output){ + file_parse.md.interactive(text, ..., envir = envir) + }else{ + file_parse.md.knitting(text, ..., envir = envir) + } + +} + +#' @importFrom knitr knit +file_parse.md.interactive <- function(text, ..., envir = parent.frame()){ + with_options(new = list(knitr.duplicate.label = "allow"), { + cat(asis_output(knit( + text = text, + envir = envir, + ..., + quiet = TRUE + ))) + cat("\n") + }) +} + +#' @importFrom knitr knit_child +file_parse.md.knitting <- function(text, ..., envir = parent.frame()){ with_options(new = list(knitr.duplicate.label = "allow"), { cat(asis_output(knit_child( text = text, @@ -101,11 +124,12 @@ file_parse.md <- function(file, ..., reference = NULL, envir = parent.frame(), d }) } + file_parse.rmd <- file_parse.md -file_parse.r_test_code <- function(file, ..., reference = NULL, envir = parent.frame(), dynamic_referencing = FALSE){ +file_parse.r_test_code <- function(file, ..., reference = NULL, envir = parent.frame(), interactive_output = interactive(), dynamic_referencing = FALSE){ text <- c("```{r echo = FALSE}", paste0("results <- eval_test_code(path = ",bquote(file),")"), @@ -116,14 +140,11 @@ file_parse.r_test_code <- function(file, ..., reference = NULL, envir = parent.f text <- text[!is.na(text)] - with_options(new = list(knitr.duplicate.label = "allow"), { - cat(asis_output(knit_child( - text = text, - envir = envir, - ..., - quiet = TRUE - ))) - }) + if(interactive_output){ + file_parse.md.interactive(text, ..., envir = envir) + }else{ + file_parse.md.knitting(text, ..., envir = envir) + } } #' output to render kable to diff --git a/R/write_validation_report.R b/R/write_validation_report.R index eea14840..934eae83 100644 --- a/R/write_validation_report.R +++ b/R/write_validation_report.R @@ -55,7 +55,11 @@ vt_use_report <- function(pkg_name = NULL, } template_files <- c(validation = "validation_report.Rmd", - requirements = "requirement_adoption.Rmd") + requirements = "requirement_adoption.Rmd", + packet = "validation_packet.Rmd") + + template <- match.arg(template,choices = names(template_files)) + report_filename <- file.path(get_config_working_dir(), get_config_report_rmd_name()) if(!file.exists(report_filename)){ diff --git a/README.md b/README.md index dd1a85a7..5e56f2c7 100644 --- a/README.md +++ b/README.md @@ -4,7 +4,7 @@ [![License:MIT](https://img.shields.io/badge/License-MIT-yellow.svg)](https://opensource.org/licenses/MIT) -# valtools +# valtools valtools helps automate the validation of R packages used in clinical research and drug development: It provides useful templates and helper functions for tasks that arise during project set up and development @@ -18,7 +18,7 @@ For background on the `R Package Validation Framework`, watch [this presentation ## Installation -{valtools} is under active development! +{valtools} is under active development. To get the latest version, install from github: ``` devtools::install_github("phuse-org/valtools") @@ -71,6 +71,23 @@ These functions are helper functions for use within the validation report Rmd. Read the [`Starting New Validation Package using {valtools}`](vignettes/starting-validated-package.Rmd) vignette for a high level overview of the functions that exist in {valtools} and their intended uses. +## Cheat Sheet + +Cheat sheet on how to use the {valtools} R Package + + +Cheatsheet on how to use the {valtools} R Package - functions + + + +Cheatsheet on how to use the {valtools} R Package - functions & validation modes + + + ## Code of conduct Please note that the {valtools} project is released with a [Contributor Code of Conduct](CONDUCT.md). By contributing to this project, you agree to abide by its terms. diff --git a/inst/CITATION b/inst/CITATION new file mode 100644 index 00000000..c4cb9e0f --- /dev/null +++ b/inst/CITATION @@ -0,0 +1,14 @@ +citHeader("To cite valtools in publications use:") + +citEntry( + entry = "Manual", + title = "Automate Validated Package Creation", + author = "Hughes, E., Vendettuoli, M., Miller, E., and Peyman, E.", + year = "2021", + #volume = "", + #number = "", + #pages = "", + url = "https://github.com/phuse-org/valtools", + note = "See also: `R Validation Framework`", + textVersion = paste("") +) diff --git a/inst/rstudio/templates/project/valtools_packet.dcf b/inst/rstudio/templates/project/valtools_packet.dcf new file mode 100644 index 00000000..9cac1dc6 --- /dev/null +++ b/inst/rstudio/templates/project/valtools_packet.dcf @@ -0,0 +1,6 @@ +Binding: vt_create_packet_wizard +Title: R Validation Packet using valtools + +Parameter: target +Widget: TextInput +Label: Validation Target diff --git a/inst/templates/validation_packet.Rmd b/inst/templates/validation_packet.Rmd new file mode 100644 index 00000000..7c850dc7 --- /dev/null +++ b/inst/templates/validation_packet.Rmd @@ -0,0 +1,151 @@ +--- +title: Validation Report for {{pkg_name}} +author: {{author}} +date: "`r Sys.Date()`" +output: + pdf_document: + toc: true + fig_crop: false + toc_depth: 2 + number_sections: true +vignette: > + %\VignetteIndexEntry{Validation Report} + \usepackage[utf8]{inputenc} + %\VignetteEngine{knitr::rmarkdown_notangle} +header-includes: + - \usepackage{array} + - \usepackage{float} + - \usepackage{multirow} + - \usepackage{longtable} + - \usepackage{booktabs} +--- + + +```{r, setup, echo=FALSE,warning=FALSE} +suppressPackageStartupMessages({ + library(valtools) + library(knitr) + library(kableExtra) + library(magrittr) + library(devtools) + library({{pkg_name}}) +}) + +opts_chunk$set( + collapse = TRUE, + comment = "#>", + eval = TRUE, + echo = FALSE, + results = "asis", + message = FALSE, + tidy = FALSE +) + +options( + knitr.kable.NA = '', + knitr.duplicate.label = "allow" +) + +``` + +```{r shared-obj} +all_sig <- vt_scrape_sig_table() +``` + +\newpage + +# Certifications + +## Signatures + +**AUTHOR** My signature designates authorship of this document. + +```{r validation-lead-sig-block} +all_sig[grepl("validation lead",all_sig$role, ignore.case = TRUE),] %>% + set_rownames(seq_len(nrow(.))) %>% + vt_kable_sig_table() +``` + +**APPROVAL** I have reviewed this document and approve its content. + +```{r sig-block} + +all_sig[!grepl("validation lead",all_sig$role, ignore.case = TRUE),] %>% + set_rownames(seq_len(nrow(.))) %>% + vt_kable_sig_table() + +``` + +The effective date of this document is the last date of signature. + +\newpage + +# Release details + +## Package Information + +### Change Log + +```{r change-log-table} +vt_scrape_change_log() %>% + vt_kable_change_log() +``` + +### Validation Environment + +```{r env-table} +vt_scrape_val_env() %>% + vt_kable_val_env() +``` + + +## Authors + +### Requirements + + +```{r req-authors} +vt_scrape_requirement_editors() %>% + vt_kable_requirement_editors() +``` + +### Test Case Authors + +```{r test-case-authors} +vt_scrape_test_case_editors() %>% + vt_kable_test_case_editors() +``` + +### Test Code Authors + +```{r test-code-authors} +vt_scrape_test_code_editors() %>% + vt_kable_test_code_editors() +``` + +## Traceability + +```{r traceability} +vt_scrape_coverage_matrix() %>% + vt_kable_coverage_matrix() +``` + +\clearpage + +# Risk Assessment + +```{r risk} +vt_scrape_risk_assessment() %>% + vt_kable_risk_assessment() +``` + +\newpage + +# Validation + + + +```{r child-files-evaluation} +child_files <- vt_get_child_files() +vt_file(vt_path(child_files),dynamic_referencing = {{enable_dynamic_referencing}}) +``` diff --git a/inst/templates/validation_report.Rmd b/inst/templates/validation_report.Rmd index 80663b9d..c63dd2ee 100644 --- a/inst/templates/validation_report.Rmd +++ b/inst/templates/validation_report.Rmd @@ -61,7 +61,7 @@ all_sig <- vt_scrape_sig_table() **AUTHOR** My signature designates authorship of this document. ```{r validation-lead-sig-block} -all_sig[tolower(all_sig$role) == "validation lead",] %>% +all_sig[grepl("validation lead",all_sig$role, ignore.case = TRUE),] %>% set_rownames(seq_len(nrow(.))) %>% vt_kable_sig_table() ``` @@ -70,7 +70,7 @@ all_sig[tolower(all_sig$role) == "validation lead",] %>% ```{r sig-block} -all_sig[tolower(all_sig$role) != "validation lead",] %>% +all_sig[!grepl("validation lead",all_sig$role, ignore.case = TRUE),] %>% set_rownames(seq_len(nrow(.))) %>% vt_kable_sig_table() diff --git a/man/figures/cheatsheets/valtools-cheatsheet.pdf b/man/figures/cheatsheets/valtools-cheatsheet.pdf new file mode 100644 index 00000000..a7e0141c Binary files /dev/null and b/man/figures/cheatsheets/valtools-cheatsheet.pdf differ diff --git a/man/figures/cheatsheets/valtools-cheatsheet/valtools-cheatsheet-p1.png b/man/figures/cheatsheets/valtools-cheatsheet/valtools-cheatsheet-p1.png new file mode 100644 index 00000000..51eb38f1 Binary files /dev/null and b/man/figures/cheatsheets/valtools-cheatsheet/valtools-cheatsheet-p1.png differ diff --git a/man/figures/cheatsheets/valtools-cheatsheet/valtools-cheatsheet-p2.png b/man/figures/cheatsheets/valtools-cheatsheet/valtools-cheatsheet-p2.png new file mode 100644 index 00000000..128f7c97 Binary files /dev/null and b/man/figures/cheatsheets/valtools-cheatsheet/valtools-cheatsheet-p2.png differ diff --git a/man/figures/logo.png b/man/figures/logo.png new file mode 100644 index 00000000..1486c4c8 Binary files /dev/null and b/man/figures/logo.png differ diff --git a/man/val_init.Rd b/man/val_init.Rd index 988e3a2c..b3422fe0 100644 --- a/man/val_init.Rd +++ b/man/val_init.Rd @@ -3,6 +3,7 @@ \name{vt_use_validation} \alias{vt_use_validation} \alias{vt_create_package} +\alias{vt_create_packet} \title{Create a validation structure} \usage{ vt_use_validation(pkg = ".", working_dir, ...) @@ -16,6 +17,14 @@ vt_create_package( check_name = TRUE, open = rlang::is_interactive() ) + +vt_create_packet( + path = ".", + target, + ..., + rstudio = rstudioapi::isAvailable(), + open = rlang::is_interactive() +) } \arguments{ \item{pkg}{Top level directory of a package} @@ -46,8 +55,16 @@ error if not} \item If on RStudio server, the current RStudio project is activated. \item Otherwise, the working directory and active project is changed. }} + +\item{path}{A path. If it exists, it is used. If it does not exist, it is +created, provided that the parent path exists.} + +\item{target}{target of validation. Character name of package or scope validation packet is being performed for.} } \description{ Creates a structure for validation artifacts. Validation items are stored in \code{inst/validation} + +Create the validation packet infrastructure. Intended to create +validation infrastructure external to an R package. } diff --git a/tests/testthat/test-coverage-matrix.R b/tests/testthat/test-coverage-matrix.R index a98f2aba..75cff03f 100644 --- a/tests/testthat/test-coverage-matrix.R +++ b/tests/testthat/test-coverage-matrix.R @@ -1,5 +1,6 @@ test_that("coverage matrix from dynam num", { withr::with_tempdir({ + capture_output <- capture.output({vt_create_package(open = FALSE)}) vt_use_test_case("testcase1", username = "a user", open = FALSE) vt_use_test_case("testcase2", username = "a user", open = FALSE) @@ -7,7 +8,7 @@ test_that("coverage matrix from dynam num", { vt_use_req("req1", username = "a user", open = FALSE, add_before = "testcase1.md") vt_use_req("req2", username = "a user", open = FALSE, add_before = "testcase2.md") vt_use_req("req3", username = "a user", open = FALSE, add_before = "testcase3.md") - + config_wd <- get_config_working_dir() cat( file = file.path(config_wd, "validation", "test_cases", "testcase1.md"), @@ -43,7 +44,7 @@ test_that("coverage matrix from dynam num", { " + T##tc:dynamic_numbering_testcase2.2 Another test case. Matches requirements: ##req:dynamic_numbering2.2 and ##req:dynamic_numbering2.3", " + T##tc:dynamic_numbering_testcase2.3 More testing. Matches requirements: ##req:dynamic_numbering2.1, ##req:dynamic_numbering2.3, and ##req:dynamic_numbering2.4", "")) - + cat( file = file.path(config_wd, "validation", "test_cases", "testcase3.md"), sep = "\n", @@ -61,44 +62,44 @@ test_that("coverage matrix from dynam num", { " + T##tc:dynamic_numbering_testcase3.2 Another test case. Matches requirements: ##req:dynamic_numbering3.2 and ##req:dynamic_numbering3.3", " + T##tc:dynamic_numbering_testcase3.1 More testing. Matches requirements: ##req:dynamic_numbering3.1, ##req:dynamic_numbering3.3, and ##req:dynamic_numbering3.4", "")) - + #vt_add_file_to_config(c("req1.md", "testcase1.md", "req2.md", "testcase2.md", "req3.md", "testcase3.md")) cov_matrix <- vt_scrape_coverage_matrix() - - expect_matrix <- data.frame(req_title = rep(paste("Requirement", 1:3), each = 7), - req_id = paste(rep(1:3, each = 7), rep(c(1, 1, 2, 2, 3, 3, 4), 3), sep = "."), + + expect_matrix <- data.frame(req_title = factor(rep(paste("Requirement", 1:3), each = 7)), + req_id = paste(rep(1:3, each = 7), rep(c(1, 2, 2,3, 1, 3, 4), 3), sep = "."), tc_title = rep(paste("Test Case", 1:3), each = 7), - tc_id = c(paste(1, c(1, 3, 1, 2, 2, 3, 3), sep = "."), - paste(2, c(2, 3, 2, 1, 1, 3, 3), sep = "."), - paste(3, c(1, 3, 1, 2, 2, 3, 3), sep = ".")), + tc_id = c(paste(1, c(1, 1, 2, 2, 3, 3, 3), sep = "."), + paste(2, c(2, 2, 1, 1, 3, 3, 3), sep = "."), + paste(3, c(1, 1, 2, 2, 3, 3, 3), sep = ".")), deprecate = "", stringsAsFactors = FALSE) attr(expect_matrix, "table_type") <- "long" expect_equal(cov_matrix, - expect_matrix) - + expect_matrix) + cov_matrix_tex_file <- tempfile(fileext = ".tex", tmpdir = getwd()) writeLines( c("---", - "title: validation report", - "output: ", - " pdf_document:", - " fig_crop: false", - "header-includes:", - " - \\usepackage{array}", - " - \\usepackage{longtable}", - " - \\usepackage{multirow}", - "classoption: dvipsnames", - "---", - "\n\n", - vt_kable_coverage_matrix(cov_matrix, format = "latex")), - con = cov_matrix_tex_file) - + "title: validation report", + "output: ", + " pdf_document:", + " fig_crop: false", + "header-includes:", + " - \\usepackage{array}", + " - \\usepackage{longtable}", + " - \\usepackage{multirow}", + "classoption: dvipsnames", + "---", + "\n\n", + vt_kable_coverage_matrix(cov_matrix, format = "latex")), + con = cov_matrix_tex_file) + suppressWarnings({ - capture_output <- capture.output({ - rmarkdown::render(cov_matrix_tex_file, output_format = "pdf_document") - })}) - + capture_output <- capture.output({ + rmarkdown::render(cov_matrix_tex_file, output_format = "pdf_document") + })}) + cov_matrix_rmd_file <- tempfile(fileext = ".Rmd", tmpdir = getwd()) writeLines( c("---", @@ -111,22 +112,22 @@ test_that("coverage matrix from dynam num", { vt_kable_coverage_matrix(cov_matrix, format = "html")), con = cov_matrix_rmd_file) suppressWarnings({ - capture_output <- capture.output({ - rmarkdown::render(cov_matrix_rmd_file) - })}) + capture_output <- capture.output({ + rmarkdown::render(cov_matrix_rmd_file) + })}) this_test <- xml2::read_html(gsub(cov_matrix_rmd_file, pattern = ".Rmd", replacement = ".html")) rendered_cov_matrix_html <- as.data.frame(rvest::html_table(rvest::html_nodes(this_test, "table")[1], fill = TRUE)[[1]], stringsAsFactors = FALSE) expect_equal(rendered_cov_matrix_html, data.frame(`Requirement Name` = rep(paste("Requirement", 1:3), each = 7), - `Requirement ID` = as.double(paste(rep(1:3, each = 7), rep(c(1, 1, 2, 2, 3, 3, 4), 3), sep = ".")), + `Requirement ID` = as.double(paste(rep(1:3, each = 7), rep(c(1, 2, 2, 3, 1, 3, 4), 3), sep = ".")), `Test Case Name` = rep(paste("Test Case", 1:3), each = 7), - `Test Cases` = as.double(c(paste(1, c(1, 3, 1, 2, 2, 3, 3), sep = "."), - paste(2, c(2, 3, 2, 1, 1, 3, 3), sep = "."), - paste(3, c(1, 3, 1, 2, 2, 3, 3), sep = "."))), + `Test Cases` = as.double(c(paste(1, c(1, 1, 2, 2, 3, 3, 3), sep = "."), + paste(2, c(2, 2, 1, 1, 3, 3, 3), sep = "."), + paste(3, c(1, 1, 2, 2, 3, 3, 3), sep = "."))), check.names = FALSE, stringsAsFactors = FALSE)) - + cov_matrix2 <- vt_scrape_coverage_matrix(type = "wide") expect_matrix2 <- data.frame(req_title = rep(paste("Requirement", 1:3), each = 7), req_id = c(paste(1, c(1, 2, 2, 3, 1, 3, 4), sep = "."), @@ -148,7 +149,7 @@ test_that("coverage matrix from dynam num", { tc_title = rep(paste("Test Case", 1:3), each = 3), deprecate = "", stringsAsFactors = FALSE) - + expect_equal(cov_matrix2, expect_matrix2) cov_matrix2_rmd_file <- tempfile(fileext = ".Rmd", tmpdir = getwd()) @@ -160,13 +161,13 @@ test_that("coverage matrix from dynam num", { "\n\n", vt_kable_coverage_matrix(cov_matrix2, format = "html")), con = cov_matrix2_rmd_file) - + capture_output <- capture.output({ rmarkdown::render(cov_matrix2_rmd_file) }) - + this_test2 <- xml2::read_html(gsub(cov_matrix2_rmd_file, pattern = ".Rmd", replacement = ".html")) - + rendered_cov_matrix2_html <- as.data.frame(rvest::html_table(rvest::html_nodes(this_test2, "table")[1], fill = TRUE)[[1]], stringsAsFactors = FALSE) expected_cov_matrix2_html <- data.frame(reqs = c("", rep(paste("Requirement", 1:3), each = 7)), @@ -187,10 +188,10 @@ test_that("coverage matrix from dynam num", { names(expected_cov_matrix2_html)[1:2] <- c("", "") expect_equal(rendered_cov_matrix2_html, expected_cov_matrix2_html ) - - + + cov_matrix2_tex_file <- tempfile(fileext = ".Rmd", tmpdir = getwd()) - + writeLines( c("---", "title: validation report", @@ -208,31 +209,31 @@ test_that("coverage matrix from dynam num", { "\n\n", vt_kable_coverage_matrix(cov_matrix2, format = "latex")), con = cov_matrix2_tex_file) - + suppressWarnings({ capture_output <- capture.output({ cov_matrix_pdf <- rmarkdown::render(cov_matrix2_tex_file, output_format = "pdf_document") })}) - + # Skip checks of pdf on cran skip_on_cran() - + expect_true(file.exists(gsub(cov_matrix2_tex_file, pattern = ".Rmd", replacement = '.pdf'))) rendered_cov_matrix_pdf <- trimws(do.call('c',strsplit(split = "\r\n", gsub("((\r)|(\n))+","\r\n", pdftools::pdf_text(gsub(cov_matrix_tex_file, pattern = ".tex", replacement = ".pdf")))))) - - + + expect_true(all(rendered_cov_matrix_pdf[2:23] != "")) - - + + rendered_cov_matrix2_pdf <- trimws(do.call('c',strsplit(split = "\r\n", gsub("((\r)|(\n))+","\r\n", - pdftools::pdf_text(gsub(cov_matrix2_tex_file, pattern = ".Rmd", replacement = '.pdf')))))) - + pdftools::pdf_text(gsub(cov_matrix2_tex_file, pattern = ".Rmd", replacement = '.pdf')))))) + rendered_cov_matrix2_pdf <- rendered_cov_matrix2_pdf[!grepl("^\\d$",rendered_cov_matrix2_pdf )] - + expect_true(all(rendered_cov_matrix2_pdf[2:24] != "")) - + }) }) @@ -247,7 +248,7 @@ test_that("coverage matrix no dynam num", { vt_use_req("req1", username = "a user", open = FALSE, add_before = "testcase1.md") vt_use_req("req2", username = "a user", open = FALSE, add_before = "testcase2.md") vt_use_req("req3", username = "a user", open = FALSE, add_before = "testcase3.md") - + config_wd <- get_config_working_dir() cat( file = file.path(config_wd, "validation", "test_cases", "testcase1.md"), @@ -283,7 +284,7 @@ test_that("coverage matrix no dynam num", { " + T2.2 Another test case. Matches requirements: 2.2 and 2.3", " + T2.3 More testing. Matches requirements: 2.1, 2.3, and 2.4", "")) - + cat( file = file.path(config_wd, "validation", "test_cases", "testcase3.md"), sep = "\n", @@ -302,18 +303,18 @@ test_that("coverage matrix no dynam num", { " + T3.1 More testing. Matches requirements: 3.1, 3.3, and 3.4", "")) cov_matrix <- vt_scrape_coverage_matrix() - expect_matrix <- data.frame(req_title = rep(paste("Requirement", 1:3), each = 7), - req_id = paste(rep(1:3, each = 7), rep(c(1, 1, 2, 2, 3, 3, 4), 3), sep = "."), + expect_matrix <- data.frame(req_title = factor(rep(paste("Requirement", 1:3), each = 7)), + req_id = paste(rep(1:3, each = 7), rep(c(1, 2, 2, 3,1, 3, 4), 3), sep = "."), tc_title = rep(paste("Test Case", 1:3), each = 7), - tc_id = c(paste(1, c(1, 3, 1, 2, 2, 3, 3), sep = "."), - paste(2, c(2, 3, 2, 1, 1, 3, 3), sep = "."), - paste(3, c(1, 3, 1, 2, 2, 3, 3), sep = ".")), + tc_id = c(paste(1, c(1, 1, 2, 2, 3, 3, 3), sep = "."), + paste(2, c(2, 2, 1, 1, 3, 3, 3), sep = "."), + paste(3, c(1, 1, 2, 2, 3, 3, 3), sep = ".")), deprecate = "", stringsAsFactors = FALSE) attr(expect_matrix, "table_type") <- "long" expect_equal(cov_matrix, expect_matrix) - + cov_matrix2 <- vt_scrape_coverage_matrix(type = "wide") expect_matrix2 <- data.frame(req_title = rep(paste("Requirement", 1:3), each = 7), req_id = c(paste(1, c(1, 2, 2, 3, 1, 3, 4), sep = "."), @@ -335,17 +336,17 @@ test_that("coverage matrix no dynam num", { tc_title = rep(paste("Test Case", 1:3), each = 3), deprecate = "", stringsAsFactors = FALSE) - + expect_equal(cov_matrix2, expect_matrix2) - - + + }) }) test_that("existing reference obj", { withr::with_tempdir({ - + capture_output <- capture.output({ vt_create_package(open = FALSE) }) @@ -355,7 +356,7 @@ test_that("existing reference obj", { vt_use_req("req1", username = "a user", open = FALSE, add_before = "testcase1.md") vt_use_req("req2", username = "a user", open = FALSE, add_before = "testcase2.md") vt_use_req("req3", username = "a user", open = FALSE, add_before = "testcase3.md") - + config_wd <- get_config_working_dir() cat( file = file.path(config_wd, "validation", "test_cases", "testcase1.md"), @@ -391,7 +392,7 @@ test_that("existing reference obj", { " + T##tc:dynamic_numbering_testcase2.2 Another test case. Matches requirements: ##req:dynamic_numbering2.2 and ##req:dynamic_numbering2.3", " + T##tc:dynamic_numbering_testcase2.3 More testing. Matches requirements: ##req:dynamic_numbering2.1, ##req:dynamic_numbering2.3, and ##req:dynamic_numbering2.4", "")) - + cat( file = file.path(config_wd, "validation", "test_cases", "testcase3.md"), sep = "\n", @@ -409,7 +410,7 @@ test_that("existing reference obj", { " + T##tc:dynamic_numbering_testcase3.2 Another test case. Matches requirements: ##req:dynamic_numbering3.2 and ##req:dynamic_numbering3.3", " + T##tc:dynamic_numbering_testcase3.1 More testing. Matches requirements: ##req:dynamic_numbering3.1, ##req:dynamic_numbering3.3, and ##req:dynamic_numbering3.4", "")) - + cat( file = file.path(config_wd, "validation", "requirements", "req1.md"), sep = "\n", @@ -430,18 +431,18 @@ test_that("existing reference obj", { "", "+ Start documenting requirements here!", "")) - + references <- vt_dynamic_referencer$new() expect_equal(references$list_references(), list()) - + references$scrape_references( do.call("rbind", vt_scrape_tags_from(type = "requirements", tags = "title"))) - + expect_equal(references$list_references(), list(`req:dynamic_numbering4` = 1, `req:dynamic_numbering5` = 2)) cov_matrix <- vt_scrape_coverage_matrix(reference = references) - + expect_equal(references$list_references(), list(`req:dynamic_numbering4` = 1, `req:dynamic_numbering5` = 2, @@ -451,20 +452,20 @@ test_that("existing reference obj", { `req:dynamic_numbering1` = 3, `req:dynamic_numbering2` = 4, `req:dynamic_numbering3` = 5)) - expect_matrix <- data.frame(req_title = rep(paste("Requirement", 3:5), each = 7), - req_id = c(paste(3, c(1, 1, 2, 2, 3, 3, 4), sep = "."), - paste(4, c(1, 1, 2, 2, 3, 3, 4), sep = "."), - paste(5, c(1, 1, 2, 2, 3, 3, 4), sep = ".")), + expect_matrix <- data.frame(req_title = factor(rep(paste("Requirement", 3:5), each = 7)), + req_id = c(paste(3, c(1, 2, 2, 3, 1, 3, 4), sep = "."), + paste(4, c(1, 2, 2, 3, 1, 3, 4), sep = "."), + paste(5, c(1, 2, 2, 3, 1, 3, 4), sep = ".")), tc_title = rep(paste("Test Case", 1:3), each = 7), - tc_id = c(paste(1, c(1, 3, 1, 2, 2, 3, 3), sep = "."), - paste(2, c(2, 3, 2, 1, 1, 3, 3), sep = "."), - paste(3, c(1, 3, 1, 2, 2, 3, 3), sep = ".")), + tc_id = c(paste(1, c(1, 1, 2, 2, 3, 3, 3), sep = "."), + paste(2, c(2, 2, 1, 1, 3, 3, 3), sep = "."), + paste(3, c(1, 1, 2, 2, 3, 3, 3), sep = ".")), deprecate = "", stringsAsFactors = FALSE) attr(expect_matrix, "table_type") <- "long" expect_equal(cov_matrix, - expect_matrix) - + expect_matrix) + cov_matrix2 <- vt_scrape_coverage_matrix(reference = references, type = "wide") expect_matrix2 <- data.frame(req_title = rep(paste("Requirement", 3:5), each = 7), req_id = c(paste(3, c(1, 2, 2, 3, 1, 3, 4), sep = "."), @@ -487,9 +488,9 @@ test_that("existing reference obj", { deprecate = "", stringsAsFactors = FALSE) expect_equal(cov_matrix2, - expect_matrix2) - - + expect_matrix2) + + }) }) @@ -504,8 +505,8 @@ test_that("coverage matrix missing or deprecated entry", { vt_use_req("req1", username = "a user", open = FALSE, add_before = "testcase1.md") vt_use_req("req2", username = "a user", open = FALSE, add_before = "testcase2.md") vt_use_req("req3", username = "a user", open = FALSE) - - + + config_wd <- valtools:::get_config_working_dir() cat( file = file.path(config_wd, "validation", "test_cases", "testcase1.md"), @@ -537,7 +538,7 @@ test_that("coverage matrix missing or deprecated entry", { " + T2.2 Another test case. Matches requirements: 2.2 and 2.3", " + T2.3 More testing. Matches requirements: 2.1, 2.3, and 2.4", "")) - + cat( file = file.path(config_wd, "validation", "test_cases", "testcase3.md"), sep = "\n", @@ -549,22 +550,22 @@ test_that("coverage matrix missing or deprecated entry", { "#' 3.1: 3.1, 3.2", "#' 3.2: 3.3, 3.4", "#' @deprecate Deprecated in v1.2")) - + cov_matrix <- vt_scrape_coverage_matrix() - expect_matrix <- data.frame(req_title = c(rep("Requirement 1", each = 7), - rep("Requirement 3", each = 4)), - req_id = c(paste(1, c(1, 1, 2, 2, 3, 3, 4), sep = "."), + expect_matrix <- data.frame(req_title = factor(c(rep("Requirement 1", each = 7), + rep("Requirement 3", each = 4))), + req_id = c(paste(1, c(1, 2, 2, 3, 1, 3, 4), sep = "."), paste(3, 1:4, sep = ".")), tc_title = c(rep("Test Case 1", each = 7), rep("Test Case 3", each = 4)), - tc_id = c(paste(1, c(1, 3, 1, 2, 2, 3, 3), sep = "."), + tc_id = c(paste(1, c(1, 1, 2, 2, 3, 3, 3), sep = "."), paste(3, c(1, 1, 2, 2), sep = ".")), deprecate = c(rep("", 7), rep("Deprecated in v1.2", 4)), stringsAsFactors = FALSE) attr(expect_matrix, "table_type") <- "long" expect_equal(cov_matrix, expect_matrix) - + cov_matrix2 <- vt_scrape_coverage_matrix(type = "wide") cov2_tc_title <- attr(cov_matrix2, "tc_title") expect_cov2_tc_title <- data.frame(tc_id = c("1.1", "1.2", "1.3", "3.1", "3.2"), @@ -573,6 +574,86 @@ test_that("coverage matrix missing or deprecated entry", { stringsAsFactors = FALSE) expect_equal(cov2_tc_title, expect_cov2_tc_title) + + }) +}) +test_that("coverage matrix malformed entry throws informative error - 1", { + withr::with_tempdir({ + capture_output <- capture.output({ + vt_create_package(open = FALSE) + }) + vt_use_test_case("testcase1", username = "a user", open = FALSE) + vt_use_test_case("testcase2", username = "a user", open = FALSE) + vt_use_test_case("testcase3", username = "a user", open = FALSE) + vt_use_req("req1", username = "a user", open = FALSE, add_before = "testcase1.md") + vt_use_req("req2", username = "a user", open = FALSE, add_before = "testcase2.md") + vt_use_req("req3", username = "a user", open = FALSE) + + + config_wd <- valtools:::get_config_working_dir() + cat( + file = file.path(config_wd, "validation", "test_cases", "testcase1.md"), + sep = "\n", + c( + "#' @title Test Case 1", + "#' @editor User One", + "#' @editDate 2021-03-17", + "#' @coverage", + "#' 1.1:1.1:1.2", + "#' 1.2: 1.2, 1.3", + "#' 1.3: 1.1, 1.3, 1.4", + "", + "+ _Test Cases_", + " + T1.1 Create a sample spec with a unique reference number. Matches requirements: 1.1 and 1.2", + " + T1.2 Another test case. Matches requirements: 1.2 and 1.3", + " + T1.3 More testing. Matches requirements: 1.1, 1.3, and 1.4", + "")) + + expect_error( + vt_scrape_coverage_matrix(), + "Coverage details must follow format Test_Case:Requirement. See Test Case 1, Coverage Entry: 1.1:1.1:1.2" + ) + + }) +}) + +test_that("coverage matrix malformed entry throws informative error - 2", { + withr::with_tempdir({ + capture_output <- capture.output({ + vt_create_package(open = FALSE) + }) + vt_use_test_case("testcase1", username = "a user", open = FALSE) + vt_use_test_case("testcase2", username = "a user", open = FALSE) + vt_use_test_case("testcase3", username = "a user", open = FALSE) + vt_use_req("req1", username = "a user", open = FALSE, add_before = "testcase1.md") + vt_use_req("req2", username = "a user", open = FALSE, add_before = "testcase2.md") + vt_use_req("req3", username = "a user", open = FALSE) + + + config_wd <- valtools:::get_config_working_dir() + cat( + file = file.path(config_wd, "validation", "test_cases", "testcase1.md"), + sep = "\n", + c( + "#' @title Test Case 1", + "#' @editor User One", + "#' @editDate 2021-03-17", + "#' @coverage", + "#' 1.1 1.1, 1.2", + "#' 1.2: 1.2, 1.3", + "#' 1.3: 1.1, 1.3, 1.4", + "", + "+ _Test Cases_", + " + T1.1 Create a sample spec with a unique reference number. Matches requirements: 1.1 and 1.2", + " + T1.2 Another test case. Matches requirements: 1.2 and 1.3", + " + T1.3 More testing. Matches requirements: 1.1, 1.3, and 1.4", + "")) + + expect_error( + vt_scrape_coverage_matrix(), + "Coverage details must follow format Test_Case:Requirement. See Test Case 1, Coverage Entry: 1.1 1.1, 1.2" + ) + }) }) diff --git a/tests/testthat/test-create_item.R b/tests/testthat/test-create_item.R index 63a65486..6e3121e9 100644 --- a/tests/testthat/test-create_item.R +++ b/tests/testthat/test-create_item.R @@ -108,3 +108,32 @@ test_that("Throw an error if the validation directory has not been set up", { ) }) }) + +test_that("simple item creation does not overwrite file", { + withr::with_tempdir({ + # set up "validation" infrastructure + dir.create("vignettes/validation", recursive = TRUE) + writeLines(c("working_dir: vignettes"),"vignettes/validation/validation.yml") + file.create(".here") + + + spec_path <- create_item( + item_name = "new_specification", + type = "requirements") + + spec_path_file_info <- file.info(spec_path) + + + spec_path <- create_item( + item_name = "new_specification", + type = "requirements") + + spec_path_file_info_2 <- file.info(spec_path) + + expect_equal( + spec_path_file_info[,c("mtime","ctime")], + spec_path_file_info_2[,c("mtime","ctime")] + ) + }) +}) + diff --git a/tests/testthat/test-create_validation_packet.R b/tests/testthat/test-create_validation_packet.R new file mode 100644 index 00000000..f34ba682 --- /dev/null +++ b/tests/testthat/test-create_validation_packet.R @@ -0,0 +1,35 @@ +test_that("Able to create packet with validated project basics", { + withr::with_tempdir({ + quiet <- capture.output({ + vt_create_packet("example_packet", target = "example.package", open = FALSE) + }) + + + withr::with_dir(new = "example_packet", { + expect_error(devtools::as.package(".")) + + expect_true(dir.exists("validation")) + + expect_true(file.exists("validation/validation.yml")) + + expect_true(file.exists("validation/validation.yml")) + }) + + }) +}) + +test_that("throws error when trying to add to existing package", { + withr::with_tempdir({ + + quiet <- capture.output({ + usethis::create_package(".") + }) + + expect_error( + vt_create_packet(".", target = "fake.package"), + paste0("`vt_create_packet()` is not intended to add validation infrastructure", + " to an existing package. Use `vt_use_validation()` instead."), + fixed=TRUE + ) + }) +}) diff --git a/tests/testthat/test-dynamic_referencing.R b/tests/testthat/test-dynamic_referencing.R index d7ad2767..5a595957 100644 --- a/tests/testthat/test-dynamic_referencing.R +++ b/tests/testthat/test-dynamic_referencing.R @@ -477,3 +477,27 @@ test_that("Dynaming referencing within a data.frame",{ stringsAsFactors = FALSE)) }) + + +test_that("Dynaming referencing within a data.frame with NA's",{ + + df_content <- + data.frame( req_id = c("##req:first","##req:first","##req:second",NA), + tc_id = c("##tc:first", "##tc:second","##tc:second","##tc:third"), + stringsAsFactors = FALSE) + + dyn_ref1 <- vt_dynamic_referencer$new() + dyn_ref1$scrape_references(df_content) + + dyn_ref_df_content <- dyn_ref1$reference_insertion(df_content) + + expect_equal( + dyn_ref_df_content, + data.frame( req_id = c("1","1","2",NA), + tc_id = c("1", "2","2","3"), + stringsAsFactors = FALSE) + ) + + +}) + diff --git a/tests/testthat/test-find_config.R b/tests/testthat/test-find_config.R new file mode 100644 index 00000000..782b1b6b --- /dev/null +++ b/tests/testthat/test-find_config.R @@ -0,0 +1,80 @@ +test_that("Find config when within a package with validation", { + + withr::with_tempdir({ + quiet <- capture.output({ + vt_create_package( + "example.package", + open = FALSE) + }) + + + withr::with_dir(new = "example.package", { + expect_equal( + vt_find_config(), + normalizePath(file.path(getwd(), "vignettes","validation","validation.yml"),winslash = "/") + ) + }) + }) +}) + +test_that("Find config when within a package with validation when working dir is non-standard", { + + withr::with_tempdir({ + quiet <- capture.output({ + vt_create_package( + "example.package", + working_dir = "inst", + open = FALSE) + }) + + + withr::with_dir(new = "example.package", { + expect_equal( + vt_find_config(), + normalizePath( + file.path(getwd(), "inst","validation","validation.yml"), + winslash = "/") + ) + }) + }) +}) + +test_that("Find config when within a validation packet", { + + withr::with_tempdir({ + quiet <- capture.output({ + vt_create_packet("example_packet", + target = "example.package", + open = FALSE) + }) + + + withr::with_dir(new = "example_packet", { + expect_equal( + vt_find_config(), + normalizePath( + file.path(getwd(), "validation","validation.yml"), + winslash = "/") + ) + }) + + }) + +}) + + +test_that("Informative error when outside a packet or package", { + + withr::with_tempdir({ + + expect_error( + vt_find_config(), + paste0( + "Could not find root directory. ", + "Is your working directory inside a package, validation packet, or project?\n" + ), + fixed = TRUE) + }) + +}) + diff --git a/tests/testthat/test-init.R b/tests/testthat/test-init.R deleted file mode 100644 index 7c44d884..00000000 --- a/tests/testthat/test-init.R +++ /dev/null @@ -1,4 +0,0 @@ -test_that("multiplication works", { - - expect_equal(2 * 2, 4) -}) diff --git a/tests/testthat/test-latex_dynamic_referencing.R b/tests/testthat/test-latex_dynamic_referencing.R index 15ec3607..15e3435b 100644 --- a/tests/testthat/test-latex_dynamic_referencing.R +++ b/tests/testthat/test-latex_dynamic_referencing.R @@ -1,6 +1,8 @@ test_that("latex Number Referencing across rmarkdown chunks", { skip_if_not_installed("valtools") + skip_if_not(rmarkdown::pandoc_version() == numeric_version("2.7.3")) + withr::with_tempdir({ ## Create test files @@ -91,6 +93,8 @@ test_that("latex Number Referencing across rmarkdown chunks", { ## this test demonstrates how to use native latex + bookdown::render_book for dynamic labeling ## does not depend on valtools dynamic labeling skip_if_not_installed("valtools") + skip_if_not(rmarkdown::pandoc_version() == numeric_version("2.7.3")) + withr::with_tempdir({ ## Create test files diff --git a/tests/testthat/test-roxygen_copy.R b/tests/testthat/test-roxygen_copy.R index 440119f8..f73546a5 100644 --- a/tests/testthat/test-roxygen_copy.R +++ b/tests/testthat/test-roxygen_copy.R @@ -33,7 +33,7 @@ test_that("Copying roxygen comments works", { }) }) -test_that("Copying roxygen comments works", { +test_that("Copying roxygen comments works for multiple comments", { withr::with_tempdir({ dir.create("R") writeLines( @@ -79,7 +79,7 @@ test_that("Copying roxygen comments works", { }) }) -test_that("Copying roxygen and error gets returned", { +test_that("Copying roxygen and error gets returned when copy fails", { withr::with_tempdir({ dir.create("R") writeLines( @@ -100,3 +100,35 @@ test_that("Copying roxygen and error gets returned", { }) }) + +test_that("Copying roxygen and error gets returned when file already exists", { + withr::with_tempdir({ + dir.create("R") + writeLines( + c("#' @title Test", + "#' @param name name to say hello to", + "#' @editor Test Person", + "#' @editDate 1900-01-01", + "hello_world <- function(name){", + " print('hello,',name)", + "}"), + con = "R/hello.R" + ) + + ## Copy once + roxygen_copy( + from = "R", + to = "function_roxygen.R" + ) + + expect_error( + roxygen_copy(from = "R", + to = "function_roxygen.R"), + "Error in copying function roxygen comments:\n", + fixed = TRUE + ) + + }) +}) + + diff --git a/tests/testthat/test-validation_config.R b/tests/testthat/test-validation_config.R index 620a4663..4d588b06 100644 --- a/tests/testthat/test-validation_config.R +++ b/tests/testthat/test-validation_config.R @@ -292,6 +292,24 @@ test_that("Test overwriting of the config file", { }) +test_that("Test config creation without validation infrastructure throws error", { + withr::with_tempdir({ + + quiet <- capture.output( + usethis::create_package(path = ".") + ) + + expect_error( + vt_use_config( + package = "test.package", + pkg = "."), + "No validation structure found. Run `valtools::vt_use_validation().", + fixed = TRUE + ) + + }) + +}) test_that("Test removal of individual from config file", { @@ -395,7 +413,6 @@ test_that("ask_user_name_title_role only requests when missing information",{ }) - test_that("adding and removing validation files from list", { withr::with_tempdir({ @@ -653,5 +670,27 @@ test_that("inserting validation file at diff location", { }) +test_that("when creating validation config yaml throws an error, error propagates up", { + withr::with_tempdir({ + + + err <- suppressWarnings(capture_error({ + write_validation_config ( + package = "test.package", + path = "Invalid/file/path__" + ) + }) + ) + expect_true( + grepl( + "Error during creation of validation.yml config file. Error:", + x = as.character(err), + fixed = TRUE + ) + ) + + }) + +}) diff --git a/tests/testthat/test-validation_config_accessors.R b/tests/testthat/test-validation_config_accessors.R index f3f66123..e35a2b64 100644 --- a/tests/testthat/test-validation_config_accessors.R +++ b/tests/testthat/test-validation_config_accessors.R @@ -217,3 +217,28 @@ test_that("Test getting package name from config file", { }) +test_that("Accessing config output dirs returns working dir when it is missing", { + + withr::with_tempdir({ + + vt_use_validation( + pkg = ".", + package = "test.package" + ) + + ## remove output_dir from config + write_yaml( + x = list( + package = "test.package", + working_dir = "working_dir" + ), + file = file.path("validation", "validation.yml") + ) + + expect_equal( + get_config_output_dir(), + "working_dir" + ) + + }) +}) diff --git a/tests/testthat/test-vt_file.R b/tests/testthat/test-vt_file.R index 095582e1..ed3b559b 100644 --- a/tests/testthat/test-vt_file.R +++ b/tests/testthat/test-vt_file.R @@ -28,45 +28,48 @@ test_that("evaluting markdown files works", { referencer <- vt_dynamic_referencer$new() sample_output <- capture.output({ - cat(file_parse.md(file = "sample.md")) + cat(file_parse.md(file = "sample.md", interactive_output = TRUE)) }) sample_output2 <- capture.output({ cat(file_parse.md( file = "sample2.md", reference = referencer, + interactive_output = TRUE, dynamic_referencing = TRUE)) }) + sample_output3 <- capture.output({ - vt_file(file = "sample.md") + vt_file(file = "sample.md", interactive_output = TRUE) }) sample_output4 <- capture.output({ vt_file( file = "sample2.md", reference = referencer, + interactive_output = TRUE, dynamic_referencing = TRUE) }) expect_equal( sample_output, - c("","## Header", "+ Content", " + more content", "+ Content 2") + c("## Header", "+ Content", " + more content", "+ Content 2") ) expect_equal( sample_output2, - c("","## Header", "+ 1.1 Reference", " + more content", "+ Content 2") + c("## Header", "+ 1.1 Reference", " + more content", "+ Content 2") ) expect_equal( sample_output3, - c("","## Header", "+ Content", " + more content", "+ Content 2") + c("## Header", "+ Content", " + more content", "+ Content 2") ) expect_equal( sample_output4, - c("","## Header", "+ 1.1 Reference", " + more content", "+ Content 2") + c("## Header", "+ 1.1 Reference", " + more content", "+ Content 2") ) }) @@ -115,6 +118,7 @@ test_that("evaluating Rmarkdown files works", { sample_output <- capture.output({ file_parse.rmd( file = "sample.Rmd", + interactive_output = FALSE, envir = curr_env) }) @@ -122,12 +126,14 @@ test_that("evaluating Rmarkdown files works", { file_parse.rmd( file = "sample2.Rmd", reference = referencer, + interactive_output = FALSE, dynamic_referencing = TRUE, envir = curr_env) }) sample_output3 <- capture.output({ vt_file(file = "sample.Rmd", + interactive_output = FALSE, envir = curr_env) }) @@ -135,6 +141,7 @@ test_that("evaluating Rmarkdown files works", { vt_file( file = "sample2.Rmd", reference = referencer, + interactive_output = FALSE, dynamic_referencing = TRUE, envir = curr_env) }) diff --git a/tests/testthat/test-vt_set_ext.R b/tests/testthat/test-vt_set_ext.R index 210c9472..43cb69bb 100644 --- a/tests/testthat/test-vt_set_ext.R +++ b/tests/testthat/test-vt_set_ext.R @@ -23,3 +23,22 @@ test_that("overriding extentions", { ) }) + +test_that("setting extentions when multiple exist", { + + expect_equal( + vt_set_ext("test_input.md",c("md","Rmd")), + "test_input.md" + ) + + expect_equal( + vt_set_ext("test_input.Rmd",c("md","Rmd")), + "test_input.Rmd" + ) + + expect_equal( + vt_set_ext("test_input.zzz",c("md","Rmd")), + "test_input.md" + ) + +}) diff --git a/vignettes/.gitignore b/vignettes/.gitignore new file mode 100644 index 00000000..097b2416 --- /dev/null +++ b/vignettes/.gitignore @@ -0,0 +1,2 @@ +*.html +*.R diff --git a/vignettes/validating-external-resources.Rmd b/vignettes/validating-external-resources.Rmd new file mode 100644 index 00000000..6c1f9ffc --- /dev/null +++ b/vignettes/validating-external-resources.Rmd @@ -0,0 +1,408 @@ +--- +title: "Validating External Resources with {valtools}" +output: + rmarkdown::html_vignette: + toc: true + toc_depth: 3 +vignette: > + %\VignetteIndexEntry{Validating External Resources with {valtools}} + %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +editor_options: + markdown: + wrap: 72 +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + eval=FALSE +) +``` + +```{r setup, warning=FALSE} +# remotes::install_github("phuse-org/valtools") +library(valtools) +``` + +This vignette steps through the process of validating external resources with +{valtools}. "External resources" is defined for this vignette as any software +or environment that does not follow the validation process defined in the +[Starting New Validation Package using {valtools}](starting-validated-package.html) +vignette. This means packages installed from other sources, collections of packages, +external software, and environments. + +This process may be invoked when an R package was already developed and +only after the fact was validation decided to be of value, validating an +externally generated package (for example a package installed from CRAN), or +validating an environment or system. + + +Creating A New Validation Packet +------------------------ + +Starting a new validation packet using {valtools} starts with `vt_create_packet()`. +Here, the user passes the directory the project is to be performed in, and optionally +the target of validation. + +The "target of validation" is what the packet intends to validate - be it an +external package, environment, software, etc. + +If the target is not provided, {valtools} will request the user provide this +information + + +```{r} + +# create a new validation packet skeleton +vt_create_packet( + path = "/my/path/to/example_validation_packet", + target = "super.package" + ) + +``` + +The validation packet folder is constructed using the `usethis::create_project()` +function, and then all the necessary validation infrastructure required for +{valtools}. + +Importantly, there is now a `validation` folder, which is the +working directory for the validation. This is where almost all the +content for validation will be created. + +Inside this folder, there is the `validation.yml` file, which will be +referred as the validation config file going forward. This YML file +informs {valtools} how to interact with the various pieces of validation +that will be created, and information that needs to be shared across +multiple sessions/users. The user does not need to interact with this +file directly, the functions inside {valtools} will update this file as +necessary. + +#### Tutorial + +Run the chunk of code below to create a validation packet in a temporary +directory to follow along with the tutorial for the {whoami} package. The new +packet project will be opened in a new session. Run all subsequent code in +that new session. + +```{r} + +valtools::vt_create_packet( + path = file.path(tempdir(),"validation_packet_whoami"), + target = "whoami" + ) + +``` + +To examine the folder structure of the new package, run the following +function: + +```{r} + +fs::dir_tree(recurse = TRUE) + +``` + +Add Requirements +---------------- + +Requirements document users needs of the target - what are the problems the target +solves for the users - and must be documented before any test cases are written. +Requirements are recorded within the `validation/requirements` folder by default. +The collection of requirements may be called specifications. + +Requirements are written as markdown (.md) documents with special roxygen headers. +Each requirement must have the following roxygen comments in the header: title, +editor, editDate, and riskAssessment. The last the roxygen comments are custom +{valtools} supported roxygen tags to support validation. `@editor` is for tracking +the last editor of the function, `@editDate` is for recording whenever a function is +modified, and `@riskAssessment` is for tracking risks for each requirement. + +To make adding validation content easy, {valtools} extended the +`usethis` approach to package contents creation through a family of +"vt\_use\_\*" functions. + +`vt_use_req()` creates a new requirement in the +`validation/requirements` folder, with the main argument being +the name of the requirement, and an optional argument `username` to +record the name of the person writing the requirement. + +If the `username` argument is not passed, {valtools} will automatically +get the computer username of the user creating the requirement and +attempt to put in their full name. If the user has not created any +validation contents before, it will ask the user some questions (Name, +Title, and Role) and record them in the validation config file for +documentation in the validation report. + +```{r} + +valtools::vt_use_req("Requirement_001") + +``` + +#### Tutorial + +Run the command above and in the newly opened requirements file, on line +5, Replace `REQUIREMENTS` with `1.1`, and `ASSESSMENT` with +`1, Low Risk, Small Impact` to indicate requirement 1.1 has a risk +assessment that determined it has a low risk and small impact when it is +wrong. + +Add a new line underneath the line above (at line 6) line that contains: +`#' 1.2: 5, Low risk, Medium Impact` + +Copy the following content: + + + 1.1 Collect user id for current session + + 1.2 Collect full name of user for current session + +Change Log +---------- + +Similar to a news file, {valtools} suggests the use of a change log that +is directly tied to validation for recording changes. The purpose of this is to +capture update and information that is useful for developers from +information that is important to capture in validation. + +To create this change log file, {valtools} has the function +`vt_use_change_log()`. It will create the change log file inside the +working directory and open it up for editing. + +The header information tracks the version of validation and the date of the +release of validation. This is a markdown file, so normal markdown can +be used to document the changes. However, critically here, only bullets +marked with [validation] will be recorded in the validation report. + +```{r} + +valtools::vt_use_change_log() + +``` + +#### Tutorial + +Run the command above to create a change log. + +Testing +------- + +Testing is done to ensure that the target meets the requirements that +were set out for the project. Testing is done in two major steps: the +firsts consists of writing out a series of cases that would prove that +the requirements have been met, the second is the application of these +cases. + +### Test Cases + +The addition and writing of test cases is handled by the +`vt_use_test_case()` function. Similarly to `vt_use_req()`, a username +can be passed, or it will look to determine which user is calling the +function and input their information. + +This function creates the test case file in the +`validation/test_cases` folder of the package and opens it for +editing. + +```{r} + +valtools::vt_use_test_case("Test_case_001") + +``` + +#### Tutorial + +Run the code above and in the newly opened test case file, replace +`TESTCASE` with `1.1`, and `REQUIREMENT` with `1.1` to indicate test +case 1.1 shows that requirement 1.1 is being met. + +Add a new line underneath the line above (at line 6) line that contains: +`#' 1.2: 1.1, 1.2` + +This is to indicate test case 1.2 shows requirements 1.1 and 1.2 are +being met. + +Copy the following test case into file where test cases are to be +documented: + + + 1.1 Test that the software can identify the username pf the user by + setting the environment variable `LOGNAME` to `jsmith` for the duration of + the test and confirming that the output of whoami::username is `jsmith`. + + 1.2 Test that the software can identify the full name of the user by + setting the environment variable `FULLNAME` to "John Smith" for the + duration of the test and confirming that the output of whoami::fullname() + is "John Smith" + +### Test Code + +Test code is the implementation of the test cases as code. The goal is +that the code is completely reproducible and able to be run without +human interaction. Additionally, test code is written by a third party - +someone that was not involved with writing the actual code or the test +case. This helps ensure the integrity of the testing as well as +providing valuable review of the documentation of the test cases and +package code. + +Similarly to `vt_use_req()` for requirements and `vt_use_test_case` for +test cases, {valtools} provide a function for creating test code files +and recording which user created the file. + +```{r} + +valtools::vt_use_test_code("Test_code_001") + +``` + +#### Tutorial + +Add "Val A Dashun" to the validation config file: + +```{r} + +valtools::vt_add_user_to_config( + username = "user_b", + name = "Val A Dashun", + title = "Programmer II", + role = "tester" +) + +``` + +Now that this persons information is recorded, construct the test code +file that they will use to record the test code through the code below. + +```{r} + +valtools::vt_use_test_code("Test_code_001", username = "Val A Dashun") + +``` + +In the newly opened test code file. Update `TESTNUMBER` to `1.1` in the +new test code file and copy the code below into the body of the test: + +``` {.r} + +withr::with_envvar( + new = list(LOGNAME = "jsmith"), + { + + user <- whoami::username() + + expect_equal( + user, + "jsmith" + ) + +}) + +``` + +add a new test with the following beneath the test. Replace "TODAYS +DATE" with today's date. + +``` {.r} + +#' @editor Val A Dashun +#' @editDate TODAYS DATE +test_that("1.2",{ + + withr::with_envvar( + new = list(FULLNAME = "John Smith"), + { + + user_full_name <- whoami::fullname() + + expect_equal( + user_full_name, + "John Smith" + ) + + }) +}) +``` + +Authoring Validation Reports +-------------------------------- + +{valtools} provides dynamic access via a Rmarkdown file to details necessary for +generating a validation report at push of button. This validation report documents +that the package meets stated goals and can be re-evaluated as necessary to +generate the report in PDF or HTML format. + +The function `vt_use_report()` creates a validation report rmarkdown file +pre-populated with code to scrape all the pieces of information +that were generated in the prior steps to create the final report when being knit. + +`vt_use_report()` saves the validation report rmarkdown file +in the working directory identified in the validation config file. +Within packages this defaults to the base folder. +This rmarkdown file will have a default name `validation.Rmd` if unspecified. + +```{r} +valtools::vt_use_report(template = "packet") +``` + +There are several sections included by default in the provided validation report +rmarkdown: + +- Signatures: Capture signatures of everyone involved in the + validation. + +- Release Details: + + - Records the validation environment + - Presents the change log of the validation. + - Subsections to show the last editor for each piece of the + validation; requirements, test cases and test code. + - Traceability table to show which requirements are being + - Risk Assessment: Combines all the risk assessments made into a + single table + +- Validation: record each requirement, test case, and results of the + test code + +{valtools} also supports a concept called "dynamic referencing", which +will be explained in another vignette. + +When editing the report, some key functions to know for extending the +report included by {valtools} are: + +- `vt_path()` allows user to base path from the validation directory. + Similar idea to the {here} package, but for validation. +- `vt_file()` allows the user to point to specific files and render + them as child documents within the report. +- `vt_scrape_*` family of functions allows users to scrape various + pieces of information from the validation infrastructure and returns + a data.frame. +- `vt_kable_*` family functions provides an opinionated formatting to + the `vt_scrape_*` functions to help quickly construct the report. +- `vt_get_child_files()` returns the list of files that are indicated + in the validation.yml to be included in the validation report. This + allows for batch creation of the dynamic content in the report. + +Keep in mind, the report is an Rmarkdown, so there is no limit to +editing and customization, and templates. + +#### Tutorial + +Run the code above to generate the report, and inspect the overall +structure of the report. See what happens when contents are moved +around. + +Running a Validation Report +--------------------------- + +Now that there is a validation report as an Rmarkdown, validation is only a +compiling of the report away. To validate the target, we execute the report +non-interactively and save the results. + +#### Tutorial + +Run the validation report + +##### Validation Mode: Running on Source + +```{r} +valtools::vt_validate_report() +``` + diff --git a/vignettes/validation_figure_tests.Rmd b/vignettes/validation_figure_tests.Rmd new file mode 100644 index 00000000..f0686c79 --- /dev/null +++ b/vignettes/validation_figure_tests.Rmd @@ -0,0 +1,86 @@ +--- +title: "Validation: Figure Tests" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{validation_figure_tests} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r setup} +library(valtools) +library(testthat) +``` + +Effective test cases cover a broad spectrum of use cases of the code intended to be validated. +More often than not, this is confirming that an input returns a specific or set of specific values. + +However, not all functions are used for their value-generation. +In fact, there are a number of functions that are used for their side effects, such as plot generation. + +{testthat} 3e (third edition) adds the option to perform snapshot, i.e. golden, testing. +That is, to use a reference output that is then compared against outputs in future runs. +This is an powerful tool that creates the opportunity to add testing of not only known outputs in the form of numbers, but of files and figures as well. + +## Image Comparison Example + +The test cases need to provide enough instruction for another programmer to consistently generate the same results. When it comes to test cases related to figure comparison, the same holds true. The test case author needs to provide the specific set of instructions, including the layering of the plot elements, to generate the same plots. + +Additionally, the test case author needs to provide instructions on how to compare files. Usually this will be what device to use to save the generated plot (ie. PNG, JPEG, TIFF) and then reference file that the test code writer will compare against. + +The comparison for most file types can be done by comparing the raw file contents or raw text via `compare_file_binary()` and `compare_file_text()` found in {testthat} V3.0.4.9000 or newer. +When performing the comparison, the two files should have been generated on the same OS to ensure consistency. + +``` + +Figure Expectation 01 +--- + +First create the temporary file path via `tempfile()` and assign to the object `tmp_png`. +Set the RNG seed to 100. +Run the function `png()`, with the argument `filename` set to be `tmp_png` to start capturing the plot generated. +Create a histogram with the function `hist()` and set the arg `x` to be the result of 100 values randomly generated from the normal distribution. +Stop capturing the plot by calling `dev.off()`. +Compare this plot against the reference file provided by the the test case writer using the `compare_file_binary()` function from {testthat} by passing the pass to the reference file to the first argument (`vt_file("test_case/references/reference_plot.png")`) and `tmp_png` to the second argument and confirming the result is "TRUE" +``` + +In this situation, the test case author generated +a reference png on the same OS that the code is intended to be run on and is saved in the validation folder under `test_case/references/reference_plot.png` for the test code writer to compare against. + +## Test Code + +The test code writer now follows the instructions to write the test case and compares the file. Note how the last instructions are to confirm the output is true, so the final expectation is to use the `expect_true()` expectation from {testthat}. + +```r + +test_that("Figure Expectation 01",{ + + tmp_png <- tempfile() + set.seed(100) + + png(tmp_png) + hist(rnorm(100)) + dev.off() + + expect_true( + compare_file_binary( + vt_file("test_case/references/reference_plot.png"), + tmp_plot + ) + +}) + +``` + + + + + +