您可以使用 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)

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

Can you add shinydashboardplus accordion items using lapply or a loop?

loops

accordion

lapply

shiny

shinydashboardplus