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