web-dev-qa-db-ja.com

R shiny：関数の実行中に「loading ...」メッセージを表示します

Shiny GUI Rパッケージを使用しています。 actionButtonが押された後に「loading ...」のようなメッセージを表示する方法を探しています。この関数の実行には数分かかるため、ボタンが実際にイベントをトリガーしたことをユーザーに通知する必要があります。 server.Rコードは次のようになります。

_DATA <- reactive({
  if(input$DownloadButton>0) {
    RunDownload()
  } else {
    NULL
  }
})

output$Download <- renderText({
  if(NROW(DATA())>0) {
    paste0(Sys.time(),": ",NROW(DATA()), " items downloaded")
  } else {
    ''
  }
})
_

actionButton()は、インターネットからデータをダウンロードする関数です。 _input$DownloadButton_はactionButtonです。そのため、ボタンが押された後、ユーザーは数分間待機し、ダウンロードが成功したというメッセージが表示されます。 actionButtonが押された直後に「Loading ...」というメッセージを表示し、実行が終了したときにpaste0(Sys.time(),": ",NROW(DATA()), " items downloaded")などの別のメッセージを表示したいと思います。

rshiny
43
user1603038

以前に投稿した方法よりも簡単で信頼性の高い方法を既に使用しています。

の組み合わせ

tags$style(type="text/css", "
           #loadmessage {
             position: fixed;
             top: 0px;
             left: 0px;
             width: 100%;
             padding: 5px 0px 5px 0px;
             text-align: center;
             font-weight: bold;
             font-size: 100%;
             color: #000000;
             background-color: #CCFF66;
             z-index: 105;
           }
  ")

と

conditionalPanel(condition="$('html').hasClass('shiny-busy')",
                 tags$div("Loading...",id="loadmessage")
)

例：

runApp(list(
  ui = pageWithSidebar(
      headerPanel("Test"),
         sidebarPanel(
           tags$head(tags$style(type="text/css", "
             #loadmessage {
               position: fixed;
               top: 0px;
               left: 0px;
               width: 100%;
               padding: 5px 0px 5px 0px;
               text-align: center;
               font-weight: bold;
               font-size: 100%;
               color: #000000;
               background-color: #CCFF66;
               z-index: 105;
             }
          ")),
           numericInput('n', 'Number of obs', 100),
           conditionalPanel(condition="$('html').hasClass('shiny-busy')",
                            tags$div("Loading...",id="loadmessage"))
         ),
         mainPanel(plotOutput('plot'))
  ),
  server = function(input, output) {
    output$plot <- renderPlot({ Sys.sleep(2); hist(runif(input$n)) })
  }
))

tags $ head（）は必須ではありませんが、headタグ内にすべてのスタイルを保持することをお勧めします。

32
user1603038

非常に簡単に、組み込みの光沢のある関数showModal()を関数の先頭で使用し、removeModal()を最後に使用できます。フッターを削除すると、モーダルは外に出られません。

例：

observeEvent(input$button, {
     showModal(modalDialog("Doing a function", footer=NULL))
     #Do the stuff here....
     #...
     #...
     #Finish the function
     removeModal()
})
4
moman822

SidebarPanel（）に次のコードを追加して問題を解決しました。

HTML('<script type="text/javascript">
        $(document).ready(function() {
          $("#DownloadButton").click(function() {
            $("#Download").text("Loading...");
          });
        });
      </script>
')
4
user1603038

ShinyJSを使用できます： https://github.com/daattali/shinyjs

ActionButtonを押すと、「loading ...」を示すテキストコンポーネントを簡単に切り替えることができ、計算が終了したら、このコンポーネントを非表示に切り替えることができます。

3
zhanxw

私はうまくいく解決策を見つけました。 Bootstrapモーダルを使用しています。関数の実行が開始されると表示され、終了すると再び非表示になります。

modalBusy <-function（id、title、...）{

 msgHandler =  singleton(tags$head(tags$script('Shiny.addCustomMessageHandler("jsCode",
                                            function(message) {
                                              console.log(message)
                                              eval(message.code);
                                            });'
                                            )
                                )
                      )

 label_id = paste(id, "label", sep='-')
 modal_tag <- div(id=id, 
               class="modal hide fade", 
               "aria-hidden"=FALSE, 
               "aria-labelledby"=label_id, 
               "role"="dialog", 
               "tabindex"="-1",
               "data-keyboard"=FALSE,
               "data-backdrop"="static")
 header_tag <- div(class="modal-header",
                h3(id=label_id, title))
 body_tag <- div(class="modal-body",
              Row(...))   
 footer_tag <- div(class="modal-footer")
 modal_tag <- tagAppendChildren(modal_tag, header_tag, body_tag, footer_tag)
 tagList(msgHandler, modal_tag) 
}

表示および非表示にするには、関数を使用します

showModal <- function(id,session) {
  session$sendCustomMessage(type="jsCode",
                            list(code= paste("$('#",id,"').modal('show')"
                                             ,sep="")))
}

hideModal <- function(id,session) {
  session$sendCustomMessage(type="jsCode",
                            list(code= paste("$('#",id,"').modal('hide')"
                                             ,sep="")))
}

関数呼び出しの前にshowModal関数を呼び出し、その後、hideModal関数を呼び出してください！

お役に立てれば。

セブ

2
Seb