基于嵌套列表实现Shinydashboard动态menuItem报错,求修复方案
动态生成Shinydashboard层级菜单问题排查与修复
问题背景
我开发了一个可正常运行的Shinydashboard应用初始版本,其中menuItem与TabItem采用硬编码方式,可正确展示层级菜单结构。现希望通过注释/取消注释列表元素快速增减菜单,计划使用嵌套列表和递归函数实现动态生成,但运行代码时出现如下错误:
Warning: Error in FUN: Expected an object with class 'shiny.tag'. 102: stop 101: FUN 100: lapply 99: <Anonymous> 97: renderUI [D:\Proyectos\scibtracker\appxx/app.R#65] 96: func 83: renderFunc 82: output$body 1: runApp
初始硬编码版本代码
library(shiny) library(shinydashboard) ui<-dashboardPage(header=dashboardHeader( title = "MyApp") ,sidebar=dashboardSidebar(uiOutput("sidebarpanel")) ,body=dashboardBody(uiOutput("body")) ,skin = "green",title = "Simple Dashboard") server <- function(input, output) { output$sidebarpanel <- renderMenu({ sidebarMenu(id="tabs",menuItem(text='Grandfather01',tabName = 'tabnameGrandfather01') ,menuItem(text='Grandfather02' ,menuItem(text='Father02_01' ,menuItem(text='Child02_01_01',tabName = 'tabNameChild02_01_01') ,menuItem(text='Child02_01_02',tabName = 'tabNameChild02_01_02') ) ) ,menuItem(text='Grandfather03' ,menuItem(text='Father03_01',tabName = 'tabNameFather03_01') ) ) }) output$body <- renderUI({ tabItems( tabItem(tabName="tabnameGrandfather01",actionButton("buttonGrandfather01","buttonGrandfather01")) ,tabItem(tabName="tabNameChild02_01_01",actionButton("buttontabNameChild02_01_01","buttontabNameChild02_01_01")) ,tabItem(tabName="tabNameChild02_01_02",actionButton("buttonChild02_01_02","buttonChild02_01_02")) ,tabItem(tabName="tabNameChild02_01_02",actionButton("buttonChild02_01_02","buttonChild02_01_02")) ,tabItem(tabName="tabnameFather02_02",actionButton("buttonFather02_02","buttonFather02_02")) ,tabItem(tabName="tabNameFather03_01",actionButton("buttonFather03_01","buttonFather03_01")) ) }) } # Run the application shinyApp(ui = ui, server = server)
尝试的动态实现代码
library(shiny) library(shinydashboard) myList<-list() myList[[length(myList)+1]]<-list(text="Grandfather01",tabName='tabnameGrandfather01',button="buttonGrandfather01") myList[[length(myList)+1]]<-list(text="Grandfather02", list(text="Father02_01" ,list(text='Child02_01_01',tabName='tabNameChild02_01_01',button="buttonChild02_01_01") ,list(text='Child02_01_01',tabName='tabNameChild02_01_01',button="buttonChild02_01_02") ) ) myList[[length(myList)+1]]<-list(text="Grandfather03", list(text='Father03_01',tabName='tabNameFather03_01',button="buttonFather03_01") ) # Excluded:No need for now. #myList[[length(myList)+1]]<-list(text="Grandfather04",tabName='tabnameGrandfather04',button="buttonGrandfather04") #myList[[length(myList)+1]]<-list(text="Grandfather05", # list(text='Father05_01',tabName='tabNameFather05_01',button="buttonFather05_01") # ) funGetTabItem<-function(lst){ mylst<-list() if(!is.null(lst$tabName)){ return(tabItem(tabName=lst$text,actionButton(lst$button,lst$button))) } else { for ( i in seq_len(length(lst))){ if (is.list(lst[[i]])) mylst[[length(mylst)+1]]<-funGetTabItem(lst[[i]]) } return(mylst) } } funGetMenuItem<-function(lst){ mylst<-list() if(!is.null(lst$tabName)){ return(menuItem(lst$text,tabName=lst$tabName)) } else { for ( i in seq_len(length(lst))){ if (is.list(lst[[i]])) mylst[[length(mylst)+1]]<-menuItem(lst$text,funGetMenuItem(lst[[i]])) } return(mylst) } } ui<-dashboardPage(header=dashboardHeader( title = "MyApp") ,sidebar=dashboardSidebar(uiOutput("sidebarpanel")) ,body=dashboardBody(uiOutput("body")) ,skin = "green",title = "Simple Dashboard") server <- function(input, output) { output$sidebarpanel <- renderMenu({ lstMenuItem<-funGetMenuItem(myList) sidebarMenu(id="tabs",lstMenuItem) }) output$body <- renderUI({ lstTabItem<-funGetTabItem(myList) do.call(tabItems, lstTabItem) }) } # Run the application shinyApp(ui = ui, server = server)
问题排查与修复
核心问题分析
- 嵌套列表结构不规范:原
myList中子菜单为匿名列表,没有统一的键标识,导致递归函数遍历到非菜单元素时出错。 - 递归函数逻辑错误:
funGetMenuItem中,非叶子节点循环生成多个重复的父节点menuItem,而非将子节点作为当前节点的子元素传递。funGetTabItem中,tabItem的tabName错误使用lst$text,应该对应lst$tabName。
- 返回值格式问题:递归过程中返回的列表包含空元素或非
shiny.tag对象,导致do.call或renderUI无法识别。
修复后的完整代码
library(shiny) library(shinydashboard) # 规范嵌套列表结构:用children键统一存放子菜单 myList <- list( list(text = "Grandfather01", tabName = "tabnameGrandfather01", button = "buttonGrandfather01"), list(text = "Grandfather02", children = list( list(text = "Father02_01", children = list( list(text = "Child02_01_01", tabName = "tabNameChild02_01_01", button = "buttonChild02_01_01"), list(text = "Child02_01_02", tabName = "tabNameChild02_01_02", button = "buttonChild02_01_02") ) ) ) ), list(text = "Grandfather03", children = list( list(text = "Father03_01", tabName = "tabNameFather03_01", button = "buttonFather03_01") ) ) # 取消注释即可快速添加菜单 # ,list(text = "Grandfather04", tabName = "tabnameGrandfather04", button = "buttonGrandfather04") # ,list(text = "Grandfather05", # children = list( # list(text = "Father05_01", tabName = "tabNameFather05_01", button = "buttonFather05_01") # ) # ) ) # 递归生成tabItem funGetTabItem <- function(lst) { mylst <- list() # 叶子节点(有tabName)生成对应的tabItem if (!is.null(lst$tabName)) { mylst <- tabItem(tabName = lst$tabName, actionButton(lst$button, lst$button)) } # 非叶子节点递归处理子菜单 if (!is.null(lst$children)) { for (child in lst$children) { child_tab <- funGetTabItem(child) if (!is.null(child_tab)) { mylst <- c(mylst, list(child_tab)) } } } return(mylst) } # 递归生成menuItem funGetMenuItem <- function(lst) { # 叶子节点生成带tabName的menuItem if (!is.null(lst$tabName)) { return(menuItem(text = lst$text, tabName = lst$tabName)) } # 非叶子节点生成包含子菜单的menuItem if (!is.null(lst$children)) { child_menus <- lapply(lst$children, funGetMenuItem) return(menuItem(text = lst$text, child_menus)) } return(NULL) } ui <- dashboardPage( header = dashboardHeader(title = "MyApp"), sidebar = dashboardSidebar(uiOutput("sidebarpanel")), body = dashboardBody(uiOutput("body")), skin = "green", title = "Simple Dashboard" ) server <- function(input, output) { output$sidebarpanel <- renderMenu({ # 遍历顶层列表生成所有菜单 menu_list <- lapply(myList, funGetMenuItem) sidebarMenu(id = "tabs", menu_list) }) output$body <- renderUI({ # 整理所有tabItem,确保传递给tabItems的是有效shiny.tag对象 tab_list <- unlist(lapply(myList, funGetTabItem), recursive = FALSE) do.call(tabItems, tab_list) }) } shinyApp(ui = ui, server = server)
优化说明
- 规范列表结构:新增
children键统一存放子菜单,让递归逻辑更清晰,避免遍历无关元素。 - 修正递归函数:
funGetMenuItem中,非叶子节点通过lapply处理子菜单,将结果作为当前menuItem的子元素,避免重复生成父节点。funGetTabItem中,修正tabName为正确的lst$tabName,并过滤空元素。
- 输出处理:在
server中用unlist整理递归结果,保证传递给do.call的是纯shiny.tag对象列表,解决类型错误。
内容的提问来源于stack exchange,提问作者Lev
相关产品推荐
相关产品推荐

