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)
Here is a way.
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)