闪亮的下拉复选框输入 [英] drop-down checkbox input in shiny
本文介绍了闪亮的下拉复选框输入的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
是否可以在 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 <- 列表(class = "下拉菜单",样式 = if (!is.null(width))paste0("width: ", validateCssUnit(width), ";"),lapply(X = list(...), FUN = tags$li, style = "margin-left: 10px; margin-right: 10px;"))# 下拉按钮外观html_button <- 列表(class = paste0("btn btn-", status," dropdown-toggle"),type = "按钮",`数据切换` =下拉")html_button <- c(html_button, list(label))html_button <- c(html_button, list(tags$span(class = "caret")))# 最后结果标签$div(类=下拉"，do.call(tags$button, html_button),do.call(tags$ul, html_ul),标签$脚本("$('.dropdown-menu').click(function(e) {e.stopPropagation();});"))}还有一个例子:
# app ---------------------------------------------------------------------图书馆(闪亮")ui <-流体页面(tags$h1("示例下拉按钮"),br(),流体行(柱子(宽度 = 6,下拉按钮(标签=检查一些框"，状态=默认"，宽度= 80，checkboxGroupInput(inputId = "check1", label = "Choose", options = paste(1:26, ") Choice ", LETTERS))),verbatimTextOutput(outputId = "res1")),柱子(宽度 = 6,下拉按钮(标签=检查一些框"，状态=默认"，宽度= 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", choice = paste(1:26, ") Choice ", LETTERS))),verbatimTextOutput(outputId = "res2"))))服务器 <- 功能(输入，输出，会话){输出$res1 <- renderPrint({输入$check1})# 按升序排序观察事件(输入$a2z，{更新复选框组输入(session = session, inputId = "check2", selection = paste(1:26, ") Choice ", LETTERS), selected = input$check2)})# 排序说明观察事件(输入$ z2a，{更新复选框组输入(session = session, inputId = "check2", options = paste(26:1, ") Choice ", rev(LETTERS)), selected = input$check2)})输出$res2 <- renderPrint({输入$check2})# 全选/取消全选观察事件(输入$全部，{如果 (is.null(input$check2)) {更新复选框组输入(session = session, inputId = "check2", selected = paste(1:26, ") Choice ", LETTERS))} 别的 {更新复选框组输入(session = session, inputId = "check2", selected = "")}})}闪亮应用(用户界面 = 用户界面，服务器 = 服务器)作为奖励，我将升序/降序排序放在第二个下拉按钮中.
编辑 2016 年 3 月 22 日
要将您的复选框拆分为多列，您可以使用 fluidRow 和 columns 和多个复选框自己进行拆分，您只需绑定服务器端的值.要实现滚动，请将复选框放入带有 style='overflow-y: scroll; 的 div 中.高度:200px;'.
看看这个例子:
图书馆(闪亮")ui <-流体页面(tags$h1("示例下拉按钮"),br(),流体行(柱子(宽度 = 6,下拉按钮(标签=检查一些框"，状态=默认"，宽度= 450，tags$label("选择:"),流体行(柱子(宽度 = 4,checkboxGroupInput(inputId = "check1a", label = NULL, selection = paste0(1:10, ") ", LETTERS[1:10]))),柱子(宽度 = 4,checkboxGroupInput(inputId = "check1b", label = NULL, selection = paste0(11:20, ") ", LETTERS[11:20]))),柱子(宽度 = 4,checkboxGroupInput(inputId = "check1c", label = NULL, selection = paste0(21:26, ") ", LETTERS[21:26]))))),verbatimTextOutput(outputId = "res1")),柱子(宽度 = 6,tags$style(".container { border:2px solid steelblue; width: 100%; height: 200px; overflow-y: scroll; }"),下拉按钮(标签=检查一些框"，状态=默认"，宽度= 120，标签$div(class = "容器",checkboxGroupInput(inputId = "check2", label = "Choose", options = paste0(1:26, ") ", LETTERS)))),verbatimTextOutput(outputId = "res2"))))服务器 <- 功能(输入，输出，会话){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)))输出$res1 <- renderPrint({值检查1$x})输出$res2 <- renderPrint({输入$check2})}闪亮应用(用户界面 = 用户界面，服务器 = 服务器)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)
这篇关于闪亮的下拉复选框输入的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
