Search code examples
javascriptrshinyrhandsontable

How to expand numeric input validation when generating a table using rhandsontable?


I started using hot_validate_numeric() of the rhandsontable package and it is proving to be very useful for user input validation. Per the below MWE code, the user can only input numeric values ranging from 1 to 10, and if the user inputs a value outside this range or inputs an alpha character or other nonsense input, the table, nicely, rejects the input and freezes until the user inputs a value using the correct form. This works when the user either changes an existing cell or when the user adds a row. This is perfect!

However, how do I expand this so the validation check is also for: (1) any input into a cell must be greater than the value in the immediate cell above it (except for the case of the first cell), and (2) only integers may be input (no decimal values)? Ideally, the response would be the same as when using hot_validate_numeric(...), in that the input is rejected and the cell freezes until the user inputs a value using the correct sequence.

It may be the case that rhandsontable doesn't support dynamic validation based on the value of other cells in the table directly through hot_validate_numeric(), I'm not certain.

I've played around with hot_validate_numeric(col = 1, choices = c(...)) but that doesn't seem to work, will submit a bug report via GitHub.

library(rhandsontable)
library(shiny)

DF <- data.frame(X = c(1,3,5,7,10))

ui <- fluidPage(
  rHandsontableOutput("base_input")
)

server <- function(input, output, session) {
  output$base_input <- renderRHandsontable({
  rhandsontable(DF) %>%  hot_validate_numeric(col = 1, min = 1, max = 10)
  })
}

shinyApp(ui, server)

Solution

  • A validator is a JavaScript function that only takes the value to be validated as input, so it does not allows to compare this value with the value of another cell.

    To validate only integer values, you can slightly modify hot_validate_numeric. That's what I did (but I didn't test):

    hot_validate_integer <- function (hot, cols, min = NULL, max = NULL, choices = NULL, 
              exclude = NULL, allowInvalid = FALSE) 
    {
      f <- paste(
        "function (value, callback) {",                              
        "  if (value === null || value === void 0) {",               
        "    value = '';",                                       
        "  }",                                                       
        "  if (this.allowEmpty && value === '') {",              
        "    return callback(true);",                                
        "  } else if (value === '') {",                          
        "    return callback(false);",                               
        "  }",                                                       
        "  let isNumber = /^-?\\d*(\\.|,)?\\d*$/.test(value);",
        "  if (!isNumber) {",                                        
        "    return callback(false);",                               
        "  }",
        "  let x = parseFloat(value);",
        "  if (isNaN(x) || !Number.isInteger(x)) {",                         
        "    return callback(false);",                               
        "  }",                                                       
        "  %exclude",                                                
        "  %min",                                                    
        "  %max",                                                    
        "  %choices",                                                
        "  return callback(true);",                                  
        "}",
        sep = "\n"
      )
      if (!is.null(exclude)) 
        ex_str = paste0("if ([", paste0(paste0("'", exclude, 
                                               "'"), collapse = ","), "].indexOf(value) > -1) { return callback(false); }")
      else ex_str = ""
      f = gsub("%exclude", ex_str, f)
      if (!is.null(min)) 
        min_str = paste0("if (value < ", min, ") { return callback(false); }")
      else min_str = ""
      f = gsub("%min", min_str, f)
      if (!is.null(max)) 
        max_str = paste0("if (value > ", max, ") { return callback(false); }")
      else max_str = ""
      f = gsub("%max", max_str, f)
      if (!is.null(choices)) 
        chcs_str = paste0("if ([", paste0(paste0("'", choices, 
                                                 "'"), collapse = ","), "].indexOf(value) == -1) { return callback(false); }")
      else chcs_str = ""
      f = gsub("%choices", chcs_str, f)
      for (x in cols) hot = hot %>% hot_col(x, validator = f, allowInvalid = allowInvalid)
      hot
    }
    

    Edit: it's possible!

    Finally it's possible to compare with the above cell, by using the afterValidateCell hook:

    jsCode <- c(
      "function(el, x) {",
      "  var hot = this.hot;",
      "  Handsontable.hooks.add('afterValidate', function(isValid, value, row, prop){",
      "    if(row > 0) {",
      "      let x = this.getDataAtCell(row - 1, prop);",
      "      if(value < x) {",
      "        return(false);",
      "      }",
      "    }",
      "  }, hot);",
      "}"
    )
    
    library(rhandsontable)
    library(htmlwidgets)
    
    MAT = matrix(seq_len(50), nrow = 10, dimnames = list(LETTERS[1:10],
                                                       letters[1:5]))
    
    rhandsontable(MAT) %>%
      hot_validate_integer(col = 1) %>% 
      onRender(jsCode)