在 R Shiny 应用程序中动态填充 tabName

Question

我正在开发一个复杂的闪亮应用程序。 sidebarMenu 包含 100 多个菜单项，其中包含一些嵌套项。我也在使用模块（callModule）来生成重复的内容。

我遇到的问题是初始加载时间，即 28 秒。当我运行 profvis 时，我发现时间正在增加，因为该站点正在为所有 100 多个菜单项生成所有表格、绘图和内容。因此，我想在用户单击菜单项时生成内容，而不是在加载站点时全部生成。

我在 server.R 文件中使用 renderUI 创建 tabItems 和 renderMenu 创建 menuItems。

在下面提供的可重现的小示例中，我将 sidebarMenu id 设置为“smenu”。我在 tabItem 中调用 input$smenu 来设置 tabName。这不能按预期工作。如果您运行该示例，您会注意到，如果您 1) 单击“Dashboard”，2) 单击“Dashboard2”，则应该出现在dashboard2 页面上的 h3() 内容不会出现。但是，如果您 3) 再次单击“Dashboard”，并且 4) 再次单击“Dashboard2”，则会出现内容。

我有两个问题。 1) 仅在网站初始加载时生成用户要求的内容而不是全部生成的最佳方式是什么？

2) 为什么这段代码会在这一系列点击之后显示内容，而不是在用户第一次点击 Dashboard2 时显示？

提前感谢您的任何建议或指点。

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      id = "smenu",
      sidebarMenuOutput("menu")
    )
  ),
  dashboardBody(
    textOutput("testmenu"),
    uiOutput("bodyUI")
  )
)

server <- function(input, output) {

  observe({
    output$testmenu <- renderText({
      out <- paste("Current menu item is", input$smenu, sep = " ")
    })
  })

  output$bodyUI <- renderUI({
    tabItems(
      tabItem(tabName = input$smenu,
              h3(paste("Hello World! You are on the", input$smenu, "menu item.", sep = " "))
      )
    )
  })  

  output$menu <- renderMenu({
    sidebarMenu(
      menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"),
               menuItem("Dashboard2", tabName = "dashboard2", icon = icon("dashboard")),
               menuItem("Dashboard3", tabName = "dashboard3", icon = icon("dashboard"))
      )
    )
  })
} 
shinyApp(ui, server)

Answer 1

如果您想使用menuItem 中的tabName，您必须为每个tabName 定义一个选项卡：

tabItems(
  tabItem(tabName = "dashboard",
          h3(paste("Hello World! You are on the", input$smenu, "menu item.", sep = " "))
  ),
  tabItem(tabName = "dashboard2",
            h3(paste("Hello World! You are on the", input$smenu, "menu item.", sep = " "))
  ),
  tabItem(tabName = "dashboard3",
            h3(paste("Hello World! You are on the", input$smenu, "menu item.", sep = " "))
  )
)

这将在第一次菜单选择后显示选项卡（因为选项卡是在服务器中定义的）

您还应该将菜单id 移动到renderMenu：

  output$menu <- renderMenu({
    sidebarMenu(id = "smenu",
      menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"),
               menuItem("Dashboard2", tabName = "dashboard2", icon = icon("dashboard")),
               menuItem("Dashboard3", tabName = "dashboard3", icon = icon("dashboard"))
      )
    )
  })

并简化ui：

...
  dashboardSidebar(
      sidebarMenuOutput("menu")
  ),
...