Create a list of all messages, warnings, and errors returned by a function

Question

I have a function in R that calls other functions. Occasionally, those functions can return the same message. I only want the message to print once. What is the best way to handle that?

In the example below, functionC will print "The value is 5." two times if the argument for b and c is 5. I only want it to print once.

functionA <- function(a){
  
  if(a==5){
    message("The value is 5.")
  }
  return(a-2)
}

functionB <- function(b){
  
  if(b==5){
    message("The value is 5.")
  }
  return(b+7)
}

functionC <- function(a,b){
  a <- functionA(a)
  b <- functionB(b)
  c <- rbind(a,b)
  return(c)
}

functionC(5,5)

Answer 1

You can use withCallingHandlers to catch (and suppress) the messages in real time, then use unique to reduce them, then re-message them out. I'll add a (n times) when repeated for the sake of transparency (since otherwise you may have no clear idea how noisy inner-calls are).

functionC <- function(a,b){
  msgs <- character(0)
  a <- withCallingHandlers(
    functionA(a),
    message = function(m) {
      msgs <<- c(msgs, conditionMessage(m))
      invokeRestart("muffleMessage")
    })
  b <- withCallingHandlers(
    functionB(b),
    message = function(m) {
      msgs <<- c(msgs, conditionMessage(m))
      invokeRestart("muffleMessage")
    })
  msgs <- trimws(msgs)
  # since 'table' does not preserve the original order, we'll do a few
  # extra steps to ensure the messages appear in the order of their
  # _first_ appearance
  counts <- table(msgs)
  counts <- counts[match(names(counts), msgs)]
  msgs <- paste0(names(counts), ifelse(counts > 1, sprintf(" (%d times)", counts), ""))
  for (m in msgs) message(m)
  c <- rbind(a, b)
  return(c)
}
functionC(5,5)
# The value is 5. (2 times)
#   [,1]
# a    3
# b   12

You can repeat the message=/"muffleMessage" with warning=/"muffleWarning" to catch warnings as well ... though you might as well use purrr::quietly for that:

functionC2 <- function(a,b){
  msgs <- character(0)
  warns <- character(0)
  aout <- purrr::quietly(functionA)(a)
  bout <- purrr::quietly(functionB)(b)
  fewer <- function(z) {
    z <- trimws(z)
    counts <- table(z)
    counts <- counts[match(names(counts), z)]
    paste0(names(counts), ifelse(counts > 1, sprintf(" (%d times)", counts), ""))
  }
  msgs <- fewer(c(aout$messages, bout$messages))
  warns <- fewer(c(aout$warnings, bout$warnings))
  cout <- rbind(aout$result, bout$result)
  for (m in msgs) message(m)
  for (w in warns) warning(w)
  return(cout)
}

Answer 2

Would suppressing the functionA/functionB warnings and including a new 'a and/or b is 5' warning suit your use-case? E.g.

functionA <- function(a){
  if(a==5){
    message("The value is 5.")
  }
  return(a-2)
}

functionB <- function(b){
  if(b==5){
    message("The value is 5.")
  }
  return(b+7)
}

functionC <- function(a,b){
  a <- functionA(a)
  b <- functionB(b)
  c <- rbind(a,b)
  return(c)
}
functionC(5,5)
#> The value is 5.
#> The value is 5.
#>   [,1]
#> a    3
#> b   12

functionD <- function(a,b){
  if(a==5 | b==5){
    message("The value of a and/or b is 5.")
  }
  a <- suppressMessages(functionA(a))
  b <- suppressMessages(functionB(b))
  c <- rbind(a,b)
  return(c)
}
functionD(5,5)
#> The value of a and/or b is 5.
#>   [,1]
#> a    3
#> b   12

^{Created on 2023-08-18 with reprex v2.0.2}