r语言 - 如何在闪亮的多个模块和应用程序中更新进度条?

Question

嗨，我对R编程很陌生。 目前，我正在仪表板上创建一些数据并显示它。 这个项目很快就变得非常大，所以我正在尝试模块化仪表板。 这给我带来了一些问题。一个是这个 多个标签项 在一个闪亮的模块中。 另一个是我希望/需要为用户提供进度条，因为数据处理占用了相当长的时间。 这种数据处理现在分为多个模块，如下例所示。 但是该栏不会比第一个模块进一步更新自己。 我的猜测是 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. 代码ist从按下"开始"按钮开始。
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)