在Shiny中使用observeEvent时，如何多次渲染？

Question

I am using shiny in R and want to render more than once when using observeEvent in server.R

I don't understand why this does not work:

library(shiny)

my_UI <- fluidPage(
  fluidRow(actionButton("test", "test")),
  fluidRow(textOutput("out"))
)

my_Server <- function(input, output) {
  observeEvent(input$test, {
    output$out <- renderText("waiting")
    Sys.sleep(2)
    output$out <- renderText("done")
  })
}

shinyApp(my_UI, my_Server)

I also tried:

library(shiny)

my_UI <- fluidPage(
  fluidRow(actionButton("test", "test")),
  fluidRow(textOutput("out"))
)

my_Server <- function(input, output) {

  observeEvent(input$test, {
    output$out <- renderText("waiting")
  })
  observeEvent(input$test, {
    Sys.sleep(2)
    output$out <- renderText("done")
  })
}

shinyApp(my_UI, my_Server)

In both cases, only the latter message is rendered... What am I doing wrong here? Thanks!

Answer 1

I can't give you solution for each line render in one observeEvent, but if you just want show loading/calculation progress, you can use

withProgress()

so app can be like this:

library(shiny)

my_UI <- fluidPage(
  fluidRow(actionButton("test", "test")),
  fluidRow(textOutput("out"))
)

my_Server <- function(input, output) {

  observeEvent(input$test, {
    withProgress(
      message = 'Calculation in progress',
      detail = 'This may take a while...', value = 0, {
        incProgress(1/2, message = "Step 1")
        Sys.sleep(2)
        # Do some stuff, load, calculate, etc
        incProgress(1/2, message = "Step 2")
      })
  })
}

shinyApp(my_UI, my_Server)

Answer 2

You can't do this with Shiny, because only the latest output value will be used.

You can do it with javascript, but you have probably better options, ie withProgress as feniw_fx mentionned

library(shiny)
my_UI <- fluidPage(
  tags$head(
    tags$script(
      "function test() {
      document.getElementById('out').innerHTML = 'waiting';
      setTimeout(function() {document.getElementById('out').innerHTML = 'done'}, 2000);}"
  )),
  fluidRow(actionButton("test", "test", onclick = "test()")),
  fluidRow(textOutput("out"))
)

my_Server <- function(input, output, session) {

}

shinyApp(my_UI, my_Server)