R语言 仅在单击菜单项时加载shiny模块

uinbv5nw  于 12个月前  发布在  其他
关注(0)|答案(1)|浏览(96)

背景

在一个modular 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。在第二行:
不要从内部调用callModule事件;保持在最高水平。获取返回的React式表达式,并使用eventReactive将其 Package 在按钮单击中。并从输出中使用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)

问题

应用程序运行,但模块未加载。问题:

  • 如何正确调用 Jmeter 板菜单项上的eventReactivetab_item似乎没有id参数,在这种情况下,tabName是等价的吗?
  • 链接的讨论是指刷新一个表。我试图找出一个例子,将与模块包含大量的接口元素和精心设计的服务器调用。

单击 * 菜单项2* 应显示**sample_module.R**文件中的内容。

1 Modularizing Shiny app code
2* 谷歌群组:使用actionButton* 激活模块

更新

我已经尝试使用以下语法显式地强制模块进入应用程序环境加载:

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

哪里

MainAppDomain <- getDefaultReactiveDomain()
hs1ihplo

hs1ihplo1#

编辑:删除Joe Cheng的顶级声明:

# 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来访问所选选项卡;请参阅shinydashboard documentation

**编辑:**如果我们想在第一次点击时只运行callModule * 一次 *(就像@UgurDar一样),我们可以引入一个阻塞变量:

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, session) {
  
  rv <- reactiveValues(tab_two_loaded = FALSE)
  
  observeEvent(input$tabs,{
    if(!(rv$tab_two_loaded) && input$tabs=="tab_two"){
      callModule(sampleModuleServer, "sampleModule")
      rv$tab_two_loaded <- TRUE
    }
  }, 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)

相关问题