input-colors: Picker input to select color(s) or palette

In esquisse: Explore and Visualize Your Data Interactively

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

esquisse documentation built on Sept. 18, 2024, 5:09 p.m.