Modularizing an app with dynamic inputs (renderUI)

shiny
2

When modularizing an app, I like to start by mentally breaking it up into standalone components. Maybe draw some boxes on the UI and figure out which boxes could function as independent, reusable units.

For this example, I don't see the individual radio button groups as modules, but all of them composing a single module that serves as the input control for the selected dataset/row. Individual radio groups wouldn't be great fits for modules as they don't make much sense in isolation. And maybe that's why you're finding it difficult to turn them into modules.

Instead, I would start with extracting the repetitive logic into functions. It's like the RStudio article says - functions alone are good enough to generate UI, define outputs, and create reactive expressions. You could make a function that adds an arbitrary dataset to the app, and then consider what could be further extracted into a module.

For some app specific advice -

The whole thing is essentially just one group of radio buttons, but laid out and labeled into subgroups. It could be done in HTML alone by giving every radio the same name, and changing the values underneath to something like cars-1 or cars-2 so they don't clash. This wouldn't even need a custom input binding since it'd only differ from the built-in radioButtons in HTML.

Here's an example where I've piggybacked off the existing radioButtons to generate the HTML. I separated radioButtons' inner content from its binding container and pulled them into functions that could be used to build radio buttons with subgroups.

library(shiny)

radioSubgroup <- function(inputId, id, label, choices, inline = FALSE) {
  values <- paste0(id, "-", choices)
  choices <- setNames(values, choices)

  rb <- radioButtons(inputId, label, choices, selected = character(0), inline = inline)
  rb$children
}

radioGroupContainer <- function(inputId, ...) {
  class <- "form-group shiny-input-radiogroup shiny-input-container"
  div(id = inputId, class = class, ...)
}

ui <- fluidPage(
  titlePanel("Example: linked radio buttons"),

  sidebarLayout(
    sidebarPanel(
      radioGroupContainer("selectedRow",
        fluidRow(
          column(4, radioSubgroup("selectedRow", "cars", label = "cars:", choices = 1:6)),
          column(4, radioSubgroup("selectedRow", "pressure", label = "pressure:", choices = 1:6)),
          column(4, radioSubgroup("selectedRow", "faithful", label = "faithful:", choices = 1:6))
        )
      )
    ),

    mainPanel(
      fluidRow(
        column(4,
               strong("Current dataset: "), textOutput("current", inline = TRUE),
               br(),
               strong("Selected row:"), textOutput("selectedRow", inline = TRUE),
               verbatimTextOutput("row"),
               strong("Summary:"),
               verbatimTextOutput("summary")
        )
      )
    )
  )
)

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

  selectedRow <- reactive({
    req(input$selectedRow)
    parts <- unlist(strsplit(input$selectedRow, "-"))
    list(id = parts[1], value = parts[2])
  })

  currentDataset <- reactive({
    getExportedValue("datasets", selectedRow()$id)
  })

  output$current <- renderText({
    selectedRow()$id
  })

  output$selectedRow <- renderText({
    selectedRow()$value
  })

  output$row <- renderPrint({
    currentDataset()[selectedRow()$value, ]
  })

  output$summary <- renderPrint({
    summary(currentDataset())
  })
}

shinyApp(ui, server)
4 Likes