Reputation: 712
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.
Upvotes: 0
Views: 583
Reputation: 84649
library(shiny)
shinyApp(
ui = fluidPage(
selectizeInput(
"variable", "Variable:",
choices =
c("<span style='color:red;font-size:30px;vertical-align:bottom'>•</span> Cylinders" = "cyl",
"<span style='color:green;font-size:30px;vertical-align:bottom'>•</span> Transmission" = "am",
"<span style='color:blue;font-size:30px;vertical-align:bottom'>•</span> 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)
}
)
Upvotes: 1