Shiny - Running a complex process ties up the UI

shiny_single_process.R

## Data creation
## 
## Create a large Excel spreadsheet within a Shiny app
##

library(shiny)
library(openxlsx)

## Create a dummy matrix

server <- function(input, output, session) {
  
  mydata <- reactiveValues(wb = NULL)
  status <- reactiveValues(text = 'Waiting')
  
  ## Disable download button
  observe({
    session$sendCustomMessage('disableButton', 'butDownload')
  })

  ## Generate Excel output
  observeEvent(input$butCreate, {
    session$sendCustomMessage('disableButton', 'butDownload')
    session$sendCustomMessage('disableButton', 'butCreate')
    
    ## Included for comparison - the status text will not update until after the spreadsheet is built
    status$text <- 'Building'
    
    m <- matrix(rexp(input$numRows * input$numCols, rate = 0.1), ncol = input$numCols)
    
    wb <- createWorkbook()
    addWorksheet(wb, 'sheet1')
    writeData(wb, 'sheet1', m)
    mydata$wb <<- wb
    session$sendCustomMessage('enableButton', 'butDownload')
    session$sendCustomMessage('enableButton', 'butCreate')
    status$text <- 'Completed'
  })
  
  output$butDownload <- downloadHandler(
    filename = function() {
      'output.xlsx'
    },
    content = function(file) {
      showNotification('Writing Excel File')
      saveWorkbook(mydata$wb, file, overwrite = TRUE)
    }
  )
  
  output$uiStatus <- renderUI(
    h4(paste0('STATUS: ', status$text), style="color:red;")
  )

  output$plt <- renderPlot({
    hist(faithful$eruptions, probability = TRUE, breaks = as.numeric(input$n_breaks),
         xlab = 'Duration (minutes)', main = 'Geyser eruption duration')
    dens <- density(faithful$eruptions, adjust = input$bw_adjust)
    lines(dens, col = 'blue')
  })
}

ui <- fluidPage(
  singleton(tags$head(HTML('
    <script type="text/javascript">
    $(document).ready(function() {
      // Enable button
      Shiny.addCustomMessageHandler("enableButton", function(id) {
        $("#" + id).removeAttr("disabled");
      });
      // Disable button
      Shiny.addCustomMessageHandler("disableButton", function(id) {
        $("#" + id).attr("disabled", "true");
      });
      })
    </script>
    ')
  )),
  fluidRow(
    column(4,
           wellPanel(
             fluidRow(
               column(6, numericInput('numRows', 'Number of Rows', value = 100000, min = 1000, step = 1000)),
               column(6, numericInput('numCols', 'Number of Columns', value = 50, min = 10, step = 10))
             )
           ),
           fluidRow(
             column(11, offset = 1,
                    actionButton('butCreate', 'Create Data', class = 'btn action-button btn-success'),
                    downloadButton('butDownload', 'Download Data', class = 'btn btn-warning'),
                    br(),
                    uiOutput('uiStatus')
             )
           )
    ),
    column(8,
           wellPanel(
             fluidRow(
               column(4, selectInput('n_breaks', label = 'Number of bins:', choices = c(10, 20, 35, 50), selected = 20)),
               column(4, sliderInput('bw_adjust', label = 'Bandwidth adjustment:', min = 0.2, max = 2, value = 1, step = 0.2))
             )
           ),
           plotOutput('plt')
           )
    )
  )


shinyApp(ui = ui, server = server)