Skip to content

Instantly share code, notes, and snippets.

@nassimhaddad
Last active February 4, 2017 18:38
Show Gist options
  • Save nassimhaddad/c9c327d10a91dcf9a3370d30dff8ac3d to your computer and use it in GitHub Desktop.
Save nassimhaddad/c9c327d10a91dcf9a3370d30dff8ac3d to your computer and use it in GitHub Desktop.
#' 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