RShiny UI checkbox for suboptions?

Question

I have a basic RShiny app that has a reactive checkbox which plots timeseries data based on the data (column of df) selected in the checkbox. My current code produces a UI with checkbox inputs like this:

    # Load R packages
library(shiny)
library(shinyBS)

##example df in similar format to the data I'm working with
Both <- data.frame(
  Year  = c("1990", "1991", "1992", "1993"),
  SST_anomaly_GOM = c("-1.1", "0.23", "0.87", "-0.09"),
  SST_anomaly_GB = c("-1.1", "0.23", "0.87", "-0.09"),
  SST_anomaly_MAB = c("-1.1", "0.23", "0.87", "-0.09"),
  BT_anomaly_GOM = c("-2.5", "0.55", "1.20", "-0.19"),
  BT_anomaly_GB = c("-1.1", "0.05", "1.24", "-0.29"),
  BT_anomaly_MAB = c("-1.1", "-1.08", "0.67", "-2.40")
)

# Define UI
ui <- fluidPage(
  # useShinyBS
    "Visualizing Indicators", #app title
    tabPanel("",      # tab title
             sidebarPanel(width=6,
                          
                          checkboxGroupInput("variable", label = "Checkbox", choiceNames  = gsub("_", " ", colnames(Both[2:7])), 
                                                choiceValues = colnames(Both[2:7]), 
                                                ),
             ), # sidebarPanel
    ), #tabPanel
) # fluidPage

#Define Server:
server<- function (input,output){
   output$rendered <-   renderUI({
    })
}
# Create Shiny object
shinyApp(ui = ui, server = server)

This Produces an interface like this:

This is fine, but a little repetitive, and with more timeseries variables I eventually want to include to this list, this can get cumbersome for the user to sift through and will take up a lot of the space on the UI to list everything in this way.

My question is how can I adjust my code such that it produces an interface with unique variables listed, then checkboxes for each sub-region of interest? (GOM, BG, MAB, etc.) An example of what I have in mind is an interface that looks more like this:

Is this possible? Is this possible with a df in the format as I currently have (such as my example df called "Both").

Thanks!

Answer 1

To create an answer for your solution, I've implemented a checkbox group input using the DT package. The solution comes in two parts: 1. The Helper functions. 2. The App.

Example Image

Helper Functions

The first helper function creates a data table with checkbox inputs, each with a unique id that is a combination of the rowname and column name.

The second helper function evaluates the 'checked' status of each of the checkboxes in the constructed table, returning a matrix with TRUE/FALSE values for each of the cells in the checkbox table.

App

The app code is pretty straight forward.

First, we create an example table using the first helper function.

Then, we render the table with DT, making sure to disable escape (so the checkboxes can be rendered), sorting, paging, and selection on the table. Most importantly, we send preDrawCallback and drawCallback JS functions to make sure the checkboxes are registered with shiny.

Lastly, any time the user interacts with the table, we call our second helper function to evaluate the checkbox statuses. You can do whatever you please with that information.

Code

# Checkbox Table Demo

library(shiny)
library(DT)


#### Helper Functions ####
#' Construct a checkbox table for an app.
construct_checkbox_table <- function(rows,
                                     cols,
                                     rownames,
                                     colnames) {
  checkbox_table <- matrix(
    character(),
    nrow = rows,
    ncol = cols,
    dimnames = list(rownames, colnames)
  )
  
  for (i in seq_len(rows)) {
    for (j in seq_len(cols)) {
      checkbox_table[i, j] <-
        sprintf(
          '<input id="%s,%s" type="checkbox" class="shiny-bound-input" />',
          rownames[[i]],
          colnames[[j]]
        )
    }
  }
  
  checkbox_table
}

#' Get the status of checkboxes in a checkbox table.
evaluate_checkbox_table_status <- function(input, input_table) {
  table_status <-
    matrix(
      logical(),
      nrow = nrow(input_table),
      ncol = ncol(input_table),
      dimnames = list(rownames(input_table), colnames(input_table))
    )
  
  table_rownames <- rownames(input_table)
  table_colnames <- colnames(input_table)
  
  for (i in seq_len(nrow(input_table))) {
    for (j in seq_len(ncol(input_table))) {
      table_status[i, j] <-
        input[[sprintf("%s,%s", table_rownames[[i]], table_colnames[[j]])]]
    }
  }
  
  table_status
}
#### End Helper Functions ####


#### App ####
# Create an example checkbox input table to use for the app
example_checkbox_table <-
  construct_checkbox_table(
    2,
    4,
    rownames = c("Annual Bottom Temp Absolute", "Bottom Temp Anomoly"),
    colnames = c("GOM", "GB", "MAB", "SS")
  )

ui <- fluidPage(DT::DTOutput("selection_table"),
                verbatimTextOutput("table_selections"),)

server <- function(input, output, session) {
  output$selection_table <- DT::renderDT({
    DT::datatable(
      example_checkbox_table,
      escape = FALSE,
      selection = "none",
      options = list(
        dom = "t",
        ordering = FALSE,
        paging = FALSE,
        preDrawCallback = JS(
          'function() { Shiny.unbindAll(this.api().table().node()); }'
        ),
        drawCallback = JS(
          'function() { Shiny.bindAll(this.api().table().node()); } '
        )
      )
    )
  }, server = FALSE)
  
  observeEvent(input$selection_table_cell_clicked, {
    output$table_selections <- renderPrint({
      evaluate_checkbox_table_status(input, example_checkbox_table)
    })
  })
}
#### End App ####

shinyApp(ui, server)