Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
237 views
in Technique[技术] by (71.8m points)

r - Update multiple related selectizeInput() controlling a reactive dataset filtered through these inputs choices

I have a simple shiny app that loads a dataset when I launch it. The app has different selectizeInput() where the user can choose one or more values of different variables with which he/she can filter the dataset. In the following reproducible example, the reactive dataset I create in the server when filtering is displayed through a table:

library(dplyr)
library(shiny)

dataset <- data.frame("Letters" = c("A", "B", "C", "A", "B", "C", "A", "B", "C", "A", "B", "C", "A", "B", "C", "A", "B", "C"),
                      "Numbers" = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9),
                      "LettersNumbers" = c("G5", "G5", "G5", "G5", "G5", "G5", "F7", "F7", "F7", "F7", "F7", "F7", "E9", "E9", "E9", "E9", "E9", "E9"))

ui <- fluidPage(

br(),

  fluidRow(
    column(width = 4,
           selectizeInput(inputId = "letters",
                          label = "Letters",
                          choices = unique(dataset$Letters),
                          multiple = TRUE),

br(),
           selectizeInput(inputId = "numbers",
                          label = "Numbers",
                          choices = unique(dataset$Numbers),
                          multiple = TRUE),

br(),

           selectizeInput(inputId = "lettersnumbers",
                          label = "Letters & Numbers",
                          choices = unique(dataset$LettersNumbers),
                          multiple = TRUE)

    ),
    column(width = 4,
           tableOutput(outputId = "table")
    ),
    column(width = 4,
           textOutput(outputId = "text")
    )
  )
  
)

server <- function(input, output, session) {
  
  # Filter the initial dataset
  dataset_filtered <- reactive({

    dataset_filtered <- dataset
    
    if (!is.null(input$letters)) {
        
      dataset_filtered <- dataset_filtered %>% 
        filter(Letters %in% c(input$letters))

    }
    
    if (!is.null(input$numbers)) {
      
      dataset_filtered <- dataset_filtered %>% 
        filter(Numbers %in% c(input$numbers))
      
    }
    
    if (!is.null(input$lettersnumbers)) {
      
      dataset_filtered <- dataset_filtered %>% 
        filter(LettersNumbers %in% c(input$lettersnumbers))
      
    }
    
    return(dataset_filtered)
    
  })
  
  # Display filtered table
  output$table <- renderTable({
    
    dataset_filtered()
    
  })
  
  # Display warning message
  output$text <- renderText({
    
    if (nrow(dataset_filtered()) == 0) {
      
      print("No combinations available")
      
    }
    
  })
  
}

shinyApp(ui = ui, server = server)

The problem: The three variables have exactly the same importance. Let's now make an example of filtering: suppose I choose the values A and B. As you can see from the table, in the Numbers column I just have the values from 1 to 8, but not 9. Now, in the second selectizeInput() (Numbers) I select the 9, and the table has, as expected 0 rows and the warning message is displayed. However, if from the same selectizeInput() I select both the 9 and the 1 some values will be displayed, because the filter considers the 1 as available in the reactive vector created and filters just for that.

In my opinion, the best way to program this interface is to reactively update every selectizeInput() when a choice in any of them is made. In other words, if I select A and B from the first input, the number 9 should not be available in the second input AT ALL. This should be valid for every input I have, there is no input with more importance than the other.

I have tried several solutions, also with updateSelectizeInput(), but nothing seems to work. Do you have any suggestion? Thanks!

question from:https://stackoverflow.com/questions/65832361/update-multiple-related-selectizeinput-controlling-a-reactive-dataset-filtered

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

Combination of updateSelectizeInput() and observeEvent() should meet your requirement. Try this:

dataset <- data.frame("Letters" = c("A", "B", "C", "A", "B", "C", "A", "B", "C", "A", "B", "C", "A", "B", "C", "A", "B", "C"),
                      "Numbers" = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9),
                      "LettersNumbers" = c("G5", "G5", "G5", "G5", "G5", "G5", "F7", "F7", "F7", "F7", "F7", "F7", "E9", "E9", "E9", "E9", "E9", "E9"))

ui <- fluidPage(
  
  br(),
  
  fluidRow(
    column(width = 4,
           selectizeInput(inputId = "letters",
                          label = "Letters",
                          choices = unique(dataset$Letters),
                          multiple = TRUE),
           
           br(),
           selectizeInput(inputId = "numbers",
                          label = "Numbers",
                          choices = unique(dataset$Numbers),
                          multiple = TRUE),
           
           br(),
           
           selectizeInput(inputId = "lettersnumbers",
                          label = "Letters & Numbers",
                          choices = unique(dataset$LettersNumbers),
                          multiple = TRUE)
           
    ),
    column(width = 4,
           tableOutput(outputId = "table")
    ),
    column(width = 4,
           textOutput(outputId = "text")
    )
  )
  
)

server <- function(input, output, session) {
  
  # Filter the initial dataset
  dataset_filtered <- reactive({
    
    dataset_filtered <- dataset
    
    if (is.null(input$letters) & is.null(input$numbers) & is.null(input$lettersnumbers)) {
      dataset_filtered <- dataset
      updateSelectizeInput(session, inputId="letters",choices=dataset$Letters, selected=NULL)
      updateSelectizeInput(session, inputId="numbers",choices=dataset$Numbers, selected=NULL)
      updateSelectizeInput(session, inputId="lettersnumbers",choices=dataset$LettersNumbers, selected=NULL)
    }else{
      if (!is.null(input$letters)) {
        
        dataset_filtered <- dataset_filtered %>% 
          filter(Letters %in% c(input$letters))
        
      } 
      
      if (!is.null(input$numbers)) {
        
        dataset_filtered <- dataset_filtered %>% 
          filter(Numbers %in% c(input$numbers))
        
      } 
      
      if (!is.null(input$lettersnumbers)) {
        
        dataset_filtered <- dataset_filtered %>% 
          filter(LettersNumbers %in% c(input$lettersnumbers))
        
      }
    }
    
    return(dataset_filtered)
    
  })
  
  observeEvent(input$letters, {
    updateSelectizeInput(session, inputId="lettersnumbers",choices=dataset_filtered()$LettersNumbers, selected=NULL)
    updateSelectizeInput(session, inputId="numbers",choices=dataset_filtered()$Numbers, selected=NULL)
  })
  
  observeEvent(input$numbers, {
    updateSelectizeInput(session, inputId="lettersnumbers",choices=dataset_filtered()$LettersNumbers, selected=NULL)
    updateSelectizeInput(session, inputId="letters",choices=dataset_filtered()$Letters, selected=NULL)
  })
  
  observeEvent(input$lettersnumbers, {
    updateSelectizeInput(session, inputId="letters",choices=dataset_filtered()$Letters, selected=NULL)
    updateSelectizeInput(session, inputId="numbers",choices=dataset_filtered()$Numbers, selected=NULL)
  })
  
  # Display filtered table
  output$table <- renderTable({
    
    dataset_filtered()
    
  })
  
  # Display warning message
  output$text <- renderText({
    
    if (nrow(dataset_filtered()) == 0) {
      
      print("No combinations available")
      
    }
    
  })
  
}

shinyApp(ui = ui, server = server)

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...