r-你能用lapply或loop添加闪亮的仪表板和手风琴吗

Question

我正试图使用shinydashboardplus手风琴功能在一个闪亮的应用程序中创建一个手风琴，由于它非常重复，手风琴的所有信息都来自一个数据表，理想情况下我想使用lapply函数或for循环。不过我不确定这是否可能。这是我迄今为止的代码。

library("shiny")
library(shinydashboardPlus)
data(iris)
# UI ----
ui <- fluidPage(

# App title ----
titlePanel("Hello Shiny!"),

# Sidebar layout  ----
sidebarLayout(

# Sidebar panel ----
sidebarPanel(

p("Some text")

),

# Main panel ----
mainPanel(

# Output: accordion ----
accordion(

id = "id-accordion",

#for (i in 1:3){
#  accordionItem( #G11
#    title = unique(ocup$nom2d[i]),
#    tableOutput(paste0("table",i))
#  )
#  
#}

accordionItem( #G11
title = unique(iris$Species)[1],
tableOutput("table1")
), #G11 fin
accordionItem( #G12
title = unique(iris$Species)[2],
tableOutput("table2")
), #G12
accordionItem( #G13
title = unique(iris$Species)[3],
tableOutput("table3")
)  #G13


) 

)
)
)

server <- function(input, output) {

lapply(1:3, function(i){
outputId <- paste0("table", i)
output[[outputId]] <- renderTable({iris %>% filter(Species == unique(iris$Species)[i]) %>% select(Sepal.Length, Sepal.Width)})
})

}

shinyApp(ui, server)

我也考虑过使用reactable而不是手风琴，但我不能让它看起来很好(参见问题自定义JS聚合函数reactable组从表中提取数据(

提前感谢您的帮助。

Answer 1

您可以使用do.call和lapply的组合以编程方式创建accordionItem的：

library(shiny)
library(shinydashboardPlus)
data(iris)
ui <- fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
p("Some text")
),
mainPanel(
do.call(accordion, c(list(id = "id-accordion"), lapply(seq_along(unique(iris$Species)), function(i){
accordionItem(
title = unique(iris$Species)[i],
tableOutput(paste0("table", i))
)
})))
)
)
)
server <- function(input, output) {
lapply(1:3, function(i){
outputId <- paste0("table", i)
output[[outputId]] <- renderTable({iris %>% filter(Species == unique(iris$Species)[i]) %>% select(Sepal.Length, Sepal.Width)})
})
}
shinyApp(ui, server)