这是一个带有自定义函数myCatch() 的base 解决方案，其形式类似于tryCatch()（与withCallingHandlers() 相同）。随意调整它，尤其是在我的# ADAPT... cmets 指定的区域。
request，我还更新 myCatch() 以接受用户定义的函数custom_fun。基于来自expr 的result，custom_fun 将处理评估expr 时抛出的任何警告对象，其输出将作为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'.
# ...
})
您可以随意自定义error 或finally，就像使用tryCatch() 一样。如果您进行自定义warning，您的diagnostics 仍将保留在输出中，但您将丢失result 的预期输出（这将成为您在@ 中指定的返回值987654347@).
如果我们按照您的具体示例here，并像这样使用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() 应用到某个示例expressions 时，只使用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() 被中断，它returns 没有值可以存储在output_ 中，这给我们留下了
Error: object 'output_4' not found