问题描述
是否可以在 Shiny 中有一个下拉列表,您可以在其中选择多个值?我知道 selectInput
有设置 multiple = T
的选项,但我不喜欢所有选定的选项都在屏幕上可见,特别是因为我已经超过 40.checkboxGroupInput()
也是如此,我更喜欢它,但仍然显示所有选定的值.是不是只能得到一个像我下面从 Excel 复制的下拉菜单,而不是之后的 Shinys selectInput
和 checkboxGroupInput()
的例子?
EDIT :此功能(和其他功能)在
代码如下:
# func --------------------------------------------------------------------dropdownButton <- function(label = "", status = c("default", "primary", "success", "info", "warning", "danger"), ..., width = NULL) {状态 <- match.arg(status)# 下拉按钮内容html_ul
还有一个例子:
# app ---------------------------------------------------------------------图书馆(闪亮")ui
作为奖励,我将升序/降序排序放在第二个下拉按钮中.
编辑 2016 年 3 月 22 日
要将您的复选框拆分为多列,您可以使用
fluidRow
和 columns
和多个复选框自己进行拆分,您只需绑定服务器端的值.要实现滚动,请将复选框放入带有 style='overflow-y: scroll; 的 div 中.高度:200px;'
.
看看这个例子:
图书馆(闪亮")ui
Is it possible to have a dropdown list in Shiny where you can select multiple values? I know
selectInput
has the option to set multiple = T
but I don't like it that all selected option are visible in the screen, especially since I have over 40. The same holds for checkboxGroupInput()
, which I like more but still all selected values are shown. Isn't it just possible to get a drop-down like the one I copied from Excel below, rather than the examples of Shinys selectInput
and checkboxGroupInput()
thereafter?
解决方案
EDIT : This function (and others) is available in package
shinyWidgets
Hi I wrote this
dropdownButton
function once, it create a bootstrap dropdown button (doc here), the results looks like :
Here is the code :
# func --------------------------------------------------------------------
dropdownButton <- function(label = "", status = c("default", "primary", "success", "info", "warning", "danger"), ..., width = NULL) {
status <- match.arg(status)
# dropdown button content
html_ul <- list(
class = "dropdown-menu",
style = if (!is.null(width))
paste0("width: ", validateCssUnit(width), ";"),
lapply(X = list(...), FUN = tags$li, style = "margin-left: 10px; margin-right: 10px;")
)
# dropdown button apparence
html_button <- list(
class = paste0("btn btn-", status," dropdown-toggle"),
type = "button",
`data-toggle` = "dropdown"
)
html_button <- c(html_button, list(label))
html_button <- c(html_button, list(tags$span(class = "caret")))
# final result
tags$div(
class = "dropdown",
do.call(tags$button, html_button),
do.call(tags$ul, html_ul),
tags$script(
"$('.dropdown-menu').click(function(e) {
e.stopPropagation();
});")
)
}
And an example :
# app ---------------------------------------------------------------------
library("shiny")
ui <- fluidPage(
tags$h1("Example dropdown button"),
br(),
fluidRow(
column(
width = 6,
dropdownButton(
label = "Check some boxes", status = "default", width = 80,
checkboxGroupInput(inputId = "check1", label = "Choose", choices = paste(1:26, ") Choice ", LETTERS))
),
verbatimTextOutput(outputId = "res1")
),
column(
width = 6,
dropdownButton(
label = "Check some boxes", status = "default", width = 80,
actionButton(inputId = "a2z", label = "Sort A to Z", icon = icon("sort-alpha-asc")),
actionButton(inputId = "z2a", label = "Sort Z to A", icon = icon("sort-alpha-desc")),
br(),
actionButton(inputId = "all", label = "(Un)select all"),
checkboxGroupInput(inputId = "check2", label = "Choose", choices = paste(1:26, ") Choice ", LETTERS))
),
verbatimTextOutput(outputId = "res2")
)
)
)
server <- function(input, output, session) {
output$res1 <- renderPrint({
input$check1
})
# Sorting asc
observeEvent(input$a2z, {
updateCheckboxGroupInput(
session = session, inputId = "check2", choices = paste(1:26, ") Choice ", LETTERS), selected = input$check2
)
})
# Sorting desc
observeEvent(input$z2a, {
updateCheckboxGroupInput(
session = session, inputId = "check2", choices = paste(26:1, ") Choice ", rev(LETTERS)), selected = input$check2
)
})
output$res2 <- renderPrint({
input$check2
})
# Select all / Unselect all
observeEvent(input$all, {
if (is.null(input$check2)) {
updateCheckboxGroupInput(
session = session, inputId = "check2", selected = paste(1:26, ") Choice ", LETTERS)
)
} else {
updateCheckboxGroupInput(
session = session, inputId = "check2", selected = ""
)
}
})
}
shinyApp(ui = ui, server = server)
In bonus I put the ascending/descending sorting thingy in the second dropdown buttons.
EDIT Mar 22 '16
To split yours checkboxes into multiple columns you can do the split yourself with
fluidRow
and columns
and multiples checkboxes, you just have to bind the values server-side.To implement scrolling put your checkboxes into a div with style='overflow-y: scroll; height: 200px;'
.
Look at this example :
library("shiny")
ui <- fluidPage(
tags$h1("Example dropdown button"),
br(),
fluidRow(
column(
width = 6,
dropdownButton(
label = "Check some boxes", status = "default", width = 450,
tags$label("Choose :"),
fluidRow(
column(
width = 4,
checkboxGroupInput(inputId = "check1a", label = NULL, choices = paste0(1:10, ") ", LETTERS[1:10]))
),
column(
width = 4,
checkboxGroupInput(inputId = "check1b", label = NULL, choices = paste0(11:20, ") ", LETTERS[11:20]))
),
column(
width = 4,
checkboxGroupInput(inputId = "check1c", label = NULL, choices = paste0(21:26, ") ", LETTERS[21:26]))
)
)
),
verbatimTextOutput(outputId = "res1")
),
column(
width = 6,
tags$style(".container { border:2px solid steelblue; width: 100%; height: 200px; overflow-y: scroll; }"),
dropdownButton(
label = "Check some boxes", status = "default", width = 120,
tags$div(
class = "container",
checkboxGroupInput(inputId = "check2", label = "Choose", choices = paste0(1:26, ") ", LETTERS))
)
),
verbatimTextOutput(outputId = "res2")
)
)
)
server <- function(input, output, session) {
valuesCheck1 <- reactiveValues(x = NULL)
observeEvent(input$check1a, valuesCheck1$x <- unique(c(valuesCheck1$x, input$check1a)))
observeEvent(input$check1b, valuesCheck1$x <- unique(c(valuesCheck1$x, input$check1b)))
observeEvent(input$check1c, valuesCheck1$x <- unique(c(valuesCheck1$x, input$check1c)))
output$res1 <- renderPrint({
valuesCheck1$x
})
output$res2 <- renderPrint({
input$check2
})
}
shinyApp(ui = ui, server = server)
这篇关于闪亮的下拉复选框输入的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!