Merge pull request #196 from pharmaverse/140-feature-request-create-u…

…nit-test-for-rmd-files

Closes #140

NEWS.md

@@ -6,6 +6,7 @@
 - Add `include_rds` argument to `axecute()` to export log as rds file
 - Add `library_call_linter()` to ensure all library calls are at the top of the script (#163)
 - Remove argument for remove_log_object from `axecute()` still accessible via `log_write()` (#182)
+- Added functionality so `axecute()` works with `.Rmd` files (#140)
 
 # logrx 0.2.2
 

R/axecute.R

@@ -34,6 +34,13 @@
 #' close(fileConn)
 #'
 #' axecute(file.path(dir, "hello.R"))
+#'
+#'
+#' fileConn <- file(file.path(dir, "hello.Rmd"))
+#' writeLines(text, fileConn)
+#' close(fileConn)
+#'
+#' axecute(file.path(dir, "hello.Rmd"))
 axecute <- function(file, log_name = NA,
  log_path = NA,
  include_rds = FALSE,

R/get.R

@@ -155,6 +155,16 @@ get_masked_functions <- function(){
 #'
 get_used_functions <- function(file){
 
+ # if markdown, write R code, including inline, to a script
+ # use this script to find functions used
+ if (grepl("*.Rmd$", file, ignore.case = TRUE)){
+ tmpfile <- tempfile(fileext = ".R")
+ on.exit(unlink(tmpfile))
+ withr::local_options(list(knitr.purl.inline = TRUE))
+ knitr::purl(file, tmpfile)
+ file <- tmpfile
+ }
+
  # catch error
  retfun <- safely(parse,
  quiet = FALSE,
@@ -191,14 +201,24 @@ get_used_functions <- function(file){
  names_from = "token") %>%
  ungroup()
 
- combine_tokens <- wide_tokens %>%
+ # if package is present, but symbol or special is not, a function did not follow the ::
+ # ex. knitr::opts_chunk$set()
+ # for this case, remove row that contains the package
+ # set will still be captured but we will be able to link it to a package in this current version
+ wide_tokens_wo_orphans <- wide_tokens[!(!is.na(wide_tokens$SYMBOL_PACKAGE) & is.na(wide_tokens$SYMBOL_FUNCTION_CALL) & is.na(wide_tokens$SPECIAL)),]
+
+ combine_tokens <- wide_tokens_wo_orphans %>%
  mutate(function_name = coalesce(.data[["SYMBOL_FUNCTION_CALL"]],
  .data[["SPECIAL"]]))
 
-get_library(combine_tokens) %>%
+ distinct_use <- get_library(combine_tokens) %>%
  select(all_of(c("function_name", "library"))) %>%
  distinct()
 
+ distinct_use[is.na(distinct_use)] <- "!!! NOT FOUND !!!"
+
+ distinct_use
+
 }
 
 

R/interact.R

@@ -110,6 +110,13 @@ set_log_name_path <- function(log_name = NA, log_path = NA) {
 #' @noRd
 run_safely <- function(file) "dummy"
 
+#' Is this a R Markdown file
+#' @param file String. Path to file to execute
+#' @noRd
+is_rmarkdown <- function(file) {
+ grepl("*.Rmd$", file, ignore.case = TRUE)
+}
+
 #' Dummy function for running a file
 #' @noRd
 run_file <- function(file){
@@ -118,7 +125,13 @@ run_file <- function(file){
  } else{
  exec_env <- getOption("log.rx.exec.env")
  }
- source(file, local = exec_env)
+
+ if(is_rmarkdown(file)){
+ rmarkdown::render(file, envir = exec_env)
+ } else{
+ source(file, local = exec_env)
+ }
+
 }
 
 #' Safely run an R script and record results, outputs, messages, errors, warnings

R/log.R

@@ -291,7 +291,7 @@ log_write <- function(file = NA,
  }
  if ("result" %in% to_report){
  cleaned_log_vec <- c(cleaned_log_vec,
- write_result())
+ write_result(file))
  }
 
  cleaned_log_vec <- c(cleaned_log_vec,

R/writer.R

@@ -282,10 +282,14 @@ write_output <- function() {
 #'
 #' @noRd
 #'
-write_result <- function() {
+write_result <- function(file) {
  result <- get_log_element("result")
 
- c("\nResult:", paste0("\t", capture.output(result$value)))
+ if (is_rmarkdown(file)) {
+ c("\nResult:", paste0("\t", capture.output(result)))
+ } else {
+ c("\nResult:", paste0("\t", capture.output(result$value)))
+ }
 }
 
 #' Format lint results for writing

inst/WORDLIST

@@ -37,3 +37,4 @@ sessionInfo
 tidylog
 initialises
 scrollable
+knitr

tests/testthat/ref/ex1.Rmd

@@ -0,0 +1,31 @@
+---
+title: "ex1"
+date: "2023-07-06"
+---
+
+## R Markdown
+
+This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see <http://rmarkdown.rstudio.com>.
+
+When you click the **Knit** button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:
+
+```{r cars}
+library(dplyr)
+summary(cars)
+```
+
+## Including Plots
+
+You can also embed plots, for example:
+
+```{r pressure, echo=FALSE}
+plot(pressure)
+```
+
+Note that the `echo = FALSE` parameter was added to the code chunk to prevent printing of the R code that generated the plot.
+
+```{r}
+mtcars %>%
+ dplyr::filter(mpg >= 20)
+```
+Let's test some inline code with `r print("print")`

tests/testthat/test-axecute.R

@@ -135,3 +135,42 @@ test_that("include_rds works to output log as rds", {
  rm(con, scriptPath, logDir, logRDS)
  log_remove()
 })
+
+test_that("axecute will run a markdown file and create the necessary log", {
+ options("log.rx" = NULL)
+
+ scriptPath <- test_path("ref", "ex1.Rmd")
+ logDir <- tempdir()
+
+ # check no log is currently written out
+ expect_warning(expect_error(file(file.path(logDir, "rmd_log_out"), "r"), "cannot open the connection"))
+
+ axecute(scriptPath, log_name = "rmd_log_out", log_path = logDir)
+ con <- file(file.path(logDir, "rmd_log_out"), "r")
+ flines <- readLines(con)
+ close(con)
+
+ # check that the output file is populated
+ expect_gt(length(flines), 1)
+ # check all the elements are there
+ expect_true(grepl(paste(write_log_header("logrx Metadata"), collapse = ','),
+ paste(flines,collapse = ',')))
+ expect_true(grepl(paste(write_log_header("User and File Information"), collapse = ','),
+ paste(flines,collapse = ',')))
+ expect_true(grepl(paste(write_log_header("Session Information"), collapse = ','),
+ paste(flines,collapse = ',')))
+ expect_true(grepl(paste(write_log_header("Masked Functions"), collapse = ','),
+ paste(flines,collapse = ',')))
+ expect_true(grepl(paste(write_log_header("Program Run Time Information"), collapse = ','),
+ paste(flines,collapse = ',')))
+ expect_true(grepl(paste(write_log_header("Errors and Warnings"), collapse = ','),
+ paste(flines,collapse = ',')))
+ expect_true(grepl(paste(write_log_header("Messages, Output, and Result"), collapse = ','),
+ paste(flines,collapse = ',')))
+ expect_true(grepl(paste(write_log_header("Log Output File"), collapse = ','),
+ paste(flines,collapse = ',')))
+
+ # remove all the stuff we added
+ rm(flines, con, scriptPath, logDir)
+ log_remove()
+})

tests/testthat/test-get.R

@@ -198,3 +198,28 @@ test_that("lint returns expected result when option is set to FALSE", {
 
  expect_identical(get_lint_results(filename), NULL)
 })
+
+test_that("functions used are returned correctly for rmd files", {
+ filename <- test_path("ref", "ex1.Rmd")
+
+ tmpfile <- tempfile(fileext = ".R")
+
+ withr::local_options(list(knitr.purl.inline = TRUE))
+
+ knitr::purl(filename, tmpfile)
+
+ source(tmpfile, local = TRUE)
+
+ expected <- tibble::tribble(
+ ~function_name, ~library,
+ "library", "package:base",
+ "summary", "package:base",
+ "plot", "package:graphics",
+ "%>%", "package:dplyr",
+ "filter", "package:dplyr",
+ "print", "package:base"
+ )
+
+ expect_identical(get_used_functions(tmpfile), expected)
+
+})

tests/testthat/test-writer.R

@@ -176,7 +176,7 @@ test_that("write_result will return a formatted log result element", {
 
  run_safely_loudly(fp)
 
- expect_identical(write_result(),
+ expect_identical(write_result(fp),
  c("\nResult:", paste0("\t", capture.output(data.frame(test = c(8, 6, 7, 5, 3, 0, 9))))))
 
  log_remove()

vignettes/approved.Rmd

@@ -176,3 +176,9 @@ logrx::log_remove()
 
 unlink(dir, recursive = TRUE)
 ```
+
+# A Few Words of Caution
+
+All packages should be attached at the top of the script to set a consistent `?base::searchpaths()` throughout the entire script. This will ensure the functions you use in your script are linked to the correct package. A lint feature is available to test your scripts follow this best practice.
+
+Some functions are stored within a list, for example `knitr::opts_chunck$get()` and `knitr::opts_current$get()`. We do not currently identify `get()` as a knitr function since it is not exported.