Shiny R：需要相互更新的两个 selectizeInput 菜单（互斥选择）

Question

这里对 Shiny 来说非常新，我有一个类似下面的模块，我只想要 2 个 SelectizeInput 菜单，每个菜单都有相同的选项。

诀窍是它们必须是互斥的，所以我知道我必须使用 updateSelectizeInput 根据另一个菜单中的选定选项来更新一个菜单中的选定选项。

这应该以这样的方式工作，如果我在一个菜单中选择一个选项，它必须从另一个菜单中的选定选项中删除，反之亦然。

我了解这里的活动部分，但我不确定将它们放置在哪里以及如何最终完成。

这是我目前所拥有的：

mod_saving_side_ui <- function(id){
  ns <- NS(id)
  tagList(
    shinyjs::useShinyjs(),
    shinyalert::useShinyalert(),

    uiOutput(outputId = ns("positive_markers")),
    uiOutput(outputId = ns("negative_markers"))
 
  )
}


mod_saving_side_server <- function(id, r){
  moduleServer( id, function(input, output, session){
    ns <- session$ns
 
    output$positive_markers <- renderUI({
      selectizeInput(inputId = ns("pos_markers"), label = "Positive:",
                     choices = LETTERS
                     selected = LETTERS[1],
                     multiple = TRUE)
    })
 
    output$negative_markers <- renderUI({
      selectizeInput(inputId = ns("neg_markers"), label = "Negative:",
                     choices = LETTERS,
                     selected = LETTERS[2],
                     multiple = TRUE)
    })

    # add selected markers to the reactive values
    observeEvent(input$pos_markers, {
      r$pos_markers <- input$pos_markers
      #selected_markers <- ALL EXCEPT pos_markers
      #updateSelectizeInput(session, inputId = "neg_markers", selected = selected_markers)
    })
    observeEvent(input$neg_markers , {
      r$neg_markers <- input$neg_markers
      #selected_markers <- ALL EXCEPT neg_markers
      #updateSelectizeInput(session, inputId = "pos_markers", selected = selected_markers)
    })
    
  })
}

不确定这是否是一个独立的 MWE...一个附带问题是如何使用上述内容制作一个...非常感谢！

Answer 1

这应该满足你的要求。

我删除了对 shinyjs 和 shinyalert 的额外调用，并添加了对 library(shiny) 的调用以使其成为 MWE。我删除了参数r 到服务器调用。

我还将输入移至 UI，删除了 uiOutput 和 renderUI，因为在这种情况下不需要（我不确定代码的其他部分是否需要）。然后采用setdiff 的选项为您提供用于更新selectizeInput 的新设置。

我还在底部添加了代码来运行和测试应用程序。

library(shiny)


mod_saving_side_ui <- function(id){
  ns <- NS(id)
  tagList(
    selectizeInput(inputId = ns("pos_markers"), label = "Positive:",
                   choices = LETTERS,
                   selected = LETTERS[1],
                   multiple = TRUE),
    selectizeInput(inputId = ns("neg_markers"), label = "Negative:",
                   choices = LETTERS,
                   selected = LETTERS[2],
                   multiple = TRUE)
    
  )
}


mod_saving_side_server <- function(id){
  moduleServer(id, function(input, output, session){
    ns <- session$ns

    # add selected markers to the reactive values
    observeEvent(input$neg_markers, {
      selected_pos_markers <- input$pos_markers
      selected_markers <- setdiff(selected_pos_markers, input$neg_markers)
      updateSelectizeInput(session, inputId = "pos_markers", selected = selected_markers)
    })
    observeEvent(input$pos_markers , {
      selected_neg_markers <- input$neg_markers
      selected_markers <- setdiff(selected_neg_markers, input$pos_markers)
      updateSelectizeInput(session, inputId = "neg_markers", selected = selected_markers)
    })
    
  })
}

demoApp <- function() {
  ui <- fluidPage(
    mod_saving_side_ui("demo")
  )
  server <- function(input, output, session) {
    mod_saving_side_server("demo")
  }
  shinyApp(ui, server)  
}

demoApp()