在所有链接的输入更新之前，不要更新模块化 R Shiny 应用程序中的绘图

Question

我有一个由三个模块组成的 R Shiny 应用程序。

plot

模块依赖于其他两个模块的输出。在这另外两个模块中，

select_new_n

模块受

select_cyl

模块的影响。当用户在应用程序中选择新的

select_cyl

选项时，绘图会更新，但随后应用程序意识到

select_new_n

选择已更新，因此绘图会再次更新。这会导致闪烁。第二次更新时渲染的图是所需的结果。

期望的效果是，当

select_cyl

发生变化时，绘图仅更新一次，从而解释

select_new_n

的变化。

我看到了一些相关的StackOverflow问题：

如何等待输入小部件更新，直到在 Shiny 中渲染输出？

如何确保闪亮的反应图仅在所有其他反应完成更改后才发生变化？

但是，我无法将此逻辑应用于模块化结构的应用程序。

图书馆：

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

第一个模块从 mtcars 中选择唯一的

cyl

值并返回该输入：

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)
  })
}

第二个模块根据选择的

cyl

更新带有数字选项的下拉菜单：

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)
  })
}

第三个模块根据前两个模块的回报生成一个图：

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)
    })
  })
}

主界面和服务器：

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)

Answer 1

“期望的效果是，当 select_cyl 发生变化时，绘图仅更新一次，从而解释 select_new_n 的变化。” - 字面上执行此操作的最简单方法是使用

isolate

函数，该函数临时/局部地从反应性对象中删除反应性。

SS所以，在你的

module_plot_server

，改变

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

到

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

但是，我不确定这是否是您真正想要的，因为这意味着当您更改“新 N”selectInput时，绘图

永远不会更新，而不仅仅是当您更改“气缸数”时

selectInput

，然后是“新 N”

selectInput

。