Jak zapisywać ostrzeżenia i błędy jako dane wyjściowe z funkcji?

Question

Używam lapply do uruchamiania złożonej funkcji na dużej liczbie elementów i chciałbym zapisać wynik każdego elementu (jeśli taki jest) wraz z wszelkimi ostrzeżeniami/błędami, które zostały wygenerowane, aby móc stwierdzić, które wyprodukowana pozycja z ostrzeżeniem/błędem.

Znalazłem sposób na złapanie ostrzeżeń za pomocą withCallingHandlers (opisany tutaj: https://stackoverflow.com/questions/4947528). Jednak muszę też wychwycić błędy. Mogę to zrobić, zawijając go w tryCatch (jak w poniższym kodzie), ale czy jest lepszy sposób na zrobienie tego?

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

Przykładowe wyjście z tej funkcji jest następująca:

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

Istnieje kilka pytania tutaj na SO, że dyskutować tryCatch i obsługę błędów, ale nie że stwierdziliśmy, że rozwiązania tego konkretnego problemu. Zobacz 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? i How to tell lapply to ignore an error and process the next thing in the list? dla najbardziej odpowiednich.

Answer 1

Może to jest takie samo jak rozwiązanie, ale napisałem factory przekształcić zwykły stary funkcji na funkcje, które oddają swoje wartości, błędy i ostrzeżenia, więc mogę

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

z każdego elementu wynik zawierający wartość, błąd i/lub ostrzeżenia. Będzie to działać z funkcjami użytkownika, funkcjami systemu lub anonimowymi funkcjami (factory(function(i) ...)). Oto fabryka

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

a niektóre pomocników do czynienia z listy wynikowej

.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

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

Obecnie brakuje piękny sposób oceny ekspresji chociaż - to głównie dlatego, że jest kierowane ku odtwarzając dokładnie to, co dany wprowadzania tekstu R wyjścia w na konsoli.

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

Przechwytuje również komunikaty, wyprowadza dane na konsolę i zapewnia, że ​​wszystko jest poprawnie przeplatane w kolejności, w jakiej miało miejsce.

Answer 3

Połączyłem Martins soulution (https://stackoverflow.com/a/4952908/2161065) i ten z listy mailingowej R-help, którą otrzymałeś pod numerem demo(error.catching).

Główną ideą jest zachowanie zarówno komunikatu ostrzegawczego/błędu, jak i polecenia wywołującego ten problem.

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

Przykłady:

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

wyjściowa:

> myTryCatch (log (1))

wartość $ [1] 0 $ NULL ostrzeżenie $ błędach NULL

> myTryCatch (log (-1))

$ wartość [1] NaN $ ostrzeżenie $ error NULL

> myTryCatch (log ("a"))

$ wartość NULL $ NULL ostrzeżenie błąd $

Answer 4

Celem mojej odpowiedzi (i modyfikacji kodu doskonałą Martin) jest tak, że funkcja fabrycznie ed zwraca strukturę danych oczekiwany jeśli wszystko pójdzie dobrze. Jeśli pojawi się ostrzeżenie, jest ono dołączane do wyniku w atrybucie factory-warning. Funkcja data.table funkcji setattr służy do zapewnienia kompatybilności z tym pakietem. Jeśli wystąpi błąd, wynikiem jest element znaku "Wystąpił błąd w funkcji fabrycznej", a atrybut factory-error wyświetli komunikat o błędzie.

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

Ponieważ nie zawijać wynik na dodatkowym liście nie możemy zrobić tego rodzaju założeń, które pozwalają na niektóre z jego funkcji dostępowych, ale możemy napisać kilka prostych czynności sprawdzających i zdecydować, jak obsługiwać przypadki co jest właściwe dla naszej konkretnej struktury danych.

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