[英]How to add an accumulating rank order number to a reactive data frame (or list) in r shiny?
下面的可重现代码适用于将元素从一个面板拖动到另一个面板,并在“拖动到”面板中自动使用 HTML/CSS 对拖动的每个元素进行排序编号。
我现在正试图将这些拖动的元素引导到数据框(列表)中,以进行进一步的构建操作。 因此在下面的代码中呈现了Table1
。
我试图在输出数据框中模仿(或更好地复制)在“拖动到”面板中通过 HTML 生成的排名顺序编号。 在下面的代码中,您可以在我定义反应性对象dragToLabels
的server
部分中看到我的失败尝试,并在 for 循环中尝试计算元素的数量。
底部的图像更好地解释了。
我如何将排名顺序编号添加(或复制)到该输出数据帧?
可重现的代码:
library(shiny)
library(sortable)
library(htmlwidgets)
icons <- function(x) {lapply(x,function(x){tags$div(tags$strong(x))})}
ui <- fluidPage(
tags$head(
tags$style(HTML('
#dragTo {list-style-type: none; counter-reset: css-counter 0;}
#dragTo > div {counter-increment: css-counter 1;}
#dragTo > 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 = "dragFrom",
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 = "dragTo"
)
)
)
),
sortable_js(
"dragFrom",
options = sortable_options(
group = list(
pull = "clone",
name = "group1",
put = FALSE
)
)
),
sortable_js(
"dragTo",
options = sortable_options(
group = list(
group = "group1",
put = TRUE,
pull = TRUE
),
onSort = sortable_js_capture_input(input_id = "selected")
)
),
helpText(h5(strong("Output to table:"))),
tableOutput("table1")
)
server <- function(input, output) {
dragToLabels <- reactive({
s <- input$selected
label = NULL
for (i in s)
label <- c(label, paste(length(input$selected), i, sep = " . "))
label
})
output$table1 <- renderTable({dragToLabels()})
}
shinyApp(ui, server)
插图:
我们可以简单地使用paste0
并从结果中创建一个data.frame
:
library(shiny)
library(sortable)
library(htmlwidgets)
icons <- function(x) {lapply(x,function(x){tags$div(tags$strong(x))})}
ui <- fluidPage(
tags$head(
tags$style(HTML('
#dragTo {list-style-type: none; counter-reset: css-counter 0;}
#dragTo > div {counter-increment: css-counter 1;}
#dragTo > 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 = "dragFrom",
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 = "dragTo"
)
)
)
),
sortable_js(
"dragFrom",
options = sortable_options(
group = list(
pull = "clone",
name = "group1",
put = FALSE
)
)
),
sortable_js(
"dragTo",
options = sortable_options(
group = list(
group = "group1",
put = TRUE,
pull = TRUE
),
onSort = sortable_js_capture_input(input_id = "selected")
)
),
helpText(h5(strong("Output to table:"))),
tableOutput("table1")
)
server <- function(input, output) {
dragToLabels <- reactive({
data.frame(data = paste0(seq_along(input$selected), ". ", input$selected))
})
output$table1 <- renderTable({dragToLabels()})
}
shinyApp(ui, server)
作为替代方案,您可以使用DT::datatable
和DT::renderDT()
默认显示行号:
library(DT)
library(shiny)
library(sortable)
library(htmlwidgets)
icons <- function(x) {lapply(x,function(x){tags$div(tags$strong(x))})}
ui <- fluidPage(
tags$head(
tags$style(HTML('
#dragTo {list-style-type: none; counter-reset: css-counter 0;}
#dragTo > div {counter-increment: css-counter 1;}
#dragTo > 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 = "dragFrom",
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 = "dragTo"
)
)
)
),
sortable_js(
"dragFrom",
options = sortable_options(
group = list(
pull = "clone",
name = "group1",
put = FALSE
)
)
),
sortable_js(
"dragTo",
options = sortable_options(
group = list(
group = "group1",
put = TRUE,
pull = TRUE
),
onSort = sortable_js_capture_input(input_id = "selected")
)
),
helpText(h5(strong("Output to table:"))),
fluidRow(column(3, DTOutput("table1")))
)
server <- function(input, output) {
dragToLabels <- reactive({
data.frame(data = input$selected)
})
output$table1 <- renderDT({dragToLabels()})
}
shinyApp(ui, server)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.