嗨,我是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)
答案 0 :(得分:1)
我会将进度更新推送到主应用程序,然后让模块简单地通知主应用程序它应该更新进度条。由于您的代码尚不清楚模块是如何(按顺序)执行工作的,以及第一个模块的执行方式如何,我作了一些假设:
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)