Shiny 表格中的拖放功能

Posted

技术标签:

【中文标题】Shiny 表格中的拖放功能【英文标题】:Drop-on functionality in table in Shiny 【发布时间】:2021-07-07 06:48:11 【问题描述】:

我正在寻找一种方法(包),它使我能够从一个表中“删除”一行另一个表中的一行。我设想的服务器端功能是我可以创建一些更新目标表的逻辑。不幸的是,我没有成功地用我能找到的可用闪亮包的包进行原型设计。

下面代码中 MVP 概念的想法是将顶部表中的一个调用者分配(使用 drag 'n drop on)到第二个表中的一行。

我得出的结论如下:

library(shiny)
library(shinyjqui)
library(tidyverse)

ui <- fluidPage(
  h1("UI functionality: Drop-on table"),
  h3("Callers - (source)"),
  tableOutput("callers"),
  h3("Calls to be made - (destination)"),
  tableOutput("calls_to_be_made"),
  hr()
)

server <- function(input, output, session) 
  
  callers <- tibble(
    Caller = c("Jerry", "Donald")
  )
  
  calls_to_be_made <- tibble(
    Name = c("John", "Fred", "Bill", "Freddy"),
    PhoneNumber = c("0123 456 785", "0123 456 6453", "9876 532 432","235 63 430"),
    Caller = c("Jerry",NA,NA,NA )
  )
  
  jqui_sortable(
    ui      = "#callers table",
    options = list(items = "tbody tr", connectWith = "#calls_to_be_made table")
  )

  jqui_sortable(
    ui      = "#calls_to_be_made table",
    options = list(items = "tbody tr")
  )

  output$callers <-  renderTable(callers, rownames = T)
  output$calls_to_be_made <-  renderTable(calls_to_be_made, rownames = T)


shinyApp(ui, server)

我已经尝试了使用 shinyjqui 函数 jqui_draggable()jqui_droppable() 的解决方案,但这些尝试没有成功,我觉得它们实际上与上面的代码草图相差甚远。

我正在寻找实现此功能的创意和建议。希望阅读这个问题的你们中的一些人会提出一些建议,以在闪亮中完成此功能。

【问题讨论】:

没有服务器端功能可以做到这一点。这将仅是客户端,例如使用 javascript 或 jQuery。我从来没有使用过闪亮的,所以我在猜测,但我怀疑它会根据需要添加标题和脚本详细信息,以便在服务器端脚本中进行拖放、排序或设置。您将需要查看生成的 html 以检查输出的编码。 @Twisty:你说得对,UI 交互将是客户端的,但它必须与 Shiny 的服务器端逻辑密切相关。 @Jochen 目前尚不清楚您是需要拖放还是仅可排序。你想来回移动项目还是只移动一种方式?这就是真正的区别。构建页面时,shiny 是否会抛出任何错误? @Twisty:上面的代码可以很好地从第一个表(调用者)添加一行到第二个表(要进行的调用);闪亮的一面没有错误。它将它放在两者之间。我正在寻找特定行的“下降”。因此,将呼叫分配给特定的呼叫者。我想捕获呼叫者 Jerry 被指派给 Bill 打电话。 【参考方案1】:

您可以使用shinyjqui 制作一个界面,允许您从某些地方拖动单元格 表,将它们放入不同的表中,并进行闪亮更新 可拖放的表的底层数据框。

首先我们需要在我们的服务器函数中定义我们的可拖放对象。

  jqui_draggable(
    ui = "#callers td",
    options = list(
      revert = "invalid",
      helper = "clone"))
  
  droppable <- function() 
    jqui_droppable(
      ui = "#calls_to_be_made td",
      options = list(
        drop = JS("function(event, ui) 
                     Shiny.setInputValue(\"update_cells\", 
                       source_col: ui.draggable.index(),
                       source_row: ui.draggable.parent().index() + 1,
                       dest_col: $(this).index(),
                       dest_row: $(this).parent().index() + 1
                     );
                   ")))
  

  droppable() #Initialisation

这里发生了几件事。

首先, jqui_droppable 调用被封装在一个函数中(droppable), 因为我们需要稍后再调用它。

其次,我们使用 Shiny.setInputValue()(一个 javascript 函数)发送行和 被删除的单元格的列索引 (source_*) 和被删除的单元格 被放到 (dest_*) 到闪亮的后端。 Javascript 索引开始 在 0 和 R 索引在 1,所以我们偏移 JS 以匹配 内部 R 的。但是,因为行名在 HTML 表格,但不在 R 数据框中,我们不需要偏移列索引。

接下来我们让calls_to_be_made 反应并编写逻辑 更新数据框服务器端。

  calls_to_be_made_react <- reactiveVal(calls_to_be_made)

  observeEvent(input$update_cells, 
    ## Update dataset
    if (min(unlist(input$update_cells)) > 0) 
      updated_ctbm <- calls_to_be_made_react()
      ## Specify what row and column to drop in
      updated_ctbm[
        input$update_cells[["dest_row"]],
        "Caller"] <- callers[
          input$update_cells[["source_row"]],
          input$update_cells[["source_col"]]]
      
      calls_to_be_made_react(updated_ctbm)

      ## Make sure the newly drawn table becomes droppable again
      droppable()
    
  )

if 语句中的条件检查是否正在拖放行名,并且当它是 案子。这个条件可以扩展到某种验证 限制哪些单元格可以被哪个可拖动单元格拖放的函数,但这超出了本问题的范围。

observableEvent 内部也是我们称之为droppable 的地方 再次发挥作用。因为闪亮重绘整个表,代码 使该表可丢弃也需要再次运行。

最后我们需要更新输出调用,所以它使用响应式 calls_to_be_made.

  output$calls_to_be_made <-  renderTable(calls_to_be_made_react(), rownames = T)

这提供了以下服务器功能,可以满足您的要求。

server <- function(input, output, session) 

  callers <- tibble(
    Caller = c("Jerry", "Donald")
  )

  calls_to_be_made <- tibble(
    Name = c("John", "Fred", "Bill", "Freddy"),
    PhoneNumber = c("0123 456 785", "0123 456 6453", "9876 532 432","235 63 430"),
    Caller = c("Jerry",NA,NA,NA )
  )

  jqui_draggable(
    ui = "#callers td",
    options = list(
      revert = "invalid",
      helper = "clone"))
  
  droppable <- function() 
    jqui_droppable(
      ui = "#calls_to_be_made td",
      options = list(
        drop = JS("function(event, ui) 
                     Shiny.setInputValue(\"update_cells\", 
                       source_col: ui.draggable.index(),
                       source_row: ui.draggable.parent().index() + 1,
                       dest_col: $(this).index()
                       dest_row: $(this).parent().index() + 1
                     );
                   ")))
  

  droppable() #Initialisation

  calls_to_be_made_react <- reactiveVal(calls_to_be_made)

  observeEvent(input$update_cells, 
    ## Update dataset
    if (min(unlist(input$update_cells)) > 0) 
      updated_ctbm <- calls_to_be_made_react()
      ## Specify what row and column to drop in
      updated_ctbm[
        input$update_cells[["dest_row"]],
        "Caller"] <- callers[
          input$update_cells[["source_row"]],
          input$update_cells[["source_col"]]]
      
      calls_to_be_made_react(updated_ctbm)

      ## Make sure the newly drawn table becomes droppable again
      droppable()
    
  )
  
  output$callers <-  renderTable(callers, rownames = T)
  output$calls_to_be_made <-  renderTable(calls_to_be_made_react(), rownames = T)

【讨论】:

太棒了!感谢您的回答。这正是我一直在寻找的。很好的答案!

以上是关于Shiny 表格中的拖放功能的主要内容,如果未能解决你的问题,请参考以下文章

使用角材料的拖放重新排列垫表行

使用 jQuery 在表格中拖放(使用两个可拖放的函数)

表单中的拖放功能仍处于禁用状态

iOS 中的拖放功能

bat文件中的拖放功能

如何在从另一个小部件拖放事件期间突出显示表格单元格