Best practice for dynamic panels in reactive app.

Hello,

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.

library(shiny)
library(hash)
library(tibble)
library(dplyr)

ui <- fluidPage(
    titlePanel(""),
    sidebarLayout(
        sidebarPanel(
            uiOutput("testId"),
            uiOutput("moduleId"),
            uiOutput("sensors"),
            width = 3
        ),
        mainPanel(
            verbatimTextOutput("main")
        )
    )
)

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({
        as_tibble(data.frame(
            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)
            cp
        })
    })
    
    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")
        }
        str
    })
}

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

thanks

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.