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

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

Encontré una forma de detectar advertencias usando withCallingHandlers ( descrito aquí ). 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) } 

La salida de muestra 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 SO que tratan sobre tryCatch y manejo de errores, pero ninguna que encontré que aborde este problema en particular. Consulte ¿Cómo puedo verificar si una llamada a función da como resultado una advertencia? , advertencias () no funciona dentro de una función? ¿Cómo puede uno solucionar esto? , y ¿Cómo decirle a lapply que ignore un error y procese lo siguiente en la lista? para los más relevantes

Tal vez esto sea lo mismo que tu solución, pero escribí una factory para convertir viejas funciones simples en funciones que capturan sus valores, errores y advertencias, para que pueda

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

con cada elemento del 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

 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 tratar con 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) 

Pruebe el paquete de evaluación .

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

Sin embargo, actualmente carece de una buena forma de evaluar la expresión, principalmente porque está dirigida a reproducir exactamente la entrada de texto dada por la salida R en la consola.

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

También captura los mensajes, los envía a la consola y garantiza que todo esté correctamente intercalado en el orden en que ocurrió.

He fusionado la versión de Martins soulution ( https://stackoverflow.com/a/4952908/2161065 ) y la 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")) 

Salida:

> myTryCatch (log (1))

$ value [1] 0 $ warning NULL $ error NULL

> myTryCatch (log (-1))

$ value [1] NaN $ warning $ error NULL

> myTryCatch (log ("a"))

$ valor NULL $ advertencia NULL $ error

El propósito de mi respuesta (y la modificación del excelente código de Martin) es que la función de fábrica devuelva la estructura de datos esperada si todo va bien. Si se experimenta una advertencia, se adjunta al resultado bajo el atributo de factory-warning . La función setattr de setattr 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 de 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 envolvemos el resultado en una lista adicional, no podemos hacer el tipo de suposiciones que permiten algunas de sus funciones de acceso, pero podemos escribir verificaciones simples y decidir cómo manejar los casos, de acuerdo con nuestro resultado particular. estructura de datos.

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