Search code examples
rshinyshinywidgets

Adding colored dots on selectInput widget dropdown options

I have a selectInput widget which allows multiple inputs to be selected. I want to add a small colored dot on each select option so as to multipurpose it as a legend for the corresponding plot generated based on the inputs.

selectInput("selectedSensors", "Select Climatic Condition(s) :",
                choices = c("Temperature" = "5a",
                  "Relative Humidity" = "5b",
                  "Pressure" = "5c",
                  "Mass Density of Particles in air (diam < 2.5μm)" = "0a",
                  "Mass Density of Particles in air (diam < 10μm)" = "0b",
                  "Wind Speed" = "6"), multiple = TRUE,
                selected = c("5b", "5a", "6"))

I tried following this approach but since I don't have existing images to use I don't think it's suitable for my need. I also tried out inserting a circle icon icon("circle") on each dropdown option which I then wanted to try to color, but couldn't manage to do so.

Solution

  • enter image description here

    library(shiny)

shinyApp(
  ui = fluidPage(
    selectizeInput(
      "variable", "Variable:",
      choices = 
        c("<span style='color:red;font-size:30px;vertical-align:bottom'>&bull;</span>&nbsp;Cylinders" = "cyl",
          "<span style='color:green;font-size:30px;vertical-align:bottom'>&bull;</span>&nbsp;Transmission" = "am",
          "<span style='color:blue;font-size:30px;vertical-align:bottom'>&bull;</span>&nbsp;Gears" = "gear"),
      options = list(render = I("
      {
        item:   function(item, escape) { return '<div>' + item.label + '</div>'; },
        option: function(item, escape) { return '<div>' + item.label + '</div>'; }
      }
    "))
    ),
    tableOutput("data")
  ),
  server = function(input, output) {
    output$data <- renderTable({
      mtcars[, c("mpg", input$variable), drop = FALSE]
    }, rownames = TRUE)
  }
)