有条件地将Shiny按钮禁用为rHandsontable格式

如何解决有条件地将Shiny按钮禁用为rHandsontable格式

我在Shiny应用程序中使用了一些条件格式的电子书，例如，如果特定列上的数据丢失（例如下面的col1，则将整个行显示为红色）。

现在，我还想将此信息（缺少必需值）返回给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)

解决方法

这是一种方法。

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)