Rhandsontable bouncing when processing a slow calculation

[lgirola]

In running the example code below, the user inputs into a table at the top of the rendered window (hottable_1 rendered with the renderRHandsontable({...}) function) and the code then executes a very time-consuming example calculation (calculate(x)) and outputs the results into the second table (non-rhandsontable) shown at the bottom of the rendered window. That single action button adds a column to both of the rendered tables, the input table (using rhandsontable) at the top and the output table at the bottom of the window. The top table provides inputs for calculating the bottom table.

If the user inputs into the top table and then hits ENTER on the keyboard before clicking the single action button (which sets off a chain of reactive events, including adding a column to both tables), then the code works fine. But if the user inputs into the top rhandsontable table and then clicks on the single action button without having hit ENTER first, then the tables starts bouncing. I've tried shiny::debounce() but you must specify the milliseconds for allowing the downstream calculations that depend on the reactive expression. The problem in this case is that it's hard to define how much time to allow because processing time depends on the user's inputs. So, in this code example, the reactivity chain is quicker than the calculation function that is called.

I suspect the issue lies with rhandsontable because when I replace rhandsontable with DT table, there is no bouncing. However user inputs into DT table are not as easy and as clean as rhandsontable, not being as interactive, and I strongly prefer using rhandsontable.

Please help!

Code:

library(rhandsontable)
library(shiny)

options(scipen=5)

seriesGenTrm <- data.frame('Series_1' = c(1), row.names = c("Input_1"))

calculation <- function(x) {
  x <- max(x, 1)
  start.time <- Sys.time()
  while (as.numeric(difftime(Sys.time(), start.time, units = "secs")) < x) {
    result <- sum(runif(10000))
  }
  result <- data.frame(Results = rep(result, 5))
  result
}

ui <- fluidPage(
  rHandsontableOutput('hottable_1'), br(),
  actionButton("addSeries", "Add series"), br(),
  tableOutput("alloc_tbl")
)

server <- function(input, output, session) {
  seriesTbl_1 <- reactiveVal(seriesGenTrm)

  observeEvent(input$hottable_1, {
    seriesTbl_1(hot_to_r(input$hottable_1))
  })

  output$hottable_1 <- renderRHandsontable({
    rhandsontable(
      data.frame(seriesTbl_1(), check.names = FALSE),
      rowHeaderWidth = 100
    )
  })

  observeEvent(input$addSeries, {
    newSeriesCol_1 <- data.frame(c(1))
    names(newSeriesCol_1) <- paste0("Series_", ncol(hot_to_r(input$hottable_1)) + 1)
    seriesTbl_1(cbind(seriesTbl_1(), newSeriesCol_1))
  })

  addCol <- function(allocData, columnName, seriesTbl_1) {
    allocData[[columnName]] <-
      calculation(seriesTbl_1()[1, colnames(seriesTbl_1()) == columnName])
    return(allocData)
  }

  allocData <- reactive({
    allocDataTmp <- data.frame(Row = 1:5)
    for (colName in colnames(seriesTbl_1())) {
      allocDataTmp <- addCol(allocDataTmp, colName, seriesTbl_1)
    }
    return(allocDataTmp)
  })

  output$alloc_tbl <- renderTable({allocData()})
}

shinyApp(ui, server)