將 Shiny 按鈕條件禁用為 rHandsontable 格式

Question

我在 Shiny 應用程序中有一個帶有一些條件格式的 rhandsontable，例如如果特定列上缺少數據（例如下面的col1 ），則將整行渲染為紅色。

現在，我還想將此信息（缺少強制值）返回給 Shiny（例如使用布爾值），以便采取其他操作（例如禁用 shiny 按鈕）。

有沒有一種簡單的方法可以做到這一點，或者我應該在 rhandsontable 上並行編碼觀察者並再次測試強制列是否已填充？

這是我想要實現的示例：

library(shiny)
library(rhandsontable)

DF <- data.frame(col1 = c(1, NA, 3), col2 = c(letters[23:22], NA), col3 = round(rnorm(3, 1e6, 1e3),0))

server <- shinyServer(function(input, output, session) {
  
  output$rt <- renderRHandsontable({
    rhandsontable(DF) %>%
      hot_cols(renderer = "
           function (instance, td, row, col, prop, value, cellProperties) {
             Handsontable.renderers.NumericRenderer.apply(this, arguments);
             var col_col1 = instance.getData()[row][0]
              if(!col_col1) {
                td.style.background = 'pink';
              }
           }")
  })
})

ui <- shinyUI(fluidPage(
  rHandsontableOutput("rt"),
  br(),
  actionButton(inputId = "btn1",
             label = "disable this btn when at least one cell is red")
))

shinyApp(ui, server)

Answer 1

這是一種方法。

library(shiny)
library(rhandsontable)
library(shinyjs)

DF <- data.frame(
  col1 = c(1, NA, 3), 
  col2 = c(letters[23:22], NA), 
  col3 = round(rnorm(3, 1e6, 1e3),0),
  col4 = 3:1
)

server <- shinyServer(function(input, output, session) {
  
  session$sendCustomMessage("dims", list(nrows = nrow(DF), ncols = ncol(DF)))
  
  output$rt <- renderRHandsontable({
    rhandsontable(DF) %>%
      hot_cols(renderer = "
           function (instance, td, row, col, prop, value, cellProperties) {
             Handsontable.renderers.NumericRenderer.apply(this, arguments);
             if(!value) {
               td.style.background = 'pink';
               array[col][row] = true;
             } else {
               array[col][row] = false;
             }
             Shiny.setInputValue('missingValues:shiny.matrix', array);
           }")
  })
  
  observeEvent(input[["missingValues"]], {
    if(any(input[["missingValues"]])){
      disable("btn1")
    }else{
      enable("btn1")
    }
  })
  
  observe({
    print(input$missingValues)
  })
})

js <- HTML(
  "var array = [];",
  "function initializeArray(dims){",
  "  for(var i = 0; i < dims.ncols; ++i){",
  "    array.push(new Array(dims.nrows));",
  "  }",
  "}",
  "$(document).on('shiny:connected', function(){",
  "  Shiny.addCustomMessageHandler('dims', initializeArray);",
  "});"
)

ui <- shinyUI(fluidPage(
  tags$head(tags$script(js)), 
  useShinyjs(),
  rHandsontableOutput("rt"),
  br(),
  actionButton(inputId = "btn1",
               label = "disable this btn when at least one cell is red")
))

shinyApp(ui, server)