如何在tabItem仪表板闪亮

时间:2017-10-24 11:53:33

标签: loops shiny lapply dashboard tabitem

我正在制作一个ShinyDashboard程序,我在找到一种方法在dashboardBody中创建循环以捕获MenuItems时遇到了一些麻烦。这是我正在尝试修复的一个简单示例:

library(shiny)
library(shinyjs) 
library(shinydashboard)

VecNames=c("A","B","C","D","E")

ui <- dashboardPage(
dashboardHeader(title = "My Page"),
dashboardSidebar(sidebarMenuOutput("sideBar_menu_UI")),
dashboardBody(
uiOutput("body_UI"),
uiOutput("test_UI")
) 
)

server <- shinyServer(function(input, output, session) { 
output$sideBar_menu_UI <- renderMenu({
sidebarMenu(id = "sideBar_Menu",
            menuItem("Menu 1", tabName="menu1_tab", icon =       icon("calendar"),
                     lapply(1:length(VecNames), function(i) {
                       menuSubItem(VecNames[i], tabName = VecNames[i]  ,icon = icon("angle-right"))
                     })
                     ),
            menuItem("Menu 2", tabName="menu2_tab", icon =  icon("database"))
 )
 }) 
output$test_UI <- renderUI ({
A=tabItems(
  tabItem(tabName = "menu1_tab", uiOutput("menu1_UI")),    



 #      lapply(1:5, function(i){
 #        tabItem(tabName = VecNames[i], uiOutput(paste0("Menu",i)))        
 #      }),
  tabItem(tabName = VecNames[1], uiOutput(paste0("Menu",1))),
  tabItem(tabName = VecNames[2], uiOutput(paste0("Menu",2))),
  tabItem(tabName = VecNames[3], uiOutput(paste0("Menu",3))),
  tabItem(tabName = VecNames[4], uiOutput(paste0("Menu",4))),
  tabItem(tabName = VecNames[5], uiOutput(paste0("Menu",5))),      


  tabItem(tabName = "menu2_tab", uiOutput("menu2_UI"))
 )
 })
 output$body_UI <- renderUI ({
 p("Default content in body outsite any sidebar menus.")
 })
 output$menu1_UI <- renderUI ({
 box("Menu 1 Content")
 })
 output$menu2_UI <- renderUI ({
 box("Menu 2 Content")
 })

 lapply(1:5, function(i){
 output[[paste0("Menu",i)]]<- renderUI({
  box(paste0("Menu",i))
  })
  })

   })

 runApp(list(ui= ui, server = server))

我想要类似下面的代码,但似乎lapply不接受tabItem作为函数

  #      lapply(1:5, function(i){
  #        tabItem(tabName = VecNames[i], uiOutput(paste0("Menu",i)))        
  #      })

有任何帮助吗? 感谢您对高级

的回答

1 个答案:

答案 0 :(得分:1)

您的代码中的问题是,您尝试使用tabItem个对象列表作为tabItems的参数,但根据tabItems的文档,这是无效的。< / p>

  

tabItems(...)

     

...要放入容器的项目。每个项目都应该是一个tabItem。

do.call可用于解决此问题。基本上,do.call的操作如下。

add <- function(x, y){x + y}
do.call(add, list(4, 3)) # same as add(4, 3)
## 7

所以你基本上想要使用从lapply返回的列表作为do.call的第二个参数,而第一个参数是要调用的函数(tabItems)。

output$test_UI <- renderUI ({
  items <- c(
    list(tabItem(tabName = "menu1_tab", uiOutput("menu1_UI"))),
    lapply(1:5, function(i){
      tabItem(tabName = VecNames[i], uiOutput(paste0("Menu",i)))        
    })
  )
  do.call(tabItems, items)
})