08_Conditions.Rmd

```{r, include = FALSE}
source("common.R")
```

# Conditions
<!-- 8 -->

## Prerequisites {-}
<!-- 8.0 -->

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

```{r, message = FALSE}
library(rlang)
```

\stepcounter{section}
## Signalling conditions
<!-- 8.2 -->

__[Q1]{.Q}__: Write a wrapper around `file.remove()` that throws an error if the file to be deleted does not exist.

__[A]{.solved}__: We prefer the following solution for its clarity and simplicity:

```{r, error = TRUE}
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")
file_remove_strict("mtcars.rds")
```

__[Q2]{.Q}__: What does the `appendLF` argument to `message()` do? How is it related to `cat()`?

__[A]{.solved}__: The `appendLF` argument automatically appends a new line to the message. Let's illustrate this behaviour with a small example function:

```{r, eval=FALSE}
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"`.

\stepcounter{section}
## Handling conditions
<!-- 8.4 -->

__[Q1]{.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.

```{r, eval = FALSE}
catch_cnd(stop("An error"))
catch_cnd(abort("An error"))
```

__[A]{.solved}__: 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!

```{r}
str(catch_cnd(stop("An error")))

str(catch_cnd(abort("An error")))
```

__[Q2]{.Q}__: Predict the results of evaluating the following code

```{r, eval = FALSE}
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("?!")
})
```

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

__[A]{.solved}__: The first three examples are straightforward:

```{r}
show_condition(stop("!"))      # stop raises an error
show_condition(10)             # no condition is signalled
show_condition(warning("?!"))  # warning raises a 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.

```{r}
show_condition({
  10
  message("?")
  warning("?!")
})
```

__[Q3]{.Q}__: Explain the results of running this code:

```{r}
withCallingHandlers(  # (1)
  message = function(cnd) message("b"),
  withCallingHandlers(  # (2)
    message = function(cnd) message("a"),
    message("c")
  )
)
```

__[A]{.solved}__: 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]{.Q}__: 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:

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

__[A]{.solved}__: `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.

```{r}
rlang::catch_cnd
```

__[Q5]{.Q}__: How could you rewrite `show_condition()` to use a single handler?

__[A]{.solved}__: `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:

```{r}
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("!"))
show_condition2(10)
show_condition2(warning("?!"))
show_condition2({
  10
  message("?")
  warning("?!")
})
```

`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.

## Custom conditions
<!-- 8.5 -->

__[Q1]{.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]{.solved}__: We use `rlang::abort()` to supply error metadata:

```{r, error = TRUE}
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")
check_installed("ggplot3")
```

__[Q2]{.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]{.solved}__: 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.

## Applications
<!-- 8.6 -->

__[Q1]{.Q}__: Create `suppressConditions()` that works like `suppressMessages()` and `suppressWarnings()` but suppresses everything. Think carefully about how you should handle errors.

__[A]{.solved}__: 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:

```{r}
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()`:

```{r}
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.

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

error_obj
```

__[Q2]{.Q}__: Compare the following two implementations of `message2error()`. What is the main advantage of `withCallingHandlers()` in this scenario? (Hint: look carefully at the traceback.)

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

__[A]{.solved}__: 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.

```{r, error = TRUE, eval = FALSE}
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
#>    })
```

```{r, error = TRUE, eval = FALSE}
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]{.Q}__:  How would you modify the `catch_cnds()` definition if you wanted to recreate the original intermingling of warnings and messages?

__[A]{.solved}__: 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.

```{r}
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")
})
```

__[Q4]{.Q}__:  Why is catching interrupts dangerous? Run this code to find out.

```{r, eval = FALSE}
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]{.solved}__: When running the `bottles_of_beer()` function in your console, the output should look somehow like the following:

```{r, eval = FALSE}
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!