Make error messages your own

The stop() function allows you to terminate the execution of a function if there is a fatal problem.

For example, imagine this code that calculates the square root of a number but only if the input number is positive.

real_root <- function(x) {
   if (x < 0) {
      stop("'x' cannot be negative.")   
   } 
   sqrt(x)
}

real_root(2)

## [1] 1.414214

real_root(-2)

## Error in real_root(-2): 'x' cannot be negative.

If x is negative, the function throws an error. Now let’s imagine that this function is part of a package and that the author wants all error messages to always be in upper case. And instead of making sure that everything is capitalised, they prefer to use the toupper() function:

toupper("lowercase")

## [1] "LOWERCASE"

Then they decide to write the STOP() function, which is a loud version of stop():

STOP <- function(message) {
   stop(toupper(message))
}

And now they create REAL_ROOT() that uses that loud stop.

REAL_ROOT <- function(x) {
   if (x < 0) {
      STOP("'x' cannot be negative.")   
   } 
   sqrt(x)
}

REAL_ROOT(2)

## [1] 1.414214

REAL_ROOT(-2)

## Error in STOP("'x' cannot be negative."): 'X' CANNOT BE NEGATIVE.

It seems to work fine, but there is a slight issue. Before, the error was coming from inside real_root(), so the error message gave the user a clue as to where the problem layed (Error in real_root(-2) :...). With this new setup, since the error technically occurs inside STOP(), the error message becomes useless. Worse, it confuses the user!

One solution is to directly hide the call:

STOP <- function(message) {
   stop(toupper(message), call. = FALSE)
}

REAL_ROOT(-2)

## Error: 'X' CANNOT BE NEGATIVE.

Now the message isn’t that useful, but at least it’s not actively confusing

But it would be nice to be able to somehow capture the previous call to be part of the error message. That is, make the STOP() function “know” which other expression called it and use that as text for the error message. And that can be done with the sys.call() function.

The sys.call() function captures the code that called a function, but has an argument that allows you to go “backwards” in the expression tree.

outer_function <- function(x) {
   inner_function(x)
}

inner_function <- function(x) {
   sys.call(x)
}

outer_function() calls inner_function() with the code inner_function(x). Since x is 0, inner_function() executes sys.call(0), which returns the last call, which is inner_function(x).

outer_function(0)

## inner_function(x)

But with the argument x set to -1, inner_function() executes sys.call(-1), which returns the penultimate call: outer_function(-1).

outer_function(-1)

## outer_function(-1)

The other piece is the simpleError() function, which can generate an error object that is then correctly interpreted by stop().

message <- "this is an error"
error <- simpleError(toupper(message))
stop(error)

## Error: THIS IS AN ERROR

Putting the two pieces together, you get:

STOP <- function(message) {
   error <- simpleError(toupper(message), call = sys.call(-1))
   stop(error)
}

And now REAL_ROOT() spits out an error as as useful as it is loud

REAL_ROOT(-2)

## Error in REAL_ROOT(-2): 'X' CANNOT BE NEGATIVE.