Comment enregistrer des avertissements et des erreurs en sortie d'une fonction?

Essayez le évaluer 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)")

il manque actuellement une bonne façon d'évaluer l'expression cependant - c'est principalement parce qu'il est destiné à reproduire exactement ce que la sortie R donné entrée de texte à la console.

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

il capte également les messages, les sorties vers la console, et s'assure que tout est correctement intercalé dans l'ordre dans lequel il s'est produit.

J'ai fusionné Martins soulution ( https://stackoverflow.com/a/4952908/2161065 ) et celui de la liste de diffusion R-help que vous obtenez avec demo(error.catching) .

l'idée principale est de conserver à la fois le message d'avertissement/d'erreur et la commande déclenchant ce problème.

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

exemples:

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

sortie:

> myTryCatch(log (1))

$ valeur [1] 0 $ avertissement NULL $error NULL

> myTryCatch(log (-1))

$ valeur [1] NaN $avertissement $error NULL

> myTryCatch (log ("a"))

$ valeur NULL $ avertissement NULL $ error

le but de ma réponse (et de la modification de L'excellent code de Martin) est que la fonction factory-ed retourne la structure de données attendue si tout va bien. Si un avertissement est ressenti, il est attaché au résultat sous l'attribut factory-warning . données.la fonction setattr de table est utilisée pour permettre la compatibilité avec ce paquet. Si une erreur se produit, le résultat est l'élément de caractère" une erreur s'est produite dans la fonction d'usine "et le factory-error attribut portera le message d'erreur.

#' 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{/q/how-do-i-save-warnings-and-errors-as-output-from-a-function-6718/"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)
  }
}

parce que nous n'emballons pas le résultat dans une liste supplémentaire, nous ne pouvons pas faire le genre d'hypothèses qui permettent certaines de ses fonctions d'accesseur, mais nous pouvons écrire des vérifications simples et décider comment traiter les cas comme il est approprié à notre structure de données résultant particulier.

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