在 R shinydashboard 中跟踪可排序 menuSubItems 的顺序

Question

我可以使用this 问题呈现可排序的 menuSubItems 列表，但我想跟踪它们在排序后的顺序。 menuSubItems 不会出现在服务器端的input 中（至少不是整个列表），我希望能够有办法访问@987654324 中值列表的顺序@ 无需深入研究在 Shiny 中创建自定义输入绑定。

任何创意都将不胜感激！

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)

Answer 1

您可以使用 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);
  }")