如何使用 `renderMenu` 在 shiny (shinydashboard) 中使用操作按钮动态添加额外的 `sidebarMenu`s？

Question

这是我正在使用的代码：

library(shiny)
library(shinydashboard)

header <- dashboardHeader(),
sidebar <- dashboardSidebar(sidebarMenu(menuItem("Home", tabName = "home")),
                            sidebarMenuOutput("menu"),
                            actionButton('add_menu', 'Add Menu'))
body <- dashboardBody()

ui <- dashboardPage(header = header, body = body, sidebar = sidebar)

server <- function(input, output, session) {
  
  shinyInput <- function(name, id) paste(name, id, sep = "_")
  counter <- reactiveValues(counter_value = 0L)
  
  observeEvent(input$add_menu, {
    counter$counter_value <- counter$counter_value + 1L
  })
  
  observeEvent(input$add_menu, {
    output$menu <- renderMenu({
                        sidebarMenu(
                          menuItem(paste("Menu", counter$counter_value),
                          value = shinyInput("new_menu", counter$counter_value)
                          ))
})
     
  })


}


shinyApp(ui = ui, server = server)

目前，当您按下actionButton时，主页选项卡下会出现一个新菜单，随后每点击一次，该菜单的名称就会增加1。这是因为output$menu 将被每次后续单击按钮 add_menu 覆盖。相反，每次单击 add_menu 我希望出现 additional/new 菜单，因此单击两次将有一个主页和两个菜单。单击三次将有一个主页和 3 个菜单等...我不确定如何完成此操作，我考虑过使用 apply 系列函数之一，但没有成功。这里的目标是单击侧边栏中的操作按钮，并向仪表板侧边栏添加其他菜单。

Answer 1

也许这会满足您的需求。

library(shiny)
library(shinydashboard)

header <- dashboardHeader()
sidebar <- dashboardSidebar(#sidebarMenu(menuItem("Home", tabName = "home")),
                            sidebarMenuOutput(outputId = "dy_menu"),
                            actionButton('add_menu', 'Add Menu'))
body <- dashboardBody()

ui <- dashboardPage(header = header, body = body, sidebar = sidebar)

server <- function(input, output, session) {
  menu_vals = reactiveValues(menu_list = NULL)
  counter <- reactiveValues(counter_value = 0L)
  
  output$dy_menu <- renderMenu({
    menu_list <- list(
      menuItem("Add Menu Items", tabName = "main", selected = TRUE),
      menu_vals$menu_list)
    sidebarMenu(.list = menu_list)
  })
  
  observeEvent(eventExpr = input$add_menu,
               handlerExpr = {
                 counter$counter_value <- counter$counter_value + 1L
                 menu_vals$menu_list[[length(menu_vals$menu_list) + 1]] <- menuItem(paste("Menu", counter$counter_value),
                                                                                    tabName = paste0("Menu", counter$counter_value)) 
                 
               })
  
}

shinyApp(ui = ui, server = server)

如何使用 `renderMenu` 在 shiny (shinydashboard) 中使用操作按钮动态添加额外的 `sidebarMenu`s？

How do I dynamically add additional `sidebarMenu`s with an action button in shiny (shinydashboard) using `renderMenu`?

r

shiny

shiny-server

shinydashboard

shinyapps