Question

我正在制作一个Shiny应用程序，用户可以从下拉菜单中选择基因，点击提交按钮，然后显示该基因的一组不同图表。生成所有这些图形的计算需要一些时间，我希望Shiny显示一个进度条或一些繁忙的通知，以便用户远离提交按钮。

我在Shiny中找到了withProgress（）和Progress对象，但是 - 如果我做对了 - 那些总是必须放在一个反应函数中，然后显示那个函数的进度。但是，我有一整套不同的renderPlot（）函数需要处理，并希望显示所有这些函数的累积进度。

在搜索网页时，我还找到了ShinySky软件包，它似乎具有busyIndicator，可以设置为在Shiny繁忙时间超过一定时间时打开。但是，我收到了错误消息＆＃34;包'shinysky'不可用（对于R版本3.3.1）＆＃34;当我试图安装它时。

我使用nycflights13天气数据生成了一个小型虚拟应用程序，并且有时间延迟来说明更改输入后图表的刷新：

library(shiny)
library(nycflights13)

ui <- fluidPage(
  wellPanel(
    fluidRow(
      column(12, offset = 0,
        titlePanel("Look up airport weather data"))),
    fluidRow(
      column(3, offset = 0,
        selectizeInput(inputId = "airportName", label = "",
          choices = c("EWR", "JFK", "LGA")))),
    fluidRow(
      column(12, offset = 0,
        actionButton(inputId = "klickButton", label = "Submit")))),
  fluidRow(
    column(6, offset = 0,
      plotOutput(outputId = "windHist")),
    column(6, offset = 0,
      plotOutput(outputId = "windData"))),
  fluidRow(
    column(6, offset = 0,
      plotOutput(outputId = "precipData")),
    column(6, offset = 0,
      plotOutput(outputId = "tempData")))
)


server <- function(input, output) {
  wSubset <- eventReactive(input$klickButton, {
    subset(weather, weather$origin == input$airportName)})
  output$windHist <- renderPlot({
    Sys.sleep(1)
    hist(wSubset()$wind_dir)})
  output$windData <- renderPlot({
    Sys.sleep(1)
    plot(wSubset()$wind_speed, wSubset()$wind_gust)})
  output$precipData <- renderPlot({
    Sys.sleep(1)
    plot(wSubset()$humid, wSubset()$precip)})
  output$tempData <- renderPlot({
    Sys.sleep(1)
    plot(wSubset()$temp, wSubset()$dewp)})
}


shinyApp(ui = ui, server = server)

我正在寻找一种显示进度条的方法，该进度条在第一个函数在按下提交按钮后变为忙碌时开始，并持续到所有图形都生成为止。如果这太复杂了，我也很高兴任何其他方式告诉用户，某些事情实际上是在后台发生的，因此需要一些耐心。

Answer 1

这是解决这个问题的一种方法，但每个情节都有一个微调器。它完全基于Dean Atali的this解决方案。在单击“提交”按钮之前，需要使用JS代码隐藏微调器。单击按钮后，将显示微调器。将spinner.gif和JS代码放在www文件夹中。

spinnerManage.js

$(document).ready(function() {
            $('#klickButton').click(function() {
            $(".loading-spinner").show();
        });  
    });
    $(document).on("shiny:connected", function(e) {
            $(".loading-spinner").hide();
    });

app.R

library(shiny)
    library(nycflights13)

    mycss <- "
    .plot-container {
      position: relative;
    }
    .loading-spinner {
      position: absolute;
      left: 50%;
      top: 50%;
      z-index: -1;
      margin-top: -33px;  /* half of the spinner's height */
      margin-left: -33px; /* half of the spinner's width */
    }
    "

    ui <- fluidPage(
            tags$head(tags$style(HTML(mycss)),
                      includeScript("./www/spinnerManage.js")),
            wellPanel(
                    fluidRow(
                            column(12, offset = 0,
                                   titlePanel("Look up airport weather data"))),
                    fluidRow(
                            column(3, offset = 0,
                                   selectizeInput(inputId = "airportName", label = "",
                                                  choices = c("EWR", "JFK", "LGA")))),
                    fluidRow(
                            column(12, offset = 0,
                                   actionButton(inputId = "klickButton", label = "Submit")))),
            fluidRow(
                    column(6, offset = 0,
                           div(class = "plot-container",
                                       tags$img(src = "spinner.gif",
                                                class = "loading-spinner"),           
                           plotOutput(outputId = "windHist"))
                    ),
                    column(6, offset = 0,
                           div(class = "plot-container",
                               tags$img(src = "spinner.gif",
                                        class = "loading-spinner"),           
                               plotOutput(outputId = "windData"))
                           )),
            fluidRow(
                    column(6, offset = 0,
                           div(class = "plot-container",
                               tags$img(src = "spinner.gif",
                                        class = "loading-spinner"),           
                               plotOutput(outputId = "precipData"))
                           ),
                    column(6, offset = 0,
                           div(class = "plot-container",
                               tags$img(src = "spinner.gif",
                                        class = "loading-spinner"),           
                               plotOutput(outputId = "tempData"))
    ))
    )


    server <- function(input, output) {
            wSubset <- eventReactive(input$klickButton, {
                    subset(weather, weather$origin == input$airportName)})
            output$windHist <- renderPlot({
                    Sys.sleep(1)
                    hist(wSubset()$wind_dir)})
            output$windData <- renderPlot({
                    Sys.sleep(1)
                    plot(wSubset()$wind_speed, wSubset()$wind_gust)})
            output$precipData <- renderPlot({
                    Sys.sleep(1)
                    plot(wSubset()$humid, wSubset()$precip)})
            output$tempData <- renderPlot({
                    Sys.sleep(1)
                    plot(wSubset()$temp, wSubset()$dewp)})
    }


    shinyApp(ui = ui, server = server)

整套反应函数的闪亮应用程序进度条

1 个答案: