show_modal_spinner disappears instantly before generating outputs in Rshiny - r

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())
})