# 6 Conditions

## 6.1 Signalling conditions

1. Q: Write a wrapper around file.remove() that throws an error if the file to be deleted does not exist.

A: We have several options here. However, we prefer the following solution for its clearness and simplicity:

file_remove_strict <- function(...) {
if(!file.exists(...)) {
stop("Can't delete ", ..., " as the file doesn't exist.", call. = FALSE)
}
file.remove(...)
}

# Test
saveRDS(iris, "iris.RDS")
file_remove_strict("iris.RDS")
#> [1] TRUE
file_remove_strict("iris.RDS")
#> Error: Can't delete iris.RDS as the file doesn't exist.
getOption("warn")
#> [1] 0
2. Q: What does the appendLF argument to message() do? How is it related to cat()?

A: The appendLF argument allows to append a new line on the message. Let us illustrate this with a small example function:

bla <- function(appendLF = TRUE) {
message("example message", appendLF = appendLF)
cat("something to print")
}

bla(appendLF = TRUE)
#> example message
#> something to print
bla(appendLF = FALSE)
#> example message
#> something to print

The almost equivalent cat() argument is fill:

bla2 <- function(fill = TRUE) {
cat("something to print", fill = fill)
message("example message")
}

bla2(fill = TRUE)
#> something to print
#> example message
bla2(fill = FALSE)
#> something to print
#> example message

However, in both cases one can ensure a new line via \n at the end of the message string.

3. Q: What does options(error = recover) do? Why might you use it?

A: In case of options(error = recover) utils::recover() will be called (without arguments) in case of an error. This will print out a list of calls which precede the error and lets the user choose to incorporate browser() directly in any of the regarding environments allowing a practical mode for debugging.

4. Q: What does options(error = quote(dump.frames(to.file = TRUE))) do? Why might you use it?

A: This option writes a dump of the evaluation environment where an error occurs into a file ending on .rda. When this option is set, R will continue to run after the first error. To stop R at the first error use quote({dump.frames(to.file=TRUE); q()}). These options are especially useful for debugging non-interactive R scripts afterwards (“post mortem debugging”).

## 6.2 Handling conditions

1. Q: Predict the results of evaluating the following code

show_condition <- function(code) {
tryCatch(
error = function(cnd) "error",
warning = function(cnd) "warning",
message = function(cnd) "message",
{
code
NULL
}
)
}

show_condition(stop("!"))      # "error"
show_condition(10)             # NULL (because no condition is signalled)
show_condition(warning("?!"))  # "warning"
show_condition({
10
message("?")
warning("?!")
})                             # "message"
2. Q: Explain the results of running this code:

withCallingHandlers(
message = function(cnd) message("b"),
withCallingHandlers(
message = function(cnd) message("a"),
message("c")
)
)
#> b
#> a
#> b
#> c

A: Lets look at the inner withCallingHandlers() first: The first message printed by this statement would be a, so the outer withCallingHandlers prints b (1). Afterwards the message of the inner handler gets printed: a (2). Next the inner withCallingHandlers() would print c, so the outer withCallingHandlers() prints again b (3). Finally c (4) gets printed.

3. Q: Read the source code for catch_cnd() and explain how it works.

A: It basically returns the default result from a wrapped tryCatch(), where the expression is forced and ensured that in case of no signalled condition NULL is returned instead of the expression’s return value. This ensures that we always get the first condition in a list (containing message and call) or NULL.

rlang::catch_cnd
#> function (expr)
#> {
#>     tryCatch(condition = identity, {
#>         force(expr)
#>         return(NULL)
#>     })
#> }
#> <bytecode: 0x2501f10>
#> <environment: namespace:rlang>
4. Q: How could you rewrite show_condition() to use a single handler?

A: We can simply use the condition argument of tryCatch as shown in rlang::catch_cond() above:

show_condition2 <- function(code) {
tryCatch(
condition = function(cnd) {
if (inherits(cnd, "error"))   {return("error")}
if (inherits(cnd, "warning")) {return("warning")}
if (inherits(cnd, "message")) {return("message")}
},
{
code
NULL
}
)
}

show_condition2(stop("!"))
#> [1] "error"
show_condition2(10)
#> NULL
show_condition2(warning("?!"))
#> [1] "warning"
show_condition2({
10
message("?")
warning("?!")
})
#> [1] "message"

If one could ensure that "error", "warning" and "message" are always in the next position of the "condition" class, this would also work:

show_condition2 <- function(code) {
tryCatch(
condition = function(cnd) {
class(cnd)[length(class(cnd)) - 1L]
},
{
code
NULL
}
)
}

## 6.3 Custom conditions

1. Q: Inside a package, it’s occassionally useful to check that a package is installed before using it. Write a function that checks if a package is installed (with requireNamespace("pkg", quietly = FALSE)) and if not, throws a custom condition that includes the package name in the metadata.

A: It’s quite tedious to build up this behaviour on top of requireNamespace(). However, if all arguments are supplied correctly, requiredNamespace()’s return behaviour can be summarised in the following way:

• when the namespace was already loaded TRUE is returned
• a message is thrown:
• depending on further success or failure TRUE or FALSE is returned.

Therefore, we adjust the behaviour mainly regarding the failure case, where we return the error condition:

library(rlang)

requireNamespace2 <- function(package)  {
# First let us include a basic check for the input:
if (!is.character(package) | !length(package) == 1L) {
message = "package must be a length-1 character vector.")
}

withCallingHandlers(
requireNamespace(package, quietly = FALSE),
# Because the original error messages are hard to differentiate in a robust way,
# we catch all messages first:
message = function(cnd)  {
# In case of failure, we throw the error.
# Otherwise the original message will be returned
if (!requireNamespace(package, quietly = TRUE)) {
abort(
"error_pkg_not_found",
message = paste0("package ", package, " not found."),
package = package
)}
}
)

