# 8 Conditions

## 8.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 clarity and simplicity:

file_remove_strict <- function(...) {
if(!file.exists(...)) {
stop("Can't delete ", ..., ", because 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, because the file doesn't exist.
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 to the message. Let’s illustrate this behaviour with a small example function:

multiline_msg <- function(appendLF = TRUE) {
message("first line", appendLF = appendLF)
cat("second line")
}

multiline_msg(appendLF = TRUE)
#> first line
#> second line
multiline_msg(appendLF = FALSE)
#> first linesecond line

This is very similar to the fill argument in cat():

multiline_cat <- function(fill = TRUE) {
cat("first line", fill = fill)
message("second line")
}

multiline_cat(fill = TRUE)
#> first line
#> second line
multiline_cat(fill = FALSE)
#> first linesecond line

Alternatively, you can also create a new line by adding \n to the end of the message string.

## 8.2 Handling conditions

1. Q: What extra information does the condition generated by abort() contain compared to the condition generated by stop()? i.e. what’s the difference between these two objects? Read the help for ?abort to learn more.

catch_cnd(stop("An error"))
catch_cnd(abort("An error"))

A: In contrast to stop(), which contains the call, abort() stores the whole backtrace generated by rlang::trace_back():

str(catch_cnd(stop("An error")))
#> List of 2
#> $message: chr "An error" #>$ call   : language force(expr)
#> - attr(*, "class")= chr [1:3] "simpleError" "error" "condition"

str(catch_cnd(abort("An error")))
#> List of 3
#> $message: chr "An error" #>$ trace  :List of 3
#>  ..$calls :List of 7 #> .. ..$ : language str(catch_cnd(abort("An error")))
#>  .. ..$: language catch_cnd(abort("An error")) #> .. ..$ : language tryCatch(condition = identity, {     force(expr) ...
#>  .. ..$: language tryCatchList(expr, classes, parentenv, handlers) #> .. ..$ : language tryCatchOne(expr, names, parentenv, handlers[[1L]])
#>  .. ..$: language doTryCatch(return(expr), name, parentenv, handler) #> .. ..$ : language force(expr)
#>  ..$parents: int [1:7] 0 0 2 3 4 5 2 #> ..$ envs   :List of 7  # (abbreviated)
#>  ..- attr(*, "class")= chr "rlang_trace"
#> $parent : NULL #> - attr(*, "class")= chr [1:3] "rlang_error" "error" "condition" 2. 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("!")) show_condition(10) show_condition(warning("?!")) show_condition({ 10 message("?") warning("?!") }) A: The first three examples are straightforward. The last example is the most interesting and makes us aware of the exiting qualities of tryCatch(), it will terminate the evaluation of the code as soon as it is called. show_condition(stop("!")) # stop raises an error #> [1] "error" show_condition(10) # no condition is signalled #> NULL show_condition(warning("?!")) # warning raises a warning #> [1] "warning" show_condition({ # tryCatch() is an exiting handler 10 message("?") warning("?!") }) #> [1] "message" 3. 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) is printed. 4. Q: Read the source code for catch_cnd() and explain how it works. A: catch_cnd basically wraps tryCatch and returns the default result. The expression is evaluated and it is ensured that NULL is returned, when there is no signalling condition (instead of the expression’s return value). catch_cnd returns a list with the the first condition caught (containing message and call) or NULL. rlang::catch_cnd #> function (expr) #> { #> tryCatch(condition = identity, { #> force(expr) #> return(NULL) #> }) #> } #> <bytecode: 0x27d5c00> #> <environment: namespace:rlang> 5. Q: How could you rewrite show_condition() to use a single handler? A: Let’s 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 } ) } # Test show_condition2(stop("!")) #> [1] "error" show_condition2(10) #> NULL show_condition2(warning("?!")) #> [1] "warning" show_condition2({ 10 message("?") warning("?!") }) #> [1] "message" ## 8.3 Custom conditions 1. Q: Inside a package, it’s occasionally 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 has already been loaded, TRUE is returned • when the namespace is not yet loaded: • a message is thrown • depending on further success or failure TRUE or FALSE is returned. Therefore, we change the behaviour of requireNamespace for missing packages and 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) { abort("error_bad_argument", 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")) # loaded already #> [1] TRUE (requireNamespace2("lobstr")) # initially loads package #> Loading required namespace: lobstr #> [1] TRUE (requireNamespace2("lobstr")) #> [1] TRUE catch_cnd(requireNamespace2("pkg")) # throws an error #> <error> #> * Message: "package pkg not found." #> * Class: error_pkg_not_found #> * Backtrace: catch_cnd(requireNamespace2("pkg"))$package  # returns package-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 returning an error it might be preferable to throw a customized condition and place a standardized error message inside the metadata. This message would remain stable and also won’t be affected by automatic translations.

## 8.4 Applications

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

A: In general we would like to catch errors, since they contain important information for debugging. 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 invisibly:

suppressErrors <- function(expr) {
tryCatch(
error = function(cnd) invisible(cnd),
interrupt = function(cnd) stop("Terminated by the user", call. = FALSE),
expr
)
}

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

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

To test the new function we apply it to a set of conditions and inspect the returned error object.

error_obj <- suppressConditions({
message("message")
warning("warning")
abort("error")
})  # the messages/ wrarnings/ conditions are suppressed successfully

error_obj
#> <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: Calling handlers are called in the context of the call that signalled the condition. Exiting handlers are called in the context of the call to tryCatch().

message2error1 <- function(code) {
withCallingHandlers(code, message = function(e) stop("error"))
}

message2error1({1;  message("hidden error"); NULL})
#> Error in (function (e) : error
traceback()
#> 9: stop("error") at #2
#> 8: (function (e)
#>    stop("error"))(list(message = "hidden error\n", call = message("hidden error")))
#> 7: signalCondition(cond)
#> 6: doWithOneRestart(return(expr), restart)
#> 5: withOneRestart(expr, restarts[[1L]])
#> 4: withRestarts({
#>        signalCondition(cond)
#>        defaultHandler(cond)
#>    }, muffleMessage = function() NULL)
#> 3: message("hidden error") at #1
#> 2: withCallingHandlers(code, message = function(e) stop("error")) at #2
#> 1: message2error1({
#>        1
#>        message("hidden error")
#>        NULL
#>    })

As seen above, the use of withCallingHandlers() returns more information and points us to the exact call in our code:

message2error2 <- function(code) {
tryCatch(code, message = function(e) (stop("error")))
}
message2error2({1; message("hidden error"); NULL})
#> Error in value[[3L]](cond) : error
traceback()
#> 6: stop("error") at #2
#> 5: value[[3L]](cond)
#> 4: tryCatchOne(expr, names, parentenv, handlers[[1L]])
#> 3: tryCatchList(expr, classes, parentenv, handlers)
#> 2: tryCatch(code, message = function(e) (stop("error"))) at #2
#> 1: message2error2({
#>        1
#>        message("hidden error")
#>        NULL
#>    })
3. Q: How would you modify the catch_cnds() defined if you wanted to recreate the original intermingling of warnings and messages?

A: The output of catch_cnds() should be returned in the order: messages, errors, warnings. To mimic the orignal behaviour we can sort the output accordingly:

catch_cnds <- function(expr) {
conds <- list()
add_cond <- function(cnd) {
conds <<- append(conds, list(cnd))
cnd_muffle(cnd)
}

tryCatch(
error = function(cnd) {
conds <<- append(conds, list(cnd))
},
withCallingHandlers(
expr
)
)

filter_cndts <- function(conds, condition) {
Filter(function(x) inherits(x, condition), conds)
}

c(filter_cndts(conds, "message"),
filter_cndts(conds, "error"),
filter_cndts(conds, "warning"))
}

# Test
catch_cnds({
inform("message a")
warn("warning b")
inform("message c")
})
#> [[1]]
#> <message: message a
#> >
#>
#> [[2]]
#> <message: message c
#> >
#>
#> [[3]]
#> <warning: warning b>
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: When running the bottles_of_beer() function in your console, the output should look somehow similar to the following:

> bottles_of_beer()
There are 99 bottles of beer on the wall, 99 bottles of beer.
Take one down, pass it around, 98 bottles of beer on the wall.
Take one down, pass it around, 97 bottles of beer on the wall.
Take one down, pass it around, 96 bottles of beer on the wall.
Take one down, pass it around, 95 bottles of beer on the wall.

> 

At this point you’ll probably recognise how hard it is to get the number of bottles down from 99 to 0. The underlying issue lies in the usage of interrupts to trigger the count of beers. Interrupts to update the beer count, need to occur within the bottles_of_beers() function’s sys.sleep() part in the tryCatch() block. Only there the intended special behaviour of interrupts triggers the update of the beer count. In cases of interrupts during the execution of other parts of the bottles_of_beer() function, these will just exit the function, as interrupts typically do in R. To make this behaviour more apparent, the following definition of bottles_of_beer() returns an explicit message, emphasising where the interrupt occured:

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.")
}