R Shiny 框中的可移动多个项目 - 类似于附加的屏幕截图
Posted
技术标签:
【中文标题】R Shiny 框中的可移动多个项目 - 类似于附加的屏幕截图【英文标题】:Moveable multiple Items in R Shiny boxes - something similar to attached screenshot 【发布时间】:2020-01-11 04:45:06 【问题描述】:我正在尝试构建一个闪亮的应用程序,我正在尝试构建类似于以下屏幕截图的功能:-
我已经使用 Shinyjqui/sortable 构建了类似的东西,但我想在移动项目之前允许多选。请让我知道是否有人构建/从事过类似的工作?
以下是我使用“shinyjqui”包创建的示例:-
library(shiny)
library(shinyjqui)
attach(mtcars)
ui <- fluidPage(
fluidRow(
column(
width = 12,
uiOutput("OrderInputRender")
)
)
)
server<- function(input,output)
output$OrderInputRender <- renderUI(
fluidRow(
column(width = 6,
orderInput(
"All_Columns",
width = "100%",
label = "Available columns",
items = colnames(mtcars),
style="margin:5px 0 0 0%; overflow: auto; background-color:#DCDCDC; border: 0px solid; padding: 10px; padding: 10px; height:360px;",
connect = c("Segment_Column","Channel_Column")##which dropboxes can interact
)## close of order input
),
column(width = 6,
orderInput(
"Channel_Column",
width = "100%",
label = "Selected Columns",
items = NULL,
style="margin:5px 0 0 0%; overflow: auto; background-color:#DCDCDC; border: 0px solid; padding: 10px; padding: 10px; height:360px;",
connect = c("All_Columns","Segment_Column")##which dropboxes can interact
)## close of order input
)
)
)
shinyApp(ui, server)
【问题讨论】:
我们总是乐于帮助和支持新的编码员,但您需要先帮助自己。在doing more research 之后,如果您有问题,请发布您尝试过的内容,并清楚说明哪些内容不起作用,并提供a Minimal, Complete, and Verifiable example。阅读'How to Ask a good question' guide。另外,请务必take the tour 并阅读this Move items between two list boxes shiny的可能重复 感谢您的强调....但问题不同 @kawsleo 我会在 6 到 7 小时内回家时回答。与此同时,您可能希望在您的帖子中添加一个最小的工作示例,以避免投票和关闭。至少为人们提供一个基本的应用程序,这样其他人就不必从头开始编写代码了。 @kawsleo 我不能拖放。我可以做选择/多选+箭头。有用吗? 【参考方案1】:这只是使用DT
包的概念证明。可以从任一侧选择多个项目并将其移至另一侧。
我不打算花时间让它变得漂亮,但使用DT
选项和css
应该是可能的。最后,它可以通过打包在一个模块中轻松地重复使用。
ui -
library(shiny)
library(DT)
ui <- fluidPage(
br(),
splitLayout(cellWidths = c("45%", "10%", "45%"),
DTOutput("pool"),
list(
br(),br(),br(),br(),br(),br(),br(),
actionButton("add", label = NULL, icon("arrow-right")),
br(),br(),
actionButton("remove", label = NULL, icon("arrow-left"))
),
DTOutput("selected")
)
)
服务器 -
server <- function(input, output, session)
mem <- reactiveValues(
pool = data.frame(LETTERS[1:10]), selected = data.frame()
)
observeEvent(input$add,
req(input$pool_rows_selected)
mem$selected <- rbind(isolate(mem$selected), mem$pool[input$pool_rows_selected, , drop = F])
mem$pool <- isolate(mem$pool[-input$pool_rows_selected, , drop = F])
)
observeEvent(input$remove,
req(input$selected_rows_selected)
mem$pool <- rbind(isolate(mem$pool), mem$selected[input$selected_rows_selected, , drop = F])
mem$selected <- isolate(mem$selected[-input$selected_rows_selected, , drop = F])
)
output$pool <- renderDT(
mem$pool
)
output$selected <- renderDT(
mem$selected
)
shinyApp(ui, server)
应用快照 -
【讨论】:
天啊!你真是天才!这几天我一直在寻找这个,甚至发布了一个关于类似问题的问题(参见***.com/questions/62782414/…)。是否也可以使用双箭头按钮来从左到右移动所有内容,反之亦然?另外,如果我在右边有更多的桌子从左边移动,反之亦然(即更可扩展?我有资格在几个小时内打开赏金;) 赏金活动开始了:***.com/questions/62782414/…【参考方案2】:对不起,我的英语很差。 我找到了 jQuery 两侧选择框,并制作了包含此脚本的闪亮演示。 https://www.jqueryscript.net/form/Two-side-Multi-Select-Plugin-with-jQuery-multiselect-js.html
shiny with two side select box jQuery
看起来不错,但有一个问题是服务器无法获取输入值,只有在右侧框中选择的选项。
# function for make UI HTML
MultiselectHTML <- function(mylist,myname)
paste_sum <- ""
for(i in 1:length(mylist))
paste_sum <- paste0(paste_sum,"<option value=",i,">",mylist[i],"</option>")
# make tag list
tagList(
div(
class = "item_search"
,div(class = "row",
div(class = "col-xs-5",
tags$select(name="from[]",id=myname,class = "form-control",multiple = "multiple",size = "8"
,HTML(paste_sum)
)
)
,div(class = "col-xs-2"
,tags$button(type = "button",class = "btn btn-primary btn-block",id=paste0(myname,"_undo"),"undo")
,tags$button(type = "button",class = "btn btn-block",id=paste0(myname,"_rightAll"),tags$i(class = "glyphicon glyphicon-forward"))
,tags$button(type = "button",class = "btn btn-block",id=paste0(myname,"_rightSelected"),tags$i(class = "glyphicon glyphicon-chevron-right"))
,tags$button(type = "button",class = "btn btn-block",id=paste0(myname,"_leftSelected"),tags$i(class = "glyphicon glyphicon-chevron-left"))
,tags$button(type = "button",class = "btn btn-block",id=paste0(myname,"_leftAll"),tags$i(class = "glyphicon glyphicon-backward"))
,tags$button(type = "button",class = "btn btn-warning btn-block",id=paste0(myname,"_redo"),"redo")
)
,div(class = "col-xs-5"
,tags$select(name="to[]",id=paste0(myname,"_to"), class="form-control" ,size="8", multiple="multiple")
)
)
)
,br()
)
ui <- fluidPage(
tags$head(includeScript("www/multiselect.js"))
,tags$script(HTML(
'jQuery(document).ready(function($)
$("#multiselect1").multiselect(
search:
left: \'<input type="text" name="q" class="form-control" placeholder="Search..." />\',
right: \'<input type="text" name="q" class="form-control" placeholder="Search..." />\',
,
fireSearch: function(value)
return value.length >= 1;
);
);
')
)
,MultiselectHTML(c("a","b","c","d","e"),"multiselect1")
,h5("Selected List :")
,textOutput("mselect")
)
server <- function(input, output, session)
output$mselect <- renderText(input$multiselect1_to)
shinyApp(ui = ui,server = server)
【讨论】:
以上是关于R Shiny 框中的可移动多个项目 - 类似于附加的屏幕截图的主要内容,如果未能解决你的问题,请参考以下文章