Connecting Plot with DT and SelectInput Causes Plot to Refresh Twice

[DaveRosenman]

The plot in the app below refreshes twice when a user selects a value in the input 'name'.

This is because the data the plot uses depends on both input$name and the rows that are currently displayed in the DT. The reason I have the plot data linked to the rows in the DT is I want the plot to update when the user filters the DT. But I'd like to do it in a way where the plot doesn't refresh multiple times when a user selects an option from the select input.

Anyone know what I can do so that the plot is linked to both the selectInput and the DT but only refreshes once when a user makes a change?

library(dplyr)

library(DT)

library(shiny)

iris_list <- replicate(200, iris, simplify = FALSE)

 

# Merge the iris datasets together

iris <- do.call(rbind, iris_list) %>%

  mutate(Name = as.factor(sample(c("A", "B", "C"), size = 30000, replace = TRUE)))

 



ui <- fluidPage(

 

    # Application title

    titlePanel("Example"),

 

 

    sidebarLayout(

        sidebarPanel(

           selectInput("name", "Name", choices = sort(unique(iris$Name)))

        ),

 

        

        mainPanel(

          plotOutput("plot"),

           DT::DTOutput("iris_table")

          

        )

    )

)

 


server <- function(input, output) {

  iris_data <- reactive({

    iris %>% filter(Name == input$name)

  })

 

  output$iris_table <- DT::renderDT(datatable(iris_data(), options = list(dom = "ft", pageLength = 10000),

                                    filter = "top"))

 

  plot_data <- reactive({

    iris_data()[input$iris_table_rows_current,]

  })

 

  output$plot <- renderPlot(plot(plot_data()$Sepal.Length, plot_data()$Sepal.Width))

 

   

}

 

# Run the application

shinyApp(ui = ui, server = server)

[scottyd22]

Welcome to the community @DaveRosenman. Below is one approach I believe addresses the "double rendering" you described. In the server code you provided, I changed plot_data from a reactive to a reactiveValue, which gets updated via an observeEvent() any time the current rows in the table are changed. Before, plot_data would update when the selectInput was changed and again after the DT table was refreshed due to current rows changing. This approach ensures the table only updates once (i.e. after current rows are changed).

server <- function(input, output) {
  
  iris_data <- reactive({
    iris %>% filter(Name == input$name)
  })
  
  output$iris_table <- DT::renderDT(
    datatable(iris_data(), 
              options = list(dom = "ft", pageLength = 10000),
              filter = "top")
    )
  
  
  plot_data = reactiveValues(d = NULL)
  
  observeEvent(input$iris_table_rows_current, {
    plot_data$d <<- iris_data()[input$iris_table_rows_current,]
  })
  
  output$plot <- renderPlot({
    plot(plot_data$d$Sepal.Length, 
         plot_data$d$Sepal.Width)
    })
  
}