clc
clc

Reputation: 107

Do not update plot in modular R Shiny app until all linked inputs update

I have an R Shiny app comprised of three modules. The plot module relies on the outputs of the other two modules. Of these other two modules, the select_new_n module is affected by the select_cyl module. When the user selects a new select_cyl choice in the app, the plot is updated, but then the app realizes that the select_new_n choice is updated, so the plot is updated again. This leads to a flicker. The plot rendered on the second update is the desired result.

The desired effect is that the plot only updates once when select_cyl changes, in a way that accounts for the change in select_new_n.

I have seen some related StackOverflow questions:

How to wait for input widget updates until rendering output in Shiny?

How do I make sure that a shiny reactive plot only changes once all other reactives finish changing?

However, I am having trouble with applying this logic to an app structured modularly.

Libraries:

library(shiny)
library(ggplot2)
library(datasets)
library(bslib)
library(dplyr)

First module selects a unique cyl values from mtcars and returns that input:

module_select_cyl_ui <- function(id) {

  ns <- NS(id)

  selectizeInput(inputId = ns("select_cyl"),
                 label = "Select Cyl:",
                 choices = unique(mtcars$cyl))
}

module_select_cyl_server <- function(id) {

  moduleServer(id, function(input, output, session) {

    this_selected_cyl <- reactive({input$select_cyl})

    return(this_selected_cyl)
  })
}

Second module updates a drop down with numeric choices depending on which cyl was selected:

module_select_new_n_ui <- function(id) {

  ns <- NS(id)

  selectizeInput(inputId = ns("select_new_n"),
                 label = "Select a Number:",
                 choices = NULL)
}

module_select_new_n_server <- function(id, this_selected_cyl) {

  moduleServer(id, function(input, output, session) {

    observe({

      if (this_selected_cyl() == 4) {
        new_choices <- 1:5
      } else if (this_selected_cyl() == 6) {
        new_choices <- 6:10
      } else if (this_selected_cyl() == 8) {
        new_choices <- 11:15
      }

      updateSelectizeInput(session, "select_new_n", choices = new_choices)

    })

    this_selected_new_n <- reactive({input$select_new_n})

    return(this_selected_new_n)
  })
}

Third module generates a plot based on the returns of BOTH of the previous two modules:

module_plot_ui <- function(id) {

  ns <- NS(id)

  plotOutput(outputId = ns("plot"))
}

module_plot_server <- function(id,
                               this_selected_cyl,
                               this_selected_new_n) {

  moduleServer(id, function(input, output, session) {

    output$plot <- renderPlot({

      mtcars_cyl_subset <- mtcars %>%
        filter(cyl == this_selected_cyl())


      cars_speed_subset <- cars %>%
        filter(speed <= this_selected_new_n())

      p <- ggplot() +
        geom_histogram(aes(cyl), mtcars_cyl_subset) +
        geom_histogram(aes(speed), cars_speed_subset)

      return(p)
    })
  })
}

Main UI and Server:

ui <- nav_panel(title = "My app",
                page_sidebar(
                  module_plot_ui("input"),
                  sidebar = sidebar(
                    module_select_cyl_ui("input"),
                    module_select_new_n_ui("input")
                  )
                )
)

server <- function(input, output, session) {

  this_selected_cyl <- module_select_cyl_server("input")
  this_selected_new_n <- module_select_new_n_server("input", this_selected_cyl)

  module_plot_server("input", this_selected_cyl, this_selected_new_n)

}

shinyApp(ui, server)

Upvotes: 0

Views: 68

Answers (1)

Limey
Limey

Reputation: 12461

"The desired effect is that the plot only updates once when select_cyl changes, in a way that accounts for the change in select_new_n." - the simplest way literally to do this is to use the isolate function, which temporarily/locally, removes reactivity from a reactive object.

So, in your module_plot_server, change

cars_speed_subset <- cars %>%
  filter(speed <= this_selected_new_n())

to

isolate({
  cars_speed_subset <- cars %>%
    filter(speed <= this_selected_new_n())
})

However, I'm not sure if this is what you really want, because it will mean that the plot never updates when you change the "new N" selectInput, not just when you change the "cylinder count" selectInput and then the "new N" selectInput.

Upvotes: 0

Related Questions