R tryCatch 但在警告的情况下保留表达式结果

R tryCatch but retain the expression result in the case of a warning

我有一个很长的 运行 函数,在某些情况下可能会生成警告。 当它执行时,我想保留函数的结果,但向结果添加一些诊断信息。

像这样

x = tryCatch(
    someLongRunningFunctionThatMightGenerateWarnings(),
    warning = function(w){
        c(w$exprResult, list(diagnostics = "some useful info"))
    }
)

有没有什么方法可以用 tryCatch 完成此操作而无需在警告处理程序中第二次计算表达式?

这是一个带有自定义函数 myCatch()base 解决方案,其形式类似于 tryCatch()(并且与 withCallingHandlers() 相同)。随意调整它,尤其是在我的 # ADAPT... 评论指定的区域。

通过 ,我还 更新了 myCatch() 以接受用户定义的函数 custom_fun。基于 exprresultcustom_fun 将处理在评估 expr 时抛出的任何警告对象,其输出将 return 编辑为 diagnostics(旁边results)。

myCatch <- function(# The expression to execute.
                    expr,
                    # Further arguments to tryCatch().
                    ...,
                    # User-defined function to extract diagnostic info from
                    # warning object, based on output that resulted from expr.
                    custom_fun = function(result, w){return(w)}) {
  ######################
  ## Default Settings ##
  ######################
  
  # Defaults to NULL results and empty list of diagnostics.
  DEFAULT_RESULTS <- NULL
  DEFAULT_DIAGNOSTICS <- NULL
  
  # Defaults to standard R error message, rather than a ponderous traceback
  # through the error handling stacks themselves; also returns the error object
  # itself as the results.
  DEFAULT_ERROR <- function(e){
    message("Error in ", deparse(e$call), " : ", e$message)
    return(e)
  }
  
  
  ################
  ## Initialize ##
  ################
  
  # Initialize output to default settings.
  res <- DEFAULT_RESULTS
  diag <- DEFAULT_DIAGNOSTICS
  err <- DEFAULT_ERROR
  
  # Adjust error handling if specified by user.
  if("error" %in% names(list(...))) {
    err <- list(...)$error
  }
  
  
  #######################
  ## Handle Expression ##
  #######################
  
  res <- tryCatch(
    expr = {
      withCallingHandlers(
        expr = expr,
        # If expression throws a warning, record diagnostics without halting,
        # so as to store the result of the expression.
        warning = function(w){
          parent <- parent.env(environment())
          parent$diag <- w
        }
      )
    },
    error = err,
    ...
  )
  
  
  ############
  ## Output ##
  ############
  
  # Package the results as desired.
  return(list(result = res,
              diagnostics = custom_fun(res, diag)))
}

申请

为了您的目的,请像这样使用 myCatch()

x <- myCatch(someLongRunningFunctionThatMightGenerateWarnings())

或更普遍

x <- myCatch(expr = {
               # ...
               # Related code.
               # ...
               someLongRunningFunctionThatMightGenerateWarnings()
             },
             # ...
             # Further arguments like 'finally' to tryCatch().
             # ...
             custom_fun = function(result, w){
                                             # ...
                                             # Extract warning info from 'w'.
                                             # ...
                                             })

您可以像自定义 tryCatch() 一样随意自定义 errorfinally。如果您 自定义 warning,您的 diagnostics 仍将保留在输出中,但您将失去 result 的预期输出(这将而是成为您在 warning).

中指定的 return 值

如果我们遵循您的具体示例 ,并像这样使用 myCatch()

output <- myCatch(
  log(-5),
  custom_fun = function(result, w){paste(as.character(result), "with warning", w$message)}
)
output 

然后 R 会显示警告信息

Warning message:
In log(-5) : NaNs produced

并给我们以下 output:

$result
[1] NaN

$diagnostics
[1] "NaN with warning NaNs produced"

更多示例

当我们将 myCatch() 应用于某些示例 expr 会话时,仅使用 custom_fun 的默认值,结果如下:

正常

