1

我有一个运行很长的进程的闪亮应用程序，我想提醒用户该进程实际上正在运行。在下面的示例中，我有一个切换开关，它以 1 秒的延迟执行一段代码（我的实际应用程序运行了大约 20 秒），并且我有一个 HTML 输出框，它应该让用户知道正在发生的事情。但是，由于底层引导过程仅在函数退出后更新 UI 元素，因此用户只能看到最后一条消息“完成”。

我已经看到类似这样的其他问题，其中的答案建议创建一个反应值，然后将 renderUI() 函数包装在一个 observe() 函数中（例如，这里），但这也有同样的问题。

我还尝试将 htmlOutput() 包装在 shinycssloaders 包中的 withSpinner() 中，但我收到一条错误消息，提示“需要 TRUE/FALSE 的地方缺少值”。我假设这是来自 shinydashboardPlus 因为它不喜欢 tagList() 元素中的 withspinner() 输出。我希望这至少会在 HTML 输出上给我一个动画微调器，表明它正在运行。

非常感谢有关使此特定设置正常工作的任何输入或向用户提供有关该过程处于活动状态的一些反馈的替代方法。

library(shiny)
library(shinycssloaders)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)

# Define UI for application that draws a histogram
ui <- dashboardPage(skin = 'blue', 
                    
shinydashboardPlus::dashboardHeader(title = 'Example',
    leftUi = tagList(
        switchInput(inputId = 'swtLabels', label = 'Labels', value = TRUE,
                    onLabel = 'Label 1', offLabel = 'Label 2',
                    onStatus = 'info', offStatus = 'info', size = 'mini', 
                    handleWidth = 230),
        htmlOutput(outputId = 'labelMessage')
        #withSpinner(htmlOutput(outputId = 'labelMessage')) # leads to error noted in text
        )
    ),
    dashboardSidebar(),
    dashboardBody()
)

server <- function(input, output) {
  rv <- reactiveValues() 
  rv$labelMessage <- 'Start' 

  observeEvent(input$swtLabels, {
     rv$labelMessage <- 'Updating labels...'
     Sys.sleep(1)
     rv$labelMessage <- 'Done'
  })

  output$labelMessage <- renderUI(HTML(rv$labelMessage))
}

# Run the application 
shinyApp(ui = ui, server = server)
4

1 回答 1

0

我使用shinyjs 包找到了解决方法，代码如下。带回家的信息是，通过使用 shinjs::html()，对 htmlOutput 的影响是立竿见影的。我什至在最后添加了一个花哨的淡出来隐藏消息。

它确实创建了另一个包依赖项，但它解决了这个问题。我确信有一种方法可以编写一个小的 JavaScript 函数并将其添加到 Shiny 应用程序以实现相同的结果。不幸的是，我不懂 JavaScript。（在 Shiny 应用程序中包含 JS 代码的参考资料 - Shiny 中的JavaScript 事件，在 Shiny中添加 JavaScript 和 CSS）

library(shiny)
library(shinycssloaders)
library(shinydashboard)
library(shinyjs)
library(shinydashboardPlus)
library(shinyWidgets)

# Define UI for application that draws a histogram
ui <- dashboardPage(skin = 'blue', 
                    
shinydashboardPlus::dashboardHeader(title = 'Example',
    leftUi = tagList(
        useShinyjs(),
        switchInput(inputId = 'swtLabels', label = 'Labels', value = TRUE,
                    onLabel = 'Label 1', offLabel = 'Label 2',
                    onStatus = 'info', offStatus = 'info', size = 'mini', 
                    handleWidth = 230),
        htmlOutput(outputId = 'labelMessage')
        #withSpinner(htmlOutput(outputId = 'labelMessage')) # leads to error noted in text
        )
    ),
    dashboardSidebar(),
    dashboardBody()
)

server <- function(input, output) {  
  observeEvent(input$swtLabels, {
     shinyjs::html(id = 'labelMessage', html = 'Starting...')
     shinyjs::showElement(id = 'labelMessage')
     Sys.sleep(1)
     shinyjs::html(id = 'labelMessage', html = 'Done') 
     shinyjs::hideElement(id = 'labelMessage', anim = TRUE, animType = 'fade', time = 2.0) 
  })
}

# Run the application 
shinyApp(ui = ui, server = server)
于 2021-11-10T16:24:44.973 回答