In running the below MWE code, the user drags items from the panel on the left to the panel on the right. Note that as items are dragged from the left "Drag from" panel, that list depletes. Is it possible to make those list elements (defined in labels = c(...)
in the first add_rank_list()
function below) reactive, so that the list is never depleted, always containing A, B, C, D, E in this example, regardless of how many times the item has been dragged over? In other words, ever time the user drags an item to the right, an observer is triggered and that same list of A, B, C, D, E is generated again?
This is similar to the cloning feature available in the sortable package, except that I understand cloning can't be used with this far simpler bucket_list(add_rank_list(...))
syntax.
MWE:
library(shiny)
library(sortable)
ui <- fluidPage(htmlOutput("rankingForm"))
server <- function(input, output, session) {
output$rankingForm <- renderUI({
fluidRow(
br(),
column(tags$b("Ranking"), width = 12,
bucket_list(header = "Drag items to the right panel:",
group_name = "bucket_list_group", orientation = "horizontal",
add_rank_list("Drag from Pool:",
labels = c("A","B","C","D","E"), # make labels reactive?
input_id = "rank_list_1"),
add_rank_list("Drag to:", labels = NULL,
input_id = "rank_list_2"))
)
)
})
}
shinyApp(ui=ui, server=server)
After further research, it seems that the cloning feature can't be used with the simplified functions bucket_list(add_rank_list(...))
, but must currently be used with sortable_js(...)
. A change to allow this feature in the simpler code has been requested of the sortable package developer, see vladimir_orbucina request at https://github.com/rstudio/sortable/issues/45.
Nevertheless through related posts listed below, the StackOverflow user base has been kind enough to guide me through sortable_js()
features that resolve the question. See "Working solution code" at the bottom.
Related solution posts: How to pull list elements from HTML/CSS and into an R data frame? and Any creative ways to add rank ordering numbering to this simple sortable package example?
And an important link explaining cloning: https://rstudio.github.io/sortable/articles/cloning.html
Working solution code:
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)