背景

在一个模块内 ¹ 闪亮的应用程序,我想加载模块只有当菜单项上 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 仅当单击相关菜单项时。在…的线上 ² :

x <- callModule(...)
y <- eventReactive(input$go, x())
output$tbl <- DT::renderDataTable(y())

尝试

附录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 模块R示例 文件。

¹ Modularizing Shiny app code

² Google groups: activate module with actionButton

更新

我尝试使用以下语法将模块显式强制加载到应用程序环境中:

eventReactive(eventExpr = input$tab_two,
              valueExpr = callModule(sampleModuleServer, "sampleModule"),
              domain = MainAppDomain
)

哪里

MainAppDomain <- getDefaultReactiveDomain()