R shinydashboard：各种菜单子项的动态和静态选项卡项的混合

Question

我正在构建一个包含三个部分的应用程序：

概述
详细结果
帮助

详细结果部分应显示多个子项目的结果，一次一个。

我对结果部分成为单个选项卡感兴趣，因为我不想为每个子项的每个选项卡编写代码。每个子项目都有相同的，在示例中是直方图。

当我运行这个例子时，我丢失了子项的 ID。是否可以采用这样的布局但保留所有菜单项和菜单子项的 ID？

很高兴看到替代方法。

下面是一个说明问题的例子。该解决方案将在概览中显示 table，在任何子项的结果中显示直方图，在帮助部分显示 HTML 输出。

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(), 
  dashboardSidebar(
    sidebarMenu(id = "SideBarMENU", 

                menuItem("Overview", tabName = "OVERVIEW", selected = TRUE),
                menuItem("Results",  startExpanded = TRUE,
                         menuSubItem("Sepal.Length", tabName = "RESULTS"),
                         menuSubItem("Sepal.Width" , tabName = "RESULTS"),
                         menuSubItem("Petal.Length", tabName = "RESULTS"),
                         menuSubItem("Petal.Width" , tabName = "RESULTS")
                ), 
                menuItem("Help", tabName = "HELP")
    )

  ),
  dashboardBody(
    tabItems(
      tabItem("OVERVIEW", 
              box("Overview box", 
                  tableOutput("overview"))
      ),
      tabItem("RESULTS", 
              box("Results box", 
                  plotOutput("results")
              )
      ),
      tabItem("HELP", 
              box("HELP box", 
                  textOutput("help"))
      ) 
    )
  )
)

server <- function(input, output, session) {


  data <- reactive({

    print(input$SideBarMENU)

    if(input$SideBarMENU %in% names(iris)){
      iris[[input$SideBarMENU]]
    } else {
      rnorm(100, 1000, 10)
    }
  })


  output$results <- renderPlot({
    hist(data())
  })


  output$overview <- renderTable({
    head(iris)
  })



  output$help <- renderText({
    HTML("A wiki is a website on which users collaboratively.....")
  })



}

shinyApp(ui, server)

Answer 1

基本上，您需要两个组件：

动态内容/剧情
动态仪表板正文

第一部分比较简单：

1.动态内容/情节

您可以按照其他一些 SO 帖子中的说明在循环中创建输出：

  lapply(nms, function(name){
    output[[name]] <- renderUI ({
      box("Results Box", plotOutput(paste0("plot_", name)))
    })

    output[[paste0("plot_", name)]] <- renderPlot({
      hist(iris[[input$SideBarMENU]], main = "")
    })
  })

2。动态仪表板正文

这部分比较复杂。您需要动态 tabitems() 并且它们必须与静态部分混合。为了将 tabitem() 的列表移交给 tabitems() 您可以使用 do.call(tabItems, ..) 进行转换，请参阅下面的 link。要将它们与静态元素组合，请将静态元素转换为 list() 元素并将它们全部组合在 list() 中，然后再调用 do.call(tabItems, ..).

  output$tabItms <- renderUI ({
    itemsDyn <- lapply(nms, function(name){
      tabItem(tabName = name, uiOutput(name))
    })

    items <- c(
      list(
        tabItem("OVERVIEW", 
              box("Overview box", 
                  tableOutput("overview"))
        )
      ),  
      itemsDyn,
      list(
        tabItem("HELP", 
                box("HELP box", 
                    textOutput("help"))
        )
      )
    )
    do.call(tabItems, items)
  })

可以在这里找到类似的组件：并在此处循环 tabItems()：How to make a function in a for loop or lapply loop in a tabItem dashboard shiny。

注：

我修改names(iris)：

nms <- gsub("[.]", "", names(iris))
names(iris) <- nms

因为选项卡项名称不允许使用点。

可重现的例子：

library(shiny)
library(shinydashboard)

nms <- gsub("[.]", "", names(iris))
names(iris) <- nms


ui <- dashboardPage(
  dashboardHeader(), 
  dashboardSidebar(
    uiOutput("menu")
  ),
  dashboardBody(
    uiOutput("tabItms")
  )
)

server <- function(input, output, session) {

  output$tabItms <- renderUI ({
    itemsDyn <- lapply(nms, function(name){
      tabItem(tabName = name, uiOutput(name))
    })

    items <- c(
      list(
        tabItem("OVERVIEW", 
              box("Overview box", 
                  tableOutput("overview"))
        )
      ),  
      itemsDyn,
      list(
        tabItem("HELP", 
                box("HELP box", 
                    textOutput("help"))
        )
      )
    )
    do.call(tabItems, items)
  })

  lapply(nms, function(name){
    output[[name]] <- renderUI ({
      box("Results Box", plotOutput(paste0("plot_", name)))
    })

    output[[paste0("plot_", name)]] <- renderPlot({
      hist(iris[[input$SideBarMENU]], main = "")
    })
  })



  output$menu <- renderUI({
    sidebarMenu(id = "SideBarMENU", 
                menuItem("Overview", tabName = "OVERVIEW", selected = TRUE),
                menuItem("Results", id = "resultChoice",  startExpanded = TRUE,
                         lapply(nms, function(name) {
                           menuSubItem(name, tabName = name)
                         })
                ), 
                menuItem("Help", tabName = "HELP")
    )
  })

  output$overview <- renderTable({
    head(iris)
  })

  output$help <- renderText({
    HTML("A wiki is a website on which users collaboratively.....")
  })

}

shinyApp(ui, server)

R shinydashboard：各种菜单子项的动态和静态选项卡项的混合

R shinydashboard: Mix of dynamic and static tabItems for various menusubitems

r

shiny

menuitem

shinydashboard