Related
I use {cli} messages in one of my packages. I would like to hide these messages in my tests because they clutter the testthat results. Is there a way to do that?
I've seen that {cli} has a TESTTHAT environment variable but I don't know if it exists for this purpose, and I don't know how to use it. Note that I would prefer a solution that is simple to implement, such as a test global option. I don't want to manually edit all my tests or messages.
Reproducible example:
library(testthat)
library(cli)
test_that("addition works", {
cli_alert_info("This message should not appear")
expect_equal(1+1, 2)
})
#> i This message should not appear
#> Test passed
Edit: I could create a custom test_that() that would wrap suppressMessages() like the following:
my_test_that <- function(desc, code) {
test_that(desc, {
suppressMessages({
code
})
})
}
my_test_that("addition works", {
cli_alert_danger("This message should not appear")
expect_equal(1+1, 2)
})
#> Test passed
and then store it in tests/testthat/setup.R. The problem is that if a test fails, it indicates the line in my_test_that() and not the line where the error actually appears (so basically all errors and warnings will refer to the same line):
my_test_that("addition works", {
cli_alert_danger("This message should not appear")
expect_equal(1+4, 2)
})
-- Failure (.active-rstudio-document:6:5): addition works ----------------------
1 + 4 (`actual`) not equal to 2 (`expected`).
Here, the error refers to the line with suppressMessages(). This makes it much harder to find the source of the problem.
One solution was given in this Github issue. Using withr::with_options() or withr::local_options() with option cli.default_handler = function(...) { } seems to work.
library(testthat)
library(cli)
my_test_that <- function(desc, code) {
withr::with_options(
list(
cli.default_handler = function(...) { },
usethis.quiet = TRUE
),
test_that(desc, {
code
})
)
}
my_test_that("addition works", {
cli_alert_danger("This message should not appear")
expect_equal(1+2, 2)
})
-- Failure (.active-rstudio-document:15:3): addition works ---------------------
1 + 2 not equal to 2.
1/1 mismatches
[1] 3 - 2 == 1
Note that this will remove all cli messages so it is not possible to use expect_message() in my_test_that().
There are several code snippets that are invaluable to my workflow and play nicely with functions in my custom R package. Can I include these code snippets in my R package so that they are added to users' code snippets (with permissions of course) when they install my package?
Rmd snippet example that creates a sql chunk:
snippet sql
```{sql, connection = conn, output.var = "${1:df}"}
${2}
```
Short answer: Yes
One way to achieve what you want (that works for my package) is:
Store the packages snippet definitions in two text files somewhere in the packages inst/ directory. It's important that the snippets follow exactly the formatting rules (e.g. tabs at the start of the lines, not spaces). I have one file for R code snippets and one for markdown.
Define a function that reads these files and copies their content into RStudios user snippets files. These files are generated at the first attempt to edit the snippets (Tools -> Global Options -> Code -> Edit Snippets) (I think RStudio uses an other, not user exposed file before one tries to edit, not sure though). On ubuntu the RStudio files are called 'r.snippets' and 'markdown.snippets' and are in '~/.R/snippets/'. I also check if the snipped definition already exists, and double check the tabs at the start of the lines before using cat(..., append=TRUE) to add the packages snippet definitions.
I first used an elaborate .onLoad function with configs and all but now I just export a addPackageSnippets function ;)
Edit
Some code:
Part that checks for already existing snippet definitons:
I just read the rstudio file and extract the lines starting with 'snippet'. I do the same for the packages snipptes definition file and use setdiff (one might want to also use trimws on the lists, just in case there is some trailing white-space)
# load package snippets definitions
#
pckgSnippetsFileContent <- readLines(pckgSnippetsFilesPath)
# Extract names of package snippets
#
pckgSnippetsFileDefinitions <- pckgSnippetsFileContent[grepl("^snippet (.*)", pckgSnippetsFileContent)]
# Extract 'names' of already existing snitppets
#
rstudioSnippetsFileContent <- readLines(rstudioSnippetsFilePath)
rstudioSnippetDefinitions <- rstudioSnippetsFileContent[grepl("^snippet (.*)", rstudioSnippetsFileContent)]
# find definitions appearing in packageSnippets but not in rstudioSnippets
# if no snippets are missing go to next file
#
snippetsToCopy <- setdiff(pckgSnippetsFileDefinitions, rstudioSnippetDefinitions)
For context here is the whole 'addPackageSnippets' function. The function is using only the base package, except getOS which returns one of 'linux', 'windows' or 'mac' (i.e. a wrapper around Sys.info()
#' #title Export snippets
#'
#' #description \code{addPackageSnippets} copies all (missing) snippet definitions
#' in 'inst/rstudio/Rsnippets.txt' and 'Rmdsnippets.txt' to the RStudios user snippet location.
#'
#' #return boolean invisible(FALSE) if nothing was added, invisible(TRUE) if snipped definitions were added
#' #export
#'
#' #examples \dontrun{addPackageSnippets()}
addPackageSnippets <- function() {
added <- FALSE
# if not on RStudio or RStudioServer exit
#
if (!nzchar(Sys.getenv("RSTUDIO_USER_IDENTITY"))) {
return(NULL)
}
# Name of files containing snippet code to copy
#
pckgSnippetsFiles <- c("Rsnippets.txt", "Rmdsnippets.txt")
# Name of files to copy into. Order has to be the same
# as in 'pckgSnippetsFiles'
#
rstudioSnippetsFiles <- c("r.snippets", "markdown.snippets")
# Path to directory for RStudios user files depends on OS
#
if (getOS() == "linux") {
rstudioSnippetsPathBase <- "~/.R/snippets"
} else if (getOS() == "windows") {
rstudioSnippetsPathBase <- file.path(path.expand('~'), ".R", "snippets")
} else {
warning(paste0("goSnippets() is only implemented on linux and windows"))
return(NULL)
}
# Read each file in pckgSnippetsFiles and add its contents
#
for (i in seq_along(pckgSnippetsFiles)) {
# Try to get template, if template is not found skip it
#
pckgSnippetsFilesPath <- system.file("rstudio", pckgSnippetsFiles[i], package = "myFunc")
if (pckgSnippetsFilesPath == "") {
next()
}
# load package snippets definitions
#
pckgSnippetsFileContent <- readLines(pckgSnippetsFilesPath)
# Extract names of package snippets
#
pckgSnippetsFileDefinitions <- pckgSnippetsFileContent[grepl("^snippet (.*)", pckgSnippetsFileContent)]
# Construct path for destination file
#
rstudioSnippetsFilePath <- file.path(rstudioSnippetsPathBase, rstudioSnippetsFiles[i])
# If targeted RStudios user file does not exist, raise error (otherwise we would 'remove')
# the default snippets from the 'user file'
#
if (!file.exists(rstudioSnippetsFilePath)) {
stop(paste0( "'", rstudioSnippetsFilePath, "' does not exist yet\n.",
"Use RStudio -> Tools -> Global Options -> Code -> Edit Snippets\n",
"To initalize user defined snippets file by adding dummy snippet\n"))
}
# Extract 'names' of already existing snitppets
#
rstudioSnippetsFileContent <- readLines(rstudioSnippetsFilePath)
rstudioSnippetDefinitions <- rstudioSnippetsFileContent[grepl("^snippet (.*)", rstudioSnippetsFileContent)]
# replace two spaces with tab, ONLY at beginning of string
#
pckgSnippetsFileContentSanitized <- gsub("(?:^ {2})|\\G {2}|\\G\t", "\t", pckgSnippetsFileContent, perl = TRUE)
# find defintions appearing in packageSnippets but not in rstudioSnippets
# if no snippets are missing go to next file
#
snippetsToCopy <- setdiff(trimws(pckgSnippetsFileDefinitions), trimws(rstudioSnippetDefinitions))
snippetsNotToCopy <- intersect(trimws(pckgSnippetsFileDefinitions), trimws(rstudioSnippetDefinitions))
if (length(snippetsToCopy) == 0) {
# cat(paste0("(\nFollowing snippets will NOT be added because there is already a snippet with that name: ",
# paste0(snippetsNotToCopy, collapse=", ") ,")"))
next()
}
# Inform user about changes, ask to confirm action
#
if (interactive()) {
cat(paste0("You are about to add the following ", length(snippetsToCopy),
" snippets to '", rstudioSnippetsFilePath, "':\n",
paste0(paste0("-", snippetsToCopy), collapse="\n")))
if (length(snippetsNotToCopy) > 0) {
cat(paste0("\n(The following snippets will NOT be added because there is already a snippet with that name:\n",
paste0(snippetsNotToCopy, collapse=", ") ,")"))
}
answer <- readline(prompt="Do you want to procedd (y/n): ")
if (substr(answer, 1, 1) == "n") {
next()
}
}
# Create list of line numbers where snippet definitons start
# This list is used to determine the end of each definition block
#
allPckgSnippetDefinitonStarts <- grep("^snippet .*", pckgSnippetsFileContentSanitized)
for (s in snippetsToCopy) {
startLine <- grep(paste0("^", s, ".*"), pckgSnippetsFileContentSanitized)
# Find last line of snippet definition:
# First find start of next defintion and return
# previous line number or lastline if already in last definiton
#
endLine <- allPckgSnippetDefinitonStarts[allPckgSnippetDefinitonStarts > startLine][1] -1
if (is.na(endLine)) {
endLine <- length(pckgSnippetsFileContentSanitized)
}
snippetText <- paste0(pckgSnippetsFileContentSanitized[startLine:endLine], collapse = "\n")
# Make sure there is at least one empty line between entries
#
if (tail(readLines(rstudioSnippetsFilePath), n=1) != "") {
snippetText <- paste0("\n", snippetText)
}
# Append snippet block, print message
#
cat(paste0(snippetText, "\n"), file = rstudioSnippetsFilePath, append = TRUE)
cat(paste0("* Added '", s, "' to '", rstudioSnippetsFilePath, "'\n"))
added <- TRUE
}
}
if (added) {
cat("Restart RStudio to use new snippets")
}
return(invisible(added))
}
For anyone who comes across this thread, and to add to Dario's great answer: from RStudio v1.3, the filepaths have changes. So in his function, the section for setting rstudioSnippetsPathBase would need to change into something like the following
if (rstudioapi::versionInfo()$version < "1.3") {
rstudioSnippetsPathBase <- file.path(path.expand('~'),".R", "snippets")
} else {
if (.Platform$OS.type == "windows") {
rstudioSnippetsPathBase <- file.path(Sys.getenv("APPDATA"), "RStudio", "snippets")
} else {
rstudioSnippetsPathBase <- file.path(path.expand('~'), ".config/rstudio", "snippets")
}
}
Aside from a vignette, I wish to add an additional document as PDF to my package. I can, of course, copy it to the inst/doc directory and it will then be included in the package documentation.
However, I would like to make it easy for the user to display this file. The authors of the edgeR package decided to do the following: the main users manual is distributed as PDF (and is not a regular vignette), and the authors include a function called edgeRUsersGuide() which shows the PDF by means of the following code:
edgeRUsersGuide <- function (view = TRUE) {
f <- system.file("doc", "edgeRUsersGuide.pdf", package = "edgeR")
if (view) {
if (.Platform$OS.type == "windows")
shell.exec(f)
else system(paste(Sys.getenv("R_PDFVIEWER"), f, "&"))
}
return(f)
}
It appears to work. Do you think it is a reasonable approach?
Or should one use something else? Potentially, the following code would also work and be more robust:
z <- list(PDF="edgeR.pdf", Dir=system.file(package="edgeR"))
class(z) <- "vignette"
return(z)
My solution was to ape the code in utils:::print.vignette():
function(docfile) {
## code inspired by tools:::print.vignette
pdfviewer <- getOption("pdfviewer")
f <- system.file("doc", docfile, package = "tmod")
if(identical(pdfviewer, "false"))
stop(sprintf("Cannot display the file %s", f))
if (.Platform$OS.type == "windows" &&
identical(pdfviewer, file.path(R.home("bin"), "open.exe"))) {
shell.exec(f)
} else {
system2(pdfviewer, shQuote(f), wait = FALSE)
}
return(invisible(f))
}
I'm trying to download PDFs using a table containing links. Due to inconsistent formatting of the links, I have created different versions of the same links residing in different columns. For privacy reasons I can't disclose the links, but here is what I did.
links <- data.frame(links1,links2,links3,links4)
filenames <- str_c(format(seq.Date(from = as.Date("2015-04-01"),
to = Sys.Date(), by = "day"),"%Y_%m_%d"),".pdf")
After having created all the versions and the names, here I try to write a loop wrapped in Try-Catch to continue despite the link not being correct. my goal is to when it doesn't find the link on column links$links1[3] to look at the other columns on the same row to find a working link.
Here is my try:
for (i in seq_along(links[,1])) {
#using trycatch to bipass the error when url doesn't exist
tryCatch({
if (!file.exists(str_c(folder,"/",filenames[i]))) {
download.file(links[i,1], filenames[i], mode = "wb")
print(paste0("Downloading: ", filenames[i]))
} }, error = function(e){
for (j in seq_along(links[i,])){
tryCatch({
download.file(links[i,j], filenames[i], mode = "wb")
}, error = function(e){}
)
}
}
)
}
For some reason its not picking up PDFs uploaded on April 9th 2015 and possibly other dates too.
The line for (j in seq_along(links[i,])){ is causing the inner loop to retry the already failed link. If the link fails, it will therefore fail again in the inner loop. Your program continues happily, never having tried the other links.
You should skip over j = 1 in your inner for loop.
Here's a slightly modified version of your program showing what is happening.
links1 <- c('a','b','c')
links2 <- c('x','y','z')
links <- data.frame(links1,links2)
for (i in seq_along(links[,1])) {
#using trycatch to bipass the error when url doesn't exist
tryCatch({
print(sprintf("trying: %s", links[i,1]))
if( i == 2 ) {
stop( simpleError("error"))
}
},
error = function(e){
for (j in seq_along(links[i,])){
tryCatch({
print(sprintf("falling back to %s", links[i,j]))
},
error = function(e){
})
}
})
}
Is there any way to stop an R program without error?
For example I have a big source, defining several functions and after it there are some calls to the functions. It happens that I edit some function, and want the function definitions to be updated in R environment, but they are not actually called.
I defined a variable justUpdate and when it is TRUE want to stop the program just after function definitions.
ReadInput <- function(...) ...
Analyze <- function(...) ...
WriteOutput <- function(...) ...
if (justUpdate)
stop()
# main body
x <- ReadInput()
y <- Analyze(x)
WriteOutput(y)
I have called stop() function, but the problem is that it prints an error message.
ctrl+c is another option, but I want to stop the source in specific line.
The problem with q() or quit() is that it terminates R session, but I would like to have the R session still open.
As #JoshuaUlrich proposed browser() can be another option, but still not perfect, because the source terminates in a new environment (i.e. the R prompt will change to Browser[1]> rather than >). Still we can press Q to quit it, but I am looking for the straightforward way.
Another option is to use if (! justUpdate) { main body } but it's clearing the problem, not solving it.
Is there any better option?
I found a rather neat solution here. The trick is to turn off all error messages just before calling stop(). The function on.exit() is used to make sure that error messages are turned on again afterwards. The function looks like this:
stop_quietly <- function() {
opt <- options(show.error.messages = FALSE)
on.exit(options(opt))
stop()
}
The first line turns off error messages and stores the old setting to the variable opt. After this line, any error that occurs will not output a message and therfore, also stop() will not cause any message to be printed.
According to the R help,
on.exit records the expression given as its argument as needing to be executed when the current function exits.
The current function is stop_quietly() and it exits when stop() is called. So the last thing that the program does is call options(opt) which will set show.error.messages to the value it had, before stop_quietly() was called (presumably, but not necessarily, TRUE).
There is a nice solution in a mailing list here that defines a stopQuietly function that basically hides the error shown from the stop function:
stopQuietly <- function(...) {
blankMsg <- sprintf("\r%s\r", paste(rep(" ", getOption("width")-1L), collapse=" "));
stop(simpleError(blankMsg));
} # stopQuietly()
> stopQuietly()
I have a similar problem and, based on #VangelisTasoulas answer, I got a simple solution.
Inside functions, I have to check if DB is updated. If it is not, stop the execution.
r=readline(prompt="Is DB updated?(y/n)")
Is DB updated?(y/n)n
if(r != 'y') stop('\r Update DB')
Update DB
Just putting \r in the beginning of the message, overwrite Error: in the message.
You're looking for the function browser.
You can use the following solution to stop an R program without error:
if (justUpdate)
return(cat(".. Your Message .. "))
Just return something at the line you want to quit the function:
f <- function(x, dry=F) {
message("hi1")
if (dry) return(x)
message("hi2")
x <- 2*x
}
y1 <- f(2) # = 4 hi1 hi2
y2 <- f(2, dry=T) # = 2 hi1
In addition to answer from Stibu on Mar 22 '17 at 7:29, if you want to write a message as a part of stop(), this message is not written.
I perceive strange that following two lines have to be used meaning on.exit(options(options(show....))) doesn't work.
opt <- options(show.error.messages = F)
on.exit(options(opt))
I had forgotten the answer to this and needed to look it up and landed here... You posted the hint to the answer in your question...
ctrl+c is another option, but I want to stop the source in specific line.
Signal an error, warning, or message
rlang::inform("Updated Only")
rlang::interrupt()
I've found it good to write a script and run it with source(). In the script, a write exit statements as a special class of error that a tryCatch() can pick up and send back as just a message:
exit <- function(..., .cl = NULL) {
# Use to capture acceptable stop
cond <- structure(
list(.makeMessage(...), .cl),
class = c("exitError", "error", "condition"),
names = c("message", "call")
)
stop(cond)
}
foo <- function() {
exit("quit here")
1
}
tryCatch(
# rather than foo(), you might use source(filename)
foo(),
exitError = function(e) message(e$message)
)
#> quit here
Created on 2022-01-24 by the reprex package (v2.0.1)
You can use with_options() in the withr package to temporarily disable error messages and then you can call stop() directly.
Here is an example:
weird_math <- function(x, y, z) {
if (x > z) {
withr::with_options(
list(show.error.messages = FALSE),
{
print("You can execute other code here if you want")
stop()
}
)
}
# only runs if x <= z
x + y ^ z
}
weird_math(1, 2, 3)
[1] 9
weird_math(3, 2, 1)
[1] "You can execute other code here if you want"
why not just use an if () {} else {}? It's only a couple of characters...
f1 <- function(){}
f2 <- function(){}
if (justUpdate) {
} else {
# main body
}
or even
f1 <- function(){}
f2 <- function(){}
if (!justUpdate) {
# main body
}
The below code work for me stopped without error messages.
opt <- options(show.error.messages = FALSE)
on.exit(options(opt))
break