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

Posted 2023-03-24

【中文标题】在 R Shiny 应用程序中动态填充 tabName

【英文标题】：Dynamically populate tabName in R Shiny application

【发布时间】：2017-02-27 03:11:45

【问题描述】：

我正在开发一个复杂的闪亮应用程序。 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)

【问题讨论】：

你有没有设法让它工作？

【参考方案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")
  ),
...

【讨论】：

感谢您的回复。我的网站目前每个 tabName 都有一个 tabItem。但是，因为我有超过 100 个选项卡项，所以初始加载时间约为 28 秒。我需要减少初始加载时间。也许我正在以错误的方式解决这个问题。我希望我可以通过仅在用户单击它时生成与 tabName 关联的 tabItem 来做到这一点。关于 sidebarMenu 的菜单 ID，我最初在您建议的地方拥有它。但是，当它在 renderMenu 中移动时，它是不可用的。我根据另一篇文章中的解决方案将其移至示例中的位置。

100 个标签是相当多的......闪亮可能不是解决这种复杂性的方法。