Update UI prior to ggvis plot in R Shiny - r

Question

Background: I'm building a dashboard that interfaces with a MySQL database. The user specifies a coarse filter to pull data from the database and clicks "Submit", the data are plotted with ggvis, then the user is able to play with fine filters to affect what subset of data are plotted. These fine filters depend on the data pulled from the database, therefore I generate them from the data using uiOutput/renderUI.
Problem: My challenge is that I want the UI to be updated based on the data before the plot is updated. Otherwise the fine filters from the old dataset are applied to the new data, which results in an error when plotting.
Example: The following example roughly reproduces the problem using mtcars. To get the error, select 4 cylinders, click "Submit", then select 6 cylinders and click "Submit" again. In this case, when the 4 cylinder fine filter is applied to the 6 cylinder dataset only a single point is returned, which causes an error when trying to apply a smoother in ggvis. Not the same error as I'm getting, but close enough.
library(shiny)
library(dplyr)
library(ggvis)
ui <- fluidPage(
headerPanel("Example"),
sidebarPanel(
h2("Course Filter:"),
selectInput("cyl_input", "Cylinders", c(4, 6)),
actionButton("submit", "Submit"),
conditionalPanel(condition = "input.submit > 0",
h2("Fine Filter: "),
uiOutput("mpg_input")
)
),
mainPanel(
ggvisOutput("mtcars_plot")
)
)
server <- function(input, output) {
mycars <- eventReactive(input$submit, {
filter(mtcars, cyl == input$cyl_input)
})
output$mpg_input <- renderUI({
mpg_range <- range(mycars()$mpg)
sliderInput("mpg_input", "MPG: ",
min = mpg_range[1], max = mpg_range[2],
value = mpg_range,
step = 0.1)
})
observe({
if (!is.null(input$mpg_input)) {
mycars() %>%
filter(mpg >= input$mpg_input[1],
mpg <= input$mpg_input[2]) %>%
ggvis(~mpg, ~wt) %>%
layer_points() %>%
layer_smooths() %>%
bind_shiny("mtcars_plot")
}
})
}
shinyApp(ui = ui, server = server)

Answer 1

After many hours of messing around, I've found a very hacky workaround. I'm not very satisfied with it, so am hoping someone can offer an improvement.
To summarize, my realization was that the renderUI call was being executed when it was supposed to be, i.e. prior to the plot being generated. However, renderUI doesn't directly change the slider in the UI, rather it sends a message to the browser telling it to update the slider. Such messages are only executed once all observers have been run. In particular, this happens after the observer wrapping the call to ggvis is run. So, the sequence seems to be
Message sent to browser to update slider.
Plot generated based on values in slider, which are still the old values.
Browser updates slider. Sadly too late :(
So, to work around this I decided to create a new reactive variable storing the range of MPG values. Immediately after the coarse filter has been applied, and before the slider is updated in the browser, this variable references the new data frame directly. Afterwards, when playing with the slider directly, this reactive variable references the slider. This just requires setting a flag specifying whether to reference the data frame or the slider, then flipping the flag in a sensible location.
Here's the code:
library(shiny)
library(dplyr)
library(ggvis)
ui <- fluidPage(
headerPanel("Example"),
sidebarPanel(
h2("Course Filter:"),
selectInput("cyl_input", "Cylinders", c(4, 6)),
actionButton("submit", "Submit"),
conditionalPanel(condition = "input.submit > 0",
h2("Fine Filter: "),
uiOutput("mpg_input")
)
),
mainPanel(
ggvisOutput("mtcars_plot")
)
)
server <- function(input, output) {
# create variable to keep track of whether data was just updated
fresh_data <- TRUE
mycars <- eventReactive(input$submit, {
# data have just been refreshed
fresh_data <<- TRUE
filter(mtcars, cyl == input$cyl_input)
})
output$mpg_input <- renderUI({
mpgs <- range(mycars()$mpg)
sliderInput("mpg_input", "MPG: ",
min = mpgs[1], max = mpgs[2],
value = mpgs,
step = 0.1)
})
# make filtering criterion a reactive expression
# required because web page inputs not updated until after everything else
mpg_range <- reactive({
# these next two lines are required though them seem to do nothing
# from what I can tell they ensure that mpg_range depends reactively on
# these variables. Apparently, the reference to these variables in the
# if statement is not enough.
input$mpg_input
mycars()
# if new data have just been pulled reference data frame directly
if (fresh_data) {
mpgs <- range(mycars()$mpg)
# otherwise reference web inputs
} else if (!is.null(input$mpg_input)) {
mpgs <- input$mpg_input
} else {
mpgs <- NULL
}
return(mpgs)
})
observe({
if (!is.null(mpg_range())) {
mycars() %>%
filter(mpg >= mpg_range()[1],
mpg <= mpg_range()[2]) %>%
ggvis(~mpg, ~wt) %>%
layer_points() %>%
layer_smooths() %>%
bind_shiny("mtcars_plot")
}
# ui now updated, data no longer fresh
fresh_data <<- FALSE
})
}
shinyApp(ui = ui, server = server)