如何使可排序包 add_rank_list 函数中的标签具有反应性?

How to make the label in the sortable package add_rank_list function reactive?

在下面的 运行 MWE 代码中,用户将项目从左侧面板拖到右侧面板。请注意,当从左侧的“拖动自”面板中拖动项目时,该列表会耗尽。是否可以使那些列表元素(在下面第一个 add_rank_list() 函数中的 labels = c(...) 中定义)具有反应性,以便列表永远不会耗尽,始终包含 A、B、C、D、E例如,无论项目被拖过多少次?换句话说,每当用户向右拖动一个项目时,就会触发观察者并再次生成相同的 A、B、C、D、E 列表?

这类似于 sortable 包中可用的克隆功能,除了我知道克隆不能用于这种更简单的 bucket_list(add_rank_list(...)) 语法。

MWE:

library(shiny)
library(sortable)   

ui <- fluidPage(htmlOutput("rankingForm"))

server <- function(input, output, session) {
  output$rankingForm <- renderUI({
    fluidRow(
      br(),
      column(tags$b("Ranking"), width = 12,
             bucket_list(header = "Drag items to the right panel:", 
                         group_name = "bucket_list_group", orientation = "horizontal",
                         add_rank_list("Drag from Pool:", 
                                       labels = c("A","B","C","D","E"), # make labels reactive?
                                       input_id = "rank_list_1"),
                         add_rank_list("Drag to:", labels = NULL,
                                       input_id = "rank_list_2"))
      )
    )
  })
}

shinyApp(ui=ui, server=server)

经过进一步研究,克隆功能似乎不能与简化函数bucket_list(add_rank_list(...))一起使用,但目前必须与sortable_js(...)一起使用。已请求 sortable 包开发人员更改以允许在更简单的代码中使用此功能,请参阅 https://github.com/rstudio/sortable/issues/45 处的 vladimir_orbucina 请求。

尽管如此,通过下面列出的相关帖子,Whosebug 用户群非常友好地指导我使用 sortable_js() 功能来解决问题。请参阅底部的“工作解决方案代码”。

相关解决方案帖子:

还有一个重要的 link 解释克隆:https://rstudio.github.io/sortable/articles/cloning.html

工作解决方案代码:

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

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

ui <- fluidPage(

# Below solution provided by I|O on Jun 1, 2022:  
  tags$head(
    tags$style(HTML('
      #drag_from > div {cursor: move; #fallback
                        cursor: grab; cursor: pointer;
                        }
      #drag_to > div {cursor: move; #fallback
                      cursor: grab; cursor: pointer;
                      }                
      #drag_to {list-style-type: none;  counter-reset: css-counter 0;}
      #drag_to > div {counter-increment: css-counter 1;}
      #drag_to > 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 = "drag_from",
          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 = "drag_to"
        )
      )
    )
  ),
  sortable_js(
    "drag_from",
    options = sortable_options(
      group = list(
        pull = "clone",
        name = "group1",
        put = FALSE
      )
    )
  ),
  sortable_js(
    "drag_to",
    options = sortable_options(
      group = list(
        group = "group1",
        put = TRUE,
        pull = TRUE
      ),
      onSort = sortable_js_capture_input(input_id = "selected") # << solution by stefan on Jun 01, 2022
    )
  ),
  helpText(h5(strong("Output to table:"))),
  tableOutput("table1")
)

server <- function(input, output) {
  output$table1 <- renderTable({input$selected})
}

shinyApp(ui, server)