Keeping widgets in sync with interactive plot in R Shiny

Question

I have a RShiny app where I want to be able to update an interactive plot with "interactions" like brushing over the plot ( https://shiny.rstudio.com/articles/plot-interaction.html ) and with a slider widget

The problem I have is that the brush updates the range, then the plot is drawn, then the range updates the slider, then the slider updates the plot. That means it is trying to draw the plot twice, but in worse cases, it can lead to an infinite loop too

Here is a small example code

library(shiny)

shinyApp(
    ui = fluidPage(
      titlePanel("Test"),
      sidebarLayout(
        sidebarPanel(
          p("This app can adjust plot with slider or with brush, but it plots the figure twice when the interactive brush is used. How to fix?"),
          uiOutput("sliderRange")
        ),
        mainPanel(
          plotOutput("distPlot",
            brush = brushOpts(
              id = "plot_brush",
              resetOnNew = T,
              direction = "x"
            )
          )
        )
      )
    ),
    server = function(input, output) {
        ranges <- reactiveValues(xmin = 0, xmax = 10)
        observeEvent(input$plot_brush, {
            brush <- input$plot_brush
            if (!is.null(brush)) {
                ranges$xmin <- brush$xmin
                ranges$xmax <- brush$xmax
            }
        })
        observeEvent(input$sliderRange, {
            ranges$xmin <- input$sliderRange[1]
            ranges$xmax <- input$sliderRange[2]
        })

        output$sliderRange <- renderUI({
            sliderInput("sliderRange", "Range", min = 0, max = 100, value = c(ranges$xmin, ranges$xmax), step = 0.001)
        })

        output$distPlot <- renderPlot({
            print('Plotting graph')
            s = ranges$xmin
            e = ranges$xmax
            plot(s:e)
        })
    }
)

Answer 1

the best would be to streamline the event flow by updating the slider from the brush, then the range from the slider:

shinyApp(
    ui = fluidPage(
      titlePanel("Test"),
      sidebarLayout(
        sidebarPanel(
          sliderInput("sliderRange", "Range", min = 0, max = 100, value = c(0,100))
        ),
        mainPanel(
          plotOutput("distPlot",brush = brushOpts(
                       id = "plot_brush",
                       resetOnNew = T,
                       direction = "x"
                     )
          )))),
    server = function(input, output, session) {
      ranges <- reactiveValues(xmin = 0, xmax = 10)

      observeEvent(input$plot_brush, {
        brush <- input$plot_brush
        if (!is.null(brush)) {
          updateSliderInput(session, "sliderRange", value=c(brush$xmin,brush$xmax))
        }
      })

      observeEvent(input$sliderRange, {
          ranges$xmin <- input$sliderRange[1]
          ranges$xmax <- input$sliderRange[2]
      })

      output$distPlot <- renderPlot({
        print('Plotting graph')
        s = ranges$xmin
        e = ranges$xmax
        plot(s:e)
      })
    }
  )

If this is not possible for your application, you can use this workaround to avoid re-plotting: Before updating the range from the slider, you can check if it has been modified. If it has just been modified by the brush, it will the same (or very close). Then you don't need update it again and the plot will not be drawn:

  observeEvent(input$sliderRange, {
    if(abs(ranges$xmin - input$sliderRange[1])>0.1 ||  # Compare doubles
       abs(ranges$xmax - input$sliderRange[2])>0.1)    # on small difference
      {
      ranges$xmin <- input$sliderRange[1]
      ranges$xmax <- input$sliderRange[2]
      }
  })