Выпадающий флажок ввода в блестящий

Ответ 1

Привет, я написал эту функцию dropdownButton один раз, создав кнопку выпадающего списка бутстрапов (doc здесь), результаты выглядят так:

Вот код:

# 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();
});")
  )
  }

И пример:

# 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)

В бонусе я помещаю сортировку по возрастанию/убыванию во второй раскрывающийся список.

EDIT Mar 22 '16

Чтобы разделить ваши флажки на несколько столбцов, вы можете сделать разделение на fluidRow и columns и умножить флажки, вам просто нужно привязать значения на стороне сервера. Чтобы реализовать прокрутку, поставьте флажки в div с помощью style='overflow-y: scroll; height: 200px;'.

Посмотрите на этот пример:

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)

РЕДАКТИРОВАТЬ Апр 12 '17

Я помещал эту функцию (и другие) в пакет: shinyWidgets

Ответ 2

Во-первых, большое спасибо за эту функцию dropdownButton. Это очень полезно!

Во-вторых, я попытался использовать его в блестящей панели sidebarmenu, но стиль символов по умолчанию - "цвет: белый" (из-за темного фона). Это занимает у меня пару часов, чтобы понять, что можно изменить внутри вашей функции, более точно в html_ul. Здесь интересующая строка, с цветом: черный:

lapply(X = list(...), FUN = tags$li, style = "margin-left: 10px; margin-right: 10px; color:black")

Довольно просто... Но когда вы этого не знаете (R - единственный язык, который я знаю)... Итак, я надеюсь, что это поможет любому другому css-невежественному (и/или HTML?), как я!

Ура!

Ответ 3

Есть несколько вопросов в комментариях, связанных с dropdownButton (отлично работал у меня, спасибо) о том, как создать прокрутку в раскрывающемся списке. Извините, у меня нет репутации, чтобы отвечать в комментариях напрямую.

Попробуйте настроить соответствующий идентификатор в ваших styles.css, для любого объекта, который вы разместили в dropdownButton. Таким образом, для примера, checkboxGroupInput ID должен иметь:

#check1
{
   height: 200px;
   overflow: auto;
}

Edit:

Чтобы вызвать styles.css в файле ui.R:

navbarPage("Superzip", id="nav",

  tabPanel("Interactive map",
    div(class="outer",

      tags$head(
        # Include our custom CSS
        includeCSS("styles.css")
      ),

      leafletOutput("map", width="100%", height="100%"), 
      ...

И styles.css, с автоматическим переполнением для inputID ttype и chain:

input[type="number"] {


max-width: 80%;
}

div.outer {
  position: fixed;
  top: 41px;
  left: 0;
  right: 0;
  bottom: 0;
  overflow: hidden;
  padding: 0;
}

/* Customize fonts */
body, label, input, button, select { 
  font-family: 'Helvetica Neue', Helvetica;
  font-weight: 200;
}
h1, h2, h3, h4 { font-weight: 400; }

#controls {
  /* Appearance */
  background-color: white;
  padding: 0 20px 20px 20px;
  cursor: move;
  /* Fade out while not hovering */
  opacity: 0.65;
  zoom: 0.9;
  transition: opacity 500ms 1s;
}
#controls:hover {
  /* Fade in while hovering */
  opacity: 0.95;
  transition-delay: 0;
}

#data_inputs {
  /* Appearance */
  background-color: white;
  padding: 0 20px 20px 20px;
  cursor: move;
  /* Fade out while not hovering */
  opacity: 0.65;
  zoom: 0.9;
  transition: opacity 500ms 1s;
}
#data_inputs:hover {
  /* Fade in while hovering */
  opacity: 0.95;
  transition-delay: 0;
}

/* Position and style citation */
#cite {
  position: absolute;
  bottom: 10px;
  left: 10px;
  font-size: 12px;
}

#cite {
  position: absolute;
  bottom: 10px;
  left: 10px;
  font-size: 12px;
}

#ttype
{
   height: 200px;
   overflow: auto;
}

#chain
{
   height: 200px;
   overflow: auto;
}



."form-group shiny-input-checkboxgroup shiny-input-container"
{
   height: 50px;
   overflow: auto;
}

/* If not using map tiles, show a white background */
.leaflet-container {
  background-color: white !important;
}