在 R Shiny 中，如何使用可排序的 js 將其在列表中出現的連續次數附加到每個列表元素？

Question

下面的可重現代碼適用於將元素從一個面板拖動到另一個面板，並在“拖動到”面板中自動使用 HTML/CSS 對拖動的每個元素進行排序編號。

但是，我現在嘗試在每個“拖動到”列表元素的末尾（使用某種形式的paste0(...)我假設）該元素出現在“拖動到"列表，如底部所示。 這怎么能做到？

可重現的代碼：

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("Puppies", "Kittens"))
        )
      ),
    ),
    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({
    data.frame(data = paste0(seq_along(input$selected), ". ", input$selected))
  })
  
  output$table1 <- renderTable({dragToLabels()})
}

shinyApp(ui, server)

插圖：

Answer 1

使用data.table的初稿：

library(shiny)
library(sortable)
library(htmlwidgets)
library(data.table)

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("Puppies", "Kittens"))
        )
      ),
    ),
    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({
    # browser()
    # DT <- data.table(data = paste0(seq_along(input$selected), ". ", input$selected))
    req(input$selected)
    DT <- data.table(item = input$selected)
    DT[, c("rownumber", "letter") := .(.I, LETTERS[seq_len(.N)]), by = item]
    setcolorder(DT, c("rownumber", "item", "letter"))
    # DT[, data := paste0(rownumber, ". ", item, " ", letter)][, c("rownumber", "item", "letter") := NULL] # paste to a single column
  })
  
  output$table1 <- renderTable({dragToLabels()})
}

shinyApp(ui, server)