如何將警告和錯誤保存爲函數的輸出？

Question

我使用lapply在大量項目上運行一個複雜的函數，並且我想將每個項目的輸出（如果有）與任何生成的警告/錯誤一起保存，以便我可以告訴哪個項目項目產生了哪個警告/錯誤。

我發現了一種使用withCallingHandlers來捕獲警告的方法（這裏描述：https://stackoverflow.com/questions/4947528）。不過，我也需要發現錯誤。我可以通過將它包裝在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" 

這裏有幾個問題上，以便討論tryCatch和錯誤處理，但沒有我發現地址這一具體問題。最相關的參見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?和How to tell lapply to ignore an error and process the next thing in the list?。

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

Answer 2

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

它目前雖然缺乏評估表達的一個很好的方式 - 這主要是因爲它的朝向在控制檯上重現正是右輸出的給定文本輸入針對性。

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

它還捕獲消息，輸出到控制檯，並確保所有內容按其發生順序正確交錯。

Answer 3

我已經合併了Martins soulution（https://stackoverflow.com/a/4952908/2161065）和您從demo(error.catching)獲得的R幫助郵件列表中的一個。

主要的想法是保持警告/錯誤信息和觸發這個問題的命令。

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（日誌（1））

$值[1] 0 $警告NULL $錯誤NULL

> myTryCatch（日誌（-1））

$值[1]的NaN $警告 $ NULL錯誤

> myTryCatch（日誌（ 「A」））

$ NULL值 $警告NULL $錯誤

Answer 4

我的回答（和修改，以馬丁的出色的代碼）的目的是使工廠-ED函數返回預期的數據結構，如果一切進展順利。如果遇到警告，則會附加factory-warning屬性下的結果。 data.table的setattr函數用於允許與該包的兼容性。如果遇到錯誤，則結果爲字符元素「工廠功能發生錯誤」，並且factory-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) 
    } 
} 

因爲我們沒有一個額外的列表包裝的結果，我們不能做出那種假設，允許他的一些訪問功能，但我們可以寫一些簡單的檢查，並決定如何處理案件適合我們特定的數據結構。

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