Reactive filtering in shiny

[vinayprakash808]

I have a shiny application where the filters here are reactive with respect to each other. Not sure there is some issue in the code. The values are not to be seen here. Can anyone help me here?

Is there any alternate way?

library(shiny)
library(readxl)
library(dplyr)
library(shinyWidgets) ## for picker input
library(shinydashboard) 
library(DT)
library(tidyverse)
library(xtable)
library(shinycssloaders)
library(plotly)
library(htmlwidgets)
library(sparkline)
library(data.table)
require(reshape2)
library(glue)

data_13_Sam  <- data.frame(
  Ratings = c(1,2,3,4,5,1,2,3,4,5), flag = c("Yes","No","Yes","No","Yes","No","Yes","No","Yes","Yes")
)

ui <- fluidPage(
  column(offset = 0, width = 1,uiOutput("rat")),
  column(offset = 0, width = 2, uiOutput("nt"))
)

server <- function(input, output, session) {
  
  
  filter_data <- reactive({
    data_13_Sam %>% filter(flag %in% input$nt, Ratings %in% input$rat)
  })
  

  
  ##### nt
  


    output$nt <- renderUI({
      selectInput("nt",label = tags$h4("New"),choices = unique(filter_data()$flag))
    })

  
  ###### rat
  

    output$rat <- renderUI({
      selectInput("rat",label = tags$h4("Rat"),choices = unique(filter_data()$Ratings))
    })
  
}

shinyApp(ui, server)

Can we not make it reactive to each other. In my question, 5 does not have "No", So when we select "No" under "New", the other filter should not have 5. Also when we select 5 under "Rat", the other filter should not have "No". Make sense ?

[pieterjanvc]

Hi,

Here is an example of your request

library(shiny)
library(dplyr)

data_13_Sam  <- data.frame(
  Ratings = c(1,2,3,4,5,1,2,3,4,5), 
  flag = c("Yes","No","Yes","No","Yes","No","Yes","No","Yes","Yes")
)

ui <- fluidPage(
  selectInput("rat",label = tags$h4("Ratings"),choices = 1),
  selectInput("flag",label = tags$h4("Flag"),choices = "Yes")
)

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

  observeEvent(input$rat, {
    updateSelectInput(session, "flag", 
                      choices = data_13_Sam %>% filter(Ratings == input$rat) %>% 
                        pull(flag) %>% sort())
  })
  
  observeEvent(input$flag, {
    updateSelectInput(session, "rat", 
                      choices = data_13_Sam %>% filter(flag == input$flag) %>% 
                        pull(Ratings) %>% sort())
  })
  
}

shinyApp(ui, server)

Instead of rendering the input boxes, I created them with default values being the first combination, then used the updateSelectInput to change the values based-off the selections made. They will trigger eachother if the other one changes.

That said, the logic is a bit weird since you want it to go in both directions. For example, in the default scenario: Ratings = 1 and Flag = No (option Yes also available, but sorted alphabetically here). This means option 5 is not visible in the Ratings dropdown, so if a user wants to see this, they need to know to set flag first to Yes before they can select 5from Ratings. This is very confusing and complicated. I don't really see why you would like to do that.

PJ

[vinayprakash808]

Thanks for the effort. I kind off tried this attempt. But again we have issue . The user cannot select 2 and "Yes", 3 and "Yes" and so on. Example, if you select 2 and "Yes", the filters values go to 1 and "No" respectively .

Not sure if you observed this

Well the reason why I need this The filter values should not be reflected if there are no values. For example, 5 only has "Yes", so if you select 5 , the other option should not show "No" . By doing this user may get confused and if he select "No" and see no value at all .

[pieterjanvc]

Ok I get now what you mean. Here is an implementation of that

library(shiny)
library(dplyr)

data_13_Sam  <- data.frame(
  Ratings = c(1,2,3,4,5,1,2,3,4,5), 
  flag = c("Yes","No","Yes","No","Yes","No","Yes","No","Yes","Yes")
)

ui <- fluidPage(
  selectInput("rat",label = tags$h4("Ratings"),choices = 1),
  selectInput("flag",label = tags$h4("Flag"),choices = "Yes")
)

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

  observeEvent(input$rat, {
    
    options = data_13_Sam %>% filter(Ratings == input$rat) %>% 
      pull(flag) %>% unique() %>% sort()
    
    if(input$flag %in% options){
      val = input$flag
    } else {
      val = options[1]
    }
    
    updateSelectInput(session, "flag", choices = options, selected = val)
  })
  
  
  observeEvent(input$flag, {
    
    options = data_13_Sam %>% filter(flag == input$flag) %>% 
      pull(Ratings) %>% unique() %>% sort()
    
    if(input$rat %in% options){
      val = input$rat
    } else {
      val = options[1]
    }
    updateSelectInput(session, "rat", choices = options, selected = val)

    
  })
  
}

shinyApp(ui, server)

I still think it's a bit weird filtering, as I would let all the downstream options depend on the top one (in this case Ratings). So I'd keep all Ratings available, and then once selecting a rating, the other options change, but not the other way around.

Anyway what I shared should work for your request I think.

PJ

[vinayprakash808]

I see. Thanks . Let me check​:blush: . But according to you bidirectional reactivity is not possible is what u mean???

Because now we have only 2 filters. Let’s say we have 5 filters. Even then if we keep all ratings. We cannot make the rest 4 filters reactive to each other . Is this what u mean,??

[vinayprakash808]

I tried with below with some reactivity. Still no luck. Can you give a try when you have time

library(shiny)
library(readxl)
library(dplyr)
library(shinydashboard) 
library(DT)
library(tidyverse)
library(xtable)
library(plotly)
library(htmlwidgets)
library(sparkline)
library(data.table)
require(reshape2)
library(glue)

data_13_Sam  <- data.frame(
  Ratings = c(1,2,3,4,5,1,2,3,4,5), flag = c("Yes","No","Yes","No","Yes","No","Yes","No","Yes","Yes")
)

ui <- fluidPage(
  column(offset = 0, width = 1,uiOutput("rat")),
  column(offset = 0, width = 2, uiOutput("nt"))
)

server <- function(input, output, session) {
  
  sel_flag <- reactiveVal()
  # choice_flag <- reactiveVal()
  
  sel_rat <- reactiveVal()
  # choice_rat <- reactiveVal()

  output$nt <- renderUI({
    selectInput("flag",label = tags$h4("New"),choices = unique(data_13_Sam$flag),selected = sel_flag())
  })
  
  output$rat <- renderUI({
    selectInput("rating",label = tags$h4("Rat"),choices = unique(data_13_Sam$Ratings), selected = sel_rat())
  })
  
  observeEvent(input$rating, {
    updateSelectInput(session, "flag", 
                      choices = data_13_Sam %>% filter(Ratings == input$rating) %>% 
                        pull(flag) %>% sort())
    sel_flag(input$flag)
  })
  
  observeEvent(input$flag, {
    updateSelectInput(session, "rating", 
                      choices = data_13_Sam %>% filter(flag == input$flag) %>% 
                        pull(Ratings) %>% sort())
    sel_rat(input$rating)
  })
  
}

shinyApp(ui, server)