Preventing double call to brush reactive in shiny? - r

Question

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.

Answer 1

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)