2

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.

I will apprecieate any help in this topic.

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

     
mattuch
  • 21
  • 3
  • Try `if (!is.null(input$selected_from_dropdown_species))` instead of `if(is.null(input$selected_from_dropdown_species)==FALSE)` – YBS Dec 17 '21 at 16:07
  • Already tried. Aswell as !='' !=NULL !=null and so on... It looks like it remembers the last selected value and it never changes to null – mattuch Dec 17 '21 at 16:20
  • There is some hint: https://github.com/rstudio/shiny/issues/559 looks like it won't go NULL. But is there any solution that could reset the list after clearing choices? – mattuch Dec 17 '21 at 21:02
  • @mattuch What is the behaviour you want from`selectInput`'s? Do you want the filters to react when the other one is pressed and update available options? And when nothing is selected show every choices? – jpdugo17 Dec 17 '21 at 21:45
  • 1
    @jpdugo17 exactly. E.g. after filtering ewoks, brown hairs should be available and vice versa. But after removing selections, all lists should be shown for select. – mattuch Dec 17 '21 at 22:23

1 Answers1

0

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"]]
)}
jpdugo17
  • 6,816
  • 2
  • 11
  • 23
  • Strangely in this solution the input values wont go NULL either but somehow it works... But is there a way to make it more fluent? So I can select multiple hair colors without refreshing hair list everytime? Now if I select one color of hair the dropdown list becomes unactive and I have to click on it again in order to add one more color. Can we make it possible to select few colors at one instance? – mattuch Dec 18 '21 at 09:56
  • please check updated syntax in my first post. This is exactly what I want to do but I need the list go default (all options available) after removing selections. You can see that the inpu$* value goes NULL but somehow filtered tables remembers last selected value. – mattuch Dec 18 '21 at 11:03
  • @mattuch While i figure out what went wrong with my code i added another solution using `shinyWidgets::`. Check my edit. – jpdugo17 Dec 18 '21 at 14:14