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

Question

I have a Shiny app using the shinydashboard package in which I'm dynamically creating menuSubItem s in the sidebarMenu of a dashboardSidebar . The creation of the subItems is triggered by an actionButton. I can create the menuSubItem s on the server side just fine, but I would like to also make them sortable using the sortable package and sortable_js function. I just can't seem to figure out where to place the sortable_js function to make this actually work, though.

Here's my 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)

Any help is much appreciated

Answer 1

The sortable_js() function generates HTML, so it'll need to be included in the UI. However, you also have to make sure it is included after the element that it applies to already exists; it won't work otherwise. Here, we can accomplish that by adding it to the output of the renderMenu() call as an additional child of the menu item created with menuItem() :

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

Now, the id that you give to sortable_js() has to be the CSS id of the element whose children you want to make sortable. In this case, that would be the ul element inside the menuItem() , which contains all of the sub-items. Unfortunately there is no way to directly set this id when creating the menu item, so we have to inject it after the fact. A quick inspection of the menuItem() source code reveals that the ul tag is the second child of the menu item tag:

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"))
})

With these modifications, your example will be up and running:

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)

^{Created on 2019-10-16 by the reprex package (v0.3.0)}