R shiny: сообщение «loading ...» во время работы

Question

Я использую пакет Shiny GUI R. Я искал способ отображения сообщения типа «загрузка ...» после нажатия кнопки actionButton. Для выполнения этой функции требуется несколько минут, поэтому мне нужно как-то проинформировать пользователя о том, что кнопка фактически вызвала какое-то событие. Теперь код 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, а затем другое сообщение, например paste0(Sys.time(),": ",NROW(DATA()), " items downloaded"), когда выполнение завершено.

Answer 1

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

Сочетание

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

теги $ головы() не требуется, но это хорошая практика, чтобы сохранить все стили внутри head бирка.

Answer 2

Я решил эту проблему, добавив следующий код sidebarPanel():

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

Answer 3

Я нашел решение, которое работает хорошо для меня. Я использую Bootstrap modal. Он отображается, когда выполнение функции начинается и снова скрывается, когда оно заканчивается.

< modalBusy - функция (идентификатор, название, ...) {

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 перед тем ваша функция Call и функция hideModal впоследствии!

Надеюсь, это поможет.

Себ

Answer 4

Вы можете использовать ShinyJS: https://github.com/daattali/shinyjs

Когда actionButton нажата, вы можете легко переключаться компонентом текста, показывающим «загрузка ...», а когда расчет будет завершен, вы можете затем переключить этот компонент скрыты ,