invisible(TRUE)
}

Now we can test our new function for all cases:

(requireNamespace2("base"))    # should be loaded already
#> [1] TRUE
(requireNamespace2("lobstr"))  # should return a message first
#> [1] TRUE
(requireNamespace2("lobstr"))
#> [1] TRUE
catch_cnd(requireNamespace2("pkg"))  # this should reutrn an error
#> <error>
#> * Message: "package pkg not found."
#> * Class: error_pkg_not_found
#> * Backtrace:
catch_cnd(requireNamespace2("pkg"))\$package  # containing the pkg name
#> [1] "pkg"
2. Q: Inside a package you often need to stop with an error when something is not right. Other packages that depend on your package might be tempted to check these errors in their unit tests. How could you help these packages to avoid relying on the error message which is part of the user interface rather than the API and might change without notice?

A: Instead of a typical error it might be advantageous to throw a customized condition and place a standardized error message inside the metadata, which should stay stable and also won’t be affected by automatic translations.

## 6.4 Applications

1. Q: Create suppressConditions() that works like suppressMessages() and supressWarnings() but supresses everything. Think carefully about how you should handle errors.

A: (The exercise might not be completely solved, as we would like to return also NULL in the test below. In other words, execution shouldn’t be stopped by the error). In general we would like to catch any error, since they contain important information for debugging. So in order to suppress the error message and hide the returned error object from the console, we handle errors within a tryCatch() and return the error object invisible:

suppressErrors <- function(expr) {
tryCatch(
error = function(cnd) invisible(cnd),
expr
)
}

After we defined our error handling, we can just chain it with the other handlers to create our suppressConditions() function:

suppressConditions <- function(expr) {
suppressErrors(suppressWarnings(suppressMessages(expr)))
}

As a quick test of our new function we apply it to a set of conditions and autoprint the returned error object.

(suppressConditions(
{
warning("warning")
message("message")
abort("error")
NULL
}
))
#> <error>
#> * Message: "error"
#> * Class: rlang_error
#> * Backtrace:
#>  ─local(...)
#>  ─suppressConditions(...)
#>  ─suppressMessages(expr)
#>  ─withCallingHandlers(expr, message = function(c) invokeRestart("muffleMessage"))
2. Q: Compare the following two implementations of message2error(). What is the main advantage of withCallingHandlers() in this scenario? (Hint: look carefully at the traceback.)

message2error <- function(code) {
withCallingHandlers(code, message = function(e) stop(e))
}
message2error <- function(code) {
tryCatch(code, message = function(e) stop(e))
}

A:

3. Q: How would you modify the catch_cnds() defined if you wanted to recreate the original intermingling of warnings and messages?

4. Q: Why is catching interrupts dangerous? Run this code to find out.

bottles_of_beer <- function(i = 99) {
message("There are ", i, " bottles of beer on the wall, ", i, " bottles of beer.")
while(i > 0) {
tryCatch(
Sys.sleep(1),
interrupt = function(err) {
i <<- i - 1
if (i > 0) {
message(
"Take one down, pass it around, ", i,
" bottle", if (i > 1) "s", " of beer on the wall."
)
}
}
)
}
message("No more bottles of beer on the wall, no more bottles of beer.")
}

A: Basically there seems to be an issue that interrupts are not handled in a general way, but seem to depend on the R interface and the implementation of the R code which is interrupted. Not sure if I understand this correct, but there needs to be a way from the frontend to supply the r code with the info that an interrupt has happened and the r code itself needs to check for this information regularly.

This issue is tracked i.e. here https://github.com/HenrikBengtsson/Wishlist-for-R/issues/47 and reported also here https://www.r-bloggers.com/interrupting-r-processes-in-ubuntu/ and more official documentation is for example under ?setTimeLimit:

Time limits are checked whenever a user interrupt could occur. This will happen frequently in R code and during Sys.sleep, but only at points in compiled C and Fortran code identified by the code author.

A minimal example pointed out in the former source would be system.time(try(Sys.sleep(3))) which will be hard to trigger under a certain time. The behaviour of Sys.sleep() is also documented under in the “Details” section of Sys.sleep():

Using this function allows R to temporarily be given very low priority and hence not to interfere with more important foreground tasks. A typical use is to allow a process launched from R to set itself up and read its input files before R execution is resumed. The intention is that this function suspends execution of R expressions but wakes the process up often enough to respond to GUI events, typically every half second. It can be interrupted (e.g. by Ctrl-C or Esc at the R console). There is no guarantee that the process will sleep for the whole of the specified interval (sleep might be interrupted), and it may well take slightly longer in real time to resume execution.

However, in the exercise it seems to be more the question why it is hard to get i from 99 to 0 and the answer might be, that interruptions are insecure since it might be hard to anticipate which part of the programm is running and instead of triggering a specific interruption-handler it’s easy to interrupt the process as a whole. The specific behaviour of Sys.sleep() as mentioned above makes it even harder to guess which part of a program is currently executed.

We can see this behaviour explicitly when we modify the code above a bit to wrap the tryCatch()-part into another tryCatch() part where we handle the regarding further interruptions and play with this code ineteractively in the console again:

bottles_of_beer <- function(i = 99) {

message("There are ", i, " bottles of beer on the wall, ", i, " bottles of beer.")

tryCatch(
while(i > 0) {
tryCatch(
Sys.sleep(1),
interrupt = function(err) {
i <<- i - 1
if (i > 0) {
message(
"Take one down, pass it around, ", i,
" bottle", if (i > 1) "s", " of beer on the wall."
)
}
}
)
},
interrupt = function(cnd) message("outer part"))

message("No more bottles of beer on the wall, no more bottles of beer.")
}