R sáng bóng: hiển thị thông báo "loading ..." khi chức năng đang chạy

Question

Tôi sử dụng gói Shiny GUI R. Tôi đang tìm cách hiển thị một thông báo như "loading ..." sau khi actionButton được nhấn. Hàm này mất vài phút để thực thi, vì vậy tôi cần thông báo cho người dùng bằng cách nào đó rằng nút đó thực sự đã kích hoạt một số sự kiện. Bây giờ mã server.R trông giống như sau:

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() là một chức năng tải xuống dữ liệu từ internet. input$DownloadButton là actionButton. Vì vậy, sau khi nút được nhấn người dùng đợi trong vài phút và chỉ sau đó thấy một thông báo cho biết rằng tải xuống đã thành công. Tôi muốn hiển thị thông báo "Đang tải ..." ngay sau khi nút actionButton được nhấn và sau đó một thông báo khác như paste0(Sys.time(),": ",NROW(DATA()), " items downloaded") khi thực hiện kết thúc.

Answer 1

Tôi đã sử dụng một cách đơn giản và đáng tin cậy hơn so với cách tôi đăng trước đây.

Một sự kết hợp của

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

với

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

Ví dụ:

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

thẻ $ đầu() là không bắt buộc, nhưng đó là một thực hành tốt để giữ cho tất cả các phong cách bên trong thẻ đầu.

Answer 2

tôi giải quyết vấn đề bằng cách thêm đoạn mã sau vào sidebarPanel():

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

Answer 3

Tôi tìm thấy một giải pháp, đó là hoạt động tốt đối với tôi. Tôi đang sử dụng phương thức Bootstrap. Nó được hiển thị khi thực thi hàm bắt đầu và được ẩn lần nữa, khi nó kết thúc.

modalBusy < - chức năng (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) 
} 

Để hiển thị và giấu nó sử dụng các chức năng

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

Gọi ShowModal chức năng trước hàm của bạn Gọi và hàm hideModal sau đó!

Hy vọng điều này sẽ hữu ích.

Seb

Answer 4

Bạn có thể sử dụng ShinyJS: https://github.com/daattali/shinyjs

Khi actionButton được nhấn, bạn có thể dễ dàng chuyển đổi một phần văn bản hiển thị "đang tải ...", và khi tính toán xong, bạn có thể sau đó chuyển đổi thành phần này để ẩn .