Search code examples
rshinyshiny-reactivityrhandsontable

How to suspend a reactive calculation until an action button is triggered?


In the below Example Code 1, a user input table hottable_1 is generated at the top of the UI window. A results table is generated beneath, alloc_tbl, which shows the user input into hottable_1 in its first row and the product of that user input and 2 in the second row, with response deliberately slow for example purposes using the calc() function. If the user inputs into hottable_1 and then immediately triggers the addSeries action button, the tables start bouncing due to slow speed of calc(). I'm trying to trigger calculations of calc() through the use of the calculate action button shown in Example Code 1. If the user inputs into hottable_1 and then immediately triggers addSeries, then a new column should be added with default values of 1 and 2 in the first and second rows respectively (and no bouncing).

In Example Code 2 below I derive an extremely simple example of triggering calculations through an action button, but I am having trouble implementing that solution into Example Code 1. Any suggestions for how to do this?

Below is an illustration of the 2 examples:

enter image description here

Example Code 1:

library(rhandsontable)
library(shiny)

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

calc <- function(x) {
  x <- max(x, 1)
  Sys.sleep(x)
  result <- x * 2
  result <- data.frame(c(x,result))
  result
}

ui <- fluidPage(
  rHandsontableOutput('hottable_1'), br(),
  actionButton("addSeries", "Add series"),
  actionButton("calculate", "Calculate"), 
  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]] <-
      calc(seriesTbl_1()[1, colnames(seriesTbl_1()) == columnName])
    return(allocData)
  }
  
  allocData <- reactive({
    allocDataTmp <- data.frame(Row = 1:2)
    for (colName in colnames(seriesTbl_1())) {
      allocDataTmp <- addCol(allocDataTmp, colName, seriesTbl_1)
    }
    return(allocDataTmp)
  })
  
  output$alloc_tbl <- renderTable({allocData()})
}

shinyApp(ui, server)

Example Code 2:

library(shiny)

ui <- fluidPage(
  numericInput("input_value", "Enter a number:", value = 1),
  actionButton("calculate", "Calculate"),
  textOutput("result")
)

server <- function(input, output) {
  inputValue <- reactiveVal()
  
  observeEvent(input$calculate, {inputValue(input$input_value)})

  calc <- reactive({
    if (input$calculate > 0) {
      Sys.sleep(3)
      result <- inputValue() * 2
      return(result)
    } else {
      return(NULL)  
    }
  })
  
  output$result <- renderText({
    result <- calc()
    if (!is.null(result)) {
      return(paste("Result:", result))
    } else {return(NULL)}
  })
}

shinyApp(ui, server)

Solution

  • As I indicated in my comment, I believe this gives you what you want. Note that I've made some changes that remove your if statments and do the same thing in a more "Shiny-like" manner.

    library(shiny)
    
    ui <- fluidPage(
      numericInput("input_value", "Enter a number:", value = 1),
      actionButton("calculate", "Calculate"),
      textOutput("result")
    )
    
    server <- function(input, output) {
      calc <- reactive({
        input$calculate
        isolate({
          Sys.sleep(3)
          input$input_value * 2
        })
      })
      
      output$result <- renderText({
        req(calc())
        
        paste("Result:", calc())
      })
    }
    
    shinyApp(ui, server)