在 shinydashboard 中动态创建可排序的 menuSubItems答案

【问题标题】：Dynamically create sortable menuSubItems in shinydashboard在 shinydashboard 中动态创建可排序的 menuSubItems
【发布时间】：2020-02-02 02:31:19
【问题描述】：

我有一个使用 shinydashboard 包的 Shiny 应用程序，我在其中动态创建 menuSubItems 在 sidebarMenu 的 dashboardSidebar 中。 subItems 的创建由 actionButton 触发。我可以在服务器端创建 menuSubItems 就好了，但我还想使用 sortable 包和 sortable_js 函数使它们可排序。不过，我似乎无法弄清楚在哪里放置 sortable_js 函数以使其真正起作用。

这是我的 MRE：

library(shiny)
library(shinydashboard)
library(sortable)

# Define UI for shinydashboard
ui <- dashboardPage(
    dashboardHeader(),
    dashboardSidebar(
      sidebarMenu(
        menuItem("tab_one", tabName = "test_body"),
        menuItemOutput("test"),
        id = "sidebar"
      )
    ),
    dashboardBody(
      tabItem("test_body",
              actionButton("click_me", "Click Me"))
    )
  )


# Define server logic to dynamically create menuSubItems
server <- function(input, output) {

  observeEvent(input$click_me, {
    tabs_list <-
      lapply(1:5, function(x) {
        menuSubItem(text = paste("tab", x))
      })

    output$test <- renderMenu({
      menuItem("test_tabs", do.call(tagList, tabs_list))
    })
    sortable_js("test_tabs")
  })
}

# Run the application
shinyApp(ui = ui, server = server)

非常感谢任何帮助

【问题讨论】：

标签： r shiny shinydashboard sortablejs

【解决方案1】：

sortable_js() 函数会生成 HTML，因此需要将其包含在 UI 中。但是，您还必须确保它包含在它适用的元素已经存在之后；否则它将无法正常工作。在这里，我们可以通过将其添加到 renderMenu() 调用的输出作为使用 menuItem() 创建的菜单项的附加子项来实现：

output$test <- renderMenu({
  menu <- menuItem("test_tabs", do.call(tagList, tabs_list))
  tagAppendChildren(menu, sortable_js("test_tabs"))
})

现在，您提供给sortable_js() 的 id 必须是您希望其子元素可排序的元素的 CSS id。在这种情况下，这将是 menuItem() 内的 ul 元素，其中包含所有子项。不幸的是，在创建菜单项时没有办法直接设置这个 id，所以我们必须在事后注入它。快速查看menuItem() 源代码发现ul 标记是菜单项标记的第二个子项：

output$test <- renderMenu({
  menu <- menuItem("test_tabs", do.call(tagList, tabs_list))
  menu$children[[2]] <- tagAppendAttributes(menu$children[[2]], id = "test_tabs")
  tagAppendChildren(menu, sortable_js("test_tabs"))
})

通过这些修改，您的示例将启动并运行：

library(shiny)
library(shinydashboard)
library(sortable)

# Define UI for shinydashboard
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      menuItem("tab_one", tabName = "test_body"),
      menuItemOutput("test")
    )
  ),
  dashboardBody(
    tabItem("test_body", actionButton("click_me", "Click Me"))
  )
)

# Define server logic to dynamically create menuSubItems
server <- function(input, output) {
  observeEvent(input$click_me, {
    tabs_list <- lapply(1:5, function(x) {
      menuSubItem(text = paste("tab", x))
    })

    output$test <- renderMenu({
      menu <- menuItem("test_tabs", do.call(tagList, tabs_list))
      menu$children[[2]] <- tagAppendAttributes(menu$children[[2]], id = "test_tabs")
      tagAppendChildren(menu, sortable_js("test_tabs"))
    })
  })
}

# Run the application
shinyApp(ui = ui, server = server)

^{由reprex package (v0.3.0) 于 2019 年 10 月 16 日创建}

【讨论】：