Search code examples
rshinyselectize.jsmultipleselectionselectinput

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


Very new to Shiny here, I have a module like the one below where I just want 2 SelectizeInput menus with the same options each.

The trick is that they have to be mutually exclusive, so I understand I have to use updateSelectizeInput to update the selected options in one menu based on the selected options in the other.

This should work in such a way that if I select one option in one menu, it has to be removed from the selected options in the other menu, and vice versa.

I understand the moving pieces here, but I am not sure where to place them and how to finally accomplish this.

This is what I have so far:

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

Not sure if this is a standalone MWE... a side question would be how to make one with the above... Many thanks!


Solution

  • This should do what you asked.

    I removed the extra calls to shinyjs and shinyalert and added call to library(shiny) to make it a MWE. I removed the argument r to the server call.

    I've also moved the input to the UI, removed the uiOutput and renderUI as it wasn't needed in this case (I'm not sure if the are needed for other parts of your code). Then taking setdiff of the options gives you the new set to update the selectizeInput with.

    I've also added code at the bottom to run and test the app.

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