R блестящий: обновите tabsetpanel перед завершением всего кода наблюденияEvent

Question

Я хочу обновить 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 обновляет интерфейс только после обновления всех недействительных наблюдений или реактивных операторов. Поэтому вы должны создавать реактивные цепочки, когда вам нужен такой рабочий процесс. Я решил это, хотя вытащил подготовку данных в отдельном реактивном утверждении (это на самом деле не обязательно, но всегда хорошая идея), а затем переместил график на вкладку «Сводка». Я предположил, что причина для переключения вкладки заключалась в том, чтобы увидеть сюжет. Пожалуйста, поправьте меня, если это не правильно. Но это откладывает вычисления до тех пор, пока не появится вкладка. Теперь, чтобы предотвратить запуск вычислений до нажатия кнопки goPlot, я просто добавил строку

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)

Надеюсь, это поможет !!

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

Тем не менее, вкладка обновляется после графика. Возможно, кто-то может пролить свет на то, что здесь происходит.