show_modal_spinner disappears instantly before generating outputs in Rshiny

Question

I'm trying to use show_modal_spinner to to display a text message while the model runs to generate outputs, I'm using PLS-PM in single obsereveEvent function but the showModal popup flashes for a second and disappears while the observe event function is still running, I'm getting all the results from this event but the Modal spinner vanishes as soon as I click the run button. Below is the observe event function I'm using. Please help in in debugging this code.

#------------------PLSPM Analysis Function------------------------

  observeEvent({input$actionButton_PLSPM_analysis}, {
    
    show_modal_spinner(
      spin = "cube-grid",
      color = "firebrick",
      text = "Please wait..."      
    )
    
    PLSPM_result_data_sym <- reactive({
      readData(exps=input$PLSPM_ProtocolSelection, crop=input$PLSPM_CropSelection, country=input$PLSPM_CountrySelection, sym = input$PLSPM_TreatmentSelection)
    })
  
  PLSPM_Model_Analysis <- reactive({run_PLSPM_Analysis(PLSPM_result_data_sym(), input$PLSPM_CropSelection)})

  PLSPM_summary <- reactive({(PLSPM_Model_Analysis()$summary)})
  PLSPM_inner_model <- reactive({innerplot(PLSPM_Model_Analysis()$model, colpos = "#6890c4BB", colneg = "#f9675dBB",
                                     box.prop = 0.55, box.size = 0.08, box.cex = 1,
                                     box.col = "gray95", lcol = "black", box.lwd = 2,
                                     txt.col = "black", shadow.size = 0, curve = 0,
                                     lwd = 3, arr.pos = 0.5, arr.width = 0.2, arr.lwd = 3,
                                     cex.txt = 0.9)})
  PLSPM_Weight_plot <- reactive({outerplot(PLSPM_Model_Analysis()$model, colpos = "#6890c4BB", colneg = "#f9675dBB",
                                     box.prop = 0.55, box.size = 0.08, box.cex = 1,
                                     box.col = "gray95", lcol = "black", box.lwd = 2,
                                     txt.col = "black", shadow.size = 0, curve = 0,
                                     lwd = 3, arr.pos = 0.5, arr.width = 0.2, arr.lwd = 3,
                                     cex.txt = 0.9)})
  PLSPM_Loading_plot <- reactive({outerplot(PLSPM_Model_Analysis()$model, colpos = "#6890c4BB", colneg = "#f9675dBB",
                                      box.prop = 0.55, box.size = 0.08, box.cex = 1,
                                      box.col = "gray95", lcol = "black", box.lwd = 2,
                                      txt.col = "black", shadow.size = 0, curve = 0,
                                      lwd = 3, arr.pos = 0.5, arr.width = 0.2, arr.lwd = 3,
                                      cex.txt = 0.9)})

  mydf_inner_model <- reactive({as.data.frame(PLSPM_summary()$inner_model$pyield)})
  mydf_outer_model <- reactive({as.data.frame(PLSPM_summary()$outer_model)})

  output$data_table_inner_model <- renderDataTable({
    datatable(mydf_inner_model(),options = list(
      scrollX = TRUE))
  })
  output$data_table_outer_model <- renderDataTable({
    datatable(mydf_outer_model(),options = list(
      scrollX = TRUE))
  })
  output$plot_PLSPM_inner_model <- renderPlot({
    (PLSPM_inner_model())
  })
  output$plot_PLSPM_Weight_plot <- renderPlot({
    (PLSPM_Weight_plot())
  })
  output$plot_PLSPM_Loading_plot <- renderPlot({
    (PLSPM_Loading_plot())
  })
  remove_modal_spinner()

  })

Answer 1

That's because you define reactive inside an observeEvent. When you use PLSPM_result_data_sym <- reactive(...) it does not do the calculation, it is simply registered to be done later (when you call PLSPM_result_data_sym()). Instead you can use reactiveValues like this (and put the output outside the observeEvent too):

