如何在闪亮的多个模块和应用程序中更新进度条？

Question

您好，我对 R 编程非常陌生。 目前我正在使用仪表板来创建一些数据并显示它。 这个项目很快就变得相当大，所以我正在尝试模块化仪表板。 这给我带来了一些问题。一个是这个Multiple tabItems in one shiny module。 另一个是我想要/需要为用户提供一个进度条，因为数据处理需要相当长的时间。 这种数据处理现在分为多个模块，如下例所示。 但是栏不会比第一个模块更进一步。 我的猜测是 id 不匹配，因此找不到以下更新。 我不知道“隔离”updateProgressBar() 的 id 并将其传递给模块。 非常感谢您的帮助！

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

#module_1
module_1_ui <- function(id){
  ns <- NS(id)
  
  tagList(
    boxPlus(
      title = "some title",
      textOutput(ns("some_output"))
    )
  )
  
}

module_1_server <- function(id,see){
  moduleServer(
    id,
    function(input, output, session){
      ns <- session$ns
      
      observe({
        progressSweetAlert(
          id = ns("progress"),
          session = session,
          value = 1,
          total = 4,
        )
        Sys.sleep(1) #dummy for some functions that take some time to process
        
        updateProgressBar(
          id = ns("progress"),
          session = session,
          value = 2,
          total = 4
        )
        
      })
      
      output$some_output <- renderText({
        see
      })
    }
  )
}


#module_1
module_2_ui <- function(id){
  ns <- NS(id)
  
  tagList(
    boxPlus(
      title = "some title",
      textOutput(ns("some_output"))
    )
  )
  
}

module_2_server <- function(id,see){
  moduleServer(
    id,
    function(input, output, session){
      ns <- session$ns
      
      observe({
        updateProgressBar(
          session = session,
          id = ns("progress"),
          value = 3,
          total = 4
        )
        
        Sys.sleep(4) #dummy for some functions that take some time to process
        
        updateProgressBar(
          session = session,
          id = ns("progress"),
          value = 4,
          total = 4
        )
        
        Sys.sleep(2)
        
        closeSweetAlert(session = session) 
        
      })
      
      output$some_output <- renderText({
        see
      })
      
      
    }
  )
}


#app

ui <- dashboardPagePlus(
  header = dashboardHeaderPlus(
    title = "dummy app"
  ),
  sidebar = dashboardSidebar(
    sidebarMenu(
      menuItem(
        text = "home",
        tabName = "home"
      ),
      menuItem(
        text = "module_1",
        tabName = "tab_1"
      ),
      menuItem(
        text = "module_2",
        tabName = "tab_2"
      ),
      menuItem(
        text = "some other tabItems",
        tabName = "some_other_tabItems"
      )
    )
  ),
  body = dashboardBody(
    tabItems(
      tabItem(
        tabName = "home",
        box(
          title = "home of the app",
          width = "auto"
        )
      ),
      tabItem(
        tabName = "tab_1",
        module_1_ui(
          id = "module_1"
        )
      ),
      tabItem(
        tabName = "tab_2",
        module_2_ui(
          id = "module_2"
        )
      ),
      tabItem(
        tabName = "some_other_tabItems",
        box(
          title = "some other content"
        )
      )
    )
  )
)

server <- function(input, output){
  module_1_server(
    id = "module_1",
    see = "something happens here"
  )
  module_2_server(
    id = "module_2",
    see = "something happens here as well"
  )
}

shinyApp(ui,server)

Answer 1

我会将进度更新推送到主应用程序，并让模块简单地通知主应用程序它应该更新进度条。由于从您的代码中不清楚模块如何（按哪个顺序）完成工作以及第一个模块是如何分层的，我做了一些假设：

1. 按下开始按钮即可启动代码。
2. 第一个模块只进行一次更新。完成后，它会通知第二个模块开始。
3. 第二个模块在第一个模块完成后启动，并执行 3 个步骤。

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

m1_ui <- function(id) {
   ns <- NS(id)
   boxPlus(
      title = "Module 1",
      textOutput(ns("text_output"))
   )
}

m1_server <- function(id, content, start) {
   moduleServer(id,
                function(input, output, session) {
                   trigger_update <- reactiveVal(0)
                   finished       <- reactiveVal(FALSE)
                   
                   observeEvent(start(), {
                      Sys.sleep(1)
                      trigger_update(trigger_update() + 1)
                      finished(rnorm(1))
                   }, ignoreInit = TRUE)
                   
                   output$text_output <- renderText(content)
                   
                   list(trigger_update = trigger_update,
                        finished       = finished)
                })
   
}

m2_ui <- function(id) {
   ns <- NS(id)
   boxPlus(
      title = "Module 2",
      textOutput(ns("text_output"))
   )
}

m2_server <- function(id, content, start) {
   moduleServer(id,
                function(input, output, session) {
                   trigger_update    <- reactiveVal(0)
                   trigger_next_step <- reactiveVal(0)
                   finished          <- reactiveVal(FALSE)
                   
                   observeEvent(start(), {
                      Sys.sleep(1)
                      trigger_update(trigger_update() + 1)
                      trigger_next_step(1)
                   }, ignoreInit = TRUE)
                   
                   observeEvent(trigger_next_step(), {
                      Sys.sleep(1)
                      trigger_update(trigger_update() + 1)
                      if (trigger_next_step() <= 2) {
                         trigger_next_step(trigger_next_step() + 1)
                      } else {
                         finished(TRUE)
                      }
                   }, ignoreInit = TRUE
                   )
                   
                   output$text_output <- renderText(content)
                   
                   list(trigger_update = trigger_update,
                        finished       = finished)
                })
}

ui <- dashboardPagePlus(
   dashboardHeaderPlus(
      title = "dummy app"
   ),
   dashboardSidebar(),
   dashboardBody(fluidRow(actionButton("start", "Start")), 
                 fluidRow(m1_ui("m1"), m2_ui("m2")))
)

server <- function(input, output, session) {
   m1_handler <- m1_server("m1", "text 1", reactive(input$start))
   m2_handler <- m2_server("m2", "text 2", m1_handler$finished)
   
   current_status <- reactiveVal(0)
   
   observeEvent({
      m1_handler$trigger_update()
      m2_handler$trigger_update()
   }, {
      current_status(current_status() + 1)
      print(paste("Update", current_status()))
   },
   ignoreInit = TRUE
   )
   
   observeEvent(input$start, {
      progressSweetAlert(
         id = "progress",
         session = session,
         value = 0,
         total = 4,
      )
   }
   )
   
   observe({
      req(current_status() > 0)
      if (current_status() < 5) {
         updateProgressBar(session, "progress", value = current_status(), total = 4)
      } else {
         current_status(0)
         closeSweetAlert(session)
      }
   })
   
}

shinyApp(ui, server)