Sometimes you want the ability to drag an item multiple times from a list, in other words the ability to “clone” the items of the original list.
And you may also then want the ability to remove cloned items, possibly by dragging to a “bin” or “remove item” list.
To clone an element from a list, you must add the
pull = "clone"
option to the sortable_options
argument::
library(sortable)
sortable_js(
"sort1",
options = sortable_options(
group = list(
pull = "clone",
name = "sortGroup1",
put = FALSE
),onSort = sortable_js_capture_input("sort_vars")
) )
To remove an element from the dropped list, one option is to create a “bin” area by using the JavaScript code:
this.el.removeChild(evt.item);
Then add to this JavaScript to the onAdd
element of
sortable_options()
. To pass your JavaScript code to R, use
the htmlwidgets::JS()
function:
sortable_js(
"sortable_bin",
options = sortable_options(
group = list(
group = "sortGroup1",
put = TRUE,
pull = TRUE
),onAdd = htmlwidgets::JS("function (evt) { this.el.removeChild(evt.item); }")
) )
And the full code:
## Example shiny app to demonstrate cloning and other sortable_options
library(shiny)
library(htmlwidgets)
library(sortable)
library(magrittr)
<- function(x){
icon_list lapply(
x,function(x) {
$div(
tagsicon("arrows-alt-h"),
$strong(x)
tags
)
}
)
}
<- fluidPage(
ui fluidRow(
class = "panel panel-heading",
div(
class = "panel-heading",
h3("Illustration of sortable_options()")
),fluidRow(
class = "panel-body",
column(
width = 4,
$div(
tagsclass = "panel panel-default",
$div(
tagsclass = "panel-heading",
icon("arrow-right"),
"Drag from here (items will clone)"
),$div(
tagsclass = "panel-body",
id = "sort1",
icon_list(c(
"A",
"B",
"C",
"D",
"E"
))
)
)
),column(
width = 4,
# analyse as x
$div(
tagsclass = "panel panel-default",
$div(
tagsclass = "panel-heading",
icon("exchange"),
"To here(max 3 items)"
),$div(
tagsclass = "panel-body",
id = "sort2"
)
),# analyse as y
$div(
tagsclass = "panel panel-default",
$div(
tagsclass = "panel-heading",
icon("exchange"),
"Or here"
),$div(
tagsclass = "panel-body",
id = "sort3"
)
)
),column(
width = 4,
# bin
$div(
tagsclass = "panel panel-default",
$div(
tagsclass = "panel-heading",
icon("trash"),
"Remove item"
),$div(
tagsclass = "panel-body",
id = "sortable_bin"
)
)
)
)
),sortable_js(
"sort1",
options = sortable_options(
group = list(
pull = "clone",
name = "sortGroup1",
put = FALSE
),# swapClass = "sortable-swap-highlight",
onSort = sortable_js_capture_input("sort_vars")
)
),sortable_js(
"sort2",
options = sortable_options(
group = list(
group = "sortGroup1",
put = htmlwidgets::JS("function (to) { return to.el.children.length < 3; }"),
pull = TRUE
),swapClass = "sortable-swap-highlight",
onSort = sortable_js_capture_input("sort_x")
)
),sortable_js(
"sort3",
options = sortable_options(
group = list(
group = "sortGroup1",
put = TRUE,
pull = TRUE
),swapClass = "sortable-swap-highlight",
onSort = sortable_js_capture_input("sort_y")
)
),sortable_js(
"sortable_bin",
options = sortable_options(
group = list(
group = "sortGroup1",
put = TRUE,
pull = TRUE
),onAdd = htmlwidgets::JS("function (evt) { this.el.removeChild(evt.item); }")
)
)
)
<- function(input, output) {
server $variables <- renderPrint(input[["sort_vars"]])
output$analyse_x <- renderPrint(input[["sort_x"]])
output$analyse_y <- renderPrint(input[["sort_y"]])
output
<- reactive({
x <- input$sort_x
x if (is.character(x)) x %>% trimws()
})
<- reactive({
y $sort_y %>% trimws()
input
})
}shinyApp(ui, server)