Question

muffleWarning中的invokeRestart("muffleWarning")如何实施？我问因为在以下代码中：

e <-expression({
  warning("Step 1",immediate.=TRUE)
  warning("Step 2",immediate.=TRUE)
})

r <- withRestarts(withCallingHandlers(eval(e)
                                      ,warning=function(co){
                                        print(co) #1
                                        invokeRestart("mymuffleWarn",co)
                                      })
                  , mymuffleWarn=function(co) print(conditionMessage(co)))

我得到第一个警告的输出（来自＃1）。但是，如果我将mymufflewarn替换为muffleWarning（在invokeRestart中），则会显示所有print(co)输出。

由于

Answer 1

Grepping R源代码揭示了这一点：

.signalSimpleWarning <- function(msg, call)
    withRestarts({
           .Internal(.signalCondition(simpleWarning(msg, call), msg, call))
           .Internal(.dfltWarn(msg, call))
        }, muffleWarning = function() NULL)

从

调用

static void vsignalWarning(SEXP call, const char *format, va_list ap)
{
    char buf[BUFSIZE];
    SEXP hooksym, hcall, qcall;

    hooksym = install(".signalSimpleWarning");
    if (SYMVALUE(hooksym) != R_UnboundValue &&
        SYMVALUE(R_QuoteSymbol) != R_UnboundValue) {
        PROTECT(qcall = LCONS(R_QuoteSymbol, LCONS(call, R_NilValue)));
        PROTECT(hcall = LCONS(qcall, R_NilValue));
        Rvsnprintf(buf, BUFSIZE - 1, format, ap);
        hcall = LCONS(mkString(buf), hcall);
        PROTECT(hcall = LCONS(hooksym, hcall));
        eval(hcall, R_GlobalEnv);
        UNPROTECT(3);
    }
    else vwarningcall_dflt(call, format, ap);
}

从

调用

void warningcall(SEXP call, const char *format, ...)
{
    va_list(ap);
    va_start(ap, format);
    vsignalWarning(call, format, ap);
    va_end(ap);
}

该函数用于在C代码中生成警告，也从do_warning调用，warning()是支持muffleWarning的C函数。

因此，只要发出警告，{{1}}处理程序就始终可用。

自定义R重启功能，不会中止

1 个答案: