在 Shiny R 中的 selectInput() 中动态分组值

Question

I am trying to create a Simple Shiny dashboard which displays the values in the form of a table. For displaying the data in the form of a table I am using select input statements and renderDT(). Kindly find the code below. The Code below is just a sample of what i want to do.

    library(shiny)
    library(shinydashboard)
    library(shinyWidgets)
    library(dplyr)
    
    d <-
      data.frame(
        Product_Name = c(
          "Table",
          "Chair",
          "Bed",
          "Table",
          "Chair",
          "Bed",
          "Table",
          "Chair",
          "Bed",
          "Table",
          "Chair",
          "Bed",
          "Table",
          "Chair",
          "Bed"
        ),
        Product_desc = c("X", "X", "X", "Y", "Y", "Y", "Z", "Z", "Z", "Y", "Y", "Y", "Z", "Z", "Z"),
        Product_cat = c(1, 2, 3, 4, 2, 3, 4, 5, 6,9,7,6,3,5,6)
      )
    
    ui <- shinyUI(fluidPage(
      useShinydashboard(),
      tabPanel(
        "Plot",
        sidebarLayout(
          sidebarPanel(
            selectInput(
              "product_name",
              "Product Name",
              choices = NULL,
              selected = FALSE,
              multiple = FALSE
            ),
            selectInput(
              "Category",
              "Product Category",
              choices = NULL,
              selected = FALSE,
              multiple = TRUE
            ),
            #width = 2,
            position = "bottom"),
          mainPanel(DT::DTOutput("table1"))
          
        )
      )
    ))
    
    server <- function(input, output, session) {
      
      updateSelectInput(
        session,
        "product_name",
        "Product Name",
        choices = unique(d$Product_Name)
      )
      
      observeEvent(input$product_name,{
        
        y <- input$product_name
        x <- d %>% select(Product_Name,Product_cat) %>% filter(Product_Name %in% y) %>% 
          select(Product_cat)
        
        updateSelectInput(
          session,
          "Category",
          "Product Category",
          choices = (x)
        )
w <- input$Category
    z <- d %>% filter(Product_Name %in% y, Product_cat %in% w)
    
    output$table1 <-
      DT::renderDT(z)
        
      })
    }
    
    shinyApp(ui, server)

A particular product will have multiple categories it belong to. The user selects those set of categories which they need to view.

Now the issue which I am facing is with the Product Category. I want to group certain categories dynamically. For example if the user instead of seeing the categories 1,4,9,3 for the Product Table separately, if they want to see grouped categories for example 1-4 for the product table. How to achieve this in shiny Application dynamically ?

I dont want to make any changes to the source data. Also the grouping might be varying with each users who is going to use it. There would be no point in doing the predefined grouping in the dataset.

So the User flow will be as follows.

1. The User selects the Product Name
2. Depending upon the Product Name the Product Categories will be present in the drop down box. Multiple category values can be selected.
3. Once the User selects the value in the drop down box then a table will get displayed in the mainPanel().

For example.

1. Lets take the user selects the Product Name as "Table"
2. Next the Product category options in the drop down list would be 1, 4, 9, 3.
3. Lets the the user selects the values 1 and 9. Now the values which have Product name as Table and which belong to the categories 1 and 9 would be getting displayed.

Whats my expectation is "is there a way in which the user has the ability group the categories as 1-9, 1-4 etc. dynamically in a Shiny Application ?

Kindly let me know your suggestions.

Thanks in advance.

Answer 1

Perhaps you are looking for this.

d <-
  data.frame(
    Product_Name = c(
      "Table",
      "Chair",
      "Bed",
      "Table",
      "Chair",
      "Bed",
      "Table",
      "Chair",
      "Bed",
      "Table",
      "Chair",
      "Bed",
      "Table",
      "Chair",
      "Bed"
    ),
    Product_desc = c("X", "X", "X", "Y", "Y", "Y", "Z", "Z", "Z", "Y", "Y", "Y", "Z", "Z", "Z"),
    Product_cat = c(1, 2, 3, 4, 2, 3, 4, 5, 6,9,7,6,3,5,6)
  )

ui <- shinyUI(fluidPage(
  useShinydashboard(),
  tabPanel(
    "Plot",
    sidebarLayout(
      sidebarPanel(
        selectInput(
          "product_name",
          "Product Name",
          choices = NULL,
          selected = FALSE,
          multiple = FALSE
        ),
        selectInput(
          "Category",
          "Product Category",
          choices = NULL,
          selected = FALSE,
          multiple = TRUE
        ),
        #width = 2,
        position = "bottom"),
      mainPanel(DTOutput("table1"), DTOutput("table2"))
      
    )
  )
))

server <- function(input, output, session) {
  
  updateSelectInput(
    session,
    "product_name",
    "Product Name",
    choices = unique(d$Product_Name)
  )
  
  observeEvent(input$product_name,{
    
    y <- input$product_name
    x <- d %>% select(Product_Name,Product_cat) %>% filter(Product_Name %in% y) %>% 
      select(Product_cat)
    
    updateSelectInput(
      session,
      "Category",
      "Product Category",
      choices = (x)
    )
    
  })
  
  observeEvent(input$Category, {
    #w <- input$Category
    z <- d %>% filter(Product_Name %in% input$product_name & Product_cat %in% input$Category)
    
    output$table1 <- renderDT({
      if (is.null(input$Category)) return(NULL)
      else z
    })
    
    val <- c()
    newpc <- unique(z$Product_cat)
    val <- newpc[1]
    n <- length(newpc)
    
    if (n>1) {
      lapply(2:n, function(i){val<<- paste0(val,'-',newpc[i]) })
      
      z2 <- z %>% mutate(New_Product_cat = val)
     
    }
    
    output$table2 <- renderDT({
      if (n>1) z2
      else return(NULL)
    })
    
  })
  
}

shinyApp(ui, server)