You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

基于嵌套列表实现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)

问题排查与修复

核心问题分析

  1. 嵌套列表结构不规范:原myList中子菜单为匿名列表,没有统一的键标识,导致递归函数遍历到非菜单元素时出错。
  2. 递归函数逻辑错误:
    • funGetMenuItem中,非叶子节点循环生成多个重复的父节点menuItem,而非将子节点作为当前节点的子元素传递。
    • funGetTabItem中,tabItem的tabName错误使用lst$text,应该对应lst$tabName。
  3. 返回值格式问题:递归过程中返回的列表包含空元素或非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)

优化说明

  1. 规范列表结构:新增children键统一存放子菜单,让递归逻辑更清晰,避免遍历无关元素。
  2. 修正递归函数:
    • funGetMenuItem中,非叶子节点通过lapply处理子菜单,将结果作为当前menuItem的子元素,避免重复生成父节点。
    • funGetTabItem中,修正tabName为正确的lst$tabName,并过滤空元素。
  3. 输出处理:在server中用unlist整理递归结果,保证传递给do.call的是纯shiny.tag对象列表,解决类型错误。

内容的提问来源于stack exchange,提问作者Lev

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.07.25 19:54:57