web-dev-qa-db-ja.com

タブパネルを変更するときにShinyがビジー（または読み込み中）であることを示す

（問題の説明の後にコードが続きます）

私はShinyを使ってWebアプリの作成に取り組んでおり、実行しているRコマンドのいくつかは完了するのに数分かかります。 Shinyが機能していることをユーザーに示す必要があることがわかりました。そうしないと、サイドパネルで提供するパラメーターが継続的に変更され、最初の実行が完了すると、Shinyが事後的に計算を再開します。

そこで、「Loading」メッセージ（モーダルと呼ばれる）を表示する条件付きパネルを作成し、次のようにしました（条件付きステートメントについてはShiny GoogleグループのJoe Chengに感謝します）。

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

ユーザーが現在のタブに残っている場合、これは意図したとおりに機能しています。ただし、ユーザーは別のタブ（しばらく実行する必要のある計算を含む可能性があります）に切り替えることができますが、Rが計算を追い払う間、ロードパネルがすぐに表示および非表示になり、その後コンテンツを更新しますされております。

これを視覚化するのは難しいかもしれないので、以下で実行するコードを提供しました。ボタンをクリックして計算を開始すると、ニースの読み込みメッセージが生成されることがわかります。ただし、タブ2に切り替えると、Rはいくつかの計算の実行を開始しますが、読み込みメッセージの表示に失敗します（Shinyがビジー状態として登録されていない可能性があります）。もう一度ボタンを押して計算を再開すると、読み込み画面が正しく表示されます。

ロード中のタブに切り替えると、ロード中のメッセージが表示されるようにします！

i.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."))
    })
  })
})
rshiny
38
ialm

Shiny Googleグループ を介して、Joe Chengが shinyIncubator パッケージを示しており、実装されている進行状況バー機能があります（?withProgressshinyIncubatorパッケージのインストール後）。

この関数は将来的に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)
  })
})
19
ialm

元のアプローチを使用した可能なソリューションを次に示します。

最初にタブの識別子を使用します。

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."))
    })
  })

最初のタブから2番目のタブに移動すると機能することがわかります。

更新

最もクリーンなオプションは、アクティブなタブセットをキャッチするリアクティブオブジェクトを定義することです。 server.Rのどこかに書いてください：

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

https://groups.google.com/d/msg/shiny-discuss/PzlSAmAxxwo/eGx187UUHvcJ を参照してください。

8
Stéphane Laurent

最も簡単なオプションは、shinyskyパッケージでbusyIndi​​cator関数を使用することだと思います。詳細については、こちらをご覧ください link

4
SBista