R Shiny中如何为响应式数据框/列表添加累计排序序号

问题原因 #

原代码序号生成逻辑有误：for循环里每次都取length(input$selected)（也就是目标面板内的元素总个数）当序号，没有按元素实际排列位置取对应索引，导致所有元素序号重复，和CSS自动渲染的排序结果对不上。
实际上sortable包的sortable_js_capture_input捕获到的input$selected值，本身就是严格按照目标拖拽面板内元素从上到下的排列顺序返回的字符向量，只要按元素在这个向量里的位置生成从1开始的连续索引，就能和CSS计数器生成的序号完全同步。

修复后代码 #

只需要调整server端的响应式逻辑即可，UI端的样式和拖拽配置不需要改动：

library(shiny)
library(sortable)
library(htmlwidgets)

icons <- function(x) {lapply(x,function(x){tags$div(tags$strong(x))})}

ui <- fluidPage(

  tags$head(
    tags$style(HTML('
      #dragTo {list-style-type: none;  counter-reset: css-counter 0;}
      #dragTo > div {counter-increment: css-counter 1;}
      #dragTo > div:before {content: counter(css-counter) ". ";}
      ')
    )
  ),
  
  div(
    style = "margin-top: 2rem; width: 60%; display: grid; grid-template-columns: 1fr 1fr; gap: 2rem; align-items: start;",
    div(
      div(
        class = "panel panel-default",
        div(class = "panel-heading", "Drag from here"),
        div(
          class = "panel-body",
          id = "dragFrom",
          icons(c("A", "B", "C", "D", "E"))
        )
      ),
    ),
    div(
      div(
        class = "panel panel-default",
        div(class = "panel-heading", "Drag to here"),
        div(
          class = "panel-body",
          id = "dragTo"
        )
      )
    )
  ),
  sortable_js(
    "dragFrom",
    options = sortable_options(
      group = list(
        pull = "clone",
        name = "group1",
        put = FALSE
      )
    )
  ),
  sortable_js(
    "dragTo",
    options = sortable_options(
      group = list(
        group = "group1",
        put = TRUE,
        pull = TRUE
      ),
      onSort = sortable_js_capture_input(input_id = "selected")
    )
  ),
  helpText(h5(strong("Output to table:"))),
  tableOutput("table1")
)

server <- function(input, output) {
  
  dragToLabels <- reactive({
    s <- input$selected
    # 无元素拖入时返回空数据框
    if (is.null(s)) {
      return(data.frame(排序序号 = integer(), 元素内容 = character()))
    }
    # 按元素位置生成连续序号，与CSS计数规则完全一致
    data.frame(
      排序序号 = seq_along(s),
      元素内容 = s
    )
  })
  
  output$table1 <- renderTable({
    dragToLabels()
  })
  
}

shinyApp(ui, server)

效果说明 #

• 无论增删、拖拽调整目标面板内的元素顺序，表格中的序号都会和面板上CSS渲染的序号完全对应
• 输出为结构化数据框格式，可直接用于后续统计、计算等数据处理操作
• 如果需要和面板显示完全一致的带点序号文本，只需要把数据框替换为data.frame(标签 = paste0(seq_along(s), ". ", s))即可

内容的提问来源于stack exchange，提问作者Curious Jorge - user9788072