javascriptrshinyrhandsontable

Disable Shiny button conditionally to a rHandsontable format


I have a rhandsontable within a Shiny application with some conditional formatting, such as rendering the whole row red if a data is missing on a specific column (such as col1 below).

Now, I would like also to return this information (that a mandatory value is missing ) to Shiny (using for example a boolean), in order to take additional action (such as disabling a shiny button).

Is there an easy way to do that or shall I code in parallel an observer on the rhandsontable and test again that the mandatory column is populated?

Here's an example of what I would like to achieve:

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)

Solution

  • Here is a way.

    enter image description here

    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)