R shinydashboard中可排序菜单项的跟踪顺序

R shinydashboard中可排序菜单项的跟踪顺序,r,shiny,shinydashboard,sortablejs,R,Shiny,Shinydashboard,Sortablejs,我可以使用question呈现一个可排序的menusubitem列表,但我希望跟踪它们排序后的顺序menuSubItems不显示在服务器端的input中(至少不是整个列表),我希望能够有一种方法来访问test\u选项卡中的值列表的顺序,而不必深入研究如何创建自定义的输入绑定 任何有创意的想法都将不胜感激 library(shiny) library(shinydashboard) library(sortable) # Define UI for shinydashboard ui <-

我可以使用question呈现一个可排序的menusubitem列表,但我希望跟踪它们排序后的顺序
menuSubItem
s不显示在服务器端的
input
中(至少不是整个列表),我希望能够有一种方法来访问
test\u选项卡中的值列表的顺序,而不必深入研究如何创建自定义的输入绑定

任何有创意的想法都将不胜感激

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)
库(闪亮)
图书馆(shinydashboard)
图书馆(可分类)
#定义shinydashboard的UI

ui您可以使用sortable_js中的一个选项在订单更改时获取事件,并触发事件以通知您

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

      # this javascript function will listen to onUpdate event fired by
      # sortable_js when reordering happened. From this event we get 'from'
      # that refers to the container whose items are reordered (our test_tab)
      # then it's content (items) as text (Maybe better to get items from DOM ...)
      # And finally send an event to shiny using Shiny.setInputValue
      update_notifier <- htmlwidgets::JS("function(evt) { Shiny.setInputValue('test_tabs_order',evt.from.innerText);}")

      # add an option to declare our update_notifier to the sortable menu
      tagAppendChildren(menu, sortable_js("test_tabs", options=sortable_options(onUpdate=update_notifier)))
    })

  })

  # listen to the event input fired by onUpdate listener above
  # we get a newline separated list of item text
  # after a bit of formatting we have now a vector of item text
  observeEvent(input$test_tabs_order, {
    ord <- input$test_tabs_order
    ord <- gsub("(^\\s*)|(\\s*$)","", ord) # trim
    ord <- unlist(strsplit(ord,"\\s*\n\\s*")) # split
    # ord is now a vector of reordered item text 
    message(paste(ord,collapse=","))
  })

服务器这太完美了。这很简单,而且很有效。非常感谢。
 update_notifier <- htmlwidgets::JS("function(evt) {
   var a=evt.from.children; 
   var b=[]; 
   for(idx=0;idx<a.length;idx++) {
     b[idx]=a[idx].innerText;
   };
   Shiny.setInputValue('test_tabs_order',b);
  }")