'Synchronise two selectizeInputs when filtering two attributes of a data frame (mulitple selection)

In my shinydashboard app I want to give the user the option to filter a data frame by alternative attributes. My data frame has an "ID" column and a "Name" column in a 1:1 relation. With two selectizeInputs the user can filter eather by the one or the other.

What I want achieve now is updating the other selectizeInput when selecting items in one of them. So both selectizeInputs show the corresponding items of the data frame. I managed to solve this, as long as I restrict the selection to a single item, but not with a multiple selection.

The following minimum code is the closest I could get so far, but it does not allow multiple selection. Obviousely due to a kind of deadlock situation where the first item selected causes the other seletizeInput to filter the same element which automatically updates the first selectizeInput again to this single item.

library(shiny)
library(shinydashboard)
library(tidyverse)

ui <- dashboardPage(
  dashboardHeader(title = 'Test alternative select') ,
  
  dashboardSidebar(
    sidebar <- dashboardSidebar(
      sidebarMenu(
              selectizeInput(inputId = 'id' ,
                             label = 'ID' ,
                             choices = NULL ,
                             selected = NULL ,
                             multiple = TRUE ,
                             options = list(plugins = list('remove_button'))) ,
              selectizeInput(inputId = 'name' ,
                             label = 'Name' ,
                             choices = NULL ,
                             selected = NULL ,
                             multiple = TRUE ,
                             options = list(plugins = list('remove_button')))
        ))) ,
  
  dashboardBody()
)
  
  server <- function(input, output , session) {
    
    data <- tribble(
      ~ID , ~Name ,
      '1' , 'France' ,
      '2' , 'Italy' ,
      '3' , 'Germany' ,
      '4' , 'Spain' ,
      '5' , 'Portugal'
    )
    
    observe({
      if (is.null(input$id)) {
        updateSelectizeInput(session = session ,
                             inputId = 'name' ,
                             choices = data$Name ,
                             options = list(plugins= list('remove_button')))
      } else {
        choices <- data %>%
          filter(ID %in% input$id) %>%
          pull(Name)
        
        updateSelectizeInput(session = session ,
                             inputId = 'name' ,
                             choices = choices ,
                             selected = choices ,
                             options = list(plugins= list('remove_button')))
      }
    })
    
    observe({
      if (is.null(input$name)) {
        updateSelectizeInput(session = session ,
                             inputId = 'id' ,
                             choices = data$ID ,
                             options = list(plugins= list('remove_button')))
      } else {
        choices <- data %>%
          filter(Name %in% input$name) %>%
          pull(ID)
        
        updateSelectizeInput(session = session ,
                             inputId = 'id' ,
                             choices = choices ,
                             selected = choices ,
                             options = list(plugins= list('remove_button')))
      }
    })
  }
  
  shinyApp(ui, server)

I'm not sure if this can be solved this way at all, but if "yes", I probably have to use "isolate" somehow. But I can't figure it out.

r shiny shinydashboard

Solution 1:^[1]

Perhaps you are looking for this

server <- function(input, output , session) {
  data <- tribble(
    ~ID , ~Name ,
    '1' , 'France' ,
    '2' , 'Italy' ,
    '3' , 'Germany' ,
    '4' , 'Spain' ,
    '5' , 'Portugal'
  )
  
  observeEvent(input$id, {
    if (is.null(input$id)) {
      updateSelectizeInput(session , 'name' , choices = data$Name , selected = NULL)
    } else{
      sel <- data %>% filter(ID %in% input$id) %>% pull('Name')
      updateSelectizeInput(session , 'name' , selected = isolate(sel))
    }
    print(input$id)
  }, ignoreNULL = FALSE)
  
  observeEvent(input$name, {
    if (is.null(input$name)) {
      updateSelectizeInput(session , 'id' , choices = data$ID , selected = NULL)
    } else {
      sel <- data %>% filter(Name %in% input$name) %>% pull('ID')
      updateSelectizeInput(session , 'id' , selected =isolate(sel))
    }
    
  }, ignoreNULL = FALSE)
  
}

Solution 2:^[2]

After some try and errors I found a solution with the following changes to my code. Essentially I used observeEvent instead of observe.

I tried the hint from kenshuri with freezeReactiveValue()(thanks for that), but it didn't help or made it even worse.

The following solution does, what I want to achieve. Only remainig issue: when deleting all items in one box the last one remains in the other box. But I can live with that.

library(shiny)
library(shinydashboard)
library(tidyverse)


ui <- dashboardPage(
  dashboardHeader(title = 'Test alternative select') ,
  
  dashboardSidebar(
    sidebar <- dashboardSidebar(
      sidebarMenu(
        selectizeInput(inputId = 'id' ,
                       label = 'ID' ,
                       choices = NULL ,
                       selected = NULL ,
                       multiple = TRUE ,
                       options = list(plugins = list('remove_button'))) ,
        selectizeInput(inputId = 'name' ,
                       label = 'Name' ,
                       choices = NULL ,
                       selected = NULL ,
                       multiple = TRUE ,
                       options = list(plugins = list('remove_button')))
      ))) ,
  
  dashboardBody()
)

server <- function(input, output , session) {
  data <- tribble(
    ~ID , ~Name ,
    '1' , 'France' ,
    '2' , 'Italy' ,
    '3' , 'Germany' ,
    '4' , 'Spain' ,
    '5' , 'Portugal'
  )
  
  observe({
    if (is.null(input$id) & is.null(input$name)) {
      updateSelectizeInput(session , 'name' , choices = data$Name , selected = NULL)
      
      updateSelectizeInput(session , 'id' , choices = data$ID , selected = NULL)
    }
  })
  
  observeEvent(input$id, {
      sel <- data %>% filter(ID %in% input$id) %>% pull('Name')
      updateSelectizeInput(session , 'name' , selected = isolate(sel))
  })
  
  observeEvent(input$name, {
      sel <- data %>% filter(Name %in% input$name) %>% pull('ID')
      updateSelectizeInput(session , 'id' , selected =isolate(sel))
  })

}

shinyApp(ui, server)

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution	Source
Solution 1	YBS
Solution 2	bthebread

'Synchronise two selectizeInputs when filtering two attributes of a data frame (mulitple selection)

Solution 1:[1]

Solution 2:[2]

Sources

Related Questions

Solution 1:^[1]

Solution 2:^[2]