input-colors {esquisse}

Picker input to select color(s) or palette

Description

Select menu to view and choose a color or a palette of colors.

Usage

colorPicker(
  inputId,
  label,
  choices,
  selected = NULL,
  textColor = "#000",
  plainColor = FALSE,
  multiple = FALSE,
  pickerOpts = list(),
  width = NULL
)

updateColorPicker(
  session = getDefaultReactiveDomain(),
  inputId,
  choices,
  textColor = "#000",
  plainColor = FALSE,
  multiple = FALSE
)

palettePicker(
  inputId,
  label,
  choices,
  selected = NULL,
  textColor = "#000",
  plainColor = FALSE,
  pickerOpts = list(),
  width = NULL
)

updatePalettePicker(
  session = getDefaultReactiveDomain(),
  inputId,
  choices,
  selected = NULL,
  textColor = "#000",
  plainColor = FALSE
)

Arguments

inputId

The input slot that will be used to access the value.

label

Display label for the control, or NULL for no label.

choices

List of values to select from. Values must be valid Hex colors. If elements of the list are named then that name rather than the value is displayed to the user.

selected

The initially selected value (or multiple values if multiple = TRUE). If not specified then defaults to the first value for single-select lists and no values for multiple select lists.

textColor

Color of the text displayed above colors, can be a vector of the same length as choices.

plainColor

Color the full space of the choice menu.

multiple

Is selection of multiple items allowed?

pickerOpts

Options for pickerInput.

width

The width of the input : 'auto', 'fit', '100px', '75%'.

session

Shiny session.

Value

A select control that can be added to a UI definition.

Examples

# colorPicker -------------------------------------------------------------

library(shiny)
library(esquisse)
library(scales)


ui <- fluidPage(
  tags$h2("colorPicker examples"),
  fluidRow(
    column(
      width = 3,
      colorPicker(
        inputId = "col1",
        label = "With a vector of colors:",
        choices = brewer_pal(palette = "Dark2")(8)
      ),
      verbatimTextOutput("res1"),
      colorPicker(
        inputId = "col5",
        label = "Update colors:",
        choices = brewer_pal(palette = "Blues", direction = -1)(8),
        textColor = "#FFF"
      ),
      verbatimTextOutput("res5"),
      radioButtons(
        "update", "Colors", c("Blues", "Greens", "Reds"),
        inline = TRUE
      )
    ),
    column(
      width = 3,
      colorPicker(
        inputId = "col2",
        label = "Change text color:",
        choices = brewer_pal(palette = "Blues")(8), 
        textColor = c("black", "black", "black", "white",
                      "white", "white", "white", "white")
      ),
      verbatimTextOutput("res2")
    ),
    column(
      width = 3,
      colorPicker(
        inputId = "col3",
        label = "With a list of vector of colors:",
        choices = list(
          "Blues" = brewer_pal(palette = "Blues")(8),
          "Reds" = brewer_pal(palette = "Reds")(8),
          "Greens" = brewer_pal(palette = "Greens")(8)
        )
      ),
      verbatimTextOutput("res3")
    ),
    column(
      width = 3,
      colorPicker(
        inputId = "col4",
        label = "Plain color & multiple choices:",
        choices = brewer_pal(palette = "Paired")(8), 
        plainColor = TRUE, 
        multiple = TRUE, 
        pickerOpts = list(`selected-text-format`= "count > 3")
      ),
      verbatimTextOutput("res4")
    )
  )
)

server <- function(input, output, session) {
  
  output$res1 <- renderPrint(input$col1)
  output$res2 <- renderPrint(input$col2)
  output$res3 <- renderPrint(input$col3)
  output$res4 <- renderPrint(input$col4)
  output$res5 <- renderPrint(input$col5)
  
  observeEvent(input$update, {
    updateColorPicker(
      inputId = "col5",
      choices = brewer_pal(palette = input$update, direction = -1)(8),
      textColor = "#FFF"
    )
  })
  
}

if (interactive()) {
  shinyApp(ui, server)
}

# palettePicker -----------------------------------------------------------

library(shiny)
library(esquisse)
library(scales)

