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

Question

我正在使用lapply对大量项目运行复杂的函数，并且我想保存每个项目的输出(如果有)以及任何警告/错误生成这样我就可以知道哪个项目产生了哪个警告/错误。

我找到了一种使用 withCallingHandlers ( described here ) 捕获警告的方法。但是，我也需要捕获错误。我可以通过将其包装在 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

也许这与您的解决方案相同，但我编写了一个工厂来将普通的旧函数转换为捕获其值、错误和警告的函数，因此我可以

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)