I'm working with a large database and I would the user to be able to extract rows from the database using multiple criteria or filters.

Suppose a data frame looks like the below, with 3 types of fruit and listing their place of origin and quantity on hand. The posted MWE code allows the user to select the type of fruit to view, either by single fruit or by multiple fruits selection. This works fine, and in the image at the very bottom I show the results of the user selecting bananas and blueberries.

      Fruit Origin Qty
1    Banana     MX   5
2 Blueberry     OR  15
3    Cherry     PA  50

I need help expanding this MWE to also allow:

1. Additionally selecting fruit by "Origin", via a second select box to the right of the current select box for "Fruit". They don't necessarily need to be linked, though it would be nice if it didn't overcomplicate things. (By "not linked", I mean if the user decides to select by Origin, any Fruit selections are ignored and overridden).
2. In the multiInput() function currently used, or whatever other package or function someone recommends instead, how to automatically input the unique row id choices available instead of manually keying them in when writing the code, like in the choices = c("Banana", "Blueberry", "Cherry") line below? In the actual database I'm working with, there are too many row id's to manually input.
3. For the user choices, for "Fruit" and "Origin", how to incorporate an option for "All"?

Maybe I need another package.

MWE code:

library("shiny")
library("shinyWidgets")

ui <- fluidPage(
  multiInput(
    inputId = "id", 
    label = "Fruits :",
    choices = c("Banana", "Blueberry", "Cherry"),
    selected = "Banana", width = "400px",
    options = list(enable_search = FALSE,
                   non_selected_header = "Choose between:",
                   selected_header = "You have selected:"
                  )
  ),
  tableOutput("table")
)

server <- function(input, output, session) {
  
  data <- data.frame(Fruit=c("Banana", "Blueberry", "Cherry"), 
                     Origin=c("MX","OR","PA"), 
                     Qty=c(5,15,50)
                    )
  
  observeEvent(input$id,{
    dataSelect <- data[data$Fruit %in% c(input$id), ]
    output$table <-  renderTable(dataSelect)
    })
  
}

shinyApp(ui = ui, server = server)

CodePudding user response：

• You can use updateMultiInput to update selections based on values inside the table instead of hard coding them in the UI
• You can create a checkbox to show everything
• Currently, rows must have both selected fruits and origins. If any of them is ok, replace (Fruit %in% input$fruit & Origin %in% input$origin) with (Fruit %in% input$fruit | Origin %in% input$origin)

library("dplyr")
library("shiny")
library("shinyWidgets")

ui <- fluidPage(
  multiInput(
    inputId = "fruit",
    label = "Fruits :",
    choices = c(""),
    selected = "",
    width = "400px",
    options = list(
      enable_search = FALSE,
      non_selected_header = "Choose between:",
      selected_header = "You have selected:"
    )
  ),
  multiInput(
    inputId = "origin",
    label = "Origins :",
    choices = c(""),
    selected = "",
    width = "400px",
    options = list(
      enable_search = FALSE,
      non_selected_header = "Choose between:",
      selected_header = "You have selected:"
    )
  ),
  checkboxInput(inputId = "all", label = "show all"),
  tableOutput("table")
)

server <- function(input, output, session) {
  data <- data.frame(
    Fruit = c("Banana", "Blueberry", "Cherry"),
    Origin = c("MX", "OR", "PA"),
    Qty = c(5, 15, 50)
  )

  updateMultiInput(session, "fruit", choices = unique(data$Fruit),
    selected = unique(data$Fruit)[[1]])
  updateMultiInput(session, "origin", choices = unique(data$Origin),
    selected = unique(data$Origin)[[1]])

  observeEvent(
    eventExpr = {
      input$fruit
      input$origin
    },
    handlerExpr = {
      output$table <- renderTable({
        filter(data,
          (Fruit %in% input$fruit & Origin %in% input$origin) |
           input$all
        )
      })
    }
  )
}

shinyApp(ui = ui, server = server)