我正在使用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?。
答案 0 :(得分:42)
也许这和你的解决方案一样,但是我写了一个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)
答案 1 :(得分:14)
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)")
它目前缺乏评估表达式的好方法 - 这主要是因为它的目标是在控制台上准确再现R输出的给定文本输入。
replay(t1)
replay(t2)
replay(t3)
它还捕获消息,输出到控制台,并确保所有内容按照发生的顺序正确交错。
答案 2 :(得分:8)
我已合并了Martins soulution(https://stackoverflow.com/a/4952908/2161065)和来自demo(error.catching)
的R-help邮件列表中的那个。
主要思想是同时保留警告/错误消息以及触发此问题的命令。
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"))
输出:
&GT; myTryCatch(日志(1))
$ value [1] 0 $ warning NULL $ error NULL
&GT; myTryCatch(log(-1))
$ value [1] NaN $警告 $ error NULL
&GT; myTryCatch(log(“a”))
$ value NULL $ warning NULL $ error
答案 3 :(得分:6)
我的回答(以及对Martin优秀代码的修改)的目的是使工厂编辑的函数返回预期的数据结构,如果一切顺利的话。如果遇到警告,则会将其附加到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))