在R中警告一次

Question

是否有一种好方法在R中只警告一次?

我现在做的是常规的

a_reason_to_warn_has_occured <- FALSE
lapply(data, function(data) {
       result <- do_something(data)
       if (warning_reason)
           a_reason_to_warn_has_occured <- TRUE
       result
})
if (a_reason_to_warn_has_occured)
    warning("This was bad.")

是否有一种方法可以用更少的混乱/锅炉板代码做到这一点?

我真的很喜欢这样的东西

lapply(data, function(data) {
       result <- do_something(data)
       warn_once_if(warning_reason, "This was bad.")
       result
})

但我不确定是否有可能在r中实现这个

Answer 1

备注

我认为你的解决方案很好，我可能会在生产代码中使用它。然而，如果你对另一种更酷但可能更脆弱的方式感兴趣，请继续往下读。

使用非标准求值的解决方案

当然可以创建一个函数，它接受一个表达式，并对其求值，并且只对每个原因发出一次警告。你可以这样使用:

warn_once(
  lapply(data, function(data) {
     result <- doSomething(data)
     warn_if_first(reason = "bad data argument", message = "This was bad.")
     result
  })
)

也可以采用您建议的形式，但是设置只需要一个警告的范围是很棘手的。请看这两个例子。第一个是原始代码。

lapply(data, function(data) {
       result <- doSomething(data)
       warn_if_first(warningReason, "This was bad.")
       result
})

这很简单。您希望每个外部lapply块都有一个警告。但是如果你有下面这个:

lapply(data, function(data) {
       result <- doSomething(data)
       sapply(result, function(x) {
           warn_if_first(warningReason, "This was bad.")
       })
       result
})

然后(至少与warn_if_first的直接实现)，您将获得每个sapply调用一个警告，并且没有简单的方法告诉warn_if_first，如果您想要每个lapply调用一个警告。

所以我建议使用上面的表单，它显式地指定您将获得单个警告的环境。

实施

warn_once <- function(..., asis = FALSE) {
  .warnings_seen <- character()
  if (asis) {
    exprs <- list(...)
  } else {
    exprs <- c(as.list(match.call(expand.dots = FALSE)$...))
  }
  sapply(exprs, eval, envir = parent.frame())
}
warn_if_first <- function(reason, ...) {
  ## Look for .warnings_seen
  for (i in sys.nframe():0) {
    warn_env <- parent.frame(i)
    found_it <- exists(".warnings_seen", warn_env)
    if (found_it) { break }
  }
  if (!found_it) { stop("'warn_if_first not inside 'warn_once'") }
  ## Warn if first, and mark the reason
  .warnings_seen <- get(".warnings_seen", warn_env)
  if (! reason %in% .warnings_seen) {
    warning(...)
    .warnings_seen <- c(.warnings_seen, reason)
    assign(".warnings_seen", .warnings_seen, warn_env)
  }
}

让我们试试!

warn_once({
  for (i in 1:10) { warn_if_first("foo", "oh, no! foo!") }
  for (i in 1:10) { warn_if_first("bar", "oh, no! bar!") }
  sapply(1:10, function(x) {
    warn_if_first("foo", "oh, no! foo again! (not really)")
    warn_if_first("foobar", "foobar, too!")
  })
  "DONE!"
})

输出

[1] "DONE!"
Warning messages:
1: In warn_if_first("foo", "oh, no! foo!") : oh, no! foo!
2: In warn_if_first("bar", "oh, no! bar!") : oh, no! bar!
3: In warn_if_first("foobar", "foobar, too!") : foobar, too!

，这似乎是对的。一个小故障是警告即将到来的warn_if_first，而不是从它的调用环境，因为它应该是，但我不知道如何解决这个问题。warning也使用非标准求值，所以不像eval(warning(...), envir = parent.frame())那样简单。您可以将call. = FALSE提供给warning()或warn_if_first()，然后您将得到

[1] "DONE!"
Warning messages:
1: oh, no! foo! 
2: oh, no! bar! 
3: foobar, too! 

可能更好。

谨慎

虽然我没有看到这个实现有任何明显的问题，但我不能保证它在某些特殊情况下不会中断。非标准评估很容易犯错误。一些基本的R函数，还有一些流行的软件包，比如magrittr，也使用非标准的求值，那么你必须加倍小心，因为它们之间可能存在交互。

我用于记账的变量名.warnings_seen足够特殊，因此它在大多数情况下不会干扰其他代码。如果你想(几乎)完全确定，生成一个长随机字符串，并使用它作为变量名。

关于范围的进一步阅读

"R入门"中关于作用域的部分:http://cran.r-project.org/doc/manuals/R-intro.html#Scope
• Hadley Wickam的书中关于非标准评估的章节:http://cran.r-project.org/doc/manuals/R-intro.html#Scope，特别是关于动态范围的部分。

Answer 2

根据评论和Gabors的回答，以下是我尝试实现无作用域解决方案的结果。它基于比较对warn_once调用的回溯。请注意，这只是一个快速的草案，绝对不完美。有关详细信息，请参见下文。

warn_once <- function(mesg) {
    trace <- traceback(0)
    if (exists(".warnings_shown", sys.frame(1))) {
        warn_list <- get(".warnings_shown", sys.frame(1))
        found_match <- FALSE
        for (warn in warn_list)
            if (all(unlist(Map(`==`, warn, trace))))
                return()
        warn_list[[length(warn_list)+1]] <- trace
        assign(".warnings_shown", warn_list, envir=sys.frame(1))
        warning(mesg)
    } else {
        assign(".warnings_shown", list(trace), envir=sys.frame(1))
        warning(mesg)
    }
}

作为测试用例，我使用了…

func <- function(x) {
  func2(x)
  func2(not(x))
  func2(x)
  func2(not(x))
}
func2 <- function(x) {
  if(x) for(i in 1:3) warn_once("yeah")
  if(not(x)) warn_once("nope")
  warn_once("yeah")
}
func(T)

…这导致了…

Warning in warn_once("yeah") : yeah
Warning in warn_once("yeah") : yeah
Warning in warn_once("nope") : nope
Warning in warn_once("yeah") : yeah
Warning in warn_once("yeah") : yeah
Warning in warn_once("yeah") : yeah
Warning in warn_once("nope") : nope
Warning in warn_once("yeah") : yeah

…以及调用traceback时产生的大量杂乱输出。

指出:

• 我猜是有可能抑制traceback()调用的输出，但我不能这样做。
• 根据警告在帧栈中的位置来识别警告，而不是像Gabors的回答那样通过警告信息来识别警告。这可能是但不一定是理想的行为。
• 从回溯中，可以推断出调用函数的名称并将其添加到警告消息中，这可能是有用的。
• 显然，可以引入一个可选参数来指定在搜索"。warnings_show"时在帧堆栈中上升的级别数。

评论和改进(只要编辑!)欢迎。