Displaying ggplot messages in a Shiny app
8 January, 2020
Background
It turns out that capturing and displaying in a Shiny app the warning and error messages generated by ggplot isn't as simple as you might think. In order to discover why that is, we need to know a little bit about what happens behind the scenes.
When you call ggplot(), you're not explicitly drawing the plot; you're only creating the ggplot object. This isn't obvious at first glance, because when we call ggplot() in an R console, our plot will appear in RStudio's plot viewer:
library(ggplot2)
ggplot(mtcars, aes(x = mpg, y = hp)) +
geom_quantile()
The reason for this behaviour is that when we run any command on the R console, the default action is to call print() on the result, so it makes it seem like ggplot() actually draws the plot. In a Shiny app, however, we aren't executing our code on the console: we aren't running print() on the ggplot() output, so we aren't getting access to any messages that ggplot feels like passing on to us.
Back to the console. You will have noticed that ggplot helpfully returned a message for us after we ran the code above: "Smoothing formula not specified. Using: y ~ x". We can demonstrate this little idiosyncrasy of behind-the-scenes printing by trying to suppress that message. Let's just wrap the whole ggplot() call with suppressMessages(), and see what happens.
suppressMessages(
ggplot(mtcars, aes(x = mpg, y = hp)) +
geom_quantile())
It didn't work! The message was still printed, because the expression that we typed was implicitly wrapped in a call to print() by the R console, so it looked like this: print(suppressMessages(ggplot(...))) -- and no messages are generated during the creation of the ggplot object itself, only upon printing. To correctly suppress the messages, we would have to do it the other way around: suppressMessages(print(ggplot(...))). This excellent Stack Overflow question and answer talk about the issue in more detail.
So, we've found out that gathering and displaying messages from ggplot within a Shiny app isn't as simple as it might first appear. Like all things in code, however, there are several ways to screw in a lightbulb, and our strategy for now will be to generate a reactive ggplot object containing our plot, and then use that object twice: firstly, to plot it as normal, and secondly -- you guessed it -- to print() the object in order to gather the error messages. We'll create a few lists that we can append messages to, so that we can continue to gather new messages whenever they appear. Let's dive right in and see what the UI will look like.
UI code
Our UI is going to be super simple. All we really want is a ggplot plotOutput, a couple of actionButton outputs to create warnings and errors, a little textOutput to spit out some information, and, of course, a verbatimTextOutput containing all our messages.
ui <- {
fluidPage(
# button row
fluidRow(
column(width = 6,
actionButton(
inputId = 'create_warning',
label = 'Create a warning')),
column(width = 6,
actionButton(
inputId = 'create_error',
label = 'Create an error!'))),
# info text row
fluidRow(
textOutput('info_text')),
# plot row
fluidRow(
plotOutput('my_plot')),
# message output row
fluidRow(
verbatimTextOutput('ggplot_messages'))
)
}
Of course, our server code is going to be a little bit more complicated.
Simulating errors and warnings
Before we start thinking about how to handle messages, we're going to have to think about how to create them on demand! For warnings, that's pretty easy. If ggplot tries to plot a geom_point() vector containing NA values, it will throw a warning. So, let's create a function that inserts an NA value into a dataframe in a random position.
insert_na <- function(df) {
# randomly select row and col indices
row_index <- sample(1:dim(df)[1], 1)
col_index <- sample(1:dim(df)[2], 1)
# insert NA in selected position
df[row_index,col_index] <- NA
# return list of outputs
return(
list(
df = df,
row_index = row_index,
col_index = col_index))
}
insert_na() will take a dataframe as its argument, and pick a random row and column using sample() in conjunction with dim(). Then, it inserts NA into that random position. Finally, it will return a list containing not just our modified dataframe, but also the row and column indices that point to our NA (just so we can keep track of it later on).
As for generating an error, well... that's easy. **manic laugh** The easiest way I can think of is just give ggplot() something that isn't a dataframe for the data argument, like, say, the number 5.
The server function
Now we're getting down to the business end of things. You could probably do this a million ways, but here's how we're going to tackle it. We'll instantiate plot_data as a reactive values object, and give it a placeholder object that we'll call "text". It'll just tell the user to click a button to get started.
plot_data <- reactiveValues(text = 'Click on a button to get started.')
Next, we're going to populate plot_data with with some actual data. We can do this by clicking either of the buttons. The buttons will be tied to observeEvent() calls, so each time we click a button, Shiny will look for the correct observeEvent() code to run, which will then overwrite plot_data with data containing either a warning or an error. The code for the warning looks like this:
# generate warning upon button click
observeEvent(input$create_warning, {
# remove placeholder for app startup
plot_data$text <- NULL
# get mtcars with one NA randomly inserted,
# along with its row and col indices
new_data <- insert_na(mtcars)
# populate plot_data reactiveValues
plot_data$df <- new_data$df
plot_data$column_with_na = names(mtcars$df)[new_data$col_index]
plot_data$row = names(mtcars)[new_data$row_index]
plot_data$col = names(mtcars)[new_data$col_index]
})
We can see that it calls our custom function insert_na(), and then overwrites the plot_data reactive values. As simple as that is, our observeEvent() for an error is even easier:
# generate error upon button click
observeEvent(input$create_error, {
# remove placeholder for app startup
plot_data$text <- NULL
# make df not a df -- creates error
plot_data$df <- 5
})
You've probably noticed that in each of those calls, we're assigning NULL to plot_data$text. The reason for this is that it's nice to have a bit of information text provided to us, that tells us, for example, where we put the NA, and what ggplot is doing. But, we'd also like to prompt the user to do something when they start the app, and it's convenient for us to have both of those things in a single reactive output. I've called it info_text.
# generate information text to accompany plot
output$info_text <- reactive({
# do nothing on app start, otherwise, provide information
if (!is.null(plot_data$text)) {
paste(plot_data$text)
} else {
paste0(
"Inserted an NA value into the ",
plot_data$column_with_na,
" column to generate a ggplot warning. Plotting ",
plot_data$row,
" vs ",
plot_data$col,
".")
}
})
You can see that if plot_data$text isn't NULL, then it pastes together a small bit of text telling us where the computer gods decided to put the NA. The only time it tells us anything different is if plot_data$text is not equal to NULL, i.e., on app startup before it's overwritten by either of the observeEvent() calls.
To actually generate the plot, we'll have a simple reactive object that will get the data from plot_data, as well as the row and column names, and make a simple call to ggplot. (Note that we use aes_string, as our x- and y-values are passed in as character strings.)
# generate reactive ggplot object dependent on plot_data
plot_object <- reactive({
# retrieve data to plot from plot_data reactiveVal
df <- plot_data$df
x = plot_data$row
y = plot_data$col
# plot simple graph
ggplot(df, aes_string(x = x, y = y)) +
geom_point()
})
Our message handler is going to be a reactive object that calls tryCatch to print(plot_object()). In other words, we're going to print the same object that we've plotted, but instead of actually displaying the plot, we're going to capture any messages, including warnings and errors, from ggplot using the elusive tryCatch(). This message handler is based on a simplified message handler that user Pork Chop came up with in this useful Stack Overflow post.
Here, we extend that concept from being able to capture one message only, to being able to capture all messages produced by ggplot, along with their timestamps and sorted by most recent.
my_messages <- reactive({
# try to print plot_object() -- this generates messages if any are produced
tryCatch({
print(plot_object())
}, message = function(m) {
# if there are no messages, then return
if (m$message == "") {
return("No messages")
# otherwise, get the message time, append it to the global
# msg_list variable, increment the msg_num counter,
# concatenate all messages into one vector, and return
# all messages sorted by most recent. The same process
# occurs for warnings and errors below.
} else {
msg_time <- paste0(Sys.time())
msg_list[[msg_time]] <<- paste0("Message ", msg_num, ": ", m$message)
msg_num <<- msg_num + 1
all_msgs <- c(msg_list,wrn_list,err_list)
return(all_msgs[rev(order(as.POSIXct(names(all_msgs))))])
}
}, warning = function(w) {
if (w$message == "") {
return("No warnings")
} else {
wrn_time <- paste0(Sys.time())
wrn_list[[wrn_time]] <<- paste0("Warning ", wrn_num, ": ", w$message)
wrn_num <<- wrn_num + 1
all_msgs <- c(msg_list,wrn_list,err_list)
return(all_msgs[rev(order(as.POSIXct(names(all_msgs))))])
}
}, error = function(e) {
if (e$message == "") {
return("No errors")
} else {
err_time <- paste0(Sys.time())
err_list[[err_time]] <<- paste0("Error ", err_num, ": ", e$message)
err_num <<- err_num + 1
all_msgs <- c(msg_list,wrn_list,err_list)
return(all_msgs[rev(order(as.POSIXct(names(all_msgs))))])
}
})
})
The my_messages reactive object tries to print the ggplot object. Using tryCatch(), it looks for messages, warnings and errors. If it finds them, appends them to a global list of messages, adds a timestamp, increments the global message counter, then returns the compiled vector of messages. We can instantiate the message lists and counter in the global environment:
# define global lists for messages,
# warnings and errors
err_list <- wrn_list <- msg_list <- list()
# define global counters for messages,
# warnings and errors
err_num <- wrn_num <- msg_num <- 1
The final piece of the puzzle is to render the plot, along with the messages.
output$my_plot <- renderPlot({
plot_object()
})
output$ggplot_messages <- renderPrint({
my_messages()
})
And there we have it. Clicking the buttons to generate either a warning or an error will append the message to the top of the verbatimTextOutput('ggplot_messages') textbox.
Final thoughts
If you're generating a bunch of messages, the textbox can start to get pretty unwieldy. A quick fix is to limit the maximum height of the output with some css. There is some great documentation on styling Shiny apps with css, and here's how I'd do it in a simple app like this one:
# limit maximum height of message box
tags$head(
tags$style(
HTML(
'
#ggplot_messages {
max-height: 200px;
}
'
)))
Check out the full code for this tutorial here.