Dynamically create sortable menuSubItems in shinydashboard

前端 未结 1 1428
感情败类
感情败类 2021-02-10 17:13

I have a Shiny app using the shinydashboard package in which I\'m dynamically creating menuSubItems in the sidebarMenu of a dashboar

1条回答
  •  醉酒成梦
    2021-02-10 18:10

    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)

    0 讨论(0)
提交回复
热议问题