在observeEvent中更新shinydashboardPlus 手风琴的内容

Question

我有一个闪亮的dashboardPlus

accordion

（AdminLTE2 手风琴容器），应用程序启动时它会折叠；单击按钮后，我想打开手风琴（使用

updateAccordion

），在手风琴内显示“计算正在进行”，然后运行计算，最后显示“计算完成”。

我的问题如下：手风琴在计算过程中保持折叠状态（第一条消息“计算正在进行”不会出现），最后只有最后一条消息可见。

这是什么原因呢？这个最小的例子有什么问题？

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)

shinyApp(
  ui = dashboardPage(
    dashboardHeader(),
    dashboardSidebar(),
    dashboardBody(
      actionButton("change_acc", "Change Accordion"),
      accordion(
        id = "accordion1",
        accordionItem(
          title = "Accordion 1 Item 1",
          status = "danger",
          collapsed = TRUE,
            uiOutput("accordion_msg")
        )
        )
    ),
    title = "Update Accordion"
  ),
  server = function(input, output, session) {
    observeEvent(input$change_acc, {
      updateAccordion(id = "accordion1", selected = 1)
      output$accordion_msg <- renderUI({
        HTML("... calculation in progress ...") ## <<<<<<<<<<<<<<< this message is never printed !
      })
      Sys.sleep(100)
      output$accordion_msg <- renderUI({
        HTML("... calculation done ...")  ### <<<<< but this one is ?!
      })
    })
  }
)

编辑：其他试用（也不起作用）-没有嵌套 renderUI 的服务器

  server = function(input, output, session) {
    x <- reactiveValues()
    x$x <- FALSE
    x$y <- FALSE
    observeEvent(input$change_acc, {
      updateAccordion(id = "accordion1", selected = 1)
      output$accordion_msg <- renderUI({
        HTML("... computation in progress ...") ## <<<<<<<<<<<<<<< this message is never printed !
      })
      x$y <- TRUE
    })
    observeEvent(x$y,{
      if(x$y){
        cat(paste0("start sleep\n"))
        Sys.sleep(5)
        cat(paste0("end sleep\n"))
        x$x <- TRUE
      }
    })
    observeEvent(x$x,{
      if(x$x){
        output$accordion_msg <- renderUI({
          HTML("... computation done ...")
        })
      }
    })
  })

Answer 1

在你的代码中，你仍然有嵌套的反应式，例如，与

observeEvent(x$x,{
      if(x$x){
        output$accordion_msg <- renderUI({
          HTML("... computation done ...")
        })
      }
    })

和

    observeEvent(input$change_acc, {
      updateAccordion(id = "accordion1", selected = 1)
      output$accordion_msg <- renderUI({
        HTML("... computation in progress ...") 
      })
      x$y <- TRUE
    })

因此，实际上，您有两个“竞争”的

output$accordion_msg

定义。

[这是一个非常直观的解释，技术能力比我更强的读者将能够为您提供更规范的解释。]

这是一个我相信可以满足您需求的解决方案。请注意，(1) 没有观察者/反应者的定义嵌套在另一个观察者/反应者的定义中。 在使用 Shiny 时，这是一个非常好的经验法则，恕我直言。 (2) 更新

status

的观察者与更新

x$msg

的观察者是分开的。

我首先认为

status

应该是响应式的，但是当我编写代码时，我意识到使其成为非响应式更容易。为了确保在任何需要的地方都可以对其进行更改，我使用

<<-

。这很hacky，但是很简单。在生产中做一些更安全的事情可能会更好。

最初，我仅更新

observeEvent

和

status

更新

observe

，但这意味着“进行中”消息仅在单击按钮后五秒出现，而不是立即出现。 （“完成”消息在单击后十秒而不是五秒出现。）x$msg