Preventing double call to brush reactive in shiny?-CodePudding

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.

CodePudding user response：

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)