function(input, output, session) {
  rv <- reactiveValues()
  observeEvent({
    input$actionButton_PLSPM_analysis
  }, {
    show_modal_spinner(spin = "cube-grid",
                       color = "firebrick",
                       text = "Please wait...")
    
    rv$PLSPM_result_data_sym <- readData(
      exps = input$PLSPM_ProtocolSelection,
      crop = input$PLSPM_CropSelection,
      country = input$PLSPM_CountrySelection,
      sym = input$PLSPM_TreatmentSelection
    )
    
    rv$PLSPM_Model_Analysis <-run_PLSPM_Analysis(rv$PLSPM_result_data_sym, input$PLSPM_CropSelection)
    
    rv$PLSPM_summary <- rv$PLSPM_Model_Analysis$summary
    rv$PLSPM_inner_model <- innerplot(
        rv$PLSPM_Model_Analysis$model,
        colpos = "#6890c4BB",
        colneg = "#f9675dBB",
        box.prop = 0.55,
        box.size = 0.08,
        box.cex = 1,
        box.col = "gray95",
        lcol = "black",
        box.lwd = 2,
        txt.col = "black",
        shadow.size = 0,
        curve = 0,
        lwd = 3,
        arr.pos = 0.5,
        arr.width = 0.2,
        arr.lwd = 3,
        cex.txt = 0.9
      )
    rv$PLSPM_Weight_plot <-
      outerplot(
        rv$PLSPM_Model_Analysis$model,
        colpos = "#6890c4BB",
        colneg = "#f9675dBB",
        box.prop = 0.55,
        box.size = 0.08,
        box.cex = 1,
        box.col = "gray95",
        lcol = "black",
        box.lwd = 2,
        txt.col = "black",
        shadow.size = 0,
        curve = 0,
        lwd = 3,
        arr.pos = 0.5,
        arr.width = 0.2,
        arr.lwd = 3,
        cex.txt = 0.9
      )
    rv$PLSPM_Loading_plot <-
      outerplot(
        rv$PLSPM_Model_Analysis$model,
        colpos = "#6890c4BB",
        colneg = "#f9675dBB",
        box.prop = 0.55,
        box.size = 0.08,
        box.cex = 1,
        box.col = "gray95",
        lcol = "black",
        box.lwd = 2,
        txt.col = "black",
        shadow.size = 0,
        curve = 0,
        lwd = 3,
        arr.pos = 0.5,
        arr.width = 0.2,
        arr.lwd = 3,
        cex.txt = 0.9
      )
    
    rv$mydf_inner_model <- as.data.frame(rv$PLSPM_summary$inner_model$pyield)
    rv$mydf_outer_model <- as.data.frame(rv$PLSPM_summary$outer_model)
    
    remove_modal_spinner()
    
  })
  
  output$data_table_inner_model <- renderDataTable({
    datatable(rv$mydf_inner_model, options = list(scrollX = TRUE))
  })
  output$data_table_outer_model <- renderDataTable({
    datatable(rv$mydf_outer_model, options = list(scrollX = TRUE))
  })
  output$plot_PLSPM_inner_model <- renderPlot({
    rv$PLSPM_inner_model
  })
  output$plot_PLSPM_Weight_plot <- renderPlot({
    rv$PLSPM_Weight_plot
  })
  output$plot_PLSPM_Loading_plot <- renderPlot({
    rv$PLSPM_Loading_plot
  })
}

Answer 2

You have not used session = shiny::getDefaultReactiveDomain() argument in both remove_modal_spinner() and show_modal_spinner(). Try this

     observeEvent({input$actionButton_PLSPM_analysis}, {
        
        show_modal_spinner(
          spin = "cube-grid",
          color = "firebrick",
          text = "Please wait...",
          session = shiny::getDefaultReactiveDomain()
        )

        ##  other computations here
    
        remove_modal_spinner(session = shiny::getDefaultReactiveDomain())
    
      })