I’m sure there’s already a way to do this, but here goes. OR maybe this is an anti-pattern. Either way, this is me, asking the stupid question.
I ran into this a few hours ago:
Sys.unsetenv("ENTREZ_KEY")
library(brranching)
mynames <- c("Poa annua", "Salix goodingii", "Helianthus annuus")
phylomatic_names(taxa = mynames, format='rsubmit')
No ENTREZ API key provided
Get one via taxize::use_entrez()
See https://ncbiinsights.ncbi.nlm.nih.gov/2017/11/02/new-api-keys-for-the-e-utilities/
No ENTREZ API key provided
Get one via taxize::use_entrez()
See https://ncbiinsights.ncbi.nlm.nih.gov/2017/11/02/new-api-keys-for-the-e-utilities/
No ENTREZ API key provided
Get one via taxize::use_entrez()
See https://ncbiinsights.ncbi.nlm.nih.gov/2017/11/02/new-api-keys-for-the-e-utilities/
[1] "poaceae%2Fpoa%2Fpoa_annua" "salicaceae%2Fsalix%2Fsalix_goodingii" "asteraceae%2Fhelianthus%2Fhelianthus_annuus"
The brranching package uses the taxize package internally, calling it’s function taxize::tax_name(). The taxize::tax_name() function throws useful messages to the userif their NCBI Entrez API key is not found, and gives them instructions on how to find it.
However, the user does not have to get an API key. If they don’t they then get subjectedto lots of repeats of the same message.
I wondered if there’s anything that could be done about this. That is, if the same message is going to be thrown that was already thrown within a function call, just skip additional messages that are the same.
There is of course suppressMessages() for messages, but in package development if youdo want a user to see a message, you don’t want to suppress messages. suppressMessagesis too blunt of an instrument for this use case.
the code
with_mssgs() captures values and messages, suppressing the message
with_mssgs <- function(expr) {
my_mssgs <- NULL
w_handler <- function(w) {
my_mssgs <<- c(my_mssgs, list(w))
invokeRestart("muffleMessage")
}
val <- withCallingHandlers(expr, message = w_handler)
list(value = val, messages = my_mssgs)
}
MessageKeeper is a little R6 class to handle messages, matching, and simple checks to see if messages have been used or not.
library(R6)
MessageKeeper <- R6::R6Class("MessageKeeper",
public = list(
bucket = NULL,
print = function(x, ...) {
cat('MessageKeeper', sep = "\n")
cat(paste0(' messages: ', length(self$bucket)))
if (length(self$bucket) > 0) {
cat("\n")
for (i in self$bucket) {
cat(paste0(" ", substring(i, 1, 50)))
}
}
},
add = function(x) {
self$bucket <- c(self$bucket, list(x))
invisible(self)
},
remove = function() {
if (self$length() == 0) return(NULL)
head <- self$bucket[[1]]
self$bucket <- self$bucket[-1]
head
},
purge = function() {
self$bucket <- NULL
},
thrown_already = function(x) {
x %in% self$bucket
},
not_thrown_yet = function(x) {
!self$thrown_already(x)
}
)
)
MessageKeeper examples
mssger <- MessageKeeper$new()
mssger
#> MessageKeeper
#> messages: 0
mssger$add("one")
mssger$add("two")
mssger
#> MessageKeeper
#> messages: 2
#> one two
mssger$thrown_already("one")
#> [1] TRUE
mssger$thrown_already("bears")
#> [1] FALSE
mssger$not_thrown_yet("bears")
#> [1] TRUE
mssger$purge()
handle_mssgs() is a function you wrap your target function in to handle the messages
handle_mssgs <- function(expr) {
res <- with_mssgs(expr)
if (!is.null(res$messages)) {
# if not thrown yet, add to bucket and throw it
if (my_mssger$not_thrown_yet(res$messages[[1]]$message)) {
my_mssger$add(res$messages[[1]]$message)
message(res$messages[[1]]$message)
}
}
return(res$value)
}
Set up the message keeper
my_mssger <- MessageKeeper$new()
squared() squares a numeric value and returns it, throwing a message if it’s greater than 20
squared <- function(x) {
stopifnot(is.numeric(x))
y <- x^2
if (y > 20) message("woops, > than 20! check your numbers")
return(y)
}
foo() runs any vector of numbers through squared() using vapply()
foo <- function(x) {
vapply(x, function(z) squared(z), numeric(1))
}
bar() does the same, but uses our MessageKeeper thingy
bar <- function(x) {
# tear down on exit
on.exit(my_mssger$purge())
vapply(x, function(z) handle_mssgs(squared(z)), numeric(1))
}
foo() annoyingly throws a message for every instance possible
foo(1:20)
#> woops, > than 20! check your numbers
#> woops, > than 20! check your numbers
#> woops, > than 20! check your numbers
#> woops, > than 20! check your numbers
#> woops, > than 20! check your numbers
#> woops, > than 20! check your numbers
#> woops, > than 20! check your numbers
#> woops, > than 20! check your numbers
#> woops, > than 20! check your numbers
#> woops, > than 20! check your numbers
#> woops, > than 20! check your numbers
#> woops, > than 20! check your numbers
#> woops, > than 20! check your numbers
#> woops, > than 20! check your numbers
#> woops, > than 20! check your numbers
#> woops, > than 20! check your numbers
#> [1] 1 4 9 16 25 36 49 64 81 100 121 144 169 196 225 256 289
#> [18] 324 361 400
while bar() only throws the message once
bar(1:20)
#> woops, > than 20! check your numbers
#> [1] 1 4 9 16 25 36 49 64 81 100 121 144 169 196 225 256 289
#> [18] 324 361 400
Top comments (0)