如何使用单选按钮启用/禁用 rhandsontable？

Question

我正在创建一个闪亮的应用程序，其中包含一个我只想读取的表格，除非用户从单选按钮列表中选择“自定义”而不是“默认”。我首先按照 Shiny: Making RHandsontable read only on click

中的说明尝试此操作

没有运气。接下来，我转向我组织的 ChatGPT 并尝试了以下操作：

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)

无论选择哪个单选按钮，该表都是可编辑的。

如果您能帮助解决此问题，我将不胜感激。

Answer 1

您需要在 UI 中初始化闪亮js -> useShinyjs() 以获得正确的功能。

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)