rshinyrhandsontable

How to ignore user inputs that would otherwise cause R Shiny App to crash?


The below R Shiny code works as intended. The user inputs values into a parent table "parentTbl", and the user can then alter the shape of the resulting line (creating a curve) by inputting into the X/Y child tables that render beneath the parent table. The image below explains how this App works.

There are certain scenarios where the App crashes, but they are difficult to replicate. Usually occurs if the user has added a row to a X/Y child table, leaves the new row blank, and then moves the slider input for object input$periods. Sometimes but not always in this scenario, a crash. Difficult to replicate, but it happens more often after a long session where I guess processing gets clogged up. R Studio console gives the following error messages:

Warning: Error in .rowNamesDF<-: invalid 'row.names' length, or

Warning: non-unique value when setting 'row.names': ‘2’
Warning: Error in .rowNamesDF<-: duplicate 'row.names' are not allowed

My question: is there a way in R Shiny to simply ignore user inputs, and revert to the previous user inputs, if the current user inputs would otherwise cause the code to crash?

enter image description here

Code:

library(shiny)
library(rhandsontable)

ui <- fluidPage(
  sliderInput("periods", "Time window (W):", min = 1, max = 10, value = 5),
  h5(strong("Variable (Y) over window (W):")),
  rHandsontableOutput("parentTbl"),  
  uiOutput("childTbl")
)

server <- function(input, output, session) {
  numVars <- 2  # Number of variables to model
  parentVars <- lapply(1:numVars, function(i) { reactiveValues(data = 20) })
  
  output$parentTbl <- renderRHandsontable({
    rhandsontable(
      data.frame(Inputs = sapply(parentVars, function(x) x$data)),
      readOnly = FALSE,
      colHeaders = c('Inputs'),
      rowHeaders = paste0("Var ", LETTERS[1:numVars]),
      contextMenu = FALSE
    )
  })
  
  observeEvent(input$parentTbl, {
    newValues <- hot_to_r(input$parentTbl)$Inputs
    for (i in 1:numVars) {
      parentVars[[i]]$data <- newValues[i]
    }
  })
  
  reviseTbl <- lapply(1:numVars, function(i) { reactiveVal() })
  
  observeEvent(input$periods, {
    for (i in 1:numVars) {
      varInputId <- paste0("var_", i, "_input")
      reviseTable <- hot_to_r(input[[varInputId]])
      reviseTable <- subset(reviseTable, X <= input$periods)
      reviseTbl[[i]](reviseTable)  # Update the corresponding reactiveVal
    }
  }, ignoreInit = TRUE)
  
  # Builds X/Y child tables
  lapply(1:numVars, function(i) {
    varInputId <- paste0("var_", i, "_input")
    output[[varInputId]] <- renderRHandsontable({
      # Always base the Y value of the first row on the current parentVars[[i]]$data
      df <- data.frame(X = 1, Y = parentVars[[i]]$data)
      
      # If reviseTbl[[i]]() has been updated, use that data instead
      if (!is.null(reviseTbl[[i]]())) {
        df <- reviseTbl[[i]]()
        if (nrow(df) > 0) {
          df[1, "Y"] <- parentVars[[i]]$data  # Ensure the Y value of the first row is updated
        }
      }
      
      rhandsontable(df, contextMenu = TRUE, minRows = 1, rowHeaders = FALSE) %>%
        hot_validate_numeric(col = 1, min = 1, max = input$periods)
    })
  })
  
  output$childTbl <- renderUI({
    lapply(1:numVars, function(i) {
      varInputId <- paste0("var_", i, "_input")
      list(
        h5(strong(paste("Adjust Var ", LETTERS[i], " (Y) at time X:"))),
        rHandsontableOutput(varInputId)
      )
    })
  })
}

shinyApp(ui, server)

Solution

  • First of all notice that the error can be replicated e.g. by

    1. Inserting one empty row into the X child table,
    2. moving the slider one to the right,
    3. and then doing the same, but inserting two empty rows before moving the slider.

    Notice that this may not be a problem with your app, but with rhandsontable itself (see e.g. this issue on GitHub, which is closed, but there are recent comments which indicate that the behavior still occurs).

    However, it should be possible to prevent the crash as follows: Currently you read the rhandsontable by using

    reviseTable <- hot_to_r(input[[varInputId]])
    

    Replace this using tryCatch such that in case of an error you take the latest value of the corresponding reactiveVal:

    reviseTable <- tryCatch({
      hot_to_r(input[[varInputId]])
    }, error = function(e) {
      reviseTbl[[i]]()
    })
    

    Using this, the app shouldn't crash due to this error any more.