Question

在我的闪亮应用程序中，我有两个SelectInput对象，其中的选项取决于两者（两个列表中可以有多个选项）。

当我与小部件A交互时，小部件B中可能存在不再适用的选项，因此我想相应地更新小部件B中的选择和选择。

有没有办法使用不触发事件的updateSelectInput更新选择和选择？换句话说，有没有办法避免使input$widgetB无效？

修改

以下示例显示了我的问题。

我使用browser()来跟踪反应链。如果Widget B只有＆＃39; X＆＃39;选中，然后小部件A应该只显示＆＃39; A＆＃39;和＆＃39; B＆＃39;作为选项（即，＆＃39; C＆＃39;不再是一种选择）。同样，如果小部件A只有C＆＃39;选中，然后小部件B应该只显示＆＃39; Y＆＃39;和＆＃39; Z＆＃39;作为选项（即，＆＃39; X＆＃39;不再是一个选项）。由于它的设置方式，反应链最终将所有选择恢复到初始集。如果updateSelectInput有一种方法可以在选项/选择发生变化时停止使相关小部件失效，我认为我不会遇到这个问题（请注意，updateSelectInput足够聪明，如果不使相关小部件无效，我们用相同的值替换了当前的选择/选择。）

我有什么想法可以达到预期的效果？

library(shiny)

ui <- fluidPage(
  selectInput(
    "WidgetA",
    label = h3("Widget A"),
    choices = c("A", "B", "C"),
    selected = c("A", "B", "C"),
    multiple = TRUE
  ), 
  selectInput(
    "WidgetB",
    label = h3("Widget B"),
    choices = c("X", "Y", "Z"),
    selected = c("X", "Y", "Z"),
    multiple = TRUE
  ),
  tableOutput("table")
)

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

  D <- data.frame(A = c("A","A","B","B","B","C","B","C","C","A"),
                  B = c("X","Y","Z","X","Y","Z","X","Y","Z","X"),
                  x = 1:10
                  )

  observeEvent(input$WidgetA,{
    # browser()

    B_choices <- unique(D$B[D$A %in% input$WidgetA])

    # Does not trigger update (i.e., it does not invalidate input$WidgetB) if choices AND selections remain the same
    updateSelectInput(session, "WidgetB", choices = B_choices, selected = B_choices)

    D_ <- D[D$A %in% input$WidgetA & D$B %in% input$WidgetB,]

    output$table <- renderTable(D_)
  })

  observeEvent(input$WidgetB,{
    # browser()

    A_choices <- unique(D$A[D$B %in% input$WidgetB])

    # Does not trigger update (i.e., it does not invalidate input$WidgetA) if choices AND selections remain the same
    updateSelectInput(session, "WidgetA", choices = A_choices, selected = A_choices)

    D_ <- D[D$A %in% input$WidgetA & D$B %in% input$WidgetB,]

    output$table <- renderTable(D_)
  })

}

shinyApp(ui = ui, server = server)

Answer 1

您可以在事物的服务器端使用renderUI来渲染selectInput，该selectInput依赖于另一个的值。然后使用uiOutput函数将您的UI添加到您的UI中：

library(shiny)

ui <- fluidPage(

  selectInput(
    "widgetA",
    label = h3("Widget A"),
    choices = c(1,2,3,4)
  ),
  uiOutput("select2")
  )

server <- function(input, output) {
   output$select2 <- renderUI({
     if(input$widgetA %in% c(1,2)) {
    selectInput(
      "WidgetB",
      label = h3("Widget B"),
      choices = c("A", "B", "C")
    ) }
    else {
      selectInput(
        "WidgetB",
        label = h3("Widget B"),
        choices = c("X", "Y", "Z")
      )
    } 
  })
}
shinyApp(ui = ui, server = server)

updateSelectInput不触发事件

1 个答案: