无法使用Shiny和Futures进行“加载”

时间:2019-08-13 09:11:06

标签: r shiny future

我正在尝试使用期货来显示“正在加载”图标。这是我的代码

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

disksUI <- function(id) {
  ns <- NS(id)
  fluidRow(
    box(
      uiOutput(ns("loading")),
      dataTableOutput(ns("filelist")),
      width=12
    )
  )
}

disksServer <- function(input, output, session) {
  state <- reactiveValues(onLoading=FALSE)

  observe({
    if (state$onLoading) {
      output$loading <- renderUI("Loading")
    } else {
      output$loading <- renderUI("Done")
    }
  })

  filelist <- reactive(
    {
      state$onLoading <- TRUE
      future({
        Sys.sleep(3)
        state$onLoading <- FALSE
       }
      )
    }
  )

  output$filelist <- renderDataTable({
    filelist()
  })

}

但是,结果不是我期望的。我期望的是

  • 正在加载字符串立即显示
  • 三秒钟后,字符串Loading被替换为Done

会发生什么

  • 三秒钟什么都没写。
  • 三秒钟后,出现正在加载的字符串。

1 个答案:

答案 0 :(得分:0)

我首先发布了答案here。但是,请在此处为以后的读者添加它:

这是一个有效的示例:

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

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

  output$loading <- renderUI("Idling")

  myFilelist <- reactiveVal(NULL)

  observeEvent(input$getBtn, {

    disable("getBtn")
    output$loading <- renderUI("Loading")

    myFuture <- future({
      Sys.sleep(3)
      data.frame(list.files(getwd()))
    })

    then(myFuture, onFulfilled = function(value) {
      enable("getBtn")
      output$loading <- renderUI("Done")
      myFilelist(value)
    },
    onRejected = NULL)

    return(NULL)
  })

  output$filelist <- renderDataTable({
    myFilelist()
  })

}

ui <- fluidPage(
  useShinyjs(),
  fluidRow(
    actionButton("getBtn", "Get file list"),
    box(
      uiOutput("loading"),
      dataTableOutput("filelist"),
      width=12
    )
  )
)

shinyApp(ui, server)

请注意return(NULL)中的observeEvent()-这掩盖了自己会话的未来-允许会话内响应。然而,正如乔诚(Joe Cheng)向您提到的here,现在我们必须处理潜在的比赛条件。在这个简单的示例中,我们可以禁用触发按钮,以避免用户在其他人仍在处理中的同时创建新期货的可能性。 有关更多详细信息,请阅读this