Shiny R:需要相互更新的两个 selectizeInput 菜单(互斥选择)

Shiny R: two selectizeInput menus that need to update each other (mutually exclusive selections)

这里是 Shiny 的新手,我有一个像下面这样的模块,我只想要 2 个 SelectizeInput 菜单,每个菜单都有相同的选项。

诀窍是它们必须相互排斥,所以我知道我必须使用 updateSelectizeInput 更新一个菜单中的 selected 选项基于 selected另一个选项。

如果我 select 一个菜单中的一个选项,则必须将其从另一个菜单中的 selected 选项中删除,反之亦然。

=13=]

我理解这里的动人部分,但我不确定将它们放在哪里以及如何最终完成它。

这是我目前拥有的:

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...附带的问题是如何使用上述内容制作一个...非常感谢!

这应该可以满足您的要求。

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

我还将输入移到了 UI,删除了 uiOutputrenderUI,因为在这种情况下不需要(我不确定代码的其他部分需要)。然后使用 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()