CODEWITHSUNDEEP
rshinyshinydashboardshinydashboardplus
mazu
mazu

Reputation: 327

Update content of shinydashboardPlus accordion in observeEvent

I have a shinydashboardPlus accordion(AdminLTE2 accordion container) that is collapsed when the application starts ; after having clicked a button, I would like to open the accordion (with updateAccordion), show "calculation in progress" inside the accordion, then run the calculation and finally show "calculation done".

My issue is the following : the accordion remains collapsed during the calculation (the first message "computation in progress" does not appear), only the last one is visible at the end.

What is the reason for that ? What is wrong in this minimal example ?

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

EDIT : other trial (also not working) - server without nested 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 ...")
        })
      }
    })
  })

Upvotes: 0

Views: 109

Answers (1)

Limey
Limey

Reputation: 12526

In your code, you still had nested reactives, for example, with

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

and

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

So, in effect, you have two "competing" definitions of output$accordion_msg.

[That's a very hand-wavy explanation and readers who are more technically able than me will be able to give you a more canonical explanation of what's going on.]

Here's a solution that I believe does what you want. Note that (1) the defintion of no observers/reactives are nested withing the definition of another. This is a very good rule of thumb when working with Shiny, IMHO. (2) The observer that updates status is separate to the one that updates x$msg.

I first thought status should be reactive, but as I was writing the code, I realised that it was easier to make it non-reactive. To ensure that changes to it are available everywhere it's needed, I use <<-. That's hacky, but simple. It would probably be better to do something safer in production.

Initially, I had the observeEvent update only status and the observe update only x$msg, but that meant that the "in progress" message only appears five seconds after the button click rather than immediately. (And the "done" message appears ten seconds after the click rather than five.)

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) {
    status <- "Ready"
    x <- reactiveValues(msg = "")

    output$accordion_msg <- renderUI({
      HTML(x$msg)
    })
    
    observeEvent(input$change_acc, {
      status <<- "Running"
      x$msg <- "... calculation in progress ..."
      updateAccordion(id = "accordion1", selected = 1)
    })
    
    observe({
      if (status == "Running") {
        x$msg <- "... calculation done ..."
        status <<- "Done"
      }
      invalidateLater(5000)
    })
  }
)

Also, note that the observe continues to be evaluated every 5 seconds even after the calculation is complete. You may want to find a way of cancelling or destroying it once it's one it's job.

Upvotes: 0

Related Questions