#' Turn a function into a new function that helps debugging upon exception | |
#' | |
#' @param fn the function to transform | |
#' @param saveFile an optional path to save RDS to, if NULL output will be in global variable '.problem' | |
#' @return new function that behaves like fn(...) normally, but if fn(...) throws an exception saves to variable or saveFile RDS of list .problem such that do.call(.problem$fn_name,.problem$args) repeats the call to fn with args. | |
#' | |
#' @examples | |
#' sum_of_log <- function(x, y){ | |
#' stopifnot(x>=0) | |
#' stopifnot(y>=0) | |
#' return(log(x)+log(y)) | |
#' } | |
#' | |
#' sum_of_log2 <- debuggable(sum_of_log, "problem.RDS") | |
#' | |
#' sum_of_log2(1,2) | |
#' sum_of_log2(1,-2) | |
#' | |
#' .problem | |
#' | |
#' do.call(.problem$fn_name, .problem$args) | |
#' | |
#' @references | |
#' inspired from http://winvector.github.io/Debugging/ | |
#' | |
debuggable <- function(fn, saveFile=NULL){ | |
fn_name <- as.character(match.call())[2] | |
new_fn <- function(...){ | |
args <- list(...) | |
tryCatch({ | |
res = do.call(fn,args) | |
res | |
}, | |
error = function(e) { | |
out <- list(fn_name=fn_name,args=args, fn_def = fn) | |
if (is.null(saveFile)){ | |
.problem <<- out | |
stop(paste0("Wrote object '.problem' on catching '",as.character(e),"'", | |
"\n You can reproduce the error with:\n'do.call(.problem$fn_name, .problem$args)'")) | |
}else{ | |
saveRDS(out,file=saveFile) | |
stop(paste0("Wrote '",saveFile,"' on catching '",as.character(e),"'", | |
"\n You can reproduce the error with:\n'p <- readRDS('",saveFile,"'); do.call(p$fn_name, p$args)'")) | |
} | |
}) | |
} | |
return(new_fn) | |
} | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment