Unable to dynamically generate tabItem within tabitems

[aSkaRiNaaezu]

Hello,

this is my first time here on github. I would be happy, if someone could help me with my issue, and in case I'm doing something wrong in the community, would help me to get it right :-)

As I wrote in the headline I want to dynamically generate tabItems within the tabItems function. If I write every tabItem single-handed it works fine, but is not dynamic enough. If I use lapply, for OR do.call I always get the same error:

Warning: Error in FUN: Expected an object with class 'shiny.tag'

The menusubitems are already dynamically generated from a list. This, however, works. My code:

unique_products<-df_merge_final_convert$product %>% sort(na.last=TRUE) %>% unique
#List with products from another source

ui <- dashboardPage(skin="yellow", dashboardHeader(title = "Dashboard", 
              dropdownMenu(type = "tasks", badgeStatus = "success",
                  taskItem(value = 90, color = "green",
                      "Documentation"
                    ),
                     taskItem(value = 17, color = "aqua",
                      "Project X"
                    ),
                     taskItem(value = 75, color = "yellow",
                      "Server deployment"
                    ),
                     taskItem(value = 80, color = "red",
                     "Overall project"
        )
)),                  
dashboardSidebar(sidebarMenu( 
                        id="tabs",
                        menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
                        menuItemOutput("dynamic_menu")
                        )
                ),                   
dashboardBody(        
         uiOutput("bodycount")
    )
    )

server <- function(input, output, session) {
output$dynamic_menu<-renderMenu({     
     sidebarMenu(
       menuItem("Products", tabName = "products", icon = icon("th"),
                lapply(unique_products, function(tab){                 
                  menuSubItem(paste(tab), tabName = tab)                  
                  })
       ),
       menuItem("Channels", tabName="channels", icon = icon("bar-chart-o"),
                lapply(unique_channels, function(tab){              
                  menuSubItem(paste(tab), tabName = tab)              
                })
       ),
       menuItem("Namingconventions", tabname="namingconventions", icon = icon("table")))
   })
 output$bodycount <- renderUI({

       tabItems(tabItem(tabName = "dashboard", h2("Management Dashboard"),
                                     fluidRow()
),
   #tabItem(tabName = unique_products[1], h2(unique_products[1])),   
                #tabItem(tabName = unique_products[2], h2(unique_products[2])),
                #tabItem(tabName = unique_products[3], h2(unique_products[3])),
                #tabItem(tabName = unique_products[4], h2(unique_products[4])),
                #tabItem(tabName = unique_products[5], h2(unique_products[5])),
                #tabItem(tabName = unique_products[6], h2(unique_products[6])),
                #tabItem(tabName = unique_products[7], h2(unique_products[7])),
                #tabItem(tabName = unique_products[8], h2(unique_products[8])),
                #tabItem(tabName = unique_products[9], h2(unique_products[9]))

                lapply(1:length(unique_products), function(tab) {
                  tabItem(tabName=tab, h2(tab))
                  })
                )
  })
  }
shinyApp(ui, server) 

tabItem only works line by line but not with lapply

I hope I could explain my issue.

All the best Askari

[wkdavis]

I faced a similar issue and it had to do with the level of the list when you want to combine a regular tabItem() with ones from lapply(). What worked for me was to use append() to combine them all and then use do.call() on the combined list.

output$bodycount <- renderUI({
  do.call(tabItems,
          append(list(
            tabItem(tabName = "dashboard", h2("Management Dashboard"),
                    fluidRow())
          ), lapply(1:length(unique_products), function(tab) {
            tabItem(tabName = tab, h2(tab))
          })))
})

[aSkaRiNaaezu]

Hey wkdavis Thanks for your answer :-) I'm sorry, I can't remember what I wrote four months ago. I completely changed my approach since then.

I generate several tabs which I ultimately combine within a vector over a second do.call. Perhaps this solution helps other people in the future!

For example:

tabs.ga <- lapply(forecasting_content_board, function(tabs.casts){
tabItem(tabName=tabs.casts,

             fluidRow(
               do.call("tabsetPanel", lapply(unique_products, function(tab_5_products){
                 tabPanel(title=paste(tab_5_products),

                          box(callModule(forc_analyses, "forc_analyses",
                                         c(tabs.casts, tab_5_products), forecast.data)),

                          box(callModule(forc_plots,"forc_plots",
                                         c(tabs.casts, tab_5_products), forecast.data))

do.call("tabItems", c(tabs.generic, tab.dashboard, tab.namings, tabs.channels, tabs.analyses, tabs.ga))

[Sanrrone]

Hi!, after searching for a long time, the only solution that I found, is to put each tabItem as part of list, the solution posted by wkdavis works only (at least for me), when no more tabItem are bellow the lapply function. So the solution that works for me is replace the lapply by for loop and unname the final list object:

output$bodycount <- renderUI({
          theitems<-list()
          theitems[["asd"]]<-tabItem(tabName = "dashboard", h2("Management Dashboard"),
                    fluidRow())

          for(x in 1:length(unique_products)) {
            theitems[[paste0("asd_",x)]]<-tabItem(tabName = tab, h2(tab))
          }
          theitems[["asd3"]]<-tabItem(tabName = "OtherDashboard", h2("Other Management Dashboard"),
                    fluidRow())

  theitems<-unname(theitems)
  do.call(tabItems,theitems)
})

it's seems a problem with the list names, hope it can help knowledge for the future :)

regards

[VipulMoudgil]

Hi, I am also facing a similar problem my code is, the Testdata$Building has iterating entries buildings ("A", "B", "C"......"H").. I want buildings as menuItems (automated) and they have different graphs in tabitems (automated). hope this helps to understand my problem

library(shiny) library(shinydashboard)

ui <- dashboardPage( dashboardHeader(),

dashboardSidebar(

sidebarMenuOutput(outputId = "mysidebar")

),

dashboardBody( uiOutput(outputId = "BuildingPage") ) )

server <- function(input, output, session) {

output$mysidebar<- renderUI({ sidebarMenu( id= "tabs", menuItem("E-dash", tabName = "E-dash"),

menuItem("setup", tabName = "setup"),

                                        lapply(unique(Testdata$Building),
                                                                       function(x){
                                                                                    menuItem(paste(x), id= paste(x), tabName = paste0(x))
                                                                                  }
                                               ) 
                                     )
                         })

output$BuildingPage<- renderUI({

theitems<- list();
theitems[["aa"]]<-  tabItem(tabName = "E-dash", h2("Management Dashboard"),
                            fluidRow())
for(x in 1:length(unique(Testdata$Building))) {
  theitems[[paste0("aa_",x)]]<-tabItem(tabName = unique(Testdata$Building)[x], "hellosdfsfsdfsfsd")
}

theitems<- unname(theitems)
do.call(tabItems,theitems)

do.call(tabItems,

   #     append(list(
     #     tabItem(tabName = "E-dash", h2("Management Dashboard"),
   #               fluidRow())
      #  ), 

      #  lapply(unique(Testdata$Building),function(i){
      #           tabItem(tabName = i, paste0("hello ",i))
      #         }

      #  )

       # ))

                            #do.call(tabItems,mytabs)
                            #updateTabItems(session,"tabs",mytabs)
                             }
                             ) 

}

shinyApp(ui = ui, server = server)

[wkdavis]

@VipulMoudgil I would recommend asking your question on StackOverflow. You should only use GitHub issues for known bugs or feature requests. StackOverflow is a better place for questions about your code and how to solve code-specific problems.