in R, how to create multilevel radioGroupButtons, as each level depends choiceNames depend on the previous level input?

Question

I am trying to create shinyapp in which the first radioGroupButtons will automatically update the second level of radioGroupButtons and then the 3r

Answer 1

You can update choices dynamically in observeEvents, here's a demo:

# Data
dat <- data.frame(
  stringsAsFactors=FALSE,
  L3 = c(1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L),
  L2 = c("gum", "gum", "biscuits", "biscuits", "choc", "choc",
         "hotdrinks", "hotdrinks", "juices", "juices", "energydrinks",
         "energydrinks"),
  L1 = c("sweets", "sweets", "sweets", "sweets", "sweets", "sweets",
         "drinks", "drinks", "drinks", "drinks", "drinks", "drinks"),
  Price = c(23, 34, 23, 23, 54, 32, 45, 23, 12, 56, 76, 43),
  Quantity = c(10, 20, 26, 22, 51, 52, 45, 23, 12, 56, 76, 43),
  value = c("trident", "clortes", "loacker", "tuc",
            "aftereight", "lindt", "tea", "green tea", "orange",
            "mango", "powerhorse", "redbull")
)


# Packages
library(dplyr)
library(shiny)
library(shinyWidgets)


# App
ui <- fluidPage(
  tags$br(),

  # Custom CSS
  tags$style(
    ".btn-group {padding: 5px 10px 5px 10px;}",
    "#l1 .btn {background-color: #5b9bd5; color: #FFF;}",
    "#l2 .btn {background-color: #ed7d31; color: #FFF;}",
    "#value .btn {background-color: #ffd966; color: #FFF;}"
  ),


  tags$br(),
  fluidRow(
    column(
      width = 4,
      offset = 4,
      radioGroupButtons(
        inputId = "l1",
        label = NULL,
        choices = unique(dat$L1),
        justified = TRUE,
        checkIcon = list(
          "yes" = icon("check")
        ), 
        individual = TRUE
      ),
      radioGroupButtons(
        inputId = "l2",
        label = NULL,
        choices = unique(dat$L2),
        justified = TRUE,
        checkIcon = list(
          "yes" = icon("check")
        ), 
        individual = TRUE
      ),
      radioGroupButtons(
        inputId = "value",
        label = NULL,
        choices = unique(dat$value),
        justified = TRUE,
        checkIcon = list(
          "yes" = icon("check")
        ), 
        individual = TRUE
      ),
      tags$br(),
      DT::DTOutput("table")
    )
  )
)

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

  observeEvent(input$l1, {
    updateRadioGroupButtons(
      session = session,
      inputId = "l2",
      choices = dat %>% 
        filter(L1 == input$l1) %>%
        pull(L2) %>%
        unique,
      checkIcon = list(
        "yes" = icon("check")
      )
    )
  })

  observeEvent(input$l2, {
    updateRadioGroupButtons(
      session = session,
      inputId = "value",
      choices = dat %>% 
        filter(L1 == input$l1, L2 == input$l2) %>%
        pull(value) %>%
        unique,
      checkIcon = list(
        "yes" = icon("check")
      )
    )
  })

  output$table <- DT::renderDataTable({
    dat %>% 
      filter(L1 == input$l1, 
             L2 == input$l2,
             value == input$value)
  })

}

shinyApp(ui, server)

Result lokk like: