rshinyrhandsontable

How do I enable/disable rhandsontable using radio buttons?


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.


Solution

  • 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)