rggplot2shinyreactivebrush

Preventing double call to brush reactive in shiny?


I am using a brushed histogram to query samples in a shiny app. In my full application, I overlay a new histogram that highlights the selected region and update a DT data table showing properties of the filtered samples.

I've noticed that a reactive that depends on the brush gets called twice each time I move it. For example, the table_data reactive below gets called twice each time I brush the histogram.

app.R

library(ggplot2)
library(shiny)

df <- data.frame(x = rnorm(1000))
base_histogram <- ggplot(df, aes(x)) +
    geom_histogram(bins = 30)

# Define UI for application that draws a histogram
ui <- fluidPage(
    column(
      plotOutput("histogram", brush = brushOpts(direction = "x", id = "brush", delay=500, delayType = "debounce")),
      width = 6
    )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
    output$histogram <- renderPlot({
        p <- base_histogram
        
        current <- table_data()
        if (nrow(current) > 0) {
            p <- p + geom_histogram(data = current, fill = "red", bins = 30)
        }

        p
    })
    
    table_data <- reactive({
        print("called")
        brushedPoints(df, input$brush)
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

In this toy example, it's barely noticeable. But in my full app, a heavy calculation has to be done within the table_data reactive, and this the double call is unnecessarily slowing everything down.

Is there any way to structure the app so that the reactive only executes once whenever a brush is ended?


Here is a GIF that shows that the table_data is being executed twice per brush.

enter image description here


Solution

  • try this, only trigger once on each brush movement.

    library(ggplot2)
    library(shiny)
    
    df <- data.frame(x = rnorm(1000))
    base_histogram <- ggplot(df, aes(x)) +
        geom_histogram(bins = 30)
    
    # Define UI for application that draws a histogram
    ui <- fluidPage(
        column(
            plotOutput("histogram", brush = brushOpts(direction = "x", id = "brush", delay=500, delayType = "debounce")),
            width = 6
        )
    )
    
    # Define server logic required to draw a histogram
    server <- function(input, output) {
        output$histogram <- renderPlot({
            p <- base_histogram
            
            if(!is.null(table_data())) {
                p <- p + geom_histogram(data = table_data(), fill = "red", bins = 30)
            }
            p
        })
        
        table_data <- reactive({
            if(is.null(input$brush)) return()
            print("called")
            brushedPoints(df, input$brush)
        })
    }
    
    shinyApp(ui, server)