Покажите, что Блестящий занят (или загрузка) при смене вкладки панели

Question

(код следует после описания проблемы)

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

Итак, я создал условную панель, которая показывает сообщение «Загрузка» (упоминаемый как модальный) со следующим (благодаря Джо Ченг в группе Блестящие Google для условного оператора):

# generateButton is the name of my action button 
loadPanel <- conditionalPanel("input.generateButton > 0 && $('html').hasClass('shiny-busy')"), 
           loadingMsg) 

Это работает как предполагалось, если пользователь остается на текущей вкладке. Тем не менее, пользователь может переключиться на другую вкладку (которая может содержать некоторые вычисления, которые должны выполняться в течение некоторого времени), но панель загрузки появляется и сразу исчезает, все время, пока R отбирается при вычислениях, а затем обновляет контент только после сделано.

Поскольку это может быть трудно представить, я предоставил некоторый код для запуска ниже. Вы заметите, что нажатие кнопки для запуска расчетов приведет к хорошему сообщению загрузки. Однако, когда вы переключаетесь на вкладку 2, R запускает некоторые вычисления, но не показывает сообщение загрузки (возможно, Shiny не регистрируется как занятый?). Если вы перезапустите вычисления, снова нажав кнопку, экран загрузки будет отображаться правильно.

Я хочу, чтобы сообщение загрузки появлялось при переключении на загружаемую вкладку!

ui.R

library(shiny) 

# Code to make a message that shiny is loading 
# Make the loading bar 
loadingBar <- tags$div(class="progress progress-striped active", 
         tags$div(class="bar", style="width: 100%;")) 
# Code for loading message 
loadingMsg <- tags$div(class="modal", tabindex="-1", role="dialog", 
         "aria-labelledby"="myModalLabel", "aria-hidden"="true", 
         tags$div(class="modal-header", 
           tags$h3(id="myModalHeader", "Loading...")), 
         tags$div(class="modal-footer", 
           loadingBar)) 
# The conditional panel to show when shiny is busy 
loadingPanel <- conditionalPanel(paste("input.goButton > 0 &&", 
             "$('html').hasClass('shiny-busy')"), 
           loadingMsg) 

# Now the UI code 
shinyUI(pageWithSidebar(
    headerPanel("Tabsets"), 
    sidebarPanel(
    sliderInput(inputId="time", label="System sleep time (in seconds)", 
       value=1, min=1, max=5), 
    actionButton("goButton", "Let's go!") 
), 

    mainPanel(
    tabsetPanel(
     tabPanel(title="Tab 1", loadingPanel, textOutput("tabText1")), 
     tabPanel(title="Tab 2", loadingPanel, textOutput("tabText2")) 
    ) 
) 
)) 

server.R

library(shiny) 

# Define server logic for sleeping 
shinyServer(function(input, output) { 
    sleep1 <- reactive({ 
    if(input$goButton==0) return(NULL) 
    return(isolate({ 
     Sys.sleep(input$time) 
     input$time 
    })) 
    }) 

    sleep2 <- reactive({ 
    if(input$goButton==0) return(NULL) 
    return(isolate({ 
     Sys.sleep(input$time*2) 
     input$time*2 
    })) 
    }) 

    output$tabText1 <- renderText({ 
    if(input$goButton==0) return(NULL) 
    return({ 
     print(paste("Slept for", sleep1(), "seconds.")) 
    }) 
    }) 

    output$tabText2 <- renderText({ 
    if(input$goButton==0) return(NULL) 
    return({ 
     print(paste("Multiplied by 2, that is", sleep2(), "seconds.")) 
    }) 
    }) 
}) 

Answer 1

Через Shiny Google group, Джо Ченг указал мне на shinyIncubator пакет, где есть функция прогресс бар, который является (см. ?withProgress после установки пакета shinyIncubator).

Возможно, эта функция будет добавлена ​​в пакет Shiny в будущем, но пока это работает.

Пример:

UI.R

library(shiny) 
library(shinyIncubator) 

shinyUI(pageWithSidebar(
    headerPanel("Testing"), 
    sidebarPanel(
    # Action button 
    actionButton("aButton", "Let's go!") 
), 

    mainPanel(
    progressInit(), 
    tabsetPanel(
     tabPanel(title="Tab1", plotOutput("plot1")), 
     tabPanel(title="Tab2", plotOutput("plot2"))) 
) 
)) 

SERVER.R

library(shiny) 
library(shinyIncubator) 

shinyServer(function(input, output, session) { 
    output$plot1 <- renderPlot({ 
    if(input$aButton==0) return(NULL) 

    withProgress(session, min=1, max=15, expr={ 
     for(i in 1:15) { 
     setProgress(message = 'Calculation in progress', 
        detail = 'This may take a while...', 
        value=i) 
     print(i) 
     Sys.sleep(0.1) 
     } 
    }) 
    temp <- cars + matrix(rnorm(prod(dim(cars))), nrow=nrow(cars), ncol=ncol(cars)) 
    plot(temp) 
    }) 

    output$plot2 <- renderPlot({ 
    if(input$aButton==0) return(NULL) 

    withProgress(session, min=1, max=15, expr={ 
     for(i in 1:15) { 
     setProgress(message = 'Calculation in progress', 
        detail = 'This may take a while...', 
        value=i) 
     print(i) 
     Sys.sleep(0.1) 
     } 
    }) 
    temp <- cars + matrix(rnorm(prod(dim(cars))), nrow=nrow(cars), ncol=ncol(cars)) 
    plot(temp) 
    }) 
}) 

Answer 2

Вот возможное решение, используя свой оригинальный подход.

Первое использование идентификатора для вкладок:

tabsetPanel(
    tabPanel(title="Tab 1", loadingPanel, textOutput("tabText1")), 
    tabPanel(title="Tab 2", loadingPanel, textOutput("tabText2")), 
    id="tab" 
) 

Затем, если вы подсоединили tabText1 к input$tab:

output$tabText1 <- renderText({ 
    if(input$goButton==0) return(NULL) 
    input$tab 
    return({ 
     print(paste("Slept for", sleep1(), "seconds.")) 
    }) 
    }) 

вы увидите, что это работает, когда вы идете из первой вкладки в второй.

Обновление

чистый вариант состоит в определении реактивной объект ловли активного tabset. Просто напишите это где-нибудь в server.R:

output$activeTab <- reactive({ 
    return(input$tab) 
    }) 
    outputOptions(output, 'activeTab', suspendWhenHidden=FALSE) 

См https://groups.google.com/d/msg/shiny-discuss/PzlSAmAxxwo/eGx187UUHvcJ некоторого объяснения.

Answer 3

Я думаю, что самый простой вариант будет использовать busyIndicator функция в пакете shinysky. Для получения дополнительной информации следуйте этим инструкциям link