从 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() 包裹如上所示的 suppressWarnings 将是一个非常丑陋的 hack，而且是没有选择的，因为 hurz() 执行计算密集型工作。

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

Answer 1

借用 this post 中演示的一些记录不充分的 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 函数的封闭框架，并覆盖调用hurz 的匿名函数环境中的error_text 值。

我不得不在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