Best practice for dynamic panels in reactive app.


I am trying to make a shiny app where the checkboxes change based on a select input. I need to remember which boxes have been checked even if the user changes the select box. Basically, someone selects a module and checks sensors, and the main window will show plots of all the boxes checked.

The first snag I ran into is I wasn't able to differentiate between the user unchecking all boxes vs the user changing the module with the select input. Basically, the callback was the same with a NULL value. Therefore, I couldn't tell if the last box was unchecked or the user switched to a module with no boxes checked. To get around this, I pre-created conditional panels in advance and now I only get callbacks when the user checks or unchecks a box.

Since the panels are dynamic, I had to create an observe function for each conditional panel. This all seems to work OK and the app is working as expected, it just seems overly complicated for what I am doing.

So, my question is, does the code below look like it follows best practices for shiny apps? Is there a better way to do this? Most of the logic is in output$sensors.


ui <- fluidPage(
            width = 3

server <- function(input, output,session) {
    ### State ###
    tests <- c(
        ` ` = 0,
        "Test 1" = 1,
        "Test 2" = 2
    modules <- list(` ` = list(` ` = 0),
                    'Hub 1' = list("200ac1", "60ac1", "water1"),
                    'Hub 2' = list("60ac2", "water2", "water3"),
                    'Hub 3' = list("lowrate1", "200ac2", "60ac3")
    modulesList <- list("200ac1", "60ac1", "water1", "60ac2", "water2", "water3",
                        "lowrate1", "200ac2", "60ac3")
    sensorList <- list(
        c("Va RMS", "Vb RMS", "Vc RMS"),
        c("Vb RMS", "Vc RMS", "Va RMS"),
        c("Va RMS", "Vb RMS", "Vc RMS"),
        c("Va RMS", "Vb RMS", "Vc RMS"),
        c("Va RMS", "Vb RMS", "Vc RMS"),
        c("Va RMS", "Vb RMS", "Vc RMS"),
        c("Va RMS", "Vb RMS", "Vc RMS"),
        c("Va RMS", "Vb RMS", "Vc RMS"),
        c("Va RMS", "Vb RMS", "Vc RMS")
    sensorMap <- hash(modulesList, sensorList)
    selections <- reactiveVal({
            mod = character(),
            sig = character()
    ### UI ###
    output$testId <- renderUI({
        selectInput("testId", "Select Test",
                    choices = tests,
    output$moduleId <- renderUI({
        selectInput("moduleId", "Select Module",
                    choices = modules
    output$sensors <- renderUI({
        lapply(modulesList, function(m) {
            # s defines the condition, only show if the module is currently
            # selected in the selectInput
            s <- paste("input.moduleId == '", m, "'", sep = '')
            # n is a generated id
            n <- paste("sensors-", m, sep = "")
            # Make a conditionalPanel to only show the checkboxes if it is the
            # currently selected module
            cp <- conditionalPanel(s,
                checkboxGroupInput(n, "Select Sensor(s):",
                        choices = sensorMap[[m]] 
            # Register to be notified if the checkbox changes
            #  Update the current selected list accordingly when that happens
            observeEvent(input[[n]], { 
                x <- input[[n]]
                selected <- selections()
                if (is.null(x)) {
                    # Nothing is checked, remove all entries associated with module 
                    selections(selected %>% filter(mod != input$moduleId))
                else {
                    # filter out anything in the tibble that is associated with 
                    # the module but not checked.
                    # Do this by retaining all the rows in the current module 
                    #  that are currently checked (sig %in% x) and all rows of 
                    # every other module (mod != input$moduleId)
                    selections(selected %>% filter( 
                        (mod != input$moduleId) |  (mod == input$moduleId & (sig %in% x))))
                # Add any checks that aren't in the tibble
                lapply(x, function(sigName) {
                    addSelections(input$moduleId, sigName)
            }, ignoreNULL = FALSE, ignoreInit = TRUE)
    addSelections <- function(m, s) {
        # Query the current tibble for the module and signal, 
        # if not found, add it to the tibble
        selected <- selections()
        found <- selected %>% filter(mod==m & sig==s)
        if (nrow(found) == 0) {
            selections(add_row(selected, mod=m, sig=s)) 
    output$main <- renderText({
        # Loop though tibble and build the string to show output
        str <- ""
        selected <- selections()
        for (i in 1:nrow(selected)) {
            str <- paste(str, selected[i,"mod"], selected[i,"sig"], "\n")

# Run the application 
shinyApp(ui = ui, server = server)


This topic was automatically closed 54 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.