提问人：Lev 提问时间：4/2/2023 更新时间：4/3/2023 访问量：56
Shinydasboard 带有动态 menuItem from nestedList
Shinydasboard with dynamic menuItem from nestedList
问：
我的应用程序的第一个版本 （MWE） 运行良好。和 是硬编码的。如您所见，有些菜单位于其他菜单中。:menuItemsTabItems
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)
它使菜单以这种方式显示，这是可以的：
现在，我的新要求是轻松包含/排除一些菜单。所以，我想用 a 来评论/取消评论该列表的某些元素。由于有些菜单在其他菜单中，因此我必须使用 and 函数。listnested listrecursive
我试图以这种方式做到这一点，但我无法弄清楚：
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)
出现此错误，但我认为它不会是唯一的错误：
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
我不确定我是否为该要求选择了最糟糕的方法，或者我的尝试是否正常，您能提供一些建议或帮助我解决它吗？
答：
1赞
stefan
4/3/2023
#1
可能有更优雅的方法来实现这一点，也许有更好的数据结构来存储嵌套列表，但至少下面的方法可以工作。
library(shiny)
library(shinydashboard)
funGetTabItem <- function(x) {
if (is.null(names(x))) {
items <- lapply(x, funGetTabItem)
do.call("c", items)
} else if ("tabName" %in% names(x)) {
list(x[c("button", "tabName")])
} else {
items <- lapply(x[!names(x) %in% "text"], funGetTabItem)
do.call("c", items)
}
}
funGetMenuItem <- function(x) {
if (is.null(names(x))) {
lapply(x, funGetMenuItem)
} else if ("tabName" %in% names(x)) {
menuItem(text = x[["text"]], tabName = x[["tabName"]])
} else {
items <- lapply(x[!names(x) %in% "text"], funGetMenuItem)
do.call(menuItem, c(list(text = x[["text"]]), items))
}
}
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)
do.call(sidebarMenu, c(list(id = "tabs"), lstMenuItem))
})
output$body <- renderUI({
lstTabItem <- funGetTabItem(myList)
lstTabItem <- lapply(lstTabItem, function(x) {
tabItem(tabName = x[["tabName"]], actionButton(x[["button"]], x[["button"]]))
})
do.call(tabItems, lstTabItem)
})
}
shinyApp(ui = ui, server = server)
评论
0赞
Lev
4/3/2023
哇，它有效！谢谢！尝试在我的原始应用程序中重现它时，我发现了一个问题。我不只是为每个 menuItem 使用一个按钮，而是使用一个包含 ui 元素的文件。文件的名称是“tabName”字段。我试图理解你的递归函数。.但真的很难。你能看看这个新问题吗：问题
上一个：从嵌套列表动态构建路径
下一个：列表推导的存储位置问题
评论