¿Cómo guardo las advertencias y los errores como salida de una función?

Question

Estoy usando lapply para ejecutar una función compleja en una gran cantidad de elementos, y me gustaría guardar la salida de cada elemento (si corresponde) junto con las advertencias/errores que se produjeron para poder decir cuál artículo producido qué advertencia/error.

Encontré una forma de detectar advertencias usando withCallingHandlers (descrito aquí: https://stackoverflow.com/questions/4947528). Sin embargo, necesito detectar errores también. Puedo hacerlo envolviéndolo en un tryCatch (como en el código a continuación), pero ¿hay una mejor manera de hacerlo?

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) 
} 

Salida de ejemplo de esta función es:

> 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" 

hay varias preguntas aquí en la SO que discuten tryCatch y manejo de errores, pero ninguno que me encontré con que abordar esta cuestión en particular. Consulte 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? y How to tell lapply to ignore an error and process the next thing in the list? para obtener los más relevantes.

Answer 1

Tal vez esto es lo mismo que su solución, pero me escribió una factory para convertir funciones llanura de edad en las funciones que capturan sus valores, los errores y las advertencias, de modo que pueda

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

con cada elemento de la resultado que contiene el valor, error y/o advertencias. Esto funcionaría con funciones de usuario, funciones del sistema o funciones anónimas (factory(function(i) ...)). Aquí está la fábrica de

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) 
    } 

y algunos ayudantes para hacer frente a la lista de resultados

.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

Prueba el 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)") 

actualmente carece de una buena manera de evaluar la expresión, aunque - esto es principalmente porque está targetted hacia reproducir exactamente lo que la introducción de texto dada de R de salida en la consola.

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

También captura, mensajes de salida a la consola, y asegura que todo se entrelaza correctamente en el orden en que se produjo.

Answer 3

He fusionado Martins soulution (https://stackoverflow.com/a/4952908/2161065) y el de la lista de correo de R-help que obtienes con demo(error.catching).

La idea principal es mantener tanto el mensaje de advertencia/error como el comando que desencadena este problema.

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) 
} 

Ejemplos:

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

de salida:

> myTryCatch (log (1))

$ valor [1] 0 $ NULL advertencia $ de error NULL

> myTryCatch (log (-1))

$ valor [1] NaN $ advertencia $ error NULL

> myTryCatch (log ("a"))

$ valor NULL $ NULL advertencia de error $

Answer 4

el propósito de mi respuesta (y la modificación a excelente código de Martin) es por lo que la función de la fábrica de opinión devuelve la estructura de datos de esperar si todo va bien. Si se experimenta una advertencia, se adjunta al resultado bajo el atributo factory-warning. La función setattr de data.table se usa para permitir la compatibilidad con ese paquete. Si se experimenta un error, el resultado es el elemento de carácter "Se produjo un error en la función de fábrica" ​​y el atributo factory-error llevará el mensaje de 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) 
    } 
} 

Debido a que no envuelva el resultado en una lista adicional que no puede hacer el tipo de supuestos que permiten algunas de sus funciones de acceso, pero podemos escribir cheques simples y decidir cómo manejar los casos como es apropiado para nuestra particular estructura de datos resultante.

.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))