Search code examples
rshinyshinydashboardshinyjsflexdashboard

Create an input variable that is dependent on another input variable in flexdashboard shiny widget


I am trying to create a user input in flexdashboard that is dependent on another user input. Example dataset: alphabet_data <- read.table( text = "Alphabet Number ABC 1 DEF 4 ABD 5 ABC 2 ABC 3 ABD 6 ABD 7 ABD 8", header = TRUE, stringsAsFactors = FALSE)

User selects "alphabet" in selectizeInput, say ABD, based on that I want the user to get the selectizeInput options for "number" to only to be shown 5,6,7,8.

  1. I tried observeEvent on "alphabet", to create the new dependent input fresh
  2. I created the dependent input "number" with NULL choices, and used observe event to updateselectizeInput.
  3. I created a new table based on alphabet choice, and then used that table within reactive to create "number" input.
  4. There's code below to reproduce the issue.

title: "Untitled" output: flexdashboard::flex_dashboard: orientation: columns vertical_layout: fill

runtime: shiny

library(flexdashboard)
library(tidyverse)
alphabet_data <- read.table(
        text = "Alphabet       Number
        ABC       1
        DEF       4
        ABD       5
        ABC       2
        ABC       3
        ABD       6
        ABD       7
        ABD       8",
        header = TRUE,
        stringsAsFactors = FALSE)

Column {.sidebar data-width=650}

Chart A


selectizeInput(
    inputId  = "alphabet",
    label    = "Alphabet",
    choices  = unique(alphabet_data$Alphabet),
    multiple = TRUE,
    options  = list(maxItems = 2)
)

selectizeInput(
        inputId  = "number",
        label    = "Number",
        choices  = NULL,
        multiple = TRUE,
        options  = list(maxItems = 2)
)

selected_alphabet <- eventReactive(
    eventExpr = input$alphabet,

    valueExpr = {
    alphabet_data %>% 
            filter(Alphabet %in% input$alphabet)
})

reactive({
    observeEvent(
        eventExpr   = input$alphabet,
        handlerExpr = {
            updateSelectizeInput(
                inputId = "number",
                choices = selected_alphabet()$number
            )
        }
    )
})


Column {data-width=350}

Chart B

output$alphabet <- renderPrint(input$alphabet)
textOutput(outputId = "alphabet")

Chart C

renderPrint(selected_alphabet())

Chart D

output$number <- renderPrint(input$number)
textOutput(outputId = "number")

I expect when the user select ABD alphabet, the options for number to showcase as 5,6,7,8.


Solution

  • I'm having trouble running your sample script, so I wrote a similar one.

    You have two options:

    1. Use renderUI() or insertUI() to generate UI components in server.
    2. use updateSelectInput() to upadte UI components.

    I wrote a demo in shiny, though it's not using flexdashboard, it does the same thing:

    library(shiny)
    
    ui <- fluidPage(
      fluidRow(
          tags$h1("level 1"),
          column(
              width = 6,
              selectizeInput("selectizeInput1","Input 1",choices = letters,selected = "",multiple = TRUE)
          ),
          column(
              width = 6,
              textOutput("textOutput1")
          )
      ),
      fluidRow(
          tags$h1("level 2"),
          column(
              width = 6,
              selectizeInput("selectizeInput2","Input 2",choices = "",selected = "",multiple = TRUE)
          ),
          column(
              width = 6,
              textOutput("textOutput2")
          )
      ),
      fluidRow(
          tags$h1("level 3"),
          column(
              width = 6,
              selectizeInput("selectizeInput3","Input 3",choices = "",selected = "",multiple = TRUE)
          ),
          column(
              width = 6,
              textOutput("textOutput3")
          )
      )
    
    )
    
    server <- function(input, output, session) {
        # level 1
        output$textOutput1 <- renderText(input$selectizeInput1)
    
        # level 2
        observe({
            updateSelectInput(
                session = session,
                inputId = "selectizeInput2",
                choices = input$selectizeInput1,
                selected = input$selectizeInput1
            )
            output$textOutput2 <- renderText(input$selectizeInput2)
    
        })
    
    
        # level 3
        observe({
            updateSelectInput(
                session = session,
                inputId = "selectizeInput3",
                choices = input$selectizeInput2,
                selected = input$selectizeInput2
            )
            output$textOutput3 <- renderText(input$selectizeInput3)
    
        })
    }
    
    shinyApp(ui, server)
    

    For better understanding, you can read this article or try out this app