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 表格中的拖放功能的主要内容,如果未能解决你的问题,请参考以下文章