ui <- fluidPage(
  tags$h2("pickerColor examples"),
  
  fluidRow(
    column(
      width = 4,
      palettePicker(
        inputId = "pal1", 
        label = "Select a palette:", 
        choices = list(
          "Blues" = brewer_pal(palette = "Blues")(8),
          "Reds" = brewer_pal(palette = "Reds")(8)
        )
      ),
      verbatimTextOutput("res1"),
      palettePicker(
        inputId = "pal4", 
        label = "Update palette:", 
        choices = list(
          "Blues" = brewer_pal(palette = "Blues")(8),
          "Reds" = brewer_pal(palette = "Reds")(8)
        )
      ),
      verbatimTextOutput("res4"),
      radioButtons(
        "update", "Palettes:", c("default", "viridis", "brewer"),
        inline = TRUE
      )
    ),
    column(
      width = 4,
      palettePicker(
        inputId = "pal2", 
        label = "With a list of palette:", 
        choices = list(
          "Viridis" = list(
            "viridis" = viridis_pal(option = "viridis")(10),
            "magma" = viridis_pal(option = "magma")(10),
            "inferno" = viridis_pal(option = "inferno")(10),
            "plasma" = viridis_pal(option = "plasma")(10),
            "cividis" = viridis_pal(option = "cividis")(10)
          ),
          "Brewer" = list(
            "Blues" = brewer_pal(palette = "Blues")(8),
            "Reds" = brewer_pal(palette = "Reds")(8),
            "Paired" = brewer_pal(palette = "Paired")(8),
            "Set1" = brewer_pal(palette = "Set1")(8)
          )
        ), 
        textColor = c(
          rep("white", 5), rep("black", 4) 
        )
      ),
      verbatimTextOutput("res2")
    ),
    column(
      width = 4,
      palettePicker(
        inputId = "pal3", 
        label = "With plain colors:", 
        choices = list(
          "BrBG" = brewer_pal(palette = "BrBG")(8), 
          "PiYG" = brewer_pal(palette = "PiYG")(8), 
          "PRGn" = brewer_pal(palette = "PRGn")(8), 
          "PuOr" = brewer_pal(palette = "PuOr")(8), 
          "RdBu" = brewer_pal(palette = "RdBu")(8), 
          "RdGy" = brewer_pal(palette = "RdGy")(8), 
          "RdYlBu" = brewer_pal(palette = "RdYlBu")(8), 
          "RdYlGn" = brewer_pal(palette = "RdYlGn")(8), 
          "Spectral" = brewer_pal(palette = "Spectral")(8)
        ), 
        plainColor = TRUE, 
        textColor = "white"
      ),
      verbatimTextOutput("res3")
    )
  )
)

server <- function(input, output, session) {
  
  output$res1 <- renderPrint(input$pal1)
  output$res2 <- renderPrint(input$pal2)
  output$res3 <- renderPrint(input$pal3)
  output$res4 <- renderPrint(input$pal4)
  
  observeEvent(input$update, {
    if (input$update == "default") {
      updatePalettePicker(
        inputId = "pal4",
        choices = list(
          "Blues" = brewer_pal(palette = "Blues")(8),
          "Reds" = brewer_pal(palette = "Reds")(8)
        )
      )
    } else if (input$update == "viridis") {
      updatePalettePicker(
        inputId = "pal4",
        choices = list(
          "viridis" = viridis_pal(option = "viridis")(10),
          "magma" = viridis_pal(option = "magma")(10),
          "inferno" = viridis_pal(option = "inferno")(10),
          "plasma" = viridis_pal(option = "plasma")(10),
          "cividis" = viridis_pal(option = "cividis")(10)
        ),
        textColor = "#FFF"
      )
    } else if (input$update == "brewer") {
      updatePalettePicker(
        inputId = "pal4",
        choices = list(
          "Blues" = brewer_pal(palette = "Blues")(8),
          "Reds" = brewer_pal(palette = "Reds")(8),
          "Paired" = brewer_pal(palette = "Paired")(8),
          "Set1" = brewer_pal(palette = "Set1")(8)
        )
      )
    }
  })
}

if (interactive()) {
  shinyApp(ui, server)
}