7 Conditions

Prerequisites

Similar to the environments chapter, we also use functions from the rlang package to work with conditions.

library(rlang)

7.1 Signalling conditions

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

A: We prefer the following solution for its clarity and simplicity:

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

# Test
saveRDS(mtcars, "mtcars.rds")
file_remove_strict("mtcars.rds")
#> [1] TRUE
file_remove_strict("mtcars.rds")
#> Error: Can't delete the file "mtcars.rds" because it doesn't exist.

Q2: What does the appendLF argument to message() do? How is it related to cat()?

A: The appendLF argument automatically appends a new line to the message. Let’s illustrate this behaviour with a small example function:

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

multiline_msg(appendLF = TRUE)
#> first
#> second
#> thirdfourth
multiline_msg(appendLF = FALSE)
#> firstsecondthirdfourth

Comparable behaviour regarding line breaks for cat() can be achieved via setting its sep argument to "\n".

7.2 Handling conditions

Q1: 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(). This is a lot of extra data!

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 8
#>   .. ..$ : language utils::str(catch_cnd(abort("An error")))
#>   .. ..$ : language rlang::catch_cnd(abort("An error"))
#>   .. ..$ : language rlang::eval_bare(rlang::expr(tryCatch(!!!handlers, {     f..
#>   .. ..$ : language base::tryCatch(condition = function (x)  x, { ...
#>   .. ..$ : language base:::tryCatchList(expr, classes, parentenv, handlers)
#>   .. ..$ : language base:::tryCatchOne(expr, names, parentenv, handlers[[1L]])
#>   .. ..$ : language base:::doTryCatch(return(expr), name, parentenv, handler)
#>   .. ..$ : language base::force(expr)
#>   ..$ parents: int [1:8] 0 0 2 2 4 5 6 2
#>   ..$ indices: int [1:8] 27 28 29 30 31 32 33 34
#>   ..- attr(*, "class")= chr "rlang_trace"
#>   ..- attr(*, "version")= int 1
#>  $ parent : NULL
#>  - attr(*, "class")= chr [1:3] "rlang_error" "error" "condition"

Q2: 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:

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"

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({
  10
  message("?")
  warning("?!")
})
#> [1] "message"

Q3: Explain the results of running this code:

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

A: It’s a little tricky to untangle the flow here:

First, message("c") is run, and it’s caught by (1). It then calls message("a"), which is caught by (2), which calls message("b"). message("b") isn’t caught by anything, so we see a b on the console, followed by a. But why do we get another b before we see c? That’s because we haven’t handled the message, so it bubbles up to the outer calling handler.

Q4: Read the source code for catch_cnd() and explain how it works. At the time Advanced R was written, the source for catch_cnd() was a little simpler:

catch_cnd <- function(expr) {
  tryCatch(
    condition = function(cnd) cnd,
    {
      force(expr)
      return(NULL)
    }
  )
}

A: catch_cnd() is a simple wrapper around tryCatch(). If a condition is signalled, it’s caught and returned. If no condition is signalled, execution proceeds sequentially and the function returns NULL.

The current version of catch_cnd() is a little more complex because it allows you to specify which classes of condition you want to capture. This requires some manual code generation because the interface of tryCatch() provides condition classes as argument names.

rlang::catch_cnd
#> function (expr, classes = "condition") 
#> {
#>     stopifnot(is_character(classes))
#>     handlers <- rep_named(classes, list(identity))
#>     eval_bare(rlang::expr(tryCatch(!!!handlers, {
#>         force(expr)
#>         return(NULL)
#>     })))
#> }
#> <bytecode: 0x7fd75d598c88>
#> <environment: namespace:rlang>

Q5: How could you rewrite show_condition() to use a single handler?

A: show_condition() was defined in one of the previous questions. Let’s use the condition argument of tryCatch() as shown in rlang::catch_cond() above for our re-implementation:

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"

tryCatch() executes the code and captures any condition raised. The function provided as the condition handles this condition. In this case it dispatches on the class of the condition.

7.3 Custom conditions

Q1: 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: We use rlang::abort() to supply error metadata:

check_installed <- function(package) {
  if (!requireNamespace(package, quietly = FALSE)) {
    abort(
      "error_pkg_not_found",
      message = paste0("package '", package, "' not installed."),
      package = package
    )
  }

  TRUE
}

check_installed("ggplot2")
#> [1] TRUE
check_installed("ggplot3")
#> Loading required namespace: ggplot3
#> Error: package 'ggplot3' not installed.

Q2: 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 returning an error it might be preferable to throw a customised condition and place a standardised error message inside the metadata. Then the downstream package could check for the class of the condition, rather than inspecting the message.

7.4 Applications

Q1: Create suppressConditions() that works like suppressMessages() and suppressWarnings() 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. 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.

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

error_obj
#> <error/rlang_error>
#> error
#> Backtrace:
#>   1. global::suppressConditions(...)
#>  12. base::suppressMessages(expr)
#>  13. base::withCallingHandlers(...)

Q2: 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: Both functions differ in the way conditions are handled. withCallingHandlers() creates a calling handler, which is executed from within the signalling function. This makes it possible to record a detailed call stack, which helps us identify the signalling condition.

tryCatch() defines an exiting handler, which means that the signalling function is terminated as soon as a condition is raised. It also returns control to the context where tryCatch() was called.

In this example the use of withCallingHandlers() returns more information than the use of tryCatch(). This allows us to determine the exact call that raised the condition.

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
#>    })

message2error2 <- function(code) {
  tryCatch(code, message = function(e) (stop("error")))
}

message2error2({1; stop("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
#>    })

Q3: How would you modify the catch_cnds() definition if you wanted to recreate the original intermingling of warnings and messages?

A: It looks like Hadley wrote a part of the chapter after the exercises, as the catch_cnds() function defined in the chapter already solves this problem by storing all messages and warnings in their original order within a list.

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(
      message = add_cond,
      warning = add_cond,
      expr
    )
  )

  conds
}

# Test
catch_cnds({
  inform("message a")
  warn("warning b")
  inform("message c")
})
#> [[1]]
#> <message: message a
#> >
#> 
#> [[2]]
#> <warning: warning b>
#> 
#> [[3]]
#> <message: message c
#> >

Q4: 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 like 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. There’s no way to break out of the function because we’re capturing the interrupt that you’d usually use!

6 Environments

8 Functionals