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!
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
.
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.
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.
# 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)