groupCheckboxInput的组标题_R_Shiny

groupCheckboxInput的组标题

r shiny

groupCheckboxInput的组标题,r,shiny,R,Shiny,在shinywidgets:：pickerInput中，您可以将命名的数据列表（此处为nms）传递给pickerInput，以从列表中创建标题和选项例如： library(shiny) library(shinyWidgets) nms = list('Consumers' = c('a', 'b'), 'Firms' = c('c', 'd')) ui <- fluidPage( pickerInput( inputId = &quo

在

shinywidgets:：pickerInput

中，您可以将命名的数据列表（此处为

nms

）传递给

pickerInput

，以从列表中创建标题和选项

例如：

library(shiny)
library(shinyWidgets)
  
nms = list('Consumers' = c('a', 'b'), 
             'Firms' = c('c', 'd'))
  
ui <- fluidPage(
  pickerInput(
    inputId = "somevalue",
    label = "A label",
    choices = nms,
    selected = 'a',
    multiple=T
    ),
    verbatimTextOutput("value")
  )
  
server <- function(input, output) {
   output$value <- renderPrint(input$somevalue)
}
  
shinyApp(ui, server)

库（闪亮）
图书馆（shinyWidgets）
nms=列表（'Consumers'=c（'a'，'b'），
“公司”=c（'c'，'d'））
ui我查看了源代码并修改了awesomeCheckboxGroup
和底层函数generateAwesomeOptions
，使其正常工作。现在，我们可以使用命名列表（创建子标签）和未命名向量（生成普通复选框）。我们仍然可以对代码进行一些优化，我也不确定标签应该是什么样子。但基本上，您可以给它们一个特殊的类属性，然后使用CSS来更改标签的外观
library(shiny)
library(shinyWidgets)

generateAwesomeOptions2 <- function (inputId, choices, selected, inline, status, flag = FALSE) {

  # if input is a list, flag will be set to `TRUE` by the calling function
  if (flag) {

  options <-  mapply(choices, names(choices), FUN = function(lchoices, lname) {

    lchoices <- shinyWidgets:::choicesWithNames(lchoices)

    tags$div(
      tags$label(lname, style = "margin-bottom: 10px;"),

    mapply(lchoices, names(lchoices), FUN = function(value, name) {

    inputTag <- tags$input(type = "checkbox", name = inputId,
                           value = value, id = paste0(inputId, value))
    if (value %in% selected)
      inputTag$attribs$checked <- "checked"
    if (inline) {
      tags$div(class = paste0("awesome-checkbox checkbox-inline checkbox-",
                              status), inputTag, tags$label(name, `for` = paste0(inputId,
                                                                                 value)))
    }
    # flag is not set `TRUE` this will create the normal checkboxes
    else {
      tags$div(class = paste0("awesome-checkbox checkbox-",
                              status), inputTag, tags$label(name, `for` = paste0(inputId,
                                                                                 value)))
    }
  }, SIMPLIFY = FALSE, USE.NAMES = FALSE)
  )

  }, SIMPLIFY = FALSE, USE.NAMES = FALSE)} else {

    options <- mapply(choices, names(choices), FUN = function(value,
                                                              name) {
      inputTag <- tags$input(type = "checkbox", name = inputId,
                             value = value, id = paste0(inputId, value))
      if (value %in% selected)
        inputTag$attribs$checked <- "checked"
      if (inline) {
        tags$div(class = paste0("awesome-checkbox checkbox-inline checkbox-",
                                status), inputTag, tags$label(name, `for` = paste0(inputId,
                                                                                   value)))
      }
      else {
        tags$div(class = paste0("awesome-checkbox checkbox-",
                                status), inputTag, tags$label(name, `for` = paste0(inputId,
                                                                                   value)))
      }
    }, SIMPLIFY = FALSE, USE.NAMES = FALSE)


    }

  tags$div(class = "shiny-options-group", options)


}

awesomeCheckboxGroup2 <- function (inputId, label, choices, selected = NULL, inline = FALSE,
                                   status = "primary", width = NULL) {
  if(!is.list(choices)) {

  choices <- shinyWidgets:::choicesWithNames(choices)
  selected <- shiny::restoreInput(id = inputId, default = selected)
  if (!is.null(selected))
    selected <- shinyWidgets:::validateSelected(selected, choices, inputId)
  options <- generateAwesomeOptions2(inputId, choices, selected,
                                     inline, status = status)

  } else {
    choices2 <- unlist(unname(choices))
    choices2 <- shinyWidgets:::choicesWithNames(choices2)
    selected <- shiny::restoreInput(id = inputId, default = selected)

    if (!is.null(selected))
      selected <- shinyWidgets:::validateSelected(selected, choices2, inputId)
    options <- generateAwesomeOptions2(inputId, choices, selected,
                                       inline, status = status, flag = TRUE)
  }

  divClass <- "form-group shiny-input-container shiny-input-checkboxgroup awesome-bootstrap-checkbox"
  if (inline)
    divClass <- paste(divClass, "shiny-input-container-inline")
  awesomeTag <- tags$div(id = inputId, style = if (!is.null(width))
    paste0("width: ", validateCssUnit(width), ";"), class = divClass,
    tags$label(label, `for` = inputId, style = "margin-bottom: 10px;"),
    options)
  shinyWidgets:::attachShinyWidgetsDep(awesomeTag, "awesome")
}


nms = list('Consumers' = c('a', 'b'),
           'Firms' = c('c', 'd'))

nms1 = c("Test", "Test2")

ui <- fluidPage(
  awesomeCheckboxGroup2(
    inputId = "somevalue",
    label = "Make a choice:",
    choices = nms
  ),
  verbatimTextOutput("value")
)

server <- function(input, output) {
  output$value <- renderPrint(input$somevalue)
}

shinyApp(ui, server)

库（闪亮）
图书馆（shinyWidgets）
GenerateAweSomeOptions 2我找不到awesomeCheckboxGroup
使用命名列表的示例。你有这样的例子吗？恐怕没有。考虑到pickerInput
和awesomeCheckboxGroup
是同一个包中的函数，这是一个奇怪的省略。两者基本上都在做相同的事情，只是UI不同而已。我可能不得不卷起袖子，比较这两种方法的源代码，看看它是否可以被破解。你只需做两个小部件A
和B
，然后使用一个反应变量reactive（c（input$A，input$B））
。在我的特定用例中，我不认为把列表压缩成一个单一的被动变量是可行的解决方案。我有一些下游代码，只允许用户选择3个或更少的复选框；当他们选择第四个选项时，它将取消选择他们的第三个选项。为此，我利用updateAwesomeCheckboxGroup
动态更新UI。如果我选中了许多复选框组，那么就很难跟踪取消选中复选框组的原因。这就是为什么我需要一个checkboxInput
。太棒了，非常感谢您花时间研究这个问题。我怀疑包作者会对PR感兴趣：