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)