下拉式复选框输入闪亮 [英] drop-down checkbox input in shiny

问题描述

可以在Shiny中有一个下拉列表，您可以在其中选择多个值吗？我知道 selectInput 可以选择设置 multiple = T 但我不喜欢所有选择的选项都可见在屏幕上，特别是因为我有40以上。同样适用于 checkboxGroupInput（），我喜欢更多，但仍显示所有选定的值。不可能像下面的Excel那样复制下拉菜单，而不是像Shinys selectInput 和 checkboxGroupInput（ ）此后？

解决方案

您好，我写了这个 dropdownButton 函数一次，它创建一个引导下拉按钮文档

以下是代码：

 ＃func --------------------------------- ----------------------------------- 
 
 dropdownButton<  -  function（label =，status = c（default，primary，success，info，warning，danger），...，width = NULL）{
 
状态<  -  match.arg（status）
＃下拉按钮内容
 html_ul<  - 列表（
 class =dropdown-menu，
 style = if .nu​​ll（width））
 paste0（width：，validateCssUnit（width），;），
 lapply（X = list（...），FUN = tags $ li，style = margin-left：10px; margin-right：10px;）
）
＃下拉按钮apparence 
 html_button<  - 列表（
 class = paste0（btn btn-，status切换），
 type =button，
`data-toggle`=dropdown
）
 html_button<  -  c（html_button，list（label））
 html_button<  -  c（html_button，list（tags $ span（class =caret）））
＃最终结果
标签$ div（
 class =dropdown 
 do.call（tags $ button，html_button），
 do.call（tags $ ul，html_ul），
标签$ script（
$（'。下拉菜单'）.click（function（e）{
 e.stopPropagation（）; 
}）;）
）
} 
  

另一个例子：

 ＃app  - -------------------------------------------------- ----------------- 
 
库（闪亮）
 ui<  -  fluidPage（
标签$ h1（示例下拉按钮），
 br（），
 fluidRow（
列（
 width = 6，
 dropdownButton（
 label =检查一些框，status =default，width = 80，
 checkboxGroupInput（inputId =check1，label =选择，选择=粘贴（1:26，）选择，LETTERS ）
），
 verbatimTextOutput（outputId =res1）
），
列（
 width = 6，
 dropdownButton（
 label =检查一些框，status =default，width = 80，
 actionButton（inputId =a2z，label =将A排序为Z，图标= icon（sort-alpha-asc ）），
 actionButton（inputId =z2a，label =排序Z到A，图标=图标（sort-alpha-desc）），
 br（），
 actionButton（inputId =all，label =（Un）select all），
 checkboxGroupInput（inputId =check2，label =Choose，choices = paste（1:26，） B 
 
 verbatimTextOutput（outputId =res2）
）
）
）
服务器<  - 函数（输入，输出，会话）{
输出$ res1<  -  renderPrint（{
 input $ check1 
}）
 
＃排序asc 
 observeEvent（输入$ a2z，{
 updateCheckboxGroupInput（
 session = session，inputId =check2，choices =粘贴（1:26，）选择，LETTERS），selected = input $ check2 
）
}）
＃排序desc 
 observeEvent（输入$ z2a，{
 updateCheckboxGroupInput（
 session = session，inputId =check2，choices = paste（26：1，）选择，rev（LETTERS）），selected = input $ check2 
）
}）
输出$ res2<  -  renderPrint（{
输入$ check2 
}）
＃选择全部/取消选择所有
 observeEvent（输入$ all， 
 if（is.null（input $ check2））{
 updateCheckboxGroupInput（
 session = session，inputId =check2，selected = paste（1:26，）选择，LETTERS ）
）
} else {
 updateCheckboxGroupInput（
 session = session，inputId =check2，selected =
）
} 
}）
} 
 shinyApp（ui = ui，server = s erver）
  

在奖金中，我将升序/降序排序的东西放在第二个下拉按钮中。

EDIT Mar 22 '16

要将您的复选框分成多个列，您可以用 fluidRow 和列和多个复选框分开，只需要绑定服务器端的值即可。
要实现滚动，将您的复选框放入具有 style ='overflow-y：scroll;高度：200px;'。

看这个例子：

 
 
 $ b标签$ h1（示例下拉按钮），
 br（），
 fluidRow（
 column（
 width = 6，
 dropdownButton（
 label =Check some boxes，status =default，width = 450，
 tags $标签（Choose：），
 fluidRow（
列（
 width = 4，
 checkboxGroupInput（inputId =check1a，label = NULL，choices = paste0（1： 10，），LETTERS [1:10]））
），
列（
 width = 4，
 checkboxGroupInput（inputId =check1b，label = choices = paste0（11:20，），LETTERS [11:20]））
），
列（
 width = 4，
 checkboxGroupInput（inputId =check1c ，label = NULL，choices = paste0（21:26，），LETTERS [21:26]））
）
）
），
 verbatimTextOutput（outputId =res1）
），
列（
 width = 6，
标签$ style（。container {border：2px solid steelblue;宽度：100％; height：200px; overflow-y：scroll; } $）
 dropdownButton（
 label =检查一些框，status =default，width = 120，
标签$ div（
 class =container 
 checkboxGroupInput（inputId =check2，label =Choose，choices = paste0（1:26，），LETTERS））
）
），
 verbatimTextOutput outputId =res2）
）
）
）
服务器<  - 函数（输入，输出，会话）{
 
 valuesCheck1 < reactiveValues（x = NULL）
 observeEvent（输入$ check1a，valuesCheck1 $ x < -  unique（c（valuesCheck1 $ x，input $ check1a）））
 observeEvent（input $ check1b，valuesCheck1 $ x< ;  -  unique（c（valuesCheck1 $ x，input $ check1b）））
 observeEvent（输入$ check1c，valuesCheck1 $ x < -  unique（c（valuesCheck1 $ x，input $ check1c）））
 
输出$ res1<  -  renderPrint（{
 valuesCheck1 $ x 
}）
 
输出$ res2<  -  renderPrint（{
 input $ check2 
}）
 
} 
 shinyApp（ui = ui，server = server）
  

编辑4月12日'17

我把这个函数（和其他）放在一个包中： shinyWidgets

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?

解决方案

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)

EDIT Apr 12 '17

I put this function (and others) in a package : shinyWidgets

这篇关于下拉式复选框输入闪亮的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！