如何将警告和错误保存为函数的输出？

Question

我使用lapply在大量项目上运行一个复杂的函数，并且我想将每个项目的输出（如果有）与任何生成的警告/错误一起保存，以便我可以告诉哪个项目项目产生了哪个警告/错误。

我发现了一种使用withCallingHandlers来捕获警告的方法（这里描述：https://stackoverflow.com/questions/4947528）。不过，我也需要发现错误。我可以通过将它包装在tryCatch（如下面的代码中）来做到，但是有没有更好的方法来做到这一点？这个功能的

catchToList <- function(expr) { 
    val <- NULL 
    myWarnings <- NULL 
    wHandler <- function(w) { 
    myWarnings <<- c(myWarnings, w$message) 
    invokeRestart("muffleWarning") 
    } 
    myError <- NULL 
    eHandler <- function(e) { 
    myError <<- e$message 
    NULL 
    } 
    val <- tryCatch(withCallingHandlers(expr, warning = wHandler), error = eHandler) 
    list(value = val, warnings = myWarnings, error=myError) 
} 

示例输出：

> catchToList({warning("warning 1");warning("warning 2");1}) 
$value 
[1] 1 

$warnings 
[1] "warning 1" "warning 2" 

$error 
NULL 

> catchToList({warning("my warning");stop("my error")}) 
$value 
NULL 

$warnings 
[1] "my warning" 

$error 
[1] "my error" 

这里有几个问题上，以便讨论tryCatch和错误处理，但没有我发现地址这一具体问题。最相关的参见How can I check whether a function call results in a warning?,warnings() does not work within a function? How can one work around this?和How to tell lapply to ignore an error and process the next thing in the list?。

Answer 1

也许这是与您的解决方案，但我写了一个factory到普通的旧功能转换为捕捉自己的价值观，错误和警告功能，这样我就可以

test <- function(i) 
    switch(i, "1"=stop("oops"), "2"={ warning("hmm"); i }, i) 
res <- lapply(1:3, factory(test)) 

用的每个元素包含值，错误和/或警告的结果。这可以与用户功能，系统功能或匿名功能（factory(function(i) ...)）一起使用。这里的工厂

factory <- function(fun) 
    function(...) { 
     warn <- err <- NULL 
     res <- withCallingHandlers(
      tryCatch(fun(...), error=function(e) { 
       err <<- conditionMessage(e) 
       NULL 
      }), warning=function(w) { 
       warn <<- append(warn, conditionMessage(w)) 
       invokeRestart("muffleWarning") 
      }) 
     list(res, warn=warn, err=err) 
    } 

和一些助手来处理结果列表

.has <- function(x, what) 
    !sapply(lapply(x, "[[", what), is.null) 
hasWarning <- function(x) .has(x, "warn") 
hasError <- function(x) .has(x, "err") 
isClean <- function(x) !(hasError(x) | hasWarning(x)) 
value <- function(x) sapply(x, "[[", 1) 
cleanv <- function(x) sapply(x[isClean(x)], "[[", 1) 

Answer 2

尝试evaluate package。

library(evaluate) 
test <- function(i) 
    switch(i, "1"=stop("oops"), "2"={ warning("hmm"); i }, i) 

t1 <- evaluate("test(1)") 
t2 <- evaluate("test(2)") 
t3 <- evaluate("test(3)") 

它目前虽然缺乏评估表达的一个很好的方式 - 这主要是因为它的朝向在控制台上重现正是右输出的给定文本输入针对性。

replay(t1) 
replay(t2) 
replay(t3) 

它还捕获消息，输出到控制台，并确保所有内容按其发生顺序正确交错。

Answer 3

我已经合并了Martins soulution（https://stackoverflow.com/a/4952908/2161065）和您从demo(error.catching)获得的R帮助邮件列表中的一个。

主要的想法是保持警告/错误信息和触发这个问题的命令。

myTryCatch <- function(expr) { 
    warn <- err <- NULL 
    value <- withCallingHandlers(
    tryCatch(expr, error=function(e) { 
     err <<- e 
     NULL 
    }), warning=function(w) { 
     warn <<- w 
     invokeRestart("muffleWarning") 
    }) 
    list(value=value, warning=warn, error=err) 
} 

实例：

myTryCatch(log(1)) 
myTryCatch(log(-1)) 
myTryCatch(log("a")) 

输出：

> myTryCatch（日志（1））

$值[1] 0 $警告NULL $错误NULL

> myTryCatch（日志（-1））

$值[1]的NaN $警告 $ NULL错误

> myTryCatch（日志（ “A”））

$ NULL值 $警告NULL $错误

Answer 4

我的回答（和修改，以马丁的出色的代码）的目的是使工厂-ED函数返回预期的数据结构，如果一切进展顺利。如果遇到警告，则会附加factory-warning属性下的结果。 data.table的setattr函数用于允许与该包的兼容性。如果遇到错误，则结果为字符元素“工厂功能发生错误”，并且factory-error属性将带有错误消息。

#' Catch errors and warnings and store them for subsequent evaluation 
#' 
#' Factory modified from a version written by Martin Morgan on Stack Overflow (see below). 
#' Factory generates a function which is appropriately wrapped by error handlers. 
#' If there are no errors and no warnings, the result is provided. 
#' If there are warnings but no errors, the result is provided with a warn attribute set. 
#' If there are errors, the result retutrns is a list with the elements of warn and err. 
#' This is a nice way to recover from a problems that may have occurred during loop evaluation or during cluster usage. 
#' Check the references for additional related functions. 
#' I have not included the other factory functions included in the original Stack Overflow answer because they did not play well with the return item as an S4 object. 
#' @export 
#' @param fun The function to be turned into a factory 
#' @return The result of the function given to turn into a factory. If this function was in error "An error as occurred" as a character element. factory-error and factory-warning attributes may also be set as appropriate. 
#' @references 
#' \url{http://stackoverflow.com/questions/4948361/how-do-i-save-warnings-and-errors-as-output-from-a-function} 
#' @author Martin Morgan; Modified by Russell S. Pierce 
#' @examples 
#' f.log <- factory(log) 
#' f.log("a") 
#' f.as.numeric <- factory(as.numeric) 
#' f.as.numeric(c("a","b",1)) 
factory <- function (fun) { 
    errorOccurred <- FALSE 
    library(data.table) 
    function(...) { 
    warn <- err <- NULL 
    res <- withCallingHandlers(tryCatch(fun(...), error = function(e) { 
     err <<- conditionMessage(e) 
     errorOccurred <<- TRUE 
     NULL 
    }), warning = function(w) { 
     warn <<- append(warn, conditionMessage(w)) 
     invokeRestart("muffleWarning") 
    }) 
    if (errorOccurred) { 
     res <- "An error occurred in the factory function" 
    } 

    if (is.character(warn)) { 
     data.table::setattr(res,"factory-warning",warn) 
    } else { 
     data.table::setattr(res,"factory-warning",NULL) 
    } 

    if (is.character(err)) { 
     data.table::setattr(res,"factory-error",err) 
    } else { 
     data.table::setattr(res, "factory-error", NULL) 
    } 
    return(res) 
    } 
} 

因为我们没有一个额外的列表包装的结果，我们不能做出那种假设，允许他的一些访问功能，但我们可以写一些简单的检查，并决定如何处理案件适合我们特定的数据结构。

.has <- function(x, what) { 
    !is.null(attr(x,what)) 
} 
hasWarning <- function(x) .has(x, "factory-warning") 
hasError <- function(x) .has(x, "factory-error") 
isClean <- function(x) !(hasError(x) | hasWarning(x))