运行 sortable package 如何补充bucket list?

How to replenish the bucket list when running the sortable package?

我正在探索可视化数学过程(一系列顺序计算)的方法,而 sortable 包可能是答案,并进行了修改。下面的可重现代码是从在线及其参考手册中找到的如何使用 sortable 的基本示例中提取的(添加了 table 输出,以便我可以开始操作数据框)。

我正在尝试查看是否有一种方法可以在用户从左侧面板(在我的示例中标记为“Pool”)拖放到右侧面板(标记为“Pool Ranking”)时不耗尽存储桶列表在我的例子中)。因此,查看底部的图像,用户可以 drag/drop 项 A、B、C、D、E 任意多次。由于元素 dragged/dropped.

的重复,右边的“拖到”面板比左边的“拖自”面板长

这在 sortable 中可行吗?如何做呢?还是我应该查看其他软件包?

如果我能解决这个问题,我的下一步将是添加另一个“从”数学公式面板拖到被拖到的标签元素 A - E 的右侧。

可重现代码:

library(shiny)
library(sortable)   

ui <- 
  fluidPage(
    tags$head(tags$style(HTML("
      .column_2 {
        counter-reset: rank;                      
      }

      .column_2 .rank-list-item::before {
        counter-increment: rank;                   
        content: counter(rank) '. ';    
      }
    "))),
    htmlOutput("rankingForm"),
    helpText(h5(strong("Output to table:"))),
    tableOutput("table1")
  
)

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

shinyApp(ui=ui, server=server)

通过这些列出的 Whosebug 帖子和解决方案,我得出了底部显示的“工作解决方案”:

相关帖子:

vladimir_orbucina 在 https://github.com/rstudio/sortable/issues/45 请求和

还有一个解释克隆的重要 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)