Question

我知道如何引发错误：

check_negative <- function(x) {
  if (x > 0) {
    stop("No way can x be positive.")
  }
  x
}

check_negative(5)
#> Error in check_negative(5) : No way can x be positive.

由于tryCatch的目的是处理此类错误，但tryCatch并未严格保留，我想知道是否有办法在check_negative(5)发生时始终引发错误，甚至如果它包裹在tryCatch中。

我的第一种方法工作得相当好，但需要至少运行一次，并且在退出时不会修复tryCatch。我尝试了tryCatch＆＃39;修复＆＃39;在on.exit内的错误之前，但这导致错误没有被提升。

（当然，以下功能会对您的R会话造成一些损害，因此请小心操作，不要在要保留的会话中运行。）

check_negative <- function(x) {
  unlockBinding("tryCatch", baseenv())
  assign("tryCatch", 
         local({
           function(expr, ..., finally) {
             expr
           }
         }), 
         pos = baseenv())

  if (x > 0) {
    stop("No way can x be positive.")
  }
  # Attempt to repair tryCatch
  unlockBinding("tryCatch", baseenv())
  assign("tryCatch", 
         function (expr, ..., finally) 
         {
           tryCatchList <- function(expr, names, parentenv, handlers) {
             nh <- length(names)
             if (nh > 1L) 
               tryCatchOne(tryCatchList(expr, names[-nh], parentenv, 
                                        handlers[-nh]), names[nh], parentenv, handlers[[nh]])
             else if (nh == 1L) 
               tryCatchOne(expr, names, parentenv, handlers[[1L]])
             else expr
           }
           tryCatchOne <- function(expr, name, parentenv, handler) {
             doTryCatch <- function(expr, name, parentenv, handler) {
               .Internal(.addCondHands(name, list(handler), parentenv, 
                                       environment(), FALSE))
               expr
             }
             value <- doTryCatch(return(expr), name, parentenv, handler)
             if (is.null(value[[1L]])) {
               msg <- .Internal(geterrmessage())
               call <- value[[2L]]
               cond <- simpleError(msg, call)
             }
             else cond <- value[[1L]]
             value[[3L]](cond)
           }
           if (!missing(finally)) 
             on.exit(finally)
           handlers <- list(...)
           classes <- names(handlers)
           parentenv <- parent.frame()
           if (length(classes) != length(handlers)) 
             stop("bad handler specification")
           tryCatchList(expr, classes, parentenv, handlers)
         }, 
         pos = baseenv())
}

tryCatch(check_negative(5), error = function(e) NULL)
#> NULL
tryCatch(check_negative(5), error = function(e) NULL)
#> Error in check_negative(5) : No way can x be positive.

这个问题背后的主要动机是好奇心;我不打算这样做。但我确实想知道这样的事情是否可能，或者是否有可能编写一个函数，其中一个不可靠但尚未确定的用户将无法避免错误。

Answer 1

您可以异步调用stop。这需要later包。

check_negative <- function(x) {
  if (x > 0) {
    later::later(function(...) stop('No way can x be positive.'))
    stop("No way can x be positive.")
  }
  x
}
tryCatch(check_negative(5), error = function(e) NULL)
#> NULL
#> Error in tryCatch(evalq(sys.calls(), <environment>), error = function (x)  : 
#>   Evaluation error: No way can x be positive..

一个功能可以通过tryCatch和朋友粉碎吗？

1 个答案: