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