如何使可排序包 add_rank_list 函数中的标签具有反应性?
How to make the label in the sortable package add_rank_list function reactive?
在下面的 运行 MWE 代码中,用户将项目从左侧面板拖到右侧面板。请注意,当从左侧的“拖动自”面板中拖动项目时,该列表会耗尽。是否可以使那些列表元素(在下面第一个 add_rank_list()
函数中的 labels = c(...)
中定义)具有反应性,以便列表永远不会耗尽,始终包含 A、B、C、D、E例如,无论项目被拖过多少次?换句话说,每当用户向右拖动一个项目时,就会触发观察者并再次生成相同的 A、B、C、D、E 列表?
这类似于 sortable 包中可用的克隆功能,除了我知道克隆不能用于这种更简单的 bucket_list(add_rank_list(...))
语法。
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)
经过进一步研究,克隆功能似乎不能与简化函数bucket_list(add_rank_list(...))
一起使用,但目前必须与sortable_js(...)
一起使用。已请求 sortable 包开发人员更改以允许在更简单的代码中使用此功能,请参阅 https://github.com/rstudio/sortable/issues/45 处的 vladimir_orbucina 请求。
尽管如此,通过下面列出的相关帖子,Whosebug 用户群非常友好地指导我使用 sortable_js()
功能来解决问题。请参阅底部的“工作解决方案代码”。
相关解决方案帖子:
和
还有一个重要的 link 解释克隆:https://rstudio.github.io/sortable/articles/cloning.html
工作解决方案代码:
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)
在下面的 运行 MWE 代码中,用户将项目从左侧面板拖到右侧面板。请注意,当从左侧的“拖动自”面板中拖动项目时,该列表会耗尽。是否可以使那些列表元素(在下面第一个 add_rank_list()
函数中的 labels = c(...)
中定义)具有反应性,以便列表永远不会耗尽,始终包含 A、B、C、D、E例如,无论项目被拖过多少次?换句话说,每当用户向右拖动一个项目时,就会触发观察者并再次生成相同的 A、B、C、D、E 列表?
这类似于 sortable 包中可用的克隆功能,除了我知道克隆不能用于这种更简单的 bucket_list(add_rank_list(...))
语法。
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)
经过进一步研究,克隆功能似乎不能与简化函数bucket_list(add_rank_list(...))
一起使用,但目前必须与sortable_js(...)
一起使用。已请求 sortable 包开发人员更改以允许在更简单的代码中使用此功能,请参阅 https://github.com/rstudio/sortable/issues/45 处的 vladimir_orbucina 请求。
尽管如此,通过下面列出的相关帖子,Whosebug 用户群非常友好地指导我使用 sortable_js()
功能来解决问题。请参阅底部的“工作解决方案代码”。
相关解决方案帖子:
还有一个重要的 link 解释克隆:https://rstudio.github.io/sortable/articles/cloning.html
工作解决方案代码:
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)