Creating two corresponding selecInput lists (input$* after removing selections never goes null)

Question

I am trying to create two corresponding selectInput lists. To do so I made two uiOutput in ui attached to renderUI in server. The renderUIs are linked to reactiveValues which should change according to input$* values.

And it does work until one point. The selection list is shrinking and can't go back to default (while in my opinion it should, based on second line of observeEvent).

I have a feeling that no matter what the input$* values are never null so the is.null() won't work.

if (interactive()) {
library(dplyr)
library(shiny)
library(shinydashboard)
library(plotly)
library(DT)
library(tidyr)

ui <-  fluidPage(
 sidebarLayout(
   sidebarPanel(
     uiOutput('hair_filter'),
     uiOutput('species_filter')
   ),
   mainPanel(        tableOutput('hairs'),
                     tableOutput('species'),
                     textOutput('text'),
                     textOutput('text2'),
                     tableOutput('hairfiltertable'),
                     tableOutput('speciesfiltertable')
   )
 ))


server <- function(input, output, session){
 
 
 
 starwars_full <- starwars %>% 
   as.data.frame() %>% 
   tibble::rownames_to_column(var = 'ID') %>%
   transform(ID=as.numeric(ID), height=as.numeric(height), mass=as.numeric(mass), birth_year=as.numeric(birth_year)) %>%
   group_by(ID, name, height,mass,hair_color, skin_color, eye_color, birth_year,sex,homeworld,species, films, vehicles, starships) %>% 
   summarise('cnt_films'=lengths(films),'cnt_vehicles'=lengths(vehicles),'cnt_ships'=lengths(starships)) 
 
 
 #creating list of hair colors based on selected species
 rv3 <- reactiveValues(hair_list = starwars_full %>% 
                         separate_rows(hair_color,sep=", ") %>% 
                         arrange(hair_color) %>% 
                         as.data.frame() %>% 
                         select(hair_color,species, name) %>% 
                         distinct()
 )
 
 observeEvent(input$selected_from_dropdown_species,{
   if(isTruthy(input$selected_from_dropdown_species))
   {
     rv3$hair_list <- starwars_full %>% 
       separate_rows(hair_color,sep=", ") %>% 
       arrange(hair_color) %>% 
       as.data.frame() %>% 
       select(hair_color,species, name) %>% 
       distinct() %>%
       filter(species %in% input$selected_from_dropdown_species)
     
     rv6$selected_species <- input$selected_from_dropdown_species
   }
   else
   {
     rv3$hair_list <- starwars_full %>% 
       separate_rows(hair_color,sep=", ") %>% 
       arrange(hair_color) %>% 
       as.data.frame() %>% 
       select(hair_color,species, name) %>% 
       distinct() 
     
     rv6$selected_species <- NULL
   }
 })
 
 #creating species list, based on selected hair colors
 rv4 <- reactiveValues(specie_list = starwars_full %>% 
                         separate_rows(species,sep=", ") %>% 
                         arrange(species) %>% as.data.frame() %>% 
                         select(hair_color,species, name) %>% 
                         distinct()
 )
 
 observeEvent(input$selected_from_dropdown_color,{
   if(isTruthy(input$selected_from_dropdown_color))
   {
     rv4$specie_list <- starwars_full %>% 
       separate_rows(species,sep=", ") %>% 
       arrange(species) %>% as.data.frame() %>% 
       select(hair_color,species, name) %>% 
       distinct() %>% 
       filter(hair_color %in% input$selected_from_dropdown_color)
     
     rv5$selected_colors <- input$selected_from_dropdown_color
   }
   else
   {
     rv4$specie_list <- starwars_full %>% 
       separate_rows(species,sep=", ") %>% 
       arrange(species) %>% as.data.frame() %>% 
       select(hair_color,species, name) %>% 
       distinct() 
     
     rv5$selected_colors <- NULL
   }
 })
 
 rv5 <- reactiveValues(selected_colors = NULL)
 rv6 <- reactiveValues(selected_species = NULL)
 
 #selecinput of hair color
 output$hair_filter = renderUI({
   selectInput("selected_from_dropdown_color",
               label ="Hair colors:",
               choices=rv3$hair_list$hair_color, 
               multiple=TRUE,
               selected=isolate(rv5$selected_colors))
 })
 
 #selectinput for species
 output$species_filter = renderUI({
   selectInput("selected_from_dropdown_species",
               label ="Species",
               choices=rv4$specie_list$species, 
               multiple=TRUE,
               selected=isolate(rv6$selected_species))
   
 })
 
 output$hairs = renderTable({input$selected_from_dropdown_color})
 output$species = renderTable({input$selected_from_dropdown_species})
 output$text = renderPrint({print(input$selected_from_dropdown_color)})
 output$text2 = renderPrint({print(input$selected_from_dropdown_species)})
 output$hairfiltertable = renderTable({rv3$hair_list})
 output$speciesfiltertable = renderTable({rv4$specie_list})
 
}

shinyApp(ui,server)
}

     

Answer 1

Edit:

We can use selectizeGroup from shinyWidgets to achieve the desired behaviour.

library(tidyverse)
library(shiny)
library(shinydashboard)
library(plotly)
library(DT)
library(tidyr)
library(shinyWidgets)


starwars_full <- starwars %>%
  as.data.frame() %>%
  rownames_to_column(var = "ID") %>%
  transform(ID = as.numeric(ID), height = as.numeric(height), mass = as.numeric(mass), birth_year = as.numeric(birth_year)) %>%
  group_by(ID, name, height, mass, hair_color, skin_color, eye_color, birth_year, sex, homeworld, species, films, vehicles, starships) %>%
  summarise("cnt_films" = lengths(films), "cnt_vehicles" = lengths(vehicles), "cnt_ships" = lengths(starships))


starwars_species_hair <- starwars_full %>%
  separate_rows(hair_color, sep = ", ") %>%
  separate_rows(species, sep = ", ") %>%
  select(hair_color, species, name)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectizeGroupUI(
        id = "my-filters",
        params = list(
          hair_color = list(inputId = "hair_color", title = "Hair color:"),
          species = list(inputId = "species", title = "Species:")
        )
      )
    ),
    mainPanel(DTOutput("resulting_table"))
  )
)



server <- function(input, output, session) {
  res_mod <- callModule(
    module = selectizeGroupServer,
    id = "my-filters",
    data = starwars_species_hair,
    vars = c("hair_color", "species")
  )

  output$resulting_table <- renderDT({
    req(res_mod)
    datatable(res_mod())
  })
}

shinyApp(ui, server)

We can access selected values inside a reactive/observer by:

observe({
 input[["my-filters-hair_color"]]
 input[["my-filters-species"]]
)}