Change input values based on another input r shiny

Question

In the server function I have observe sinppet in which the plot and datatable output dependent variables are there which filter the data based on input variables.

Now the output plot and datatable are working fine and as expected but I want the other dropdown inputs to react when I change any value in any other pickerinputs.

If I include renderUI in the observe then everything breaks since at initialization every other input is null so filter data returns No records.

Do I have to write observeEvent function for each input and update every other input? or there is another way to do it?

In the end I want the pickerinputs to work like slicers in Excel.

server <- function(input, output) {
  
  observe({

#filter data
bData <- dplyr::filter(bData, Crncy %in% input$selCrncy)
bData <- dplyr::filter(bData, bData$`AXE?` %in% input$selAxe)
bData <- dplyr::filter(bData, bData$`Owned?` %in% input$selOwned)
bData <- dplyr::filter(bData, bData$Floater %in% input$selFloater)
bData <- dplyr::filter(bData, bData$`Collateral Type` %in% input$selCollateralType)
bData <- dplyr::filter(bData, bData$`Maturity Type` %in% input$selMaturityType)
bData <- dplyr::filter(bData, bData$`Issuer Name` %in% input$selIssuerName)
bData <- dplyr::filter(bData, bData$Sector %in% input$selSector)
bData <- subset(bData, bData$MatYear >= input$dtrng[1] &  bData$MatYear <= input$dtrng[2])



 #Scatter Plot
    output$OPlot<-renderPlotly({
      
      p <- plot_ly(data = bData,  x = ~`Maturity Date`, y =  ~YVal,  type = 'scatter', mode='markers', 
              color = ~Crncy, colors = setNames(rainbow(nrow(bData)), bData$Crncy),
              marker = list(opacity = 0.7, size=12) ,
              text = ~paste(" Security: ", bData$Security, "<br>",
                            "Currency: ", bData$Crncy, "<br>",
                            "YTM: ", bData$YTM,"<br>",
                            "DM: ", bData$DM)) %>% 
        layout(xaxis = list(title="Maturity"), 
               yaxis = list(title="FRN: DM | Fixed: YAS ASW USD")) %>% 
        add_markers(symbol = ~factor(bData$Sym),color = I("black"), marker = list( opacity = 1, size=6))
      
        
        #add_markers(symbol = ~factor(bData$Sym),symbols = c('circle-open','x-open','diamond-open'),color = I("black"), marker = list( opacity = 1, size=9))

    })
    
    #Data table output
    output$datatbl = DT::renderDataTable(
      bData,
      options = list(scrollX = TRUE)
    )
    
    
  })
  

  output$dateUIOP <- renderUI({

    sliderInput("dtrng", "Year Range:",
                min=min(bData$MatYear), max=max(bData$MatYear),
                value = c(min(bData$MatYear),max=max(bData$MatYear))
                )
  
  })
  
  output$selCrncyUIOP <- renderUI({
    
    pickerInput("selCrncy","Currency", choices=unique(bData$Crncy),
                selected = unique(bData$Crncy),
                options = list(`actions-box` = TRUE),multiple = T)
    
  })
  
  output$selAxeUIOP <- renderUI({
    
    pickerInput("selAxe","Axe?", choices=unique(bData$`AXE?`),
                selected = unique(bData$`AXE?`),
                options = list(`actions-box` = TRUE),multiple = T)
    
  })

Answer 1

The OP said they want Excel-style slicers, which are also like List Boxes in QlikView. These allow the user to filter data that appears in the rest of the app, but also react to the selections from other filters. I thought it was an interesting challenge and so I made the following prototype.

library(tidyverse)
library(shiny)
library(reactable)

my_mpg <- mpg %>% 
  mutate(across(c(manufacturer, class, cyl), ~factor(., ordered = TRUE)))

ui <- fluidPage(
  fluidRow(
    column(4, reactableOutput("manufacturer_slicer")),
    column(4, reactableOutput("class_slicer")),
    column(4, reactableOutput("cyl_slicer"))
  ),
    plotOutput("scatterplot")
)

server <- function(input, output, session){
  user_selections <- reactiveValues(manufacturer = levels(my_mpg$manufacturer),
                                    class = levels(my_mpg$class),
                                    cyl = levels(my_mpg$cyl))
  
  output$manufacturer_slicer <- renderReactable({
    my_mpg %>% 
      group_by(manufacturer) %>% 
      summarize(`# Rows` = n(),
                `Total cty` = sum(cty), .groups = "drop") %>% 
      arrange(manufacturer) %>% 
      reactable(sortable = TRUE, searchable = TRUE, compact = TRUE, highlight = TRUE,
                selection = "multiple", onClick = "select", defaultSelected = 1:length(levels(my_mpg$manufacturer)))
  })
  
  output$class_slicer <- renderReactable({
    my_mpg %>% 
      group_by(class) %>% 
      summarize(`# Rows` = n(),
                `Total cty` = sum(cty), .groups = "drop") %>% 
      reactable(sortable = TRUE, searchable = TRUE, compact = TRUE, highlight = TRUE,
                selection = "multiple", onClick = "select", defaultSelected = 1:length(levels(my_mpg$class)))
  })
  
  output$cyl_slicer <- renderReactable({
    my_mpg %>% 
      group_by(cyl) %>% 
      summarize(`# Rows` = n(),
                `Total cty` = sum(cty), .groups = "drop") %>% 
      reactable(sortable = TRUE, searchable = TRUE, compact = TRUE, highlight = TRUE,
                selection = "multiple", onClick = "select", defaultSelected = 1:length(levels(my_mpg$cyl)))
  })
  
  observeEvent(getReactableState("manufacturer_slicer", "selected"), priority = 20, {
    user_selections$manufacturer <- levels(my_mpg$manufacturer)[getReactableState("manufacturer_slicer", "selected")]
  })
  
  observeEvent(getReactableState("class_slicer", "selected"), priority = 20, {
    user_selections$class <- levels(my_mpg$class)[getReactableState("class_slicer", "selected")]
  })
  
  observeEvent(getReactableState("cyl_slicer", "selected"), priority = 20, {
    user_selections$cyl <- levels(my_mpg$cyl)[getReactableState("cyl_slicer", "selected")]
  })
  
  filtered_data <- reactive({
    my_mpg %>% 
      filter(manufacturer %in% user_selections$manufacturer,
             class %in% user_selections$class,
             cyl %in% user_selections$cyl)
  })
  
  output$scatterplot <- renderPlot({
    filtered_data() %>% 
      ggplot(aes(x=displ, y = hwy)) +
      geom_point()
  })
  
  observeEvent(filtered_data(), priority = 10, {
    req(filtered_data())
    
    new_manufacturer_data <- filtered_data() %>% 
      group_by(manufacturer) %>% 
      summarize(`# Rows` = n(),
                `Total cty` = sum(cty), .groups = "drop") %>% 
      complete(manufacturer, fill = list(`# Rows` = 0, `Total cty` = 0)) %>% 
      arrange(manufacturer)
    
    new_manufacturer_selected <- which(new_manufacturer_data$manufacturer %in% user_selections$manufacturer)
    
    new_manufacturer_page = getReactableState("manufacturer_slicer", "page")
    
    new_class_data <- filtered_data() %>% 
      group_by(class) %>% 
      summarize(`# Rows` = n(),
                `Total cty` = sum(cty), .groups = "drop") %>% 
      complete(class, fill = list(`# Rows` = 0, `Total cty` = 0)) %>% 
      arrange(class)
    
    new_class_selected <- which(new_class_data$class %in% user_selections$class)
    
    new_class_page = getReactableState("class_slicer", "page")
    
    new_cyl_data <- filtered_data() %>% 
      group_by(cyl) %>% 
      summarize(`# Rows` = n(),
                `Total cty` = sum(cty), .groups = "drop") %>% 
      complete(cyl, fill = list(`# Rows` = 0, `Total cty` = 0)) %>% 
      arrange(cyl)
    
    new_cyl_selected <- which(new_cyl_data$cyl %in% user_selections$cyl)
    
    new_cyl_page = getReactableState("cyl_slicer", "page")
    
    updateReactable("manufacturer_slicer", data = new_manufacturer_data, selected = new_manufacturer_selected, page = new_manufacturer_page)
    updateReactable("class_slicer", data = new_class_data, selected = new_class_selected, page = new_class_page)
    updateReactable("cyl_slicer", data = new_cyl_data, selected = new_cyl_selected, page = new_cyl_page)
  })
}

shinyApp(ui = ui, server = server)

One problem with this kind of situation is the circular logic that can cause an endless cascade of reactions. I save the user's selections in a reactiveValues to break the chain. I use observeEvent to first update the saved selections in the user_selections object, and then to update the slicer UI elements. The priority setting ensures the user's choices are saved before doing any updates.

The slicers can contain statistics from the data that tell the user about the relevance of the different column values in the context of the current filtering. These should change based on the business logic. The # Rows tells the user if that value appears in the filtered data.

I use ordered factors for the columns because I'm worried about problems from the fact that reactable refers to row indices, not the values themselves.

I'm not happy with the amount of copy-and-paste boilerplate, but this should get you started.

Answer 2

You should use reactive() and not observe() to filter your data. Use req() to silently stop the reactive from giving an error before the input pickers are ready.

filtered_data <- reactive({
    req(input$selCrncy, input$selAxe, input$selOwned, input$selFloater, input$selCollateralType, input$selMaturityType, input$selIssuerName, input$selSector, input$dtrng)
    bData %>% 
        filter(Crncy %in% input$selCrncy,
               bData$`AXE?` %in% input$selAxe,
               bData$`Owned?` %in% input$selOwned,
               bData$Floater %in% input$selFloater,
               bData$`Collateral Type` %in% input$selCollateralType,
               bData$`Maturity Type` %in% input$selMaturityType,
               bData$`Issuer Name` %in% input$selIssuerName,
               bData$Sector %in% input$selSector,
               bData$MatYear >= input$dtrng[1],
               bData$MatYear <= input$dtrng[2])
})

output$datatbl = DT::renderDataTable(
    filtered_data(),
    options = list(scrollX = TRUE)
)

Also use data = filtered_data() instead of data = bData in the renderPlotly command.

I'm not sure exactly how you want the pickers to change based on other pickers, but renderUI is definitely the way to do it. If you want a picker to depend on another picker, use req() to stop it from rendering until the other one is ready.