I am creating a shiny app that includes a table that I would like to be read only unless the user selects 'Custom' instead of 'Default' from a list of radio buttons. I first attempted this following the instructions at Shiny: Making RHandsontable read only on click
with no luck. I next turned to my organization's ChatGPT and tried the following:
library(rhandsontable)
library(shiny)
library(shinydashboard)
library(shinyjs)
opts.adv <- c("Default","Custom")
ui <- dashboardPage(skin = "blue",
dashboardHeader(title = "Leslie Matrix Model",titleWidth = 450),
dashboardSidebar(id="",
width = 450,
sidebarMenu(id = "tabs",
menuItem("Welcome",tabName = "menuWelcome", icon = shiny::icon("face-smile")),
menuItem("Advanced",tabName = "menuAdvanced", icon = shiny::icon("star")),
actionButton("btnQuit","Quit",icon = shiny::icon("xmark"),class="btn-lg btn-danger"))),
dashboardBody(tabItems(
tabItem(tabName = "menuWelcome",
valueBox("Welcome","Population viability analysis",icon = shiny::icon("face-smile"),width=9)),
tabItem(tabName = "menuAdvanced",
fluidRow(box(title="Age-1+ Survival",status="primary",solidHeader=TRUE,width=4,
radioButtons("adv.adultS.sel","Age-1+ survival options",opts.adv))),
fluidRow(box(title="Custom Age-1+ Survival",status="primary",solidHeader=TRUE,width=9,rHandsontableOutput("hot")))))))
server <- function(input, output, session) {
# Create a reactive value to hold the data
customS <- reactiveValues(data = NULL)
# Initialize the table with sequential column names and no initial data
observe({
if (is.null(customS$data)) {
agenum <- sprintf("age%d",seq(1:15))
# Initialize an empty data frame with sequential column names
customS$data <- setNames(data.frame(matrix(ncol = 15, nrow = 1)), agenum)
}
})
# Render the rhandsontable
output$hot <- renderRHandsontable({
rhandsontable(customS$data, readOnly = (input$adv.adultS.sel == "Default"))
# Render the table, ensuring all columns are numeric
rhandsontable(customS$data) %>%
hot_col(col = seq_len(ncol(customS$data)), type = "numeric") # Set all columns to numeric type
})
observeEvent(input$adv.adultS.sel, {
if (input$adv.adultS.sel == "Default") {
shinyjs::disable("hot")
} else {
shinyjs::enable("hot")
}
})
# Quit app
observeEvent(input$btnQuit, {
stopApp()
})
}
shinyApp(ui, server)
The table is editable no matter which radio button is selected.
I would appreciate any help in solving this issue.
you need to initialized shinyjs -> useShinyjs() in the UI for proper functionality. Also needed to add this if statement if (!is.null(customS$data))
. The condition acts as a safeguard, ensuring that rendering only occurs when valid data is available. This is particularly important in reactive contexts, where timing of updates can vary.
# Render the rhandsontable
output$hot <- renderRHandsontable({
if (!is.null(customS$data)) {
rhandsontable(customS$data, readOnly = (input$adv.adultS.sel == "Default")) %>%
hot_col(col = seq_len(ncol(customS$data)), type = "numeric") # Ensure numeric columns
}
})
Corrected Code:
library(shiny)
library(shinydashboard)
library(rhandsontable)
library(shinyjs)
opts.adv <- c("Default", "Custom")
ui <- dashboardPage(
skin = "blue",
dashboardHeader(title = "Leslie Matrix Model", titleWidth = 450),
dashboardSidebar(
width = 450,
sidebarMenu(
id = "tabs",
menuItem("Welcome", tabName = "menuWelcome", icon = shiny::icon("face-smile")),
menuItem("Advanced", tabName = "menuAdvanced", icon = shiny::icon("star")),
actionButton("btnQuit", "Quit", icon = shiny::icon("xmark"), class = "btn-lg btn-danger")
)
),
dashboardBody(
useShinyjs(), # Initialize shinyjs
tabItems(
tabItem(
tabName = "menuWelcome",
valueBox("Welcome", "Population viability analysis", icon = shiny::icon("face-smile"), width = 9)
),
tabItem(
tabName = "menuAdvanced",
fluidRow(
box(
title = "Age-1+ Survival",
status = "primary",
solidHeader = TRUE,
width = 4,
radioButtons("adv.adultS.sel", "Age-1+ survival options", opts.adv)
)
),
fluidRow(
box(
title = "Custom Age-1+ Survival",
status = "primary",
solidHeader = TRUE,
width = 9,
rHandsontableOutput("hot")
)
)
)
)
)
)
server <- function(input, output, session) {
# Create a reactive value to hold the data
customS <- reactiveValues(data = NULL)
# Initialize the table with sequential column names and no initial data
observe({
if (is.null(customS$data)) {
agenum <- sprintf("age%d", seq(1:15))
customS$data <- setNames(data.frame(matrix(ncol = 15, nrow = 1)), agenum)
}
})
# Render the rhandsontable
output$hot <- renderRHandsontable({
if (!is.null(customS$data)) {
rhandsontable(customS$data, readOnly = (input$adv.adultS.sel == "Default")) %>%
hot_col(col = seq_len(ncol(customS$data)), type = "numeric") # Ensure numeric columns
}
})
# Enable or disable the table based on selection
observeEvent(input$adv.adultS.sel, {
if (input$adv.adultS.sel == "Default") {
shinyjs::disable("hot")
} else {
shinyjs::enable("hot")
}
})
# Quit app
observeEvent(input$btnQuit, {
stopApp()
})
}
shinyApp(ui, server)