在模块化 1 闪亮的应用程序中,仅当单击shinydashboard上的菜单项时,我才想加载模块。如果未访问菜单项,则我不想加载模块。
app.R
# Libs
library(shiny)
library(shinydashboard)
# Source module
source("sample_module.R")
ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(sidebarMenuOutput("menu")),
dashboardBody(tabItems(
tabItem(tabName = "tab_one", h1("Tab One")),
tabItem(tabName = "tab_two", sampleModuleUI("sampleModule"))
))
)
server <- function(input, output) {
callModule(sampleModuleServer, "sampleModule")
output$menu <- renderMenu({
sidebarMenu(
menuItem(
"Menu item 1",
icon = icon("calendar"),
tabName = "tab_one"
),
menuItem(
"Menu item 2",
icon = icon("globe"),
tabName = "tab_two"
)
)
})
}
shinyApp(ui, server)
sample_module.R
sampleModuleServer <- function(input, output, session) {
output$plot1 <- renderPlot({
plot(mtcars)
})
}
sampleModuleUI <- function(id) {
ns <- NS(id)
plotOutput(ns("plot1"))
}
仅当单击相关菜单项时,所需的实现才会加载sample_module
。在 2 的行中:
不要从observeEvent内部调用callModule;保持在顶层。取得返回的反应式,并使用eventReactive将其包装在按钮单击中。并从输出等中使用eventReactive。
x <- callModule(...) y <- eventReactive(input$go, x()) output$tbl <- DT::renderDataTable(y())
app.R
(已修改) # Libs
library(shiny)
library(shinydashboard)
# Source module
source("sample_module.R")
ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(sidebarMenuOutput("menu")),
dashboardBody(tabItems(
tabItem(tabName = "tab_one", h1("Tab One")),
tabItem(tabName = "tab_two", sampleModuleUI("sampleModule"))
))
)
server <- function(input, output) {
eventReactive(eventExpr = input$tab_two,
valueExpr = callModule(sampleModuleServer, "sampleModule")
)
output$menu <- renderMenu({
sidebarMenu(
menuItem(
"Menu item 1",
icon = icon("calendar"),
tabName = "tab_one"
),
menuItem(
"Menu item 2",
icon = icon("globe"),
tabName = "tab_two"
)
)
})
}
shinyApp(ui, server)
应用程序运行,但模块未加载。问题:
eventReactive
?在这种情况下,tab_item
似乎没有id
参数等效于tabName
吗?点击菜单项2 会显示 sample_module.R
文件中的内容。
2 Google groups: activate module with actionButton
我尝试使用以下语法显式强制模块进入应用程序环境负载:
eventReactive(eventExpr = input$tab_two,
valueExpr = callModule(sampleModuleServer, "sampleModule"),
domain = MainAppDomain
)
其中
MainAppDomain <- getDefaultReactiveDomain()
答案 0 :(得分:2)
编辑:删除郑乔的顶层声明:
# Libs
library(shiny)
library(shinydashboard)
# Source module
source("sample_module.R")
ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(sidebarMenuOutput("menu")),
dashboardBody(tabItems(
tabItem(tabName = "tab_one", h1("Tab One")),
tabItem(tabName = "tab_two", sampleModuleUI("sampleModule"))
))
)
server <- function(input, output) {
observeEvent(input$tabs,{
if(input$tabs=="tab_two"){
callModule(sampleModuleServer, "sampleModule")
}
}, ignoreNULL = TRUE, ignoreInit = TRUE)
output$menu <- renderMenu({
sidebarMenu(id = "tabs",
menuItem(
"Menu item 1",
icon = icon("calendar"),
tabName = "tab_one"
),
menuItem(
"Menu item 2",
icon = icon("globe"),
tabName = "tab_two"
)
)
})
}
shinyApp(ui, server)
此外,您的sidebarMenu
需要一个ID才能访问选定的标签;请参阅闪亮的仪表板documentation。