在R Shiny中的ggvis绘图之前更新UI

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, ie 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

1. Message sent to browser to update slider.
2. Plot generated based on values in slider, which are still the old values.
3. 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)