Possible to show console messages (written with `message`) in a shiny ui?

Question

I don't understand R's message vs cat vs print vs etc. too deeply, but I'm wondering if it's possible to capture messages and show them in a shiny app?

Example: the following app can capture cat statements (and print statements as well) but not message statements

runApp(shinyApp(
  ui = fluidPage(
    textOutput("test")
  ),
  server = function(input,output, session) {
    output$test <- renderPrint({
      cat("test cat")
      message("test message")
    })
  }
))

Cross post from the shiny-discuss Google group since I got 0 answers.

Answer 1

Yihui suggested I use withCallingHandlers, and that indeed let me to a solution. I wasn't quite sure how to use that function in a way that would do exactly what I needed because my problem was that I had a function that printed out several messages one at a time and using a naive approach only printed the last message. Here is the my first attempt (which works if you only have one message to show):

foo <- function() {
  message("one")
  message("two")
}

runApp(shinyApp(
  ui = fluidPage(
    actionButton("btn","Click me"),
    textOutput("text")
  ),
  server = function(input,output, session) {
    observeEvent(input$btn, {
      withCallingHandlers(
        foo(),
        message = function(m) output$text <- renderPrint(m$message)
      )
    })
  }
))

Notice how only two\n gets outputted. So my final solution was to use the html function from shinyjs package (disclaimer: I wrote that package), which lets me change or append to the HTML inside an element. It worked perfectly - now both messages got printed out in real-time.

foo <- function() {
  message("one")
  Sys.sleep(0.5)
  message("two")
}

runApp(shinyApp(
  ui = fluidPage(
    shinyjs::useShinyjs(),
    actionButton("btn","Click me"),
    textOutput("text")
  ),
  server = function(input,output, session) {
    observeEvent(input$btn, {
      withCallingHandlers({
        shinyjs::html("text", "")
        foo()
      },
        message = function(m) {
          shinyjs::html(id = "text", html = m$message, add = TRUE)
      })
    })
  }
))

Answer 2

I know this isn't nearly as elegant, but I worked around a bit similar problem using capture.output; sadly sink doesn't allow simultaneous capture of messages and output though. You don't get them in the original order, but you can extract both streams at least (here turned to HTML):

runApp(shinyApp(
  ui = fluidPage(
    uiOutput("test")
  ),
  server = function(input,output, session) {
    output$test <- renderUI({
      HTML(
      paste(capture.output(type = "message", expr = { 
        message(capture.output(type = "output", expr = {
          cat("test cat<br>")
          message("test message")
          cat("test cat2<br>")
          message("test message2")
        }))
      }), collapse="<br>")
  )})
 })
)

Output:

test message
test message2
test cat
test cat2

Perhaps in the case if user wants to capture both but also separate them, this will provide a handy work-around. (Your shinyjs package seems neat, need to take a look at it!)

Answer 3

This can now be done with the high-level function shinyCatch from the spsComps package.

Basic usage

library(shiny)
library(spsComps)
ui <- fluidPage(
  actionButton("msg", "msg"),
  actionButton("warn", "warn"),
  actionButton("err", "err"),
)

server <- function(input, output, session) {
    observeEvent(input$msg, {
      shinyCatch({message("a message")}, prefix = '')
    })
    observeEvent(input$warn, {
        shinyCatch({warning("a warning")}, prefix = '')
    })
    observeEvent(input$err, {
        shinyCatch({stop("an error")}, prefix = '')
    })
    
}

shinyApp(ui, server)

Choose blocking level

If exceptions happened, we can choose to continue the code or block downstream code in the reactive context. For example, we want to stop downstream code if an error/warning/message happens:

library(shiny)
library(spsComps)
ui <- fluidPage(
  actionButton("err", "code not blocked after error"),
  actionButton("err_block", "code blocked after error"),
)

server <- function(input, output, session) {
    observeEvent(input$err, {
        shinyCatch({stop("an error")}, prefix = '')
        print("error does not block ")
    })
    
    observeEvent(input$err_block, {
        shinyCatch({stop("an error")}, prefix = '', blocking_level = "error")
        print("you can't see me if error happens")
    })
}

shinyApp(ui, server)

More advanced use

check website and demo

cat and print

There is still no good method to catch real-time info from cat and print. I will come back to update this answer if I found a fix for this.