Shiny - Рендеринг нескольких выходов параллельно - PullRequest
0 голосов
/ 15 января 2019

Когда я хочу визуализировать несколько выходов, связанных с одним наблюдателем, они отображаются после того, как оба выхода рассчитаны. Если между выходами имеется длительный расчет, то на отображение всех выходов уходит много времени.

Возможно ли в приложении Shiny выводить результаты, связанные с одним наблюдателем, индивидуально или параллельно? Вместо ожидания с рендерингом до тех пор, пока не будут рассчитаны все выходные данные.

Пример

library(shiny)

ui <- fluidPage(
  actionButton('button', 'klik'),
  textOutput('first'),
  textOutput('second')
)

server <- function(input, output, session) {
  observeEvent({input$button},{
    output$first <- renderText({Sys.Date()})
    Sys.sleep(10)
    output$second <- renderText({Sys.Date()})
  })
}

shinyApp(ui, server)

1 Ответ

0 голосов
/ 16 января 2019

Благодаря @BertilBaron я нашел способ избежать ожидания длинных вычислений в R-Shiny. Статью, которую я использовал, можно найти здесь .

По сути, вы выполняете каждый процесс параллельно, используя пакет future. С этим пакетом каждый раз, когда пользователь нажимает на кнопку, будет выполняться расчет. Так что имейте в виду, что вы должны построить блок для нетерпеливых пользователей.

Мой рабочий пример

library(shiny)
library(promises)
library(future)
plan(multiprocess)

ui <- fluidPage(
  actionButton('button', 'klik'),
  textOutput('first'),
  textOutput('second')
)

server <- function(input, output) {
  nclicks <- reactiveVal(0)
  nclicks2 <- reactiveVal(0)
  result_val <- reactiveVal()
  result_val2 <- reactiveVal()

  observeEvent(input$button,{
    # Don't do anything if analysis is already being run
    if(nclicks() != 0 | nclicks2() != 0){
      showNotification("Already running analysis")
      return(NULL)
    }

    # Increment clicks and prevent concurrent analyses
    nclicks(nclicks() + 1)
    nclicks2(nclicks2() + 1)

    result <- future({
      # Long Running Task
      Sys.sleep(10)

      #Some results
      Sys.time()
    }) %...>% result_val()

    result2 <- future({
      #Some results
      Sys.time()
    }) %...>% result_val2()

    # Catch inturrupt (or any other error) and notify user
    result <- catch(result,
                    function(e){
                      result_val(NULL)
                      print(e$message)
                      showNotification(e$message)
                    })
    result2 <- catch(result2,
                    function(e){
                      result_val2(NULL)
                      print(e$message)
                      showNotification(e$message)
                    })

    # After the promise has been evaluated set nclicks to 0 to allow for anlother Run
    result <- finally(result,
                      function(){
                        nclicks(0)
                      })
    result2 <- finally(result2,
                      function(){
                        nclicks2(0)
                      })

    # Return something other than the promise so shiny remains responsive
    NULL
  })

  output$first <- renderText({
    req(result_val())
  })
  output$second <- renderText({
    req(result_val2())
  })
}

# Run the application 
shinyApp(ui = ui, server = server)
...