从 R 中的函数中捕获警告并仍然获得它们的返回值？

Question

在一个函数中，我正在调用另一个计算密集型外部函数，该函数在某些情况下会触发警告，但也会返回一个值，我想评估该值，无论是否发生警告。

此外，如果发生警告或错误，我想捕获警告/错误消息以进行进一步处理。

下面的 R 代码展示了我的意图：

hurz <- function(x) {
  # HINT: max(x) triggers a warning when x = NULL
  max(x)
  return(12345)
}

laus <- function(x) {
  r <- tryCatch({
      list(value = hurz(x), error_text = "No error.")
    }, warning = function(e) {
      error_text <- paste0("WARNING: ", e)
      # ugly hack to get the result while still catching the warning
      return(list(value = (suppressWarnings(hurz(5))), error_text = error_text))
    }, error = function(e) {
      error_text <- paste0("ERROR: ", e)
      return(list(value = NA, error_text = error_text))
    }, finally = {
    }, quiet = TRUE)
  return(r)
}

发生错误时，代码会在错误捕获部分结束，因此很明显我将无法从 hurz() 获取返回值。

但是，似乎没有好的方法可以同时获得

• hurz() 的返回值以及
• 产生的警告。

打电话时，laus(3)我收到以下回复：

$value
[1] 12345

$error_text
[1] "No error."

另一方面，打电话时laus(NULL)我得到：

[1] 12345

$error_text
[1] "WARNING: simpleWarning in max(x): no non-missing arguments to max; returning -Inf\n"

当然，调用 hurz() 包裹着如上所示的抑制警告将是一个非常丑陋的 hack 并且没有选择，因为 hurz() 执行非常计算密集型的工作。

有没有人知道如何以一种很好的方式解决这个问题，以及我如何捕捉警告并仍然一次性获得函数的返回值？

Answer 1

借用这篇文章中展示的一些记录不佳的 R 魔法，我认为以下修改后的laus()函数可以解决问题：

laus <- function(x) {
  r <- 
    tryCatch(
      withCallingHandlers(
        {
          error_text <- "No error."
          list(value = hurz(x), error_text = error_text)
        }, 
        warning = function(e) {
          error_text <<- trimws(paste0("WARNING: ", e))
          invokeRestart("muffleWarning")
        }
      ), 
      error = function(e) {
        return(list(value = NA, error_text = trimws(paste0("ERROR: ", e))))
      }, 
      finally = {
      }
    )
  
  return(r)
}

现在我可以打电话laus(3)并得到：

$value
[1] 12345

$error_text
[1] "No error."

或laus(NULL)并得到：

$value
[1] 12345

$error_text
[1] "WARNING: simpleWarning in max(x): no non-missing arguments to max; returning -Inf"

或laus(foo)并得到：

$value
[1] NA

$error_text
[1] "ERROR: Error in hurz(x): object 'foo' not found"

注意<<-在warning函数中的使用。这将搜索warning函数的封闭框架并覆盖error_text调用 的匿名函数的环境中的值hurz。

我不得不在warning函数中使用带有断点的调试器来找出封闭的帧。如果您不了解 R 中的环境和框架，只需相信<<-在此上下文中使用将覆盖error_text初始化为“无错误”的变量。

为了更好地理解这段代码，请意识到它withCallingHandlers()本身就是一个独立的函数。函数的以下变体说明了这一点，它将捕获并从警告中恢复，但不会处理错误：

lausOnlyHandleWarnings <- function(x) {
  r <- 
    withCallingHandlers(
      {
        error_text <- "No error."
        list(value = hurz(x), error_text = error_text)
      }, 
      warning = function(e) {
        error_text <<- trimws(paste0("WARNING: ", e))
        invokeRestart("muffleWarning")
      }
    )
  
  return(r)
}

laus()除非出现错误，否则此函数的输出将与函数相同。在出现错误的情况下，它将简单地失败并报告错误，就像任何其他缺少tryCatch. 例如，lausOnlyHandleWarnings(foo)产量：

Error in hurz(x) : object 'foo' not found