您可以使用 lapply 或循环添加 shinydashboardplus 手风琴项目吗？

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 代替手风琴，但我不能让它看起来很好（见问题 Custom JS aggregation function reactable groups pull data from table）

提前感谢您的所有帮助。

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)