output_1 <- myCatch(expr = {log(2)},
                    finally = {message("This is just like using 'finally' for tryCatch().")})
output_1

将显示自定义消息

This is just like using 'finally' for tryCatch().

并给我们输出:

$result
[1] 0.6931472

$diagnostics
NULL

警告

output_2 <- myCatch(expr = {log(-1)})
output_2

将显示警告信息

Warning message:
In log(-1) : NaNs produced

并给我们输出:

$result
[1] NaN

$diagnostics
<simpleWarning in log(-1): NaNs produced>

错误(默认)

output_3 <- myCatch(expr = {log("-1")})
output_3

将优雅地处理错误并显示其消息

Error in log("-1") : non-numeric argument to mathematical function

并且仍然给我们输出(带有 results 的错误对象):

$result
<simpleError in log("-1"): non-numeric argument to mathematical function>

$diagnostics
NULL

错误(自定义)

output_4 <- myCatch(expr = {log("-1")}, error = function(e){stop(e)})
output_4

将终止 myCatch() 并立即抛出错误,并通过 myCatch():

中的处理函数(此处 tryCatch())进行大量回溯
Error in log("-1") : non-numeric argument to mathematical function 

  6. stop(e) 
  5. value[[3L]](cond) 
  4. tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
         names[nh], parentenv, handlers[[nh]]) 
  3. tryCatchList(expr, classes, parentenv, handlers) 
  2. tryCatch(expr = {
         withCallingHandlers(expr = expr, warning = function(w) {
             parent <- parent.env(environment())
             parent$diag <- w ... 
  1. myCatch(expr = {
         log("-1")
     }, error = function(e) {
         stop(e) ...

由于myCatch()被中断,return没有值可以存储在output_中,这就给我们留下了

Error: object 'output_4' not found

不知道为什么我不能让它使用参数名称 warning 而不是 mywarning 并且不知道为什么它仍然打印警告消息,即使警告已处理,但这只是为了证明这个想法。

myCatch <- function(# The expression to execute.
  expr,
  # Further arguments to tryCatch().
  ...) {
  ######################
  ## Default Settings ##
  ######################
  
  # Defaults to NULL results and empty list of diagnostics.
  DEFAULT_RESULTS <- NULL
  DEFAULT_DIAGNOSTICS <- NULL
  
  # Defaults to standard R error message, rather than a ponderous traceback
  # through the error handling stacks themselves; also returns the error object
  # itself as the results.
  DEFAULT_ERROR <- function(e){
    message("Error in ", deparse(e$call), " : ", e$message)
    return(e)
  }
  
  DEFAULT_WARNING <- function(result,w){
    w
  }
  ################
  ## Initialize ##
  ################
  
  # Initialize output to default settings.
  res <- DEFAULT_RESULTS
  diag <- DEFAULT_DIAGNOSTICS
  err <- DEFAULT_ERROR
  warn <- DEFAULT_WARNING
  
  # Adjust error handling if specified by user.
  if("error" %in% names(list(...))) {
    err <- list(...)$error
  }
  
  if("mywarning" %in% names(list(...))){
    warn <- list(...)$mywarning
  }
  
  #######################
  ## Handle Expression ##
  #######################
  
  res <- tryCatch(
    expr = {
      withCallingHandlers(
        expr = expr,
        
        ###################################################################################
        ######### ADAPT the code STARTING HERE. ###########################################
        ###################################################################################
        
        # If expression throws a warning, record diagnostics without halting,
        # so as to store the result of the expression.
        warning = function(w){
          parent <- parent.env(environment())
          parent$warning_arg <- w
        }
        
        ###################################################################################
        ######### ADAPT the code ENDING HERE. #############################################
        ###################################################################################
        
      )
    },
    error = err,
    ...
  )
  
  ############
  ## Output ##
  ############
  if ("warning_arg" %in% ls()){
    diag <- warn(res, warning_arg)
  }
  # Package the results as desired.
  return(list(result = res,
              diagnostics = diag))
}


myCatch(
  log(-5),
  mywarning = function(result, w){paste(as.character(result), "with warning", w$message)}
  
)