chrispy chrispy - 7 days ago 5
R Question

Printing stack trace and continuing after error occurs in R

I'm writing some R code that calls other code that may fail. If it does, I want to print a stack trace (to track down what went wrong), then carry on regardless. However, the traceback() function only provides information about uncaught exceptions. I can get the result I want via a rather complex, natty construction involving tryCatch and dump.frames, but is there not an easier way of doing this?

Answer

I ended up writing a general-purpose logger that produces Java-like logging messages when the standard R "message", "warning" and "stop" methods are called. It includes timestamps, and stack traces for warnings and above.

Many thanks to Man Group for permission to distribute this! Thanks also to Bob Albright, whose answer gave me a leg-up to what I was looking for.

withJavaLogging = function(expr, silentSuccess=FALSE, stopIsFatal=TRUE) {
    hasFailed = FALSE
    messages = list()
    warnings = list()
    logger = function(obj) {
        # Change behaviour based on type of message
        level = sapply(class(obj), switch, debug="DEBUG", message="INFO", warning="WARN", caughtError = "ERROR",
                error=if (stopIsFatal) "FATAL" else "ERROR", "")
        level = c(level[level != ""], "ERROR")[1]
        simpleMessage = switch(level, DEBUG=,INFO=TRUE, FALSE)
        quashable = switch(level, DEBUG=,INFO=,WARN=TRUE, FALSE)

        # Format message
        time  = format(Sys.time(), "%Y-%m-%d %H:%M:%OS3")
        txt   = conditionMessage(obj)
        if (!simpleMessage) txt = paste(txt, "\n", sep="")
        msg = paste(time, level, txt, sep=" ")
        calls = sys.calls()
        calls = calls[1:length(calls)-1]
        trace = limitedLabels(c(calls, attr(obj, "calls")))
        if (!simpleMessage && length(trace) > 0) {
            trace = trace[length(trace):1]
            msg = paste(msg, "  ", paste("at", trace, collapse="\n  "), "\n", sep="")
        }

        # Output message
        if (silentSuccess && !hasFailed && quashable) {
            messages <<- append(messages, msg)
            if (level == "WARN") warnings <<- append(warnings, msg)
        } else {
            if (silentSuccess && !hasFailed) {
                cat(paste(messages, collapse=""))
                hasFailed <<- TRUE
            }
            cat(msg)
        }

        # Muffle any redundant output of the same message
        optionalRestart = function(r) { res = findRestart(r); if (!is.null(res)) invokeRestart(res) }
        optionalRestart("muffleMessage")
        optionalRestart("muffleWarning")
    }
    vexpr = withCallingHandlers(withVisible(expr),
            debug=logger, message=logger, warning=logger, caughtError=logger, error=logger)
    if (silentSuccess && !hasFailed) {
        cat(paste(warnings, collapse=""))
    }
    if (vexpr$visible) vexpr$value else invisible(vexpr$value)
}

To use it, just wrap it around your code:

withJavaLogging({
  // Your code here...
})

For a quieter output in the absence of errors (useful for tests!), set the silentSuccess flag. Messages will only be output if an error occurs, to give context to the failure.

To achieve the original goal (dump stack trace + carry on), just use try:

try(withJavaLogging({
  // Your code here...
}, stopIsFatal=FALSE))