show_modal_spinner 在 R Shiny 中生成输出之前立即消失

Question

我正在尝试使用 show_modal_spinner 来显示文本消息，而模型运行s 来生成输出，我在单个 obsereveEvent 函数中使用 PLS-PM，但是 showModal 弹出窗口闪烁一秒钟然后消失，而观察事件功能仍然是运行ning，我正在从该事件中获取所有结果，但是当我单击运行按钮时模态微调器就会消失。下面是我正在使用的观察事件函数。请帮助调试此代码。

#------------------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

您没有在 remove_modal_spinner() 和 show_modal_spinner() 中使用 session = shiny::getDefaultReactiveDomain() 参数。试试这个

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

Answer 2

那是因为你在 observeEvent 中定义了 reactive。当您使用 PLSPM_result_data_sym <- reactive(...) 时，它不会进行计算，它只是注册为稍后完成（当您调用 PLSPM_result_data_sym() 时）。相反，您可以像这样使用 reactiveValues（并将 output 也放在 observeEvent 之外）：

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

show_modal_spinner 在 R Shiny 中生成输出之前立即消失

show_modal_spinner disappears instantly before generating outputs in Rshiny

r

showmodaldialog

shiny