General remarks
I think your solution is fine, and I would probably use that in production code. Nevertheless, if you are interested in another, cooler but possibly more fragile way of doing this, read on.
A solution using non-standard evaluation
It is certainly possible to create a function that takes an expression, and evaluates it, and takes care about warning only once for each reason. You could use it like this:
warn_once(
lapply(data, function(data) {
result <- doSomething(data)
warn_if_first(reason = "bad data argument", message = "This was bad.")
result
})
)
It is also possible to do it in the form you suggested, but it is tricky to set the scope in which you want only one warning. E.g. look at these two examples. The first one is your original code.
lapply(data, function(data) {
result <- doSomething(data)
warn_if_first(warningReason, "This was bad.")
result
})
This is easy. You want one warning per the outer lapply block. But if you have the following one:
lapply(data, function(data) {
result <- doSomething(data)
sapply(result, function(x) {
warn_if_first(warningReason, "This was bad.")
})
result
})
then (at least with the straightforward implementation of warn_if_first) you will get one warning per sapply call, and there is no easy way to tell warn_if_first if you want one warning per lapply call.
So I suggest the form above, that explicitly specifies the environment in which you will get a single warning.
Implementation
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)
}
}
Example usage
Let's try it!
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!"
})
Which outputs
[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!
and this seems about right. A glitch is that the warning is coming warn_if_first, and not from its calling environment, as it should be, but I have no idea how to fix this. warning also uses non-standard evaluation, so it is not as simple as just doing eval(warning(...), envir = parent.frame()). You can supply call. = FALSE to warning() or to warn_if_first(), and then you will get
[1] "DONE!"
Warning messages:
1: oh, no! foo!
2: oh, no! bar!
3: foobar, too!
which is probably better.
Caution
While I don't see any obvious problems with this implementation, I cannot guarantee that it does not break in some special circumstances. It is very easy to make mistakes with non-standard evaluation. Some base R functions, and also some popular packages like magrittr, also use non-standard evaluation, and then you have to be doubly cautious, because there might be interactions between them.
The variable name I used for the book-keeping, .warnings_seen is special enough, so that it will not interfere with other code most of the time. If you want to be (almost) completely sure, generate a long random string and use that as the variable name instead.
Further reading about scoping
