![](/img/trans.png)
[英]Track order of sortable menuSubItems in R shinydashboard
[英]Dynamically create sortable menuSubItems in shinydashboard
我有一个 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)
任何帮助深表感谢
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 日创建
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.