Question

我想立即更新tabsetpanel，而不要等到完成下载功能。在这里，您可以找到一个简单的代码。它带有一个按钮，并在按下按钮时模拟下载并更新tabsetpanel。我想在完成下载之前更新面板。

谢谢！

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

observeEvent(input$goPlot,{

updateTabsetPanel(session, "inTabset",
                  selected = 'Summary'
)

output$plot <- renderPlot({
  input$goPlot # Re-run when button is clicked

  # Create 0-row data frame which will be used to store data
  dat <- data.frame(x = numeric(0), y = numeric(0))

  withProgress(message = 'Making plot', value = 0, {
    # Number of times we'll go through the loop
    n <- 10

    for (i in 1:n) {
      # Each time through the loop, add another row of data. This is
      # a stand-in for a long-running computation.
      dat <- rbind(dat, data.frame(x = rnorm(1), y = rnorm(1)))

      # Increment the progress bar, and update the detail text.
      incProgress(1/n, detail = paste("Doing part", i))

      # Pause for 0.1 seconds to simulate a long computation.
      Sys.sleep(1)
    }
  })

  plot(dat$x, dat$y)
})



})
}

ui <- shinyUI(fluidPage(
actionButton('goPlot', 'Go plot'),
tabsetPanel(id = "inTabset",
tabPanel("Plot", plotOutput("plot")),
tabPanel("Summary")

)
)   

)

shinyApp(ui = ui, server = server)

Answer 1

Shiny仅在更新所有无效的观察或反应性语句之后才更新UI。因此，当您需要这样的工作流程时，您必须构建反应链。我通过在单独的反应式语句中撤出数据准备工作来解决了这一问题（虽然这不是必须的，但始终是个好主意），然后将图移至“摘要”选项卡。我以为切换选项卡的原因是看情节。如果这不正确，请纠正我。但这会推迟计算，直到显示选项卡。现在，为了防止在单击req(input$goPlot)按钮之前开始计算，我刚刚添加了行

server <- function(input, output,session) {
  observeEvent(input$goPlot,{

    updateTabsetPanel(session, "inTabset",
                      selected = 'Summary'
    )
    generate_plot <- reactive({

      req(input$goPlot) 

      # Create 0-row data frame which will be used to store data
      dat <- data.frame(x = numeric(0), y = numeric(0))

      withProgress(message = 'Making plot', value = 0, {
        # Number of times we'll go through the loop
        n <- 10

        for (i in 1:n) {
          # Each time through the loop, add another row of data. This is
          # a stand-in for a long-running computation.
          dat <- rbind(dat, data.frame(x = rnorm(1), y = rnorm(1)))

          # Increment the progress bar, and update the detail text.
          incProgress(1/n, detail = paste("Doing part", i))

          # Pause for 0.1 seconds to simulate a long computation.
          Sys.sleep(1)
        }
      })

      plot(dat$x, dat$y)

    })
    output$plot <- renderPlot({
      generate_plot()
    })



  })
}

ui <- shinyUI(fluidPage(
  actionButton('goPlot', 'Go plot'),
  tabsetPanel(id = "inTabset",
              tabPanel("Plot"),
              tabPanel("Summary", plotOutput("plot"))

  )
)   

)

shinyApp(ui = ui, server = server)

到反应式语句的开头。

.join

希望这会有所帮助！

Answer 2

您可以这样做：

  observeEvent(input$goPlot, {
    updateTabsetPanel(session, "inTabset",
                      selected = 'Summary'
    )       
  })

  output$plot <- renderPlot({
    req(input$inTabset == "Summary") # require "Summary" is the active tab
    input$goPlot # Re-run when button is clicked
    ......

或执行一些Javascript代码来更改活动标签，例如与shinyjs：

library(shiny)
library(shinyjs)

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

  observeEvent(input$goPlot, {

    runjs("$('a[data-value=Summary]').click();") # go to Summary tab

    output$plot <- renderPlot({
      input$goPlot # Re-run when button is clicked

      # Create 0-row data frame which will be used to store data
      dat <- data.frame(x = numeric(0), y = numeric(0))

      withProgress(message = 'Making plot', value = 0, {
        # Number of times we'll go through the loop
        n <- 10
        for (i in 1:n) {
          # Each time through the loop, add another row of data. This is
          # a stand-in for a long-running computation.
          dat <- rbind(dat, data.frame(x = rnorm(1), y = rnorm(1)))
          # Increment the progress bar, and update the detail text.
          incProgress(1/n, detail = paste("Doing part", i))
          # Pause for 0.1 seconds to simulate a long computation.
          Sys.sleep(1)
        }
      })

      plot(dat$x, dat$y)
    })

  })


}

ui <- shinyUI(fluidPage(
  useShinyjs(),
  actionButton('goPlot', 'Go plot'),
  tabsetPanel(id = "inTabset",
              tabPanel("Plot", plotOutput("plot")),
              tabPanel("Summary")
  )
))

shinyApp(ui = ui, server = server)

Answer 3

我知道，这并不是一个真正的答案，但我并不真正理解为什么以下内容不起作用。它可以确保正确的执行顺序，但是问题仍然存在。我想问题是更新没有在更新完成之前就被刷新。

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

  rv <- reactiveValues(goPlot_wait = 0)

  observeEvent(input$goPlot,{
    cat("A EXECUTED\n")
    updateTabsetPanel(session, "inTabset", selected = 'Summary')
    rv$goPlot_wait <- rv$goPlot_wait + 1
  })

  observeEvent(rv$goPlot_wait,{
    if(rv$goPlot_wait == 0) {
      return()
    }
    cat("B EXECUTED\n")

    output$plot <- renderPlot({
      # Create 0-row data frame which will be used to store data
      dat <- data.frame(x = numeric(0), y = numeric(0))

      withProgress(message = 'Making plot', value = 0, {
        # Number of times we'll go through the loop
        n <- 10

        for (i in 1:n) {
          # Each time through the loop, add another row of data. This is
          # a stand-in for a long-running computation.
          dat <- rbind(dat, data.frame(x = rnorm(1), y = rnorm(1)))

          # Increment the progress bar, and update the detail text.
          incProgress(1/n, detail = paste("Doing part", i))

          # Pause for 0.1 seconds to simulate a long computation.
          Sys.sleep(0.25)
        }
      })

      plot(dat$x, dat$y)
    })

  })
}

ui <- shinyUI(fluidPage(
  actionButton('goPlot', 'Go plot'),
  tabsetPanel(id = "inTabset",
              tabPanel("Plot", plotOutput("plot")),
              tabPanel("Summary"))))

shinyApp(ui = ui, server = server)

运行该应用程序并按下按钮时，我得到：

> shinyApp(ui = ui, server = server)

Listening on http://127.0.0.1:6800
A EXECUTED
B EXECUTED

但是，在绘制图形后，选项卡集已更新。也许有人可以阐明这里发生的事情。

R Shiny：在完成所有observeEvent代码之前更新tabsetpanel

3 个答案: