Как сохранить предупреждения и ошибки как выходные данные из функции?
Я использую lapply
для запуска сложной функции для большого количества элементов, и я хотел бы сохранить результат из каждого элемента (если есть) вместе с любыми предупреждениями/ошибками, которые были созданы, чтобы я мог определить, какой предмет был создан которое предупреждение/ошибка.
Я нашел способ поймать предупреждения, используя withCallingHandlers
(описано здесь). Однако мне также нужно ловить ошибки. Я могу сделать это, обернув его в 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"
На SO есть несколько вопросов, которые обсуждают tryCatch
и обработку ошибок, но ни один из них не нашел, что касается этой конкретной проблемы. См. Как проверить, вызывает ли вызов функции предупреждение? , warnings() не работает внутри функции? Как можно обойти это? , и как сказать lapply игнорировать ошибку и обработать следующее в списке? для наиболее релевантных.
Ответы
Ответ 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
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)
Ответ 2
Попробуйте оценить пакет.
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)
Он также захватывает сообщения, выводит на консоль и гарантирует, что все правильно перемежено в том порядке, в котором оно произошло.
Ответ 3
Я объединил малиновскую мануальность (fooobar.com/questions/206156/...) и одну из списка рассылки R-help, которую вы получили с помощью demo(error.catching)
.
Основная идея состоит в том, чтобы сохранить как предупреждение, так и команду, запускающую эту проблему.
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 (log (1))
$value [1] 0 $warning NULL $error NULL
> myTryCatch (log (-1))
$value [1] NaN $предупреждение $error NULL
> myTryCatch (log ( "a" ))
$значение NULL $warning NULL $error
Ответ 4
Цель моего ответа (и модификация превосходного кода Мартина) заключается в том, что функция factory -ed возвращает ожидаемую структуру данных, если все будет хорошо. Если предупреждение возникает, оно привязывается к результату в атрибуте factory-warning
. data.table setattr
используется для обеспечения совместимости с этим пакетом. Если возникла ошибка, результатом будет элемент символа "Ошибка в функции factory", а атрибут factory-error
будет содержать сообщение об ошибке.
#' Catch errors and warnings and store them for subsequent evaluation
#'
#' Factory modified from a version written by Martin Morgan on Qaru (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 Qaru 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/info/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))