在 shinydashboard 中動態創建可排序的 menuSubItems

Question

我有一個 Shiny 應用程序，它使用shinydashboard package 在其中我在dashboardSidebar的sidebarMenu中動態創建menuSubItem 。 subItems 的創建由 actionButton 觸發。 我可以在服務器端創建menuSubItem就好了，但我也想使用可排序的 package 和sortable function 使它們可sortable_js 。 不過，我似乎無法弄清楚將sortable_js function 放在哪里才能使其真正起作用。

這是我的 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)

任何幫助深表感謝

Answer 1

sortable_js() function 生成 HTML，所以它需要包含在 UI 中。 但是，您還必須確保它包含在它適用的元素已經存在之后； 否則它將無法正常工作。 在這里，我們可以通過將其添加到renderMenu()調用的 output 作為使用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 日創建}