How to functionalize hierarchical selection

Hi, I have a lot of repetition in my code (reprex below) that I'd like to functionalize if possible.

I'm not sure functionalizing is advised, as my writing follows the hierarchical select example in the Mastering Shiny book.

library(shiny)
library(ggplot2)

mod_data_ui <- function(id, .data){

  umanufacturer <- unique(.data$manufacturer)
  umodel <- unique(.data$model)
  udispl <- unique(.data$displ)
  ucyl <- unique(.data$cyl)

  ns <- NS(id)

  tagList(
    selectInput(
      ns("manufacturer"),
      label = "Choose manufacturer(s)",
      choices =  c("All", as.character(umanufacturer)),
      selected = "All"
    ),

    selectInput(
      ns("model"),
      label = "Choose model(s)",
      choices =  c("All", as.character(umodel)),
      selected = "All"
    ),

    selectInput(
      ns("displ"),
      label = "Choose displacement(s)",
      choices =  c("All", as.character(udispl)),
      selected = "All"
    ),

    selectInput(
      inputId = ns("cyl"),
      label = "Choose cylinder(s)",
      choices = ucyl
    )
  )
}

mod_data_server <- function(id, .data){
  moduleServer( id, function(input, output, session){

    ## Hierarchical Select: manufacturer -> model -> displ -> cyl

    # First instance --------------------------------------------------------

# -------------------------------------------------------------------------


    .manufacturer <- reactive({
      chosen <- if(input$manufacturer == "All"){
        unique(.data$manufacturer)
      } else {input$manufacturer}
      dplyr::filter(.data, manufacturer %in% chosen)
    })

    observeEvent(.manufacturer(), {
      choices <- if(input$manufacturer == "All"){
        c("All", unique(.manufacturer()$model))
      } else {unique(.manufacturer()$model)}
      updateSelectInput(inputId = "model",
                        choices = choices)
    })

# -------------------------------------------------------------------------


    # Second --------------------------------------------------------


# -------------------------------------------------------------------------

    .model <- reactive({
      chosen <- if(input$model == "All"){
        unique(.data$model)
      } else {input$model}
      dplyr::filter(.manufacturer(), model %in% chosen)
    })

    observeEvent(.model(), {
      choices <- unique(.model()$displ)
      updateSelectInput(inputId = "displ",
                        choices = choices,
                        selected = choices[1])
    })


    # Third --------------------------------------------------------

# -------------------------------------------------------------------------


    .displ <- reactive({
      chosen <- if(input$displ == "All"){
        unique(.data$displ)
      } else {input$displ}
      dplyr::filter(.model(), displ %in% chosen)
    })


    observeEvent(.displ(), {
      choices <- unique(.displ()$cyl)
      updateSelectInput(inputId = "cyl",
                        choices = choices,
                        selected = choices[1])
    })


# -------------------------------------------------------------------------

    manus <- reactive({
      if(input$manufacturer == "All"){
      unique(.data$manufacturer)
      } else {input$manufacturer}
      })

    models <- reactive({
      if(input$model == "All"){
      unique(.data$model)
      } else {input$model}
    })

    .data_filtered <- reactive({
      .displ() |>
        dplyr::filter(
          manufacturer %in% !!manus()
          & model %in% !!models()
          & displ %in% input$displ
          & cyl %in% input$cyl
        )
    })
  })
}

ui <- tagList(
  fluidPage(
    sidebarLayout(
      sidebarPanel(
        mod_data_ui("data_1", .data = mpg)
      ),
      mainPanel(
        tableOutput("table")
      )
    )
  )
)

server <- function(input, output, session, .data) {
  .data <- mod_data_server("data_1", .data = ggplot2::mpg)
  output$table <- renderTable(.data())
}

shinyApp(ui, server)

You are probably right on the line where the cost in time/effort/further abstraction when coming back to look at the code later, balances with the possible gains in shorter/less repetitive code.

As a general rule though, don't spend time optimising programs that don't yet work as intended. I.e. when launching this app, the top two boxes show all. but no content is shown in the table.

I edited the reprex to work as intended on the mpg data.

This topic was automatically closed 